boot2

Playing with the boostrap
git clone https://git.ryansepassi.com/git/boot2.git
Log | Files | Refs | README

120-list-prims.scm (2855B)

      1 ; List-traversal primitives: assq, assoc, reverse.
      2 ; Locks down the prim contract that replaced the interpreted prelude
      3 ; defines (see docs/SCHEME1-LIST-PRIMS.md).
      4 
      5 ; ---- assq: eq? key compare ----
      6 
      7 (define al-sym (list (cons 'a 1) (cons 'b 2) (cons 'c 3)))
      8 
      9 ; hit
     10 (if (equal? (cons 'b 2) (assq 'b al-sym))   0 (sys-exit 1))
     11 (if (equal? (cons 'a 1) (assq 'a al-sym))   0 (sys-exit 2))
     12 (if (equal? (cons 'c 3) (assq 'c al-sym))   0 (sys-exit 3))
     13 
     14 ; miss
     15 (if (not (assq 'z al-sym))                   0 (sys-exit 4))
     16 
     17 ; empty
     18 (if (not (assq 'a (quote ())))               0 (sys-exit 5))
     19 
     20 ; identity preservation: assq returns the actual pair from the alist
     21 (let* ((p (cons 'k 99)) (al (list p)))
     22   (if (eq? p (assq 'k al))                   0 (sys-exit 6)))
     23 
     24 ; assq with bv keys -- distinct bv objects with same contents are NOT
     25 ; eq?, so a freshly-built lookup key must miss.
     26 (if (not (assq "foo" (list (cons "foo" 1)))) 0 (sys-exit 7))
     27 
     28 ; ---- assoc: equal? key compare ----
     29 
     30 ; hit on symbol keys (eq? would also match)
     31 (if (equal? (cons 'b 2) (assoc 'b al-sym))   0 (sys-exit 10))
     32 
     33 ; hit on bv keys -- distinct objects, equal contents
     34 (define al-bv (list (cons "alpha" 1) (cons "beta" 2) (cons "gamma" 3)))
     35 (if (equal? (cons "beta" 2) (assoc "beta" al-bv))     0 (sys-exit 11))
     36 (if (equal? (cons "alpha" 1) (assoc "alpha" al-bv))   0 (sys-exit 12))
     37 (if (equal? (cons "gamma" 3) (assoc "gamma" al-bv))   0 (sys-exit 13))
     38 
     39 ; miss
     40 (if (not (assoc "delta" al-bv))              0 (sys-exit 14))
     41 
     42 ; empty
     43 (if (not (assoc "x" (quote ())))             0 (sys-exit 15))
     44 
     45 ; nested-equal? key (list compared structurally)
     46 (define al-list (list (cons (list 1 2) 'a) (cons (list 3 4) 'b)))
     47 (if (eq? 'b (cdr (assoc (list 3 4) al-list))) 0 (sys-exit 16))
     48 
     49 ; identity preservation: assoc returns the actual pair from the alist
     50 (let* ((p (cons "k" 99)) (al (list p)))
     51   (if (eq? p (assoc "k" al))                 0 (sys-exit 17)))
     52 
     53 ; ---- reverse ----
     54 
     55 ; empty
     56 (if (null? (reverse (quote ())))             0 (sys-exit 20))
     57 
     58 ; single element
     59 (if (equal? (list 1) (reverse (list 1)))     0 (sys-exit 21))
     60 
     61 ; typical
     62 (if (equal? (list 4 3 2 1) (reverse (list 1 2 3 4)))   0 (sys-exit 22))
     63 
     64 ; mixed types
     65 (if (equal? (list "c" 'b 1) (reverse (list 1 'b "c")))  0 (sys-exit 23))
     66 
     67 ; double-reverse is identity (structurally; fresh allocation)
     68 (let ((xs (list 1 2 3 4 5)))
     69   (if (equal? xs (reverse (reverse xs)))     0 (sys-exit 24)))
     70 
     71 ; reverse does not mutate the input
     72 (let* ((xs (list 1 2 3))
     73        (ys (reverse xs)))
     74   (if (equal? (list 1 2 3) xs)               0 (sys-exit 25))
     75   (if (equal? (list 3 2 1) ys)               0 (sys-exit 26)))
     76 
     77 ; reverse allocates fresh pairs (head of result is not eq? to any
     78 ; input pair, since the elements themselves get re-consed)
     79 (let* ((xs (list 1 2 3))
     80        (ys (reverse xs)))
     81   (if (eq? xs ys)   (sys-exit 27) 0))
     82 
     83 (sys-exit 0)