-> (cons 'a '())
(a)
-> (cons 'a '(b))
(a b)
-> (cons '(a) '(b))
((a) b)
-> (cdr '(a (b (c d))))
((b (c d)))
-> (null? '())
#t
-> (null? '(()))
#f
-> (length '(a b))
2
-> (equal? 'a 'b)
#f
-> (equal? '(a (1 3) c) '(a (1 3) c))
#t
-> (equal? '(a (1 3) d) '(a (1 3) c))
#f
-> (equal? #f #f)
#t
-> (append '(moon over) '(miami vice))
(moon over miami vice)
-> (define reverse (l)
     (if (null? l)
        l
        (append (reverse (cdr l)) (list1 (car l)))))
-> (reverse '(my bonny lies over))
(over lies bonny my)
-> (reverse '(a b (c d) e))
(e (c d) b a)
-> (define reverse (l)
     (revapp l '()))
-> (reverse '(the atlantic ocean))
(ocean atlantic the)
-> (define divides (m n) (= (mod n m) 0))
-> (define seq (m n)
     (if (> m n) '() (cons m (seq (+ 1 m) n))))
-> (seq 3 7)
(3 4 5 6 7)
-> (define remove-multiples (n l)
     (if (null? l)
       '()
       (if (divides n (car l))
         (remove-multiples n (cdr l))
         (cons (car l) (remove-multiples n (cdr l))))))
-> (remove-multiples 2 '(2 3 4 5 6 7))
(3 5 7)
-> (define sieve (l)
     (if (null? l)
       '()
       (cons (car l) (sieve (remove-multiples (car l) (cdr l))))))
-> (define primes<= (n)
     (sieve (seq 2 n)))
-> (primes<= 10)
(2 3 5 7)
-> (primes<= 50)
(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47)
-> (define insert (x l)
     (if (null? l) (list1 x)
       (if (< x (car l))
         (cons x l)
         (cons (car l) (insert x (cdr l))))))
-> (define insertion-sort (l)
     (if (null? l)
       '()
       (insert (car l) (insertion-sort (cdr l)))))
-> (insertion-sort '(4 3 2 6 8 5))
(2 3 4 5 6 8)
-> (val emptyset '())
-> (define member? (x s)
     (if (null? s)
       #f
       (if (equal? x (car s))
         #t
         (member? x (cdr s)))))
-> (define add-element (x s)
     (if (member? x s)
       s
       (cons x s)))
-> (define size (s)
     (length s))
-> (define union (s1 s2)
     (if (null? s1)
       s2
       (add-element (car s1) (union (cdr s1) s2))))
-> (val s (add-element 3 (add-element 'a emptyset)))
(3 a)
-> (member? 'a s)
#t
-> (union s (add-element 2 (add-element 3 emptyset)))
(a 2 3)
-> (val t (add-element '(a b) (add-element 1 emptyset)))
((a b) 1)
-> (member? '(a b) t)
#t
-> (val al (bind 'I 'Ching '()))
((I Ching))
-> (val al (bind 'E 'coli al))
((I Ching) (E coli))
-> (val al (bind 'I 'Magnin al))
((I Magnin) (E coli))
-> (find 'I al)
Magnin
-> (val fruits 
     '((apple  ((texture crunchy) (color green)))
       (banana ((texture mushy)   (color yellow)))))
-> (define property (x p plist)
     (find p (find x plist)))
-> (define set-property (x p y plist)
     (bind x (bind p y (find x plist)) plist))
-> (property 'apple 'texture fruits)
crunchy
-> (set fruits (set-property 'apple 'color 'red fruits))
-> (property 'apple 'color fruits)
red
-> (define has-property (p y alist) (= (find p alist) y))
-> (define gather-property (p y plist)
     (if (null? plist)
       '()
       (if (has-property p y (cadar plist))
         (cons (caar plist) (gather-property p y (cdr plist)))
         (gather-property p y (cdr plist)))))
-> (set fruits (set-property 'lemon 'color 'yellow fruits))
-> (gather-property 'color 'yellow fruits)
(banana lemon)
-> (define sqrt (n)
     (letrec ((find (lambda (r)
                      (if (> (* r r) n) (- r 1) (find (+ r 1))))))
       (find 0)))
-> (define roots (a b c)
     (let ((discriminant (sqrt (- (* b b) (* 4 (* a c)))))
           (two-a        (* 2 a))
           (minus-b      (- 0 b)))
       (list2 (/ (+ minus-b discriminant) two-a)
              (/ (- minus-b discriminant) two-a))))
-> (roots 1 3 -70)
(7 -10)
-> (val x 'global-x)
-> (val y 'global-y)
-> (let
     ((x 'local-x)
      (y x))
     (list2 x y))
(local-x global-x)
-> (val x 'global-x)
-> (val y 'global-y)
-> (let*
     ((x 'local-x)
      (y x))
     (list2 x y))
(local-x local-x)
-> (val even?
     (letrec
       ((odd-test (lambda (n) (not (even-test n))))
        (even-test
          (lambda (n)
            (if (= n 0)
              #t
              (odd-test (- n 1))))))
       even-test))
-> (even? 0)
#t
-> (even? 1)
#f
-> (even? 2)
#t
-> (define leaf? (node) (atom? node))
-> (define left  (node) (cadr  node))
-> (define right (node) (caddr node))
-> (define label (node) (if (leaf? node) node (car node)))
-> (define pre-ord (t)
     (cons
       (label t)
       (if (leaf? t)
         '()
         (append
           (pre-ord (left t))
           (pre-ord (right t))))))
-> (pre-ord '(A (B C D) (E (F G H) I)))
(A B C D E F G H I)
-> (val emptyqueue '())
-> (define front    (q) (car q))
-> (define rm-front (q) (cdr q))
-> (define enqueue (t q)
     (if (null? q)
       (cons t q)
       (cons (car q) (enqueue t (cdr q)))))
-> (define empty? (q) (null? q))
-> (define level-ord* (queue)
     (if (empty? queue)
       '()
       (let* ((hd   (front    queue))
              (tl   (rm-front queue))
              (newq (if (leaf? hd)
                       tl
                       (enqueue (right hd) (enqueue (left hd) tl)))))
         (cons (label hd) (level-ord* newq)))))
-> (define level-ord (t)
     (level-ord* (enqueue t emptyqueue)))
-> (level-ord '(A (B C D) (E (F G H) I)))
(A B E C D F I G H)
-> (define level-ord* (queue)
     (if (empty? queue)
       '()
       (let* ((hd    (front    queue))
              (queue (rm-front queue))
              (queue (if (leaf? hd)
                       queue
                       (enqueue (right hd) (enqueue (left hd) queue)))))
         (cons (label hd) (level-ord* queue)))))
-> (define level-ord (t)
     (level-ord* (enqueue t emptyqueue)))
-> (level-ord '(A (B C D) (E (F G H) I)))
(A B E C D F I G H)
-> ((lambda (x y) (+ (* x x) (* y y))) 707 707)
999698
-> ((lambda (x y z) (+ x (+ y z))) 1 2 3)
6
-> ((lambda (y) (* y y)) 7)
49
-> (define apply-n-times (n f x)
     (if (= 0 n)
        x
        (apply-n-times (- n 1) f (f x))))
-> (define twice  (n) (* 2 n))
-> (define square (n) (* n n))
-> (apply-n-times 2 twice 10)
40
-> (apply-n-times 2 square 10)
10000
-> (apply-n-times 10 twice 1)
1024
-> (apply-n-times 10 square 1)
1
-> (val add (lambda (x) (lambda (y) (+ x y))))
-> (val add1 (add 1))
-> (add1 4)
5
-> (val counter-from
     (lambda (n)
        (lambda () (set n (+ n 1)))))
-> (val ten (counter-from 10))
<procedure>
-> (ten)
11
-> (ten)
12
-> (ten)
13
-> (val resettable-counter-from
     (lambda (n)
        (list2
          (lambda () (set n (+ n 1)))
          (lambda () (set n 0)))))
-> (val step  (lambda (ctr) ((car  ctr))))
-> (val reset (lambda (ctr) ((cadr ctr))))
-> (val hundred (resettable-counter-from 100))
-> (val twenty  (resettable-counter-from 20))
-> (step hundred)
101
-> (step hundred)
102
-> (step twenty)
21
-> (reset hundred)
0
-> (step hundred)
1
-> (step twenty)
22
-> (val init-rand (lambda (seed)
      (lambda () (set seed (mod (+ (* seed 9) 5) 1024)))))
-> (val rand (init-rand 1))
-> (rand)
14
-> (rand)
131
-> (define even? (n) (= 0 (mod n 2)))
-> (val odd? (o not even?))
-> (odd? 3)
#t
-> (odd? 4)
#f
-> (val list3-curried (lambda (a) (lambda (b) (lambda (c) (list3 a b c)))))
-> (list3-curried 'x)
<procedure>
-> ((list3-curried 'x) 'y)
<procedure>
-> (((list3-curried 'x) 'y) 'z)
(x y z)
-> (val <-curried (lambda (n) (lambda (m) (< n m))))
-> (val positive? (<-curried 0))
-> (positive? 0)
#f
-> (positive? 8)
#t
-> (positive? -3)
#f
-> (val zero? ((curry =) 0))
-> (zero? 0)
#t
-> (val add1 ((curry +) 1))
-> (add1 4)
5
-> (val new+ (uncurry (curry +)))
-> (new+ 1 4)
5
-> (define even? (x) (= (mod x 2) 0))
-> (filter even? (seq 1 10))
(2 4 6 8 10)
-> (exists? even? (seq 1 10))
#t
-> (all? even? (seq 1 10))
#f
-> (all? even? (filter even? (seq 1 10)))
#t
-> (exists? even? (filter (o not even?) (seq 1 10)))
#f
-> (exists? even? '())
#f
-> (all? even? '())
#t
-> (map add1 '(3 4 5))
(4 5 6)
-> (map ((curry +) 5) '(3 4 5))
(8 9 10)
-> (map (lambda (x) (* x x)) (seq 1 10))
(1 4 9 16 25 36 49 64 81 100)
-> (primes<= 20)
(2 3 5 7 11 13 17 19)
-> (map ((curry <) 10) (primes<= 20))
(#f #f #f #f #t #t #t #t)
-> (foldl - 0 '(1 2 3 4))
2
-> (foldr - 0 '(1 2 3 4))
-2
-> (define alt-all? (p? l) (not (exists? (o not p?) l)))
-> (alt-all? even? (seq 1 10))
#f
-> (alt-all? even? '())
#t
-> (alt-all? even? (filter even? (seq 1 10)))
#t
-> (val emptyset '())
-> (define member?     (x s) (exists? ((curry equal?) x) s))
-> (define add-element (x s) (if (member? x s) s (cons x s)))
-> (define union     (s1 s2) (foldl add-element s1 s2))
-> (define set-from-list (l) (foldl add-element '() l))
-> (set-from-list '(a b c x y a))
(y x c b a)
-> (union '(1 2 3 4) '(2 4 6 8))
(8 6 1 2 3 4)
-> (define sub-alist? (al1 al2)
      (not (exists?
              (lambda (pair)
                 (not (equal? (cadr pair) (find (car pair) al2))))
              al1)))
-> (define =alist? (al1 al2)
      (if (sub-alist? al1 al2) (sub-alist? al2 al1) #f))
-> (=alist? '() '())
#t
-> (=alist? '((E coli)(I Magnin)(U Thant))
            '((E coli)(I Ching)(U Thant)))
#f
-> (=alist? '((U Thant)(I Ching)(E coli))
            '((E coli)(I Ching)(U Thant)))
#t
-> (val mk-set-ops (lambda (eqfun)
      (list2
         (lambda (x s) (exists? ((curry eqfun) x) s)) ; member?
         (lambda (x s) ; add-element
                (if (exists? ((curry eqfun) x) s) s (cons x s))))))
-> (val list-of-al-ops (mk-set-ops =alist?))
-> (val al-member?     (car list-of-al-ops))
-> (val al-add-element (cadr list-of-al-ops))
-> (val emptyset '())
-> (val s (al-add-element '((U Thant)(I Ching)(E coli)) emptyset))
(((U Thant) (I Ching) (E coli)))
-> (val s (al-add-element '((Hello Dolly)(Goodnight Irene)) s))
(((Hello Dolly) (Goodnight Irene)) ((U Thant) (I Ching) (E coli)))
-> (val s (al-add-element '((E coli)(I Ching)(U Thant)) s))
(((Hello Dolly) (Goodnight Irene)) ((U Thant) (I Ching) (E coli)))
-> (al-member? '((Goodnight Irene)(Hello Dolly)) s)
#t
-> (define mk-insertion-sort (lt)
     (letrec (
       (insert (lambda (x l)
                  (if (null? l) (list1 x)
                      (if (lt x (car l))
                          (cons x l)
                          (cons (car l) (insert x (cdr l)))))))
       (sort   (lambda (l)
                 (if (null? l)
                     '()
                     (insert (car l) (sort (cdr l)))))))
       sort))
-> (val sort< (mk-insertion-sort <))
-> (val sort> (mk-insertion-sort >))
-> (sort< '(6 9 1 7 4 3 8 5 2 10))
(1 2 3 4 5 6 7 8 9 10)
-> (sort> '(6 9 1 7 4 3 8 5 2 10))
(10 9 8 7 6 5 4 3 2 1)
-> (define pair< (p1 p2)
     (or (< (car p1) (car p2))
         (and (= (car p1) (car p2))
              (< (cadr p1) (cadr p2)))))
-> ((mk-insertion-sort pair<) '((4 5) (2 9) (3 3) (8 1) (2 7)))
((2 7) (2 9) (3 3) (4 5) (8 1))
-> (define find-c (key alist success-cont failure-cont)
      (letrec
          ((search (lambda (alist)
                      (if (null? alist)
                          (failure-cont)
                          (if (equal? key (caar alist))
                              (success-cont (cadar alist))
                              (search (cdr alist)))))))
        (search alist)))
-> (find-c 'Hello '((Hello Dolly) (Goodnight Irene))
           (lambda (v) (list2 'the-answer-is v))
           (lambda ()  'the-key-was-not-found))
(the-answer-is Dolly)
-> (find-c 'Goodbye '((Hello Dolly) (Goodnight Irene))
           (lambda (v) (list2 'the-answer-is v))
           (lambda ()  'the-key-was-not-found))
the-key-was-not-found
-> (define find-default (key table default)
      (find-c key table (lambda (x) x) (lambda () default)))
-> (define freq (l)
     (let
         ((add (lambda (word table)
                   (bind word (+ 1 (find-default word table 0)) table)))
          (sort (mk-insertion-sort (lambda (p1 p2) (> (cadr p1) (cadr p2))))))
       (sort (foldr add '() l))))
-> (freq '(it was the best of times , it was the worst of times ! ))
((it 2) (was 2) (the 2) (of 2) (times 2) (best 1) (, 1) (worst 1) (! 1))
-> (define followers (l)
     (letrec
         ((add (lambda (word follower table)
                   (bind word
                         (add-element follower (find-default word table '()))
                         table)))
          (walk (lambda (first rest table)
                  (if (null? rest)
                      table
                      (walk (car rest) (cdr rest) (add first (car rest) table))))))
       (walk (car l) (cdr l) '())))
-> (followers '(it was the best of times , it was the worst of times ! ))
((it (was)) (was (the)) (the (worst best)) (best (of)) (of (times)) (times (! ,)) (, (it)) (worst (of)))
-> (val multi-followers
      (o
      ((curry filter) (lambda (p) (> (length (cadr p)) 1)))
      followers))
-> (multi-followers '(it was the best of times , it was the worst of times ! ))
((the (worst best)) (times (! ,)))
-> (multi-followers '(now is the time for all good men to come to the aid of the party))
((the (party aid time)) (to (the come)))
-> (define variable-of (literal)
     (if (symbol? literal)
        literal
        (cadr literal)))
-> (define binds? (literal alist)
     (not (null? (find (variable-of literal) alist))))
-> (define satisfying-value (literal)
      (symbol? literal))  ; #t satisfies 'x; #f satisfies '(not x)
-> (define satisfies? (literal alist)
     (= (find (variable-of literal) alist) (satisfying-value literal)))
-> (define solve-literal (lit cur fail succeed)
     (if (satisfies? lit cur)
        (succeed cur fail)
        (if (binds? lit cur)
           (fail)
           (succeed (bind (variable-of lit) (satisfying-value lit) cur) fail))))
-> (define solve-disjunction (disjuncts cur fail succeed)
     (if (null? disjuncts)
       (fail)
       (solve-literal (car disjuncts) cur 
          (lambda () (solve-disjunction (cdr disjuncts) cur fail succeed))
          succeed)))
-> (define solve-conjunction (conjuncts cur fail succeed)
     (if (null? conjuncts)
       (succeed cur fail)
       (solve-disjunction (car conjuncts) cur fail
          (lambda (cur resume)
             (solve-conjunction (cdr conjuncts) cur resume succeed)))))
-> (define one-solution (formula)
      (solve-conjunction formula '() (lambda () 'no-solution)
                                     (lambda (cur resume) cur)))
-> (val f '((x y z) ((not x) (not y) (not z)) (x y (not z))))
-> (one-solution f)
((x #t) (y #f))
-> (define all-solutions (formula)
      (solve-conjunction formula '() (lambda () '())
                         (lambda (cur resume) (al-add-element cur (resume)))))
-> (val answers (all-solutions f))
-> (length answers)
9
-> (exists? (lambda (cur) (and (= #f (find 'x cur)) (= #f (find 'y cur)))) answers)
#f
-> (exists? (lambda (cur) (and (= #t (find 'x cur)) (= #t (find 'y cur)))) answers)
#t
-> (one-solution '((x) ((not x))))
no-solution
-> (= 3 3)
#t
-> (= 'a 'a)
#t
-> (= (cons 'a 'b) (cons 'a 'b))
#f
-> (cons 'a (cons 'b (cons 4 (cons 5 '()))))
(a b 4 5)
-> (cons 'a (cons 'b (cons 4 5)))
(a b 4 . 5)
-> (cons (cons 'a 'b) (cons 4 5))
((a . b) 4 . 5)
-> (define member? (x s eqfun)
      (exists? ((curry eqfun) x) s))
member?
-> (define add-element (x s eqfun)
      (if (member? x s eqfun) s (cons x s)))
add-element
-> (define mk-set (eqfun elements) (cons eqfun elements))
-> (define eqfun-of    (set) (car set))
-> (define elements-of (set) (cdr set))
-> (val emptyset (lambda (eqfun) (mk-set eqfun '())))
emptyset
-> (define member? (x s)
      (exists? ((curry (eqfun-of s)) x) (elements-of s)))
member?
-> (define add-element (x s)
      (if (member? x s) s (mk-set (eqfun-of s) (cons x (elements-of s)))))
add-element
-> (val alist-empty (emptyset =alist?))
-> (val s (add-element '((U Thant)(I Ching)(E coli)) alist-empty))
(<procedure> ((U Thant) (I Ching) (E coli)))
-> (val s (add-element '((Hello Dolly)(Goodnight Irene)) s))
(<procedure> ((Hello Dolly) (Goodnight Irene)) ((U Thant) (I Ching) (E coli)))
-> (val s (add-element '((E coli)(I Ching)(U Thant)) s))
(<procedure> ((Hello Dolly) (Goodnight Irene)) ((U Thant) (I Ching) (E coli)))
-> (member? '((Goodnight Irene)(Hello Dolly)) s)
#t