├── tests ├── exercise-5.10-test.rkt ├── exercise-5.9-test.rkt ├── exercise-3.33-test.rkt ├── exercise-1.21-test.rkt ├── exercise-2.8-test.rkt ├── exercise-5.52-test.rkt ├── exercise-1.16-test.rkt ├── exercise-1.22-test.rkt ├── exercise-1.24-test.rkt ├── exercise-1.25-test.rkt ├── exercise-1.19-test.rkt ├── exercise-1.15-test.rkt ├── exercise-3.6-test.rkt ├── exercise-1.23-test.rkt ├── exercise-3.39-test.rkt ├── exercise-3.17-test.rkt ├── exercise-1.18-test.rkt ├── exercise-3.18-test.rkt ├── exercise-5.3-test.rkt ├── exercise-1.20-test.rkt ├── exercise-3.7-test.rkt ├── exercise-3.16-test.rkt ├── exercise-3.28-test.rkt ├── exercise-1.26-test.rkt ├── exercise-1.17-test.rkt ├── exercise-3.12-test.rkt ├── exercise-3.38-test.rkt ├── exercise-1.27-test.rkt ├── exercise-3.26-test.rkt ├── exercise-1.28-test.rkt ├── exercise-3.10-test.rkt ├── exercise-2.25-test.rkt ├── exercise-2.31-test.rkt ├── exercise-1.8-test.rkt ├── exercise-2.23-test.rkt ├── exercise-6.10-test.rkt ├── exercise-4.40-test.rkt ├── exercise-5.51-test.rkt ├── exercise-2.30-test.rkt ├── exercise-2.12-test.rkt ├── exercise-2.22-test.rkt ├── exercise-4.9-test.rkt ├── exercise-1.9-test.rkt ├── exercise-4.39-test.rkt ├── exercise-5.29-test.rkt ├── exercise-4.25-test.rkt ├── exercise-3.13-test.rkt ├── exercise-2.7-test.rkt ├── exercise-2.9-test.rkt ├── exercise-2.13-test.rkt ├── exercise-1.36-test.rkt ├── exercise-1.12-test.rkt ├── exercise-1.13-test.rkt ├── exercise-3.32-test.rkt ├── exercise-2.28-test.rkt ├── exercise-3.36-test.rkt ├── exercise-3.8-test.rkt ├── exercise-3.29-test.rkt ├── exercise-4.23-test.rkt ├── exercise-5.11-test.rkt ├── exercise-6.6-test.rkt ├── exercise-3.x-let-lang-test.rkt ├── exercise-5.4-test.rkt ├── exercise-3.44-test.rkt ├── exercise-4.27-test.rkt ├── exercise-1.7-test.rkt ├── exercise-3.27-test.rkt ├── exercise-3.21-test.rkt ├── exercise-4.21-test.rkt ├── exercise-2.29-test.rkt ├── exercise-4.30-test.rkt ├── exercise-2.24-test.rkt ├── exercise-2.21-test.rkt ├── exercise-3.42-test.rkt ├── exercise-4.32-test.rkt ├── exercise-1.31-test.rkt ├── exercise-3.9-test.rkt ├── exercise-5.5-test.rkt ├── exercise-4.17-test.rkt ├── exercise-5.13-test.rkt ├── exercise-3.41-test.rkt ├── exercise-2.3-test.rkt ├── exercise-4.34-test.rkt ├── exercise-2.14-test.rkt ├── exercise-4.24-test.rkt ├── exercise-2.18-test.rkt ├── exercise-2.10-test.rkt ├── exercise-5.7-test.rkt ├── exercise-2.1-test.rkt ├── exercise-4.35-test.rkt ├── exercise-2.15-test.rkt ├── exercise-2.16-test.rkt ├── exercise-2.5-test.rkt ├── exercise-2.11-test.rkt ├── exercise-2.19-test.rkt ├── exercise-1.29-test.rkt ├── exercise-3.22-test.rkt ├── exercise-4.33-test.rkt ├── exercise-3.20-test.rkt ├── exercise-4.26-test.rkt ├── exercise-1.32-test.rkt ├── exercise-3.43-test.rkt ├── exercise-5.6-test.rkt ├── exercise-5.25-test.rkt ├── exercise-4.42-test.rkt ├── exercise-3.40-test.rkt ├── exercise-6.19-test.rkt ├── exercise-1.34-test.rkt ├── exercise-3.31-test.rkt ├── exercise-3.35-test.rkt ├── exercise-3.x-proc-lang-test.rkt ├── exercise-5.8-test.rkt ├── exercise-2.26-test.rkt ├── exercise-3.x-lexaddr-lang-test.rkt ├── exercise-3.15-test.rkt ├── exercise-4.38-test.rkt ├── exercise-5.1-test.rkt ├── exercise-5.15-test.rkt ├── exercise-5.17-test.rkt ├── exercise-5.18-test.rkt ├── exercise-5.19-test.rkt ├── exercise-5.2-test.rkt ├── exercise-5.26-test.rkt ├── exercise-6.7-inlined-test.rkt ├── exercise-6.7-procedural-test.rkt ├── exercise-3.x-letrec-lang-test.rkt ├── exercise-5.x-letrec-lang-test.rkt ├── exercise-3.x-letrec-lang-circular-test.rkt ├── exercise-5.x-letrec-lang-registers-test.rkt ├── exercise-5.x-letrec-lang-trampolined-test.rkt ├── exercise-2.20-test.rkt ├── exercise-3.25-test.rkt ├── exercise-3.23-test.rkt ├── exercise-4.11-test.rkt ├── exercise-4.29-test.rkt ├── exercise-1.35-test.rkt ├── exercise-4.13-test.rkt ├── exercise-1.33-test.rkt ├── exercise-1.30-test.rkt ├── exercise-5.16-test.rkt ├── exercise-4.22-test.rkt ├── exercise-3.24-test.rkt ├── exercise-5.35-test.rkt ├── exercise-5.36-test.rkt ├── exercise-5.41-test.rkt ├── exercise-5.39-test.rkt ├── exercise-6.8-inlined-test.rkt ├── exercise-6.8-procedural-test.rkt └── exercise-5.x-exceptions-lang-test.rkt ├── README.md └── solutions ├── exercise-2.8.rkt ├── exercise-6.7-procedural.rkt ├── exercise-5.29.rkt ├── exercise-1.16.rkt ├── exercise-1.9.rkt ├── exercise-1.25.rkt ├── exercise-1.24.rkt ├── exercise-2.23.rkt ├── exercise-1.17.rkt ├── exercise-1.36.rkt ├── exercise-1.19.rkt ├── exercise-1.8.rkt ├── exercise-1.15.rkt ├── exercise-6.10.rkt ├── exercise-1.13.rkt ├── exercise-2.9.rkt ├── exercise-1.22.rkt ├── exercise-1.32.rkt ├── exercise-2.16.rkt ├── exercise-1.12.rkt ├── exercise-2.12.rkt ├── exercise-1.20.rkt ├── exercise-2.10.rkt ├── exercise-1.18.rkt ├── exercise-1.23.rkt ├── exercise-1.7.rkt ├── exercise-1.34.rkt ├── exercise-1.28.rkt ├── exercise-1.31.rkt ├── exercise-2.22.rkt ├── exercise-1.21.rkt ├── exercise-1.26.rkt ├── exercise-1.27.rkt ├── exercise-5.52.rkt ├── exercise-2.21.rkt ├── exercise-5.51.rkt ├── exercise-2.13.rkt ├── exercise-2.28.rkt ├── exercise-2.5.rkt ├── exercise-2.15.rkt ├── exercise-2.24.rkt ├── exercise-2.14.rkt ├── exercise-1.35.rkt ├── exercise-4.9.rkt ├── exercise-1.33.rkt ├── exercise-2.26.rkt ├── exercise-2.1.rkt ├── exercise-2.7.rkt ├── exercise-1.29.rkt ├── exercise-2.29.rkt ├── exercise-2.19.rkt ├── exercise-1.30.rkt ├── exercise-2.3.rkt └── exercise-2.11.rkt /tests/exercise-5.10-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require "exercise-5.x-implicit-refs-lang-test.rkt") 4 | -------------------------------------------------------------------------------- /tests/exercise-5.9-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require "exercise-5.x-implicit-refs-lang-test.rkt") 4 | -------------------------------------------------------------------------------- /tests/exercise-3.33-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "exercise-3.31-test.rkt") 5 | (require "exercise-3.32-test.rkt") 6 | -------------------------------------------------------------------------------- /tests/exercise-1.21-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.21.rkt") 5 | 6 | (check-equal? (product '(a b c) '(x y)) (reverse '((a x) (a y) (b x) (b y) (c x) (c y)))) 7 | -------------------------------------------------------------------------------- /tests/exercise-2.8-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.8.rkt") 5 | 6 | (check-true (empty-env? (empty-env))) 7 | (check-false (empty-env? (extend-env 'a 1 (empty-env)))) 8 | -------------------------------------------------------------------------------- /tests/exercise-5.52-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-threads-lang.rkt") 5 | (require "../solutions/exercise-5.52.rkt") 6 | 7 | (check-equal? (run program) (num-val 3)) 8 | -------------------------------------------------------------------------------- /tests/exercise-1.16-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.16.rkt") 5 | 6 | (check-equal? (invert '((a 1) (a 2) (1 b) (2 b))) '((1 a) (2 a) (b 1) (b 2))) 7 | (check-equal? (invert '()) '()) 8 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # EOPL Exercises 2 | 3 | My solutions to exercises from the book [Essentials of Programming Languages](http://www.eopl3.com). 4 | 5 | Original blog post can be found [here](https://efanzh.org/blog/essentials-of-programming-languages-exercises/). 6 | -------------------------------------------------------------------------------- /tests/exercise-1.22-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.22.rkt") 5 | 6 | (check-equal? (filter-in number? '(a 2 (1 3) b 7)) '(2 7)) 7 | (check-equal? (filter-in symbol? '(a (b c) 17 foo)) '(a foo)) 8 | -------------------------------------------------------------------------------- /tests/exercise-1.24-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.24.rkt") 5 | 6 | (check-false (every? number? '(a b c 3 e))) 7 | (check-true (every? number? '(1 2 3 5 4))) 8 | (check-true (every? number? '())) 9 | -------------------------------------------------------------------------------- /tests/exercise-1.25-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.25.rkt") 5 | 6 | (check-true (exists? number? '(a b c 3 e))) 7 | (check-false (exists? number? '(a b c d e))) 8 | (check-false (exists? number? '())) 9 | -------------------------------------------------------------------------------- /tests/exercise-1.19-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.19.rkt") 5 | 6 | (check-equal? (list-set '(a b c d) 2 '(1 2)) '(a b (1 2) d)) 7 | (check-equal? (list-ref (list-set '(a b c d) 3 '(1 5 10)) 3) '(1 5 10)) 8 | -------------------------------------------------------------------------------- /solutions/exercise-2.8.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.7 [★] Rewrite apply-env in figure 2.1 to give a more informative error message. 4 | 5 | (require "exercise-2.5.rkt") 6 | 7 | (define empty-env? null?) 8 | 9 | (provide empty-env extend-env empty-env?) 10 | -------------------------------------------------------------------------------- /solutions/exercise-6.7-procedural.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 6.7 [★★] Write out the procedural and the inlined representations for the interpreter in figures 5.4, 5.5, 4 | ;; and 5.6. 5 | 6 | (require "exercise-5.1.rkt") 7 | 8 | (provide bool-val num-val run) 9 | -------------------------------------------------------------------------------- /tests/exercise-1.15-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.15.rkt") 5 | 6 | (check-equal? (duple 2 3) '(3 3)) 7 | (check-equal? (duple 4 '(ha ha)) '((ha ha) (ha ha) (ha ha) (ha ha))) 8 | (check-equal? (duple 0 '(blah)) '()) 9 | -------------------------------------------------------------------------------- /tests/exercise-3.6-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-let-lang.rkt") 5 | 6 | (check-equal? (run "minus(1)") (num-val -1)) 7 | (check-equal? (run "minus(-(4, 2))") (num-val -2)) 8 | (check-equal? (run "minus(-(2, 4))") (num-val 2)) 9 | -------------------------------------------------------------------------------- /tests/exercise-1.23-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.23.rkt") 5 | 6 | (check-equal? (list-index number? '(a 2 (1 3) b 7)) 1) 7 | (check-equal? (list-index symbol? '(a (b c) 17 foo)) 0) 8 | (check-equal? (list-index symbol? '(1 2 (a b) 3)) #f) 9 | -------------------------------------------------------------------------------- /tests/exercise-3.39-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-lexaddr-lang.rkt") 5 | 6 | (check-equal? (run "let u = 7 7 | in unpack x y = pack(u, 3) 8 | in -(x, y)") 9 | (num-val 4)) 10 | -------------------------------------------------------------------------------- /tests/exercise-3.17-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-let-lang.rkt") 5 | 6 | (check-equal? (run "let x = 30 7 | in let* x = -(x, 1) y = -(x, 2) 8 | in -(x, y)") 9 | (num-val 2)) 10 | -------------------------------------------------------------------------------- /tests/exercise-1.18-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.18.rkt") 5 | 6 | (check-equal? (swapper 'a 'd '(a b c d)) '(d b c a)) 7 | (check-equal? (swapper 'a 'd '(a d () c d)) '(d a () c a)) 8 | (check-equal? (swapper 'x 'y '((x) y (z (x)))) '((y) x (z (y)))) 9 | -------------------------------------------------------------------------------- /tests/exercise-3.18-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-let-lang.rkt") 5 | 6 | (check-equal? (run "let u = 7 7 | in unpack x y = cons(u, cons(3, emptylist)) 8 | in -(x, y)") 9 | (num-val 4)) 10 | -------------------------------------------------------------------------------- /tests/exercise-5.3-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-letrec-lang.rkt") 5 | 6 | (check-equal? (run "let x = 2 7 | in let2 x = 3 8 | y = x 9 | in -(x, y)") 10 | (num-val 1)) 11 | -------------------------------------------------------------------------------- /tests/exercise-1.20-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.20.rkt") 5 | 6 | (check-equal? (count-occurrences 'x '((f x) y (((x z) x)))) 3) 7 | (check-equal? (count-occurrences 'x '((f x) y (((x z) () x)))) 3) 8 | (check-equal? (count-occurrences 'w '((f x) y (((x z) x)))) 0) 9 | -------------------------------------------------------------------------------- /tests/exercise-3.7-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-let-lang.rkt") 5 | 6 | (check-equal? (run "+(3, 4)") (num-val 7)) 7 | (check-equal? (run "*(3, 7)") (num-val 21)) 8 | (check-equal? (run "/(4, 2)") (num-val 2)) 9 | (check-equal? (run "/(4, 3)") (num-val 1)) 10 | -------------------------------------------------------------------------------- /tests/exercise-3.16-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-let-lang.rkt") 5 | 6 | (check-equal? (run "let x = 30 7 | in let x = -(x, 1) 8 | y = -(x, 2) 9 | in -(x, y)") 10 | (num-val 1)) 11 | -------------------------------------------------------------------------------- /tests/exercise-3.28-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.28.rkt") 5 | 6 | (check-equal? (run "let a = 3 7 | in let p = proc (x) -(x, a) 8 | a = 5 9 | in -(a, (p 2))") 10 | (num-val 8)) 11 | -------------------------------------------------------------------------------- /tests/exercise-1.26-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.26.rkt") 5 | 6 | (check-equal? (up '((1 2) (3 4))) '(1 2 3 4)) 7 | (check-equal? (up '((x (y)) z)) '(x (y) z)) 8 | (check-equal? (up '()) '()) 9 | (check-equal? (up '(1 (2) (3 4 5) (6 (7 8)) 9)) '(1 2 3 4 5 6 (7 8) 9)) 10 | -------------------------------------------------------------------------------- /tests/exercise-1.17-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.17.rkt") 5 | 6 | (check-equal? (down '(1 2 3)) '((1) (2) (3))) 7 | (check-equal? (down '((a) (fine) (idea))) '(((a)) ((fine)) ((idea)))) 8 | (check-equal? (down '(a (more (complicated)) object)) '((a) ((more (complicated))) (object))) 9 | -------------------------------------------------------------------------------- /tests/exercise-3.12-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-let-lang.rkt") 5 | 6 | (check-equal? (run "cond zero?(1) ==> 2 7 | zero?(3) ==> 4 8 | zero?(0) ==> 5 9 | zero?(6) ==> 7 10 | end") 11 | (num-val 5)) 12 | -------------------------------------------------------------------------------- /tests/exercise-3.38-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-lexaddr-lang.rkt") 5 | 6 | (check-equal? (run "cond zero?(1) ==> 2 7 | zero?(3) ==> 4 8 | zero?(0) ==> 5 9 | zero?(6) ==> 7 10 | end") 11 | (num-val 5)) 12 | -------------------------------------------------------------------------------- /tests/exercise-1.27-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.27.rkt") 5 | 6 | (check-equal? (flatten '(a b c)) '(a b c)) 7 | (check-equal? (flatten '((a) () (b ()) () (c))) '(a b c)) 8 | (check-equal? (flatten '((a b) c (((d)) e))) '(a b c d e)) 9 | (check-equal? (flatten '(a b (() (c)))) '(a b c)) 10 | (check-equal? (flatten '()) '()) 11 | -------------------------------------------------------------------------------- /solutions/exercise-5.29.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | (define n1 'uninitialized) 4 | (define a 'uninitialized) 5 | 6 | (define (fact-iter-acc) 7 | (if (zero? n1) 8 | a 9 | (begin (set! a (* n1 a)) 10 | (set! n1 (- n1 1)) 11 | (fact-iter-acc)))) 12 | 13 | (define (fact-iter n) 14 | (set! n1 n) 15 | (set! a 1) 16 | (fact-iter-acc)) 17 | 18 | (provide fact-iter) 19 | -------------------------------------------------------------------------------- /tests/exercise-3.26-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-proc-lang.rkt") 5 | 6 | (check-equal? (run "(let x = 5 7 | in let y = 4 8 | in let x = 3 9 | in proc (z) 10 | -(z, x) 11 | 9)") 12 | (num-val 6)) 13 | -------------------------------------------------------------------------------- /tests/exercise-1.28-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.28.rkt") 5 | 6 | (check-equal? (merge '(1 4) '(1 2 8)) '(1 1 2 4 8)) 7 | (check-equal? (merge '(35 62 81 90 91) '(3 83 85 90)) '(3 35 62 81 83 85 90 90 91)) 8 | (check-equal? (merge '() '()) '()) 9 | (check-equal? (merge '() '(1 2 3)) '(1 2 3)) 10 | (check-equal? (merge '(1 2 3) '()) '(1 2 3)) 11 | -------------------------------------------------------------------------------- /solutions/exercise-1.16.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.16 [★] (invert lst), where lst is a list of 2-lists (lists of length two), returns a list with each 4 | ;; 2-list reversed. 5 | ;; 6 | ;; > (invert '((a 1) (a 2) (1 b) (2 b))) 7 | ;; ((1 a) (2 a) (b 1) (b 2)) 8 | 9 | (define invert 10 | (lambda (lst) 11 | (map (lambda (x) 12 | (list (cadr x) (car x))) 13 | lst))) 14 | 15 | (provide invert) 16 | -------------------------------------------------------------------------------- /tests/exercise-3.10-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-let-lang.rkt") 5 | 6 | (check-equal? (run "let x = 4 7 | in list(x, -(x, 1), -(x, 3))") 8 | (pair-val (num-val 4) 9 | (pair-val (num-val 3) 10 | (pair-val (num-val 1) 11 | (emptylist-val))))) 12 | -------------------------------------------------------------------------------- /tests/exercise-2.25-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.25.rkt") 5 | 6 | (define tree-1 7 | (interior-node 'foo (leaf-node 2) (leaf-node 3))) 8 | 9 | (define tree-2 10 | (interior-node 'bar (leaf-node -1) tree-1)) 11 | 12 | (define tree-3 13 | (interior-node 'baz tree-2 (leaf-node 1))) 14 | 15 | (check-eqv? (max-interior tree-2) 'foo) 16 | (check-eqv? (max-interior tree-3) 'baz) 17 | -------------------------------------------------------------------------------- /solutions/exercise-1.9.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.9 [★★] Define remove, which is like remove-first, except that it removes all occurrences of a given 4 | ;; symbol from a list of symbols, not just the first. 5 | 6 | (define remove 7 | (lambda (s los) 8 | (if (null? los) 9 | '() 10 | (if (eqv? (car los) s) 11 | (remove s (cdr los)) 12 | (cons (car los) (remove s (cdr los))))))) 13 | 14 | (provide remove) 15 | -------------------------------------------------------------------------------- /tests/exercise-2.31-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.31.rkt") 5 | 6 | (check-equal? (parse-prefix-list '(- - 3 2 - 4 - 12 7)) 7 | (diff-exp (diff-exp (const-exp 3) 8 | (const-exp 2)) 9 | (diff-exp (const-exp 4) 10 | (diff-exp (const-exp 12) 11 | (const-exp 7))))) 12 | -------------------------------------------------------------------------------- /solutions/exercise-1.25.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.25 [★★] (exists? pred lst) returns #t if any element of lst satisfies pred, and returns #f otherwise. 4 | ;; 5 | ;; > (exists? number? '(a b c 3 e)) 6 | ;; #t 7 | ;; > (exists? number? '(a b c d e)) 8 | ;; #f 9 | 10 | (define exists? 11 | (lambda (pred lst) 12 | (if (null? lst) 13 | #f 14 | (or (pred (car lst)) 15 | (exists? pred (cdr lst)))))) 16 | 17 | (provide exists?) 18 | -------------------------------------------------------------------------------- /tests/exercise-1.8-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.8.rkt") 5 | 6 | (check-equal? (remove-first 'a '()) '()) 7 | (check-equal? (remove-first 'a '(a)) '()) 8 | (check-equal? (remove-first 'a '(b)) '()) 9 | (check-equal? (remove-first 'a '(b c)) '()) 10 | (check-equal? (remove-first 'b '(a b c)) '(c)) 11 | (check-equal? (remove-first 'b '(a b c d)) '(c d)) 12 | (check-equal? (remove-first 'b '(a b c d b e f)) '(c d b e f)) 13 | -------------------------------------------------------------------------------- /tests/exercise-2.23-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.23.rkt") 5 | 6 | (check-false (identifier? 'lambda)) 7 | (check-true (identifier? 'a)) 8 | (check-true (identifier? 'b)) 9 | (check-true (identifier? 'c)) 10 | (check-false (identifier? 0)) 11 | (check-false (identifier? 1)) 12 | (check-false (identifier? 2)) 13 | (check-false (identifier? '())) 14 | (check-false (identifier? '(1))) 15 | (check-false (identifier? '(a))) 16 | -------------------------------------------------------------------------------- /tests/exercise-6.10-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-6.10.rkt") 5 | 6 | (define (list-sum-2 loi) 7 | (list-sum/k loi 0)) 8 | 9 | (for ([f (list list-sum list-sum-2)]) 10 | (check-eq? (f '()) 0) 11 | (check-eq? (f '(0)) 0) 12 | (check-eq? (f '(1)) 1) 13 | (check-eq? (f '(2)) 2) 14 | (check-eq? (f '(0 1)) 1) 15 | (check-eq? (f '(0 1 2)) 3) 16 | (check-eq? (f '(0 1 2 3)) 6) 17 | (check-eq? (f '(0 1 2 3 4)) 10)) 18 | -------------------------------------------------------------------------------- /solutions/exercise-1.24.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.24 [★★] (every? pred lst) returns #f if any element of lst fails to satisfy pred, and returns #t 4 | ;; otherwise. 5 | ;; 6 | ;; > (every? number? '(a b c 3 e)) 7 | ;; #f 8 | ;; > (every? number? '(1 2 3 5 4)) 9 | ;; #t 10 | 11 | (define every? 12 | (lambda (pred lst) 13 | (if (null? lst) 14 | #t 15 | (and (pred (car lst)) 16 | (every? pred (cdr lst)))))) 17 | 18 | (provide every?) 19 | -------------------------------------------------------------------------------- /tests/exercise-4.40-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-call-by-need-lang.rkt") 5 | 6 | (check-equal? (run "let f = proc (x) 7 | -(x, 1) 8 | in (f 3)") 9 | (num-val 2)) 10 | 11 | (check-equal? (run "let f = proc (g) 12 | (g 4) 13 | in (f proc (x) 14 | -(x, 3))") 15 | (num-val 1)) 16 | -------------------------------------------------------------------------------- /tests/exercise-5.51-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-threads-lang.rkt") 5 | (require "../solutions/exercise-5.51.rkt") 6 | 7 | (let* ([result 'uninitialized] 8 | [output (with-output-to-string (λ () 9 | (set! result (run program))))] 10 | [nums (map string->number (string-split output))]) 11 | (check-equal? result (num-val 44)) 12 | (check-equal? nums '(300 205 204 203 202 201))) 13 | -------------------------------------------------------------------------------- /tests/exercise-2.30-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.30.rkt") 5 | 6 | (check-equal? (parse-expression 'a) (var-exp 'a)) 7 | (check-equal? (parse-expression 'b) (var-exp 'b)) 8 | (check-equal? (parse-expression '(lambda (x) y)) (lambda-exp 'x (var-exp 'y))) 9 | (check-equal? (parse-expression '(lambda (x) (lambda (y) z))) (lambda-exp 'x (lambda-exp 'y (var-exp 'z)))) 10 | (check-equal? (parse-expression '(a b)) (app-exp (var-exp 'a) (var-exp 'b))) 11 | -------------------------------------------------------------------------------- /solutions/exercise-2.23.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.23 [★] The definition of lc-exp ignores the condition in definition 1.1.8 that says “Identifier is any 4 | ;; symbol other than lambda.” Modify the definition of identifier? to capture this condition. As a hint, remember that 5 | ;; any predicate can be used in define-datatype, even ones you define. 6 | 7 | (define identifier? 8 | (lambda (value) 9 | (and (symbol? value) 10 | (not (eqv? value 'lambda))))) 11 | 12 | (provide identifier?) 13 | -------------------------------------------------------------------------------- /solutions/exercise-1.17.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.17 [★] (down lst) wraps parentheses around each top-level element of lst. 4 | ;; 5 | ;; > (down '(1 2 3)) 6 | ;; ((1) (2) (3)) 7 | ;; > (down '((a) (fine) (idea))) 8 | ;; (((a)) ((fine)) ((idea))) 9 | ;; > (down '(a (more (complicated)) object)) 10 | ;; ((a) ((more (complicated))) (object)) 11 | 12 | (define down 13 | (lambda (lst) 14 | (map (lambda (x) 15 | (list x)) 16 | lst))) 17 | 18 | (provide down) 19 | -------------------------------------------------------------------------------- /tests/exercise-2.12-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.12.rkt") 5 | 6 | (check-pred empty-stack? (empty-stack)) 7 | (check-false (empty-stack? (push (empty-stack) 1))) 8 | (check-false (empty-stack? (push (push (empty-stack) 1) 2))) 9 | (check-eqv? (top (push (empty-stack) 1)) 1) 10 | (check-pred empty-stack? (pop (push (empty-stack) 1))) 11 | (check-eqv? (top (push (push (empty-stack) 1) 2)) 2) 12 | (check-eqv? (top (pop (push (push (empty-stack) 1) 2))) 1) 13 | -------------------------------------------------------------------------------- /tests/exercise-2.22-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.22.rkt") 5 | 6 | (check-pred empty-stack? (empty-stack)) 7 | (check-false (empty-stack? (push (empty-stack) 1))) 8 | (check-false (empty-stack? (push (push (empty-stack) 1) 2))) 9 | (check-eqv? (top (push (empty-stack) 1)) 1) 10 | (check-pred empty-stack? (pop (push (empty-stack) 1))) 11 | (check-eqv? (top (push (push (empty-stack) 1) 2)) 2) 12 | (check-eqv? (top (pop (push (push (empty-stack) 1) 2))) 1) 13 | -------------------------------------------------------------------------------- /tests/exercise-4.9-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.9.rkt") 5 | 6 | (initialize-store!) 7 | 8 | (check-eq? (deref (newref 7)) 7) 9 | 10 | (let ([ref1 (newref 13)] 11 | [ref2 (newref 17)] 12 | [ref3 (newref 24)]) 13 | (check-eq? (deref ref1) 13) 14 | (check-eq? (deref ref2) 17) 15 | (check-eq? (deref ref3) 24) 16 | (setref! ref2 34) 17 | (check-eq? (deref ref1) 13) 18 | (check-eq? (deref ref2) 34) 19 | (check-eq? (deref ref3) 24)) 20 | -------------------------------------------------------------------------------- /tests/exercise-1.9-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.9.rkt") 5 | 6 | (check-equal? (remove 'a '()) '()) 7 | (check-equal? (remove 'a '(a)) '()) 8 | (check-equal? (remove 'a '(a b)) '(b)) 9 | (check-equal? (remove 'a '(b)) '(b)) 10 | (check-equal? (remove 'a '(b c)) '(b c)) 11 | (check-equal? (remove 'b '(a b)) '(a)) 12 | (check-equal? (remove 'b '(a b c)) '(a c)) 13 | (check-equal? (remove 'b '(a b c b)) '(a c)) 14 | (check-equal? (remove 'b '(a b c b d)) '(a c d)) 15 | -------------------------------------------------------------------------------- /tests/exercise-4.39-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-call-by-need-lang.rkt") 5 | 6 | (check-equal? (run "let x = 0 7 | in let f = proc (y) 8 | begin y; 9 | y 10 | end 11 | in (f begin set x = -(x, -1); 12 | x 13 | end)") 14 | (num-val 1)) 15 | -------------------------------------------------------------------------------- /solutions/exercise-1.36.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.36 [★★★] Write a procedure g such that number-elements from page 23 could be defined as 4 | ;; 5 | ;; (define number-elements 6 | ;; (lambda (lst) 7 | ;; (if (null? lst) '() 8 | ;; (g (list 0 (car lst)) (number-elements (cdr lst)))))) 9 | 10 | (define g 11 | (lambda (head tail) 12 | (cons head 13 | (map (lambda (item) 14 | (list (+ (car item) 1) (cadr item))) 15 | tail)))) 16 | 17 | (provide g) 18 | -------------------------------------------------------------------------------- /solutions/exercise-1.19.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.19 [★] (list-set lst n x) returns a list like lst, except that the n-th element, using zero-based 4 | ;; indexing, is x. 5 | ;; 6 | ;; > (list-set '(a b c d) 2 '(1 2)) 7 | ;; (a b (1 2) d) 8 | ;; > (list-ref (list-set '(a b c d) 3 '(1 5 10)) 3) 9 | ;; (1 5 10) 10 | 11 | (define list-set 12 | (lambda (lst n x) 13 | (if (zero? n) 14 | (cons x (cdr lst)) 15 | (cons (car lst) (list-set (cdr lst) (- n 1) x))))) 16 | 17 | (provide list-set) 18 | -------------------------------------------------------------------------------- /tests/exercise-5.29-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.29.rkt") 5 | 6 | (check-equal? (fact-iter 0) 1) 7 | (check-equal? (fact-iter 1) 1) 8 | (check-equal? (fact-iter 2) 2) 9 | (check-equal? (fact-iter 3) 6) 10 | (check-equal? (fact-iter 4) 24) 11 | (check-equal? (fact-iter 5) 120) 12 | (check-equal? (fact-iter 6) 720) 13 | (check-equal? (fact-iter 7) 5040) 14 | (check-equal? (fact-iter 8) 40320) 15 | (check-equal? (fact-iter 9) 362880) 16 | (check-equal? (fact-iter 10) 3628800) 17 | -------------------------------------------------------------------------------- /solutions/exercise-1.8.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.8 [★] In the definition of remove-first, if the last line were replaced by (remove-first s (cdr los)), 4 | ;; what function would the resulting procedure compute? Give the contract, including the usage statement, for the 5 | ;; revised procedure. 6 | 7 | (define remove-first 8 | (lambda (s los) 9 | (if (null? los) 10 | '() 11 | (if (eqv? (car los) s) 12 | (cdr los) 13 | (remove-first s (cdr los)))))) 14 | 15 | (provide remove-first) 16 | -------------------------------------------------------------------------------- /tests/exercise-4.25-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.25.rkt") 5 | 6 | (define (get-output string) 7 | (with-output-to-string 8 | (λ () 9 | (run string)))) 10 | 11 | (check-equal? (get-output "var x = 8, y = 3; 12 | print -(x, y)") 13 | "5\n") 14 | 15 | (check-equal? (get-output "var x = 8, y = 3; 16 | var x = y, y = x; 17 | print -(x, y)") 18 | "-5\n") 19 | -------------------------------------------------------------------------------- /solutions/exercise-1.15.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.15 [★] (duple n x) returns a list containing n copies of x. 4 | ;; 5 | ;; > (duple 2 3) 6 | ;; (3 3) 7 | ;; > (duple 4 '(ha ha)) 8 | ;; ((ha ha) (ha ha) (ha ha) (ha ha)) 9 | ;; > (duple 0 '(blah)) 10 | ;; () 11 | 12 | (define duple-helper 13 | (lambda (lst n x) 14 | (if (zero? n) 15 | lst 16 | (duple-helper (cons x lst) (- n 1) x)))) 17 | 18 | (define duple 19 | (lambda (n x) 20 | (duple-helper '() n x))) 21 | 22 | (provide duple) 23 | -------------------------------------------------------------------------------- /solutions/exercise-6.10.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 6.10 [★] For list-sum, formulate a succinct representation of the continuations, like the one for fact/k 4 | ;; above. 5 | 6 | (define list-sum 7 | (lambda (loi) 8 | (if (null? loi) 9 | 0 10 | (+ (car loi) 11 | (list-sum (cdr loi)))))) 12 | 13 | (define list-sum/k 14 | (lambda (loi cont) 15 | (if (null? loi) 16 | cont 17 | (list-sum/k (cdr loi) 18 | (+ cont (car loi)))))) 19 | 20 | (provide list-sum list-sum/k) 21 | -------------------------------------------------------------------------------- /tests/exercise-3.13-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.13.rkt") 5 | 6 | (check-equal? (run "if zero?(0) then 5 else 7") 7 | (num-val 5)) 8 | 9 | (check-equal? (run "if zero?(1) then 5 else 7") 10 | (num-val 7)) 11 | 12 | (check-equal? (run "if -1 then 5 else 7") 13 | (num-val 5)) 14 | 15 | (check-equal? (run "if 0 then 5 else 7") 16 | (num-val 7)) 17 | 18 | (check-equal? (run "if 1 then 5 else 7") 19 | (num-val 5)) 20 | -------------------------------------------------------------------------------- /tests/exercise-2.7-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.7.rkt") 5 | 6 | (check-exn exn:fail? 7 | (λ () 8 | (apply-env (empty-env) 'b))) 9 | 10 | (check-eqv? (apply-env (extend-env 'a 1 (empty-env)) 'a) 11 | 1) 12 | 13 | (check-exn exn:fail? 14 | (λ () 15 | (apply-env (extend-env 'a 1 (empty-env)) 'b))) 16 | 17 | (check-exn exn:fail? 18 | (λ () 19 | (apply-env (extend-env'c 2 (extend-env 'a 1 (empty-env))) 'b))) 20 | -------------------------------------------------------------------------------- /tests/exercise-2.9-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.9.rkt") 5 | 6 | (check-false (has-binding? (empty-env) 'a)) 7 | (check-true (has-binding? (extend-env 'a 1 (empty-env)) 'a)) 8 | (check-false (has-binding? (extend-env 'a 1 (empty-env)) 'b)) 9 | (check-true (has-binding? (extend-env 'b 2 (extend-env 'a 1 (empty-env))) 'a)) 10 | (check-true (has-binding? (extend-env 'b 2 (extend-env 'a 1 (empty-env))) 'b)) 11 | (check-false (has-binding? (extend-env 'b 2 (extend-env 'a 1 (empty-env))) 'c)) 12 | -------------------------------------------------------------------------------- /solutions/exercise-1.13.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.13 [★★] In our example, we began by eliminating the Kleene star in the grammar for S-list. Write subst 4 | ;; following the original grammar by using map. 5 | 6 | (define subst-in-s-exp 7 | (lambda (new old sexp) 8 | (if (symbol? sexp) 9 | (if (eqv? sexp old) new sexp) 10 | (subst new old sexp)))) 11 | 12 | (define subst 13 | (lambda (new old slist) 14 | (map (lambda (sexp) 15 | (subst-in-s-exp new old sexp)) 16 | slist))) 17 | 18 | (provide subst) 19 | -------------------------------------------------------------------------------- /tests/exercise-2.13-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.13.rkt") 5 | 6 | (check-pred empty-env? (empty-env)) 7 | (check-false (empty-env? (extend-env 'a 1 (empty-env)))) 8 | (check-false (empty-env? (extend-env 'b 2 (extend-env 'a 1 (empty-env))))) 9 | (check-eqv? (apply-env (extend-env 'b 2 (extend-env 'a 1 (empty-env))) 'a) 1) 10 | (check-eqv? (apply-env (extend-env 'b 2 (extend-env 'a 1 (empty-env))) 'b) 2) 11 | (check-eqv? (apply-env (extend-env 'a 3 (extend-env 'b 2 (extend-env 'a 1 (empty-env)))) 'a) 3) 12 | -------------------------------------------------------------------------------- /tests/exercise-1.36-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.36.rkt") 5 | 6 | (define number-elements 7 | (lambda (lst) 8 | (if (null? lst) '() 9 | (g (list 0 (car lst)) (number-elements (cdr lst)))))) 10 | 11 | (check-equal? (number-elements '()) '()) 12 | (check-equal? (number-elements '(a)) '((0 a))) 13 | (check-equal? (number-elements '(a b)) '((0 a) (1 b))) 14 | (check-equal? (number-elements '(a b c)) '((0 a) (1 b) (2 c))) 15 | (check-equal? (number-elements '(a b c d)) '((0 a) (1 b) (2 c) (3 d))) 16 | -------------------------------------------------------------------------------- /solutions/exercise-2.9.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.9 [★] Add to the environment interface an observer called has-binding? that takes an environment env and 4 | ;; a variable s and tests to see if s has an associated value in env. Implement it using the a-list representation. 5 | 6 | (require "exercise-2.5.rkt") 7 | 8 | (define has-binding? 9 | (lambda (env search-var) 10 | (cond [(null? env) #f] 11 | [(eqv? (caar env) search-var) #t] 12 | [else (has-binding? (cdr env) search-var)]))) 13 | 14 | (provide empty-env extend-env has-binding?) 15 | -------------------------------------------------------------------------------- /tests/exercise-1.12-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.12.rkt") 5 | 6 | (check-equal? (subst 'b 'a '()) '()) 7 | (check-equal? (subst 'b 'a '(a)) '(b)) 8 | (check-equal? (subst 'b 'a '(b)) '(b)) 9 | (check-equal? (subst 'b 'a '(c)) '(c)) 10 | (check-equal? (subst 'b 'a '(a b a c d a)) '(b b b c d b)) 11 | (check-equal? (subst 'b 'a '((a) b a c d a)) '((b) b b c d b)) 12 | (check-equal? (subst 'b 'a '((x (a)) b a c d a)) '((x (b)) b b c d b)) 13 | (check-equal? (subst 'b 'a '(() ((x a (y a) (a z))))) '(() ((x b (y b) (b z))))) 14 | -------------------------------------------------------------------------------- /tests/exercise-1.13-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.13.rkt") 5 | 6 | (check-equal? (subst 'b 'a '()) '()) 7 | (check-equal? (subst 'b 'a '(a)) '(b)) 8 | (check-equal? (subst 'b 'a '(b)) '(b)) 9 | (check-equal? (subst 'b 'a '(c)) '(c)) 10 | (check-equal? (subst 'b 'a '(a b a c d a)) '(b b b c d b)) 11 | (check-equal? (subst 'b 'a '((a) b a c d a)) '((b) b b c d b)) 12 | (check-equal? (subst 'b 'a '((x (a)) b a c d a)) '((x (b)) b b c d b)) 13 | (check-equal? (subst 'b 'a '(() ((x a (y a) (a z))))) '(() ((x b (y b) (b z))))) 14 | -------------------------------------------------------------------------------- /tests/exercise-3.32-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-letrec-lang.rkt") 5 | 6 | (check-equal? (run "letrec even(x) = if zero?(x) then 1 else (odd -(x, 1)) 7 | odd(x) = if zero?(x) then 0 else (even -(x, 1)) 8 | in (odd 13)") 9 | (num-val 1)) 10 | 11 | (check-equal? (run "letrec even(x) = if zero?(x) then 1 else (odd -(x, 1)) 12 | odd(x) = if zero?(x) then 0 else (even -(x, 1)) 13 | in (odd 16)") 14 | (num-val 0)) 15 | -------------------------------------------------------------------------------- /tests/exercise-2.28-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.28.rkt") 5 | 6 | (check-equal? (unparse-lc-exp (var-exp 'a)) "a") 7 | (check-equal? (unparse-lc-exp (lambda-exp 'a (var-exp 'b))) "(lambda (a) b)") 8 | (check-equal? (unparse-lc-exp (app-exp (var-exp 'a) (var-exp 'b))) "(a b)") 9 | (check-equal? (unparse-lc-exp (lambda-exp 'a (app-exp (var-exp 'b) (var-exp 'c)))) "(lambda (a) (b c))") 10 | 11 | (check-equal? (unparse-lc-exp (app-exp (app-exp (var-exp 'a) (var-exp 'b)) (app-exp (var-exp 'c) (var-exp 'd)))) 12 | "((a b) (c d))") 13 | -------------------------------------------------------------------------------- /tests/exercise-3.36-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-letrec-lang-circular.rkt") 5 | 6 | (check-equal? (run "letrec even(x) = if zero?(x) then 1 else (odd -(x, 1)) 7 | odd(x) = if zero?(x) then 0 else (even -(x, 1)) 8 | in (odd 13)") 9 | (num-val 1)) 10 | 11 | (check-equal? (run "letrec even(x) = if zero?(x) then 1 else (odd -(x, 1)) 12 | odd(x) = if zero?(x) then 0 else (even -(x, 1)) 13 | in (odd 16)") 14 | (num-val 0)) 15 | -------------------------------------------------------------------------------- /tests/exercise-3.8-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-let-lang.rkt") 5 | 6 | (check-equal? (run "equal?(3, 3)") (bool-val #t)) 7 | (check-equal? (run "equal?(3, 4)") (bool-val #f)) 8 | (check-equal? (run "equal?(4, 3)") (bool-val #f)) 9 | (check-equal? (run "greater?(3, 3)") (bool-val #f)) 10 | (check-equal? (run "greater?(3, 4)") (bool-val #f)) 11 | (check-equal? (run "greater?(4, 3)") (bool-val #t)) 12 | (check-equal? (run "less?(3, 3)") (bool-val #f)) 13 | (check-equal? (run "less?(3, 4)") (bool-val #t)) 14 | (check-equal? (run "less?(4, 3)") (bool-val #f)) 15 | -------------------------------------------------------------------------------- /solutions/exercise-1.22.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.22 [★★] (filter-in pred lst) returns the list of those elements in lst that satisfy the predicate pred. 4 | ;; 5 | ;; > (filter-in number? '(a 2 (1 3) b 7)) 6 | ;; (2 7) 7 | ;; > (filter-in symbol? '(a (b c) 17 foo)) 8 | ;; (a foo) 9 | 10 | (define filter-in 11 | (lambda (pred lst) 12 | (if (null? lst) 13 | '() 14 | (let ([element (car lst)] 15 | [tail (filter-in pred (cdr lst))]) 16 | (if (pred element) 17 | (cons element tail) 18 | tail))))) 19 | 20 | (provide filter-in) 21 | -------------------------------------------------------------------------------- /solutions/exercise-1.32.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.32 [★] Write a procedure double-tree that takes a bintree, as represented in definition 1.1.7, and 4 | ;; produces another bintree like the original, but with all the integers in the leaves doubled. 5 | 6 | (require "exercise-1.31.rkt") 7 | 8 | (define double-tree 9 | (lambda (bin-tree) 10 | (if (leaf? bin-tree) 11 | (leaf (* (contents-of bin-tree) 2)) 12 | (interior-node (contents-of bin-tree) 13 | (double-tree (lson bin-tree)) 14 | (double-tree (rson bin-tree)))))) 15 | 16 | (provide double-tree) 17 | -------------------------------------------------------------------------------- /tests/exercise-3.29-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.28.rkt") 5 | 6 | (check-equal? (run "let a = 3 7 | in let p = proc (z) a 8 | in let f = proc (x) (p 0) 9 | in let a = 5 10 | in (f 2)") 11 | (num-val 5)) 12 | 13 | (check-equal? (run "let a = 3 14 | in let p = proc (z) a 15 | in let f = proc (a) (p 0) 16 | in let a = 5 17 | in (f 2)") 18 | (num-val 2)) 19 | -------------------------------------------------------------------------------- /tests/exercise-4.23-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-statement-oriented-implicit-refs-lang.rkt") 5 | 6 | (define (get-output string input) 7 | (with-input-from-string input 8 | (λ () 9 | (with-output-to-string 10 | (λ () 11 | (run string)))))) 12 | 13 | (check-equal? (get-output "var x, y; 14 | { 15 | read x; 16 | read y; 17 | print -(x, y) 18 | }" 19 | "7 4") 20 | "3\n") 21 | -------------------------------------------------------------------------------- /tests/exercise-5.11-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-implicit-refs-lang.rkt") 5 | 6 | (check-equal? (run "begin 2 7 | end") 8 | (num-val 2)) 9 | 10 | (check-equal? (run "let x = 3 11 | in begin set x = 5; 12 | x 13 | end") 14 | (num-val 5)) 15 | 16 | (check-equal? (run "let x = 7 17 | in begin set x = 13; 18 | set x = 17; 19 | x 20 | end") 21 | (num-val 17)) 22 | -------------------------------------------------------------------------------- /tests/exercise-6.6-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-6.6.rkt") 5 | 6 | (define (run-solution solution) 7 | (solution 'x 8 | 'y 9 | (λ (x) 10 | x))) 11 | 12 | (define expected-result '(+ (f (g x)) (h (j y)))) 13 | 14 | (check-equal? (run-solution solution1) expected-result) 15 | (check-equal? (run-solution solution2) expected-result) 16 | (check-equal? (run-solution solution3) expected-result) 17 | (check-equal? (run-solution solution4) expected-result) 18 | (check-equal? (run-solution solution5) expected-result) 19 | (check-equal? (run-solution solution6) expected-result) 20 | -------------------------------------------------------------------------------- /tests/exercise-3.x-let-lang-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-let-lang.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | -------------------------------------------------------------------------------- /tests/exercise-5.4-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-letrec-lang.rkt") 5 | 6 | (check-equal? (run "let x = 2 7 | in let y = 3 8 | in let3 x = y 9 | y = x 10 | w = y 11 | in -(x, w)") 12 | (num-val 0)) 13 | 14 | 15 | (check-equal? (run "let x = 2 16 | in let y = 3 17 | in let3 x = y 18 | y = x 19 | w = y 20 | in -(x, y)") 21 | (num-val 1)) 22 | -------------------------------------------------------------------------------- /solutions/exercise-2.16.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.16 [★] Modify the implementation to use a representation in which there are no parentheses around the 4 | ;; bound variable in a lambda expression. 5 | 6 | (require "exercise-2.15.rkt") 7 | 8 | (define lambda-exp 9 | (lambda (bound-var body) 10 | `(lambda ,bound-var ,body))) 11 | 12 | (define lambda-exp->bound-var cadr) 13 | 14 | (provide var-exp 15 | lambda-exp 16 | app-exp 17 | var-exp? 18 | lambda-exp? 19 | app-exp? 20 | var-exp->var 21 | lambda-exp->bound-var 22 | lambda-exp->body 23 | app-exp->rator 24 | app-exp->rand) 25 | -------------------------------------------------------------------------------- /solutions/exercise-1.12.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.12 [★] Eliminate the one call to subst-in-s-exp in subst by replacing it by its definition and 4 | ;; simplifying the resulting procedure. The result will be a version of subst that does not need subst-in-s-exp. This 5 | ;; technique is called inlining, and is used by optimizing compilers. 6 | 7 | (define subst 8 | (lambda (new old slist) 9 | (if (null? slist) 10 | '() 11 | (cons (let ([sexp (car slist)]) 12 | (if (symbol? sexp) 13 | (if (eqv? sexp old) new sexp) 14 | (subst new old sexp))) 15 | (subst new old (cdr slist)))))) 16 | 17 | (provide subst) 18 | -------------------------------------------------------------------------------- /tests/exercise-3.44-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-lexaddr-lang.rkt") 5 | 6 | (check-equal? (run "let f = proc (y) 7 | -(y, 4) 8 | in (f 13)") 9 | (num-val 9)) 10 | 11 | (check-equal? (run "let f = proc (y) 12 | -(y, 2) 13 | x = 6 14 | in (f x)") 15 | (num-val 4)) 16 | 17 | (check-equal? (run "let f = proc (x, y) 18 | -(x, y) 19 | x = 8 20 | y = 1 21 | in (f x y)") 22 | (num-val 7)) 23 | -------------------------------------------------------------------------------- /tests/exercise-4.27-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.27.rkt") 5 | 6 | (define (get-output string) 7 | (with-output-to-string 8 | (λ () 9 | (run string)))) 10 | 11 | (check-equal? (get-output "var my-print = sub (num) 12 | print num; 13 | call (my-print 13)") 14 | "13\n") 15 | 16 | (check-equal? (get-output "var f = proc (x, y) 17 | -(x, y), 18 | g = sub (num) 19 | print (f num 3); 20 | call (g 6)") 21 | "3\n") 22 | -------------------------------------------------------------------------------- /tests/exercise-1.7-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.7.rkt") 5 | 6 | (check-exn exn:fail? (λ () (nth-element '() 0))) 7 | (check-exn exn:fail? (λ () (nth-element '() 1))) 8 | (check-exn exn:fail? (λ () (nth-element '() 2))) 9 | (check-eq? (nth-element '(a) 0) 'a) 10 | (check-exn exn:fail? (λ () (nth-element '(a) 1))) 11 | (check-exn exn:fail? (λ () (nth-element '(a) 2))) 12 | (check-exn exn:fail? (λ () (nth-element '(a) 3))) 13 | (check-eq? (nth-element '(a b) 0) 'a) 14 | (check-eq? (nth-element '(a b) 1) 'b) 15 | (check-exn exn:fail? (λ () (nth-element '(a b) 2))) 16 | (check-exn exn:fail? (λ () (nth-element '(a b) 3))) 17 | (check-exn exn:fail? (λ () (nth-element '(a b) 4))) 18 | -------------------------------------------------------------------------------- /tests/exercise-3.27-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-proc-lang.rkt") 5 | 6 | (define (get-result string) 7 | (let* ([result 'uninitialized] 8 | (output (with-output-to-string (λ () 9 | (set! result (run string)))))) 10 | (cons result output))) 11 | 12 | (check-equal? (get-result "(let x = 5 13 | in let y = 4 14 | in let x = 3 15 | in traceproc (z) 16 | -(z, x) 17 | 9)") 18 | (cons (num-val 6) 19 | "Entering procedure.\nExiting procedure.\n")) 20 | -------------------------------------------------------------------------------- /solutions/exercise-2.12.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.12 [★] Implement the stack data type of exercise 2.4 using a procedural representation. 4 | 5 | (define empty-stack 6 | (lambda () 7 | (lambda (command) 8 | (cond [(eqv? command 'empty?) #t])))) 9 | 10 | (define push 11 | (lambda (stack val) 12 | (lambda (command) 13 | (cond [(eqv? command 'empty?) #f] 14 | [(eqv? command 'pop) stack] 15 | [(eqv? command 'top) val])))) 16 | 17 | (define pop 18 | (lambda (stack) 19 | (stack 'pop))) 20 | 21 | (define top 22 | (lambda (stack) 23 | (stack 'top))) 24 | 25 | (define empty-stack? 26 | (lambda (stack) 27 | (stack 'empty?))) 28 | 29 | (provide empty-stack push pop top empty-stack?) 30 | -------------------------------------------------------------------------------- /tests/exercise-3.21-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-proc-lang.rkt") 5 | 6 | (check-equal? (run "let f = proc (x, y) -(x, y) 7 | in (f 0 0)") 8 | (num-val 0)) 9 | 10 | (check-equal? (run "let f = proc (x, y) -(x, y) 11 | in (f 0 1)") 12 | (num-val -1)) 13 | 14 | (check-equal? (run "let f = proc (x, y) -(x, y) 15 | in (f 1 0)") 16 | (num-val 1)) 17 | 18 | (check-equal? (run "let f = proc (x, y) -(x, y) 19 | in (f 1 1)") 20 | (num-val 0)) 21 | 22 | (check-equal? (run "let f = proc (x, y) -(x, y) 23 | in (f 7 4)") 24 | (num-val 3)) 25 | -------------------------------------------------------------------------------- /tests/exercise-4.21-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-implicit-refs-lang.rkt") 5 | 6 | (check-equal? (run "let x = 11 7 | in let p = proc (y) 8 | -(y, x) 9 | in -(setdynamic x = 17 10 | during (p 22), 11 | (p 13))") 12 | (num-val 3)) 13 | 14 | (check-equal? (run "let x = 2 15 | in let y = setdynamic x = begin set x = 3; 16 | 5 17 | end 18 | during x 19 | in -(x, y)") 20 | (num-val -2)) 21 | -------------------------------------------------------------------------------- /tests/exercise-2.29-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.29.rkt") 5 | 6 | (check-equal? (parse-expression 'a) (var-exp 'a)) 7 | (check-equal? (parse-expression 'b) (var-exp 'b)) 8 | (check-equal? (parse-expression '(lambda (x) y)) (lambda-exp '(x) (var-exp 'y))) 9 | (check-equal? (parse-expression '(lambda (x y) z)) (lambda-exp '(x y) (var-exp 'z))) 10 | (check-equal? (parse-expression '(lambda (x) (lambda (y) z))) (lambda-exp '(x) (lambda-exp '(y) (var-exp 'z)))) 11 | (check-equal? (parse-expression '(a)) (app-exp (var-exp 'a) '())) 12 | (check-equal? (parse-expression '(a b)) (app-exp (var-exp 'a) (list (var-exp 'b)))) 13 | (check-equal? (parse-expression '(a b c)) (app-exp (var-exp 'a) (list (var-exp 'b) (var-exp 'c)))) 14 | -------------------------------------------------------------------------------- /tests/exercise-4.30-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-mutable-pairs-lang.rkt") 5 | 6 | (check-equal? (run "arraylength(newarray(1, 3))") (num-val 1)) 7 | (check-equal? (run "arraylength(newarray(2, 3))") (num-val 2)) 8 | (check-equal? (run "arraylength(newarray(3, 3))") (num-val 3)) 9 | (check-equal? (run "arraylength(newarray(4, 3))") (num-val 4)) 10 | 11 | (check-equal? (run "let a = newarray(3, 1) 12 | in let x = 5 13 | in arrayref(a, 2)") 14 | (num-val 1)) 15 | 16 | (check-exn exn:fail? (λ () 17 | (run "let a = newarray(3, 1) 18 | in let x = 5 19 | in arrayref(a, 3)"))) 20 | -------------------------------------------------------------------------------- /tests/exercise-2.24-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.24.rkt") 5 | 6 | (check-equal? (bintree-to-list (interior-node 'a (leaf-node 3) (leaf-node 4))) 7 | '(interior-node a (leaf-node 3) (leaf-node 4))) 8 | 9 | (check-equal? (bintree-to-list (leaf-node 3)) '(leaf-node 3)) 10 | 11 | (check-equal? (bintree-to-list (interior-node 'a (leaf-node 3) (interior-node 'b (leaf-node 4) (leaf-node 5)))) 12 | '(interior-node a (leaf-node 3) (interior-node b (leaf-node 4) (leaf-node 5)))) 13 | 14 | (check-equal? (bintree-to-list (interior-node 'a (interior-node 'b (leaf-node 3) (leaf-node 4)) (leaf-node 5))) 15 | '(interior-node a (interior-node b (leaf-node 3) (leaf-node 4)) (leaf-node 5))) 16 | -------------------------------------------------------------------------------- /solutions/exercise-1.20.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.20 [★] (count-occurrences s slist) returns the number of occurrences of s in slist. 4 | ;; 5 | ;; > (count-occurrences 'x '((f x) y (((x z) x)))) 6 | ;; 3 7 | ;; > (count-occurrences 'x '((f x) y (((x z) () x)))) 8 | ;; 3 9 | ;; > (count-occurrences 'w '((f x) y (((x z) x)))) 10 | ;; 0 11 | 12 | (define count-occurrences-sexp 13 | (lambda (s sexp) 14 | (if (symbol? sexp) 15 | (if (eqv? sexp s) 1 0) 16 | (count-occurrences s sexp)))) 17 | 18 | (define count-occurrences 19 | (lambda (s slist) 20 | (if (null? slist) 21 | 0 22 | (+ (count-occurrences-sexp s (car slist)) 23 | (count-occurrences s (cdr slist)))))) 24 | 25 | (provide count-occurrences) 26 | -------------------------------------------------------------------------------- /solutions/exercise-2.10.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.10 [★] Add to the environment interface a constructor extend-env*, and implement it using the a-list 4 | ;; representation. This constructor takes a list of variables, a list of values of the same length, and an environment, 5 | ;; and is specified by (extend-env* (var1 … vark) (val1 … valk) ⌈f⌉) = ⌈g⌉, where g(var) = vali if var = vari for some i 6 | ;; such that 1 ≤ i ≤ k, f(var) otherwise. 7 | 8 | (require "exercise-2.5.rkt") 9 | 10 | (define extend-env* 11 | (lambda (vars vals env) 12 | (if (null? vars) 13 | env 14 | (extend-env* (cdr vars) 15 | (cdr vals) 16 | (cons (cons (car vars) (car vals)) env))))) 17 | 18 | (provide empty-env apply-env extend-env*) 19 | -------------------------------------------------------------------------------- /tests/exercise-2.21-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.21.rkt") 5 | 6 | (check-eqv? (apply-env (extend-env 'b 2 (extend-env 'a 1 (empty-env))) 'a) 1) 7 | (check-eqv? (apply-env (extend-env 'b 2 (extend-env 'a 1 (empty-env))) 'b) 2) 8 | (check-eqv? (apply-env (extend-env 'a 3 (extend-env 'b 2 (extend-env 'a 1 (empty-env)))) 'a) 3) 9 | 10 | (check-false (has-binding? (empty-env) 'a)) 11 | (check-true (has-binding? (extend-env 'a 1 (empty-env)) 'a)) 12 | (check-false (has-binding? (extend-env 'a 1 (empty-env)) 'b)) 13 | 14 | (let ([env (extend-env 'a 3 (extend-env 'b 2 (extend-env 'a 1 (empty-env))))]) 15 | (check-true (has-binding? env 'a)) 16 | (check-true (has-binding? env 'b)) 17 | (check-false (has-binding? env 'c))) 18 | -------------------------------------------------------------------------------- /solutions/exercise-1.18.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.18 [★] (swapper s1 s2 slist) returns a list the same as slist, but with all occurrences of s1 replaced by 4 | ;; s2 and all occurrences of s2 replaced by s1. 5 | ;; 6 | ;; > (swapper 'a 'd '(a b c d)) 7 | ;; (d b c a) 8 | ;; > (swapper 'a 'd '(a d () c d)) 9 | ;; (d a () c a) 10 | ;; > (swapper 'x 'y '((x) y (z (x)))) 11 | ;; ((y) x (z (y))) 12 | 13 | (define swapper 14 | (lambda (s1 s2 slist) 15 | (map (lambda (sexp) 16 | (if (symbol? sexp) 17 | (if (eqv? sexp s1) 18 | s2 19 | (if (eqv? sexp s2) 20 | s1 21 | sexp)) 22 | (swapper s1 s2 sexp))) 23 | slist))) 24 | 25 | (provide swapper) 26 | -------------------------------------------------------------------------------- /solutions/exercise-1.23.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.23 [★★] (list-index pred lst) returns the 0-based position of the first element of lst that satisfies the 4 | ;; predicate pred. If no element of lst satisfies the predicate, then list-index returns #f. 5 | ;; 6 | ;; > (list-index number? '(a 2 (1 3) b 7)) 7 | ;; 1 8 | ;; > (list-index symbol? '(a (b c) 17 foo)) 9 | ;; 0 10 | ;; > (list-index symbol? '(1 2 (a b) 3)) 11 | ;; #f 12 | 13 | (define list-index-helper 14 | (lambda (n pred lst) 15 | (if (null? lst) 16 | #f 17 | (if (pred (car lst)) 18 | n 19 | (list-index-helper (+ n 1) pred (cdr lst)))))) 20 | 21 | (define list-index 22 | (lambda (pred lst) 23 | (list-index-helper 0 pred lst))) 24 | 25 | (provide list-index) 26 | -------------------------------------------------------------------------------- /tests/exercise-3.42-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-lexaddr-lang.rkt") 5 | 6 | (check-equal? (run "(let x = 5 7 | in let y = 4 8 | in let x = 3 9 | in proc (z) 10 | -(z, x) 11 | 9)") 12 | (num-val 6)) 13 | 14 | (check-equal? (run "(let x = 6 15 | in let y = 4 16 | in proc () 17 | -(x, y))") 18 | (num-val 2)) 19 | 20 | (check-equal? (run "((proc (x, y) 21 | proc () 22 | -(x, y) 23 | 7 24 | 3))") 25 | (num-val 4)) 26 | -------------------------------------------------------------------------------- /solutions/exercise-1.7.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.7 [★★] The error message from nth-element is uninformative. Rewrite nth-element so that it produces a 4 | ;; more informative error message, such as “(a b c) does not have 8 elements.” 5 | 6 | (define report-list-too-short 7 | (lambda (lst n) 8 | (eopl:error 'nth-element 9 | "~s does not have ~s elements.~%" lst (+ n 1)))) 10 | 11 | (define nth-element-helper 12 | (lambda (lst n current-list i) 13 | (if (null? current-list) 14 | (report-list-too-short lst n) 15 | (if (zero? i) 16 | (car current-list) 17 | (nth-element-helper lst n (cdr current-list) (- i 1)))))) 18 | 19 | (define nth-element 20 | (lambda (lst n) 21 | (nth-element-helper lst n lst n))) 22 | 23 | (provide nth-element) 24 | -------------------------------------------------------------------------------- /solutions/exercise-1.34.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.34 [★★★] Write a procedure path that takes an integer n and a binary search tree bst (page 10) that 4 | ;; contains the integer n, and returns a list of lefts and rights showing how to find the node containing n. If n is 5 | ;; found at the root, it returns the empty list. 6 | ;; 7 | ;; > (path 17 '(14 (7 () (12 () ())) 8 | ;; (26 (20 (17 () ()) 9 | ;; ()) 10 | ;; (31 () ())))) 11 | ;; (right left left) 12 | 13 | (define path 14 | (lambda (n bst) 15 | (let ([head (car bst)]) 16 | (if (< n head) 17 | (cons 'left (path n (cadr bst))) 18 | (if (= n head) 19 | '() 20 | (cons 'right (path n (caddr bst)))))))) 21 | 22 | (provide path) 23 | -------------------------------------------------------------------------------- /tests/exercise-4.32-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-call-by-reference-lang.rkt") 5 | 6 | (check-equal? (run "let x = 2 7 | in let y = 1 8 | in let f = proc (x, y) 9 | begin set x = 7; 10 | set y = 4 11 | end 12 | in begin (f x y); 13 | -(x, y) 14 | end") 15 | (num-val 3)) 16 | 17 | (check-equal? (run "letrec plus(x, y) = if zero?(x) 18 | then y 19 | else (plus -(x, 1) -(y, -1)) 20 | in (plus 8 6)") 21 | (num-val 14)) 22 | -------------------------------------------------------------------------------- /tests/exercise-1.31-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.31.rkt") 5 | 6 | (check-true (leaf? (leaf 0))) 7 | (check-false (leaf? (interior-node 'a (leaf 0) (leaf 1)))) 8 | (check-true (leaf? (lson (interior-node 'a (leaf 0) (leaf 1))))) 9 | (check-false (leaf? (lson (interior-node 'a (interior-node 'b (leaf 0) (leaf 1)) (leaf 2))))) 10 | (check-true (leaf? (rson (interior-node 'a (leaf 0) (leaf 1))))) 11 | (check-false (leaf? (rson (interior-node 'a (leaf 0) (interior-node 'b (leaf 1) (leaf 2)))))) 12 | (check-eqv? (contents-of (leaf 0)) 0) 13 | (check-eqv? (contents-of (leaf 1)) 1) 14 | (check-eqv? (contents-of (interior-node 'a (leaf 0) (leaf 1))) 'a) 15 | (check-eqv? (contents-of (lson (interior-node 'b (leaf 0) (leaf 1)))) 0) 16 | (check-eqv? (contents-of (rson (interior-node 'b (leaf 0) (leaf 1)))) 1) 17 | -------------------------------------------------------------------------------- /tests/exercise-3.9-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-let-lang.rkt") 5 | 6 | (check-equal? (run "let x = 4 7 | in cons(x, 8 | cons(cons(-(x, 1), 9 | emptylist), 10 | emptylist))") 11 | (pair-val (num-val 4) 12 | (pair-val (pair-val (num-val 3) 13 | (emptylist-val)) 14 | (emptylist-val)))) 15 | 16 | (check-equal? (run "car(cons(2, 3))") (num-val 2)) 17 | (check-equal? (run "cdr(cons(2, 3))") (num-val 3)) 18 | (check-equal? (run "null?(emptylist)") (bool-val #t)) 19 | (check-equal? (run "null?(1)") (bool-val #f)) 20 | (check-equal? (run "null?(cons(2, 3))") (bool-val #f)) 21 | -------------------------------------------------------------------------------- /tests/exercise-5.5-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-letrec-lang.rkt") 5 | 6 | (check-equal? (run "let x = 4 7 | in cons(x, 8 | cons(cons(-(x, 1), 9 | emptylist), 10 | emptylist))") 11 | (pair-val (num-val 4) 12 | (pair-val (pair-val (num-val 3) 13 | (emptylist-val)) 14 | (emptylist-val)))) 15 | 16 | (check-equal? (run "car(cons(2, 3))") (num-val 2)) 17 | (check-equal? (run "cdr(cons(2, 3))") (num-val 3)) 18 | (check-equal? (run "null?(emptylist)") (bool-val #t)) 19 | (check-equal? (run "null?(1)") (bool-val #f)) 20 | (check-equal? (run "null?(cons(2, 3))") (bool-val #f)) 21 | -------------------------------------------------------------------------------- /solutions/exercise-1.28.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.28 [★★] (merge loi1 loi2), where loi1 and loi2 are lists of integers that are sorted in ascending order, 4 | ;; returns a sorted list of all the integers in loi1 and loi2. 5 | ;; 6 | ;; > (merge '(1 4) '(1 2 8)) 7 | ;; (1 1 2 4 8) 8 | ;; > (merge '(35 62 81 90 91) '(3 83 85 90)) 9 | ;; (3 35 62 81 83 85 90 90 91) 10 | 11 | (define merge-helper 12 | (lambda (loi1 loi2) 13 | (if (null? loi1) 14 | loi2 15 | (let ([i1 (car loi1)] 16 | [i2 (car loi2)]) 17 | (if (< i1 i2) 18 | (cons i1 (merge-helper (cdr loi1) loi2)) 19 | (cons i2 (merge-helper (cdr loi2) loi1))))))) 20 | 21 | (define merge 22 | (lambda (loi1 loi2) 23 | (if (null? loi1) 24 | loi2 25 | (merge-helper loi2 loi1)))) 26 | 27 | (provide merge) 28 | -------------------------------------------------------------------------------- /solutions/exercise-1.31.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.31 [★] Write the following procedures for calculating on a bintree (definition 1.1.7): leaf and 4 | ;; interior-node, which build bintrees, leaf?, which tests whether a bintree is a leaf, and lson, rson, and contents-of, 5 | ;; which extract the components of a node. contents-of should work on both leaves and interior nodes. 6 | 7 | (define leaf 8 | (lambda (num) 9 | num)) 10 | 11 | (define interior-node 12 | (lambda (symbol left-child right-child) 13 | (cons symbol (cons left-child right-child)))) 14 | 15 | (define leaf? integer?) 16 | 17 | (define lson cadr) 18 | 19 | (define rson cddr) 20 | 21 | (define contents-of 22 | (lambda (bin-tree) 23 | (if (leaf? bin-tree) 24 | bin-tree 25 | (car bin-tree)))) 26 | 27 | (provide leaf interior-node leaf? lson rson contents-of) 28 | -------------------------------------------------------------------------------- /solutions/exercise-2.22.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.22 [★] Using define-datatype, implement the stack data type of exercise 2.4. 4 | 5 | (define-datatype stack-type stack? 6 | [empty-stack] 7 | [push [saved-stack stack?] 8 | [val always?]]) 9 | 10 | (define pop 11 | (lambda (stack) 12 | (cases stack-type stack 13 | [empty-stack () (eopl:error 'pop "Can not pop an empty stack.")] 14 | [push (saved-stack val) saved-stack]))) 15 | 16 | (define top 17 | (lambda (stack) 18 | (cases stack-type stack 19 | [empty-stack () (eopl:error 'pop "Can not top an empty stack.")] 20 | [push (saved-stack val) val]))) 21 | 22 | (define empty-stack? 23 | (lambda (stack) 24 | (cases stack-type stack 25 | [empty-stack () #t] 26 | [push (saved-stack val) #f]))) 27 | 28 | (provide empty-stack push pop top empty-stack?) 29 | -------------------------------------------------------------------------------- /tests/exercise-4.17-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-implicit-refs-lang.rkt") 5 | 6 | (check-equal? (run "let x = 7 7 | in let f = proc () 8 | set x = 5 9 | in let y = x 10 | in begin (f); 11 | let z = x 12 | in -(y, z) 13 | end") 14 | (num-val 2)) 15 | 16 | (check-equal? (run "let plus = proc (x, y) 17 | -(x, -(0, y)) 18 | in (plus 3 (plus 4 (plus 5 6)))") 19 | (num-val 18)) 20 | 21 | (check-equal? (run "let x = 30 22 | in let x = -(x, 1) 23 | y = -(x, 2) 24 | in -(x, y)") 25 | (num-val 1)) 26 | -------------------------------------------------------------------------------- /tests/exercise-5.13-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-implicit-refs-lang.rkt") 5 | 6 | (check-equal? (run "letrec fact(n) = if zero?(n) 7 | then 1 8 | else *(n, (fact -(n, 1))) 9 | in (fact 4)") 10 | (num-val 24)) 11 | 12 | (check-equal? (run "let fact-iter = letrec fact-iter-acc(n) = proc (a) 13 | if zero?(n) 14 | then a 15 | else ((fact-iter-acc -(n, 1)) *(n, a)) 16 | in proc (n) 17 | ((fact-iter-acc n) 1) 18 | in (fact-iter 4)") 19 | (num-val 24)) 20 | -------------------------------------------------------------------------------- /solutions/exercise-1.21.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.21 [★★] (product sos1 sos2), where sos1 and sos2 are each a list of symbols without repetitions, returns 4 | ;; a list of 2-lists that represents the Cartesian product of sos1 and sos2. The 2-lists may appear in any order. 5 | ;; 6 | ;; > (product '(a b c) '(x y)) 7 | ;; ((a x) (a y) (b x) (b y) (c x) (c y)) 8 | 9 | (define product-symbol 10 | (lambda (tail s sos) 11 | (if (null? sos) 12 | tail 13 | (product-symbol (cons (list s (car sos)) tail) s (cdr sos))))) 14 | 15 | (define product-helper 16 | (lambda (tail sos1 sos2) 17 | (if (null? sos1) 18 | tail 19 | (product-helper (product-symbol tail (car sos1) sos2) 20 | (cdr sos1) 21 | sos2)))) 22 | 23 | (define product 24 | (lambda (sos1 sos2) 25 | (product-helper '() sos1 sos2))) 26 | 27 | (provide product) 28 | -------------------------------------------------------------------------------- /tests/exercise-3.41-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-lexaddr-lang.rkt") 5 | 6 | (check-equal? (run "let f = proc (x, y) -(x, y) 7 | in (f 0 0)") 8 | (num-val 0)) 9 | 10 | (check-equal? (run "let f = proc (x, y) -(x, y) 11 | in (f 0 1)") 12 | (num-val -1)) 13 | 14 | (check-equal? (run "let f = proc (x, y) -(x, y) 15 | in (f 1 0)") 16 | (num-val 1)) 17 | 18 | (check-equal? (run "let f = proc (x, y) -(x, y) 19 | in (f 1 1)") 20 | (num-val 0)) 21 | 22 | (check-equal? (run "let f = proc (x, y) -(x, y) 23 | in (f 7 4)") 24 | (num-val 3)) 25 | 26 | (check-equal? (run "let f = proc (x, y) -(x, y) 27 | in let x = 4 28 | in (f 7 x)") 29 | (num-val 3)) 30 | -------------------------------------------------------------------------------- /tests/exercise-2.3-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.3.rkt") 5 | 6 | (define interpret 7 | (lambda (n) 8 | (if (eqv? (car n) 'one) 9 | 1 10 | (- (interpret (cadr n)) 11 | (interpret (caddr n)))))) 12 | 13 | (define-binary-check (check-integer actual expected) 14 | (= (interpret actual) expected)) 15 | 16 | (define (from-integer n) 17 | (let loop ([result (zero)] 18 | [n n]) 19 | (cond [(zero? n) result] 20 | [(negative? n) (loop (predecessor result) (+ n 1))] 21 | [else (loop (successor result) (- n 1))]))) 22 | 23 | (for ([i (in-range -100 100)]) 24 | (check-integer (from-integer i) i)) 25 | 26 | (for ([i (in-range -20 20)] 27 | [j (in-range -20 20)]) 28 | (check-integer (diff-tree-plus (from-integer i) 29 | (from-integer j)) 30 | (+ i j))) 31 | -------------------------------------------------------------------------------- /solutions/exercise-1.26.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.26 [★★] (up lst) removes a pair of parentheses from each top-level element of lst. If a top-level element 4 | ;; is not a list, it is included in the result, as is. The value of (up (down lst)) is equivalent to lst, but 5 | ;; (down (up lst)) is not necessarily lst. (See exercise 1.17.) 6 | ;; 7 | ;; > (up '((1 2) (3 4))) 8 | ;; (1 2 3 4) 9 | ;; > (up '((x (y)) z)) 10 | ;; (x (y) z) 11 | 12 | (define extend-head 13 | (lambda (tail head) 14 | (if (null? head) 15 | tail 16 | (cons (car head) (extend-head tail (cdr head)))))) 17 | 18 | (define up-element 19 | (lambda (tail element) 20 | (if (list? element) 21 | (extend-head tail element) 22 | (cons element tail)))) 23 | 24 | (define up 25 | (lambda (lst) 26 | (if (null? lst) 27 | '() 28 | (up-element (up (cdr lst)) (car lst))))) 29 | 30 | (provide up) 31 | -------------------------------------------------------------------------------- /tests/exercise-4.34-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-call-by-reference-lang.rkt") 5 | 6 | (check-equal? (run "letref x = 3 7 | in x") 8 | (num-val 3)) 9 | 10 | (check-equal? (run "let x = 3 11 | in let y = x 12 | in begin set y = 4; 13 | x 14 | end") 15 | (num-val 3)) 16 | 17 | (check-equal? (run "let x = 3 18 | in letref y = x 19 | in begin set y = 4; 20 | x 21 | end") 22 | (num-val 4)) 23 | 24 | (check-equal? (run "let x = 3 25 | in letref y = -(x, 2) 26 | in begin set y = 4; 27 | x 28 | end") 29 | (num-val 3)) 30 | -------------------------------------------------------------------------------- /tests/exercise-2.14-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.14.rkt") 5 | 6 | (check-pred empty-env? (empty-env)) 7 | (check-false (empty-env? (extend-env 'a 1 (empty-env)))) 8 | (check-false (empty-env? (extend-env 'b 2 (extend-env 'a 1 (empty-env))))) 9 | (check-eqv? (apply-env (extend-env 'b 2 (extend-env 'a 1 (empty-env))) 'a) 1) 10 | (check-eqv? (apply-env (extend-env 'b 2 (extend-env 'a 1 (empty-env))) 'b) 2) 11 | (check-eqv? (apply-env (extend-env 'a 3 (extend-env 'b 2 (extend-env 'a 1 (empty-env)))) 'a) 3) 12 | 13 | (check-false (has-binding? (empty-env) 'a)) 14 | (check-true (has-binding? (extend-env 'a 1 (empty-env)) 'a)) 15 | (check-false (has-binding? (extend-env 'a 1 (empty-env)) 'b)) 16 | 17 | (let ([env (extend-env 'a 3 (extend-env 'b 2 (extend-env 'a 1 (empty-env))))]) 18 | (check-true (has-binding? env 'a)) 19 | (check-true (has-binding? env 'b)) 20 | (check-false (has-binding? env 'c))) 21 | -------------------------------------------------------------------------------- /tests/exercise-4.24-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-statement-oriented-implicit-refs-lang.rkt") 5 | 6 | (define (get-output string) 7 | (with-output-to-string 8 | (λ () 9 | (run string)))) 10 | 11 | (check-equal? (get-output "var x; { 12 | x = 0; 13 | do print x 14 | while not(zero?(x)) 15 | }") 16 | "0\n") 17 | 18 | (check-equal? (get-output "var x; { 19 | x = 5; 20 | do { 21 | print x; 22 | x = -(x, 1) 23 | } 24 | while not(zero?(x)) 25 | }") 26 | "5\n4\n3\n2\n1\n") 27 | -------------------------------------------------------------------------------- /tests/exercise-2.18-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.18.rkt") 5 | 6 | (check-equal? (number->sequence 7) '(7 () ())) 7 | (check-equal? (current-element '(6 (5 4 3 2 1) (7 8 9))) 6) 8 | (check-equal? (move-to-left '(6 (5 4 3 2 1) (7 8 9))) '(5 (4 3 2 1) (6 7 8 9))) 9 | (check-equal? (move-to-right '(6 (5 4 3 2 1) (7 8 9))) '(7 (6 5 4 3 2 1) (8 9))) 10 | (check-equal? (insert-to-left 13 '(6 (5 4 3 2 1) (7 8 9))) '(6 (13 5 4 3 2 1) (7 8 9))) 11 | (check-equal? (insert-to-right 13 '(6 (5 4 3 2 1) (7 8 9))) '(6 (5 4 3 2 1) (13 7 8 9))) 12 | 13 | (check-true (at-left-end? '(7 () ()))) 14 | (check-true (at-left-end? '(7 () (1)))) 15 | (check-true (at-right-end? '(7 () ()))) 16 | (check-true (at-right-end? '(7 (1) ()))) 17 | (check-false (at-left-end? '(7 (1) ()))) 18 | (check-false (at-right-end? '(7 () (1)))) 19 | (check-exn exn:fail? (λ () (move-to-left '(7 () (1 2 3))))) 20 | (check-exn exn:fail? (λ () (move-to-right '(7 (3 2 1) ())))) 21 | -------------------------------------------------------------------------------- /solutions/exercise-1.27.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.27 [★★] (flatten slist) returns a list of the symbols contained in slist in the order in which they occur 4 | ;; when slist is printed. Intuitively, flatten removes all the inner parentheses from its argument. 5 | ;; 6 | ;; > (flatten '(a b c)) 7 | ;; (a b c) 8 | ;; > (flatten '((a) () (b ()) () (c))) 9 | ;; (a b c) 10 | ;; > (flatten '((a b) c (((d)) e))) 11 | ;; (a b c d e) 12 | ;; > (flatten '(a b (() (c)))) 13 | ;; (a b c) 14 | 15 | (define flatten-element 16 | (lambda (tail element) 17 | (if (list? element) 18 | (flatten-helper tail element) 19 | (cons element tail)))) 20 | 21 | (define flatten-helper 22 | (lambda (tail slist) 23 | (if (null? slist) 24 | tail 25 | (flatten-element (flatten-helper tail (cdr slist)) 26 | (car slist))))) 27 | 28 | (define flatten 29 | (lambda (slist) 30 | (flatten-helper '() slist))) 31 | 32 | (provide flatten) 33 | -------------------------------------------------------------------------------- /tests/exercise-2.10-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.10.rkt") 5 | 6 | (check-eqv? (apply-env (extend-env* '(a) '(7) (empty-env)) 7 | 'a) 8 | 7) 9 | 10 | (let ([env (extend-env* '(a b) '(7 4) (empty-env))]) 11 | (check-eqv? (apply-env env 'a) 7) 12 | (check-eqv? (apply-env env 'b) 4)) 13 | 14 | (let ([env (extend-env* '(a b c) '(7 4 12) (empty-env))]) 15 | (check-eqv? (apply-env env 'a) 7) 16 | (check-eqv? (apply-env env 'b) 4) 17 | (check-eqv? (apply-env env 'c) 12)) 18 | 19 | (let ([env (extend-env* '(b d e) 20 | '(7 4 12) 21 | (extend-env* '(a b c) 22 | '(9 6 19) 23 | (empty-env)))]) 24 | (check-eqv? (apply-env env 'a) 9) 25 | (check-eqv? (apply-env env 'b) 7) 26 | (check-eqv? (apply-env env 'c) 19) 27 | (check-eqv? (apply-env env 'd) 4) 28 | (check-eqv? (apply-env env 'e) 12)) 29 | -------------------------------------------------------------------------------- /solutions/exercise-5.52.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | (define program 4 | "let x = 0 5 | in let mut = mutex() 6 | in let incr_x = proc (id) 7 | let mut1 = mutex() 8 | in begin wait(mut1); 9 | spawn(proc (dummy) 10 | begin wait(mut); 11 | set x = -(x, -1); 12 | signal(mut); 13 | signal(mut1) 14 | end); 15 | mut1 16 | end 17 | in let mut1 = (incr_x 100) 18 | in let mut2 = (incr_x 200) 19 | in let mut3 = (incr_x 300) 20 | in begin wait(mut1); 21 | wait(mut2); 22 | wait(mut3); 23 | x 24 | end") 25 | 26 | (provide program) 27 | -------------------------------------------------------------------------------- /tests/exercise-5.7-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-letrec-lang.rkt") 5 | 6 | (check-equal? (run "let 7 | in 1") 8 | (num-val 1)) 9 | 10 | (check-equal? (run "let x = 4 11 | in x") 12 | (num-val 4)) 13 | 14 | (check-equal? (run "let x = 3 15 | y = 5 16 | in x") 17 | (num-val 3)) 18 | 19 | (check-equal? (run "let x = 3 20 | y = 5 21 | in y") 22 | (num-val 5)) 23 | 24 | (check-equal? (run "let x = 3 25 | y = 5 26 | in let x = y 27 | y = x 28 | in x") 29 | (num-val 5)) 30 | 31 | (check-equal? (run "let x = 3 32 | y = 5 33 | in let x = y 34 | y = x 35 | in y") 36 | (num-val 3)) 37 | -------------------------------------------------------------------------------- /tests/exercise-2.1-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.1.rkt") 5 | 6 | (define (is-natural n expected) 7 | (if (zero? expected) 8 | (is-zero? n) 9 | (and (not (is-zero? n)) 10 | (is-natural (predecessor n) (- expected 1))))) 11 | 12 | (define-binary-check (check-natural is-natural actual expected)) 13 | 14 | (define (from-integer-helper base n) 15 | (if (zero? n) 16 | base 17 | (from-integer-helper (successor base) (- n 1)))) 18 | 19 | (define (from-integer n) 20 | (from-integer-helper (zero) n)) 21 | 22 | (for ([i 100]) 23 | (check-natural (from-integer i) i)) 24 | 25 | (check-natural (factorial (from-integer 0)) 1) 26 | (check-natural (factorial (from-integer 1)) 1) 27 | (check-natural (factorial (from-integer 2)) 2) 28 | (check-natural (factorial (from-integer 3)) 6) 29 | (check-natural (factorial (from-integer 4)) 24) 30 | (check-natural (factorial (from-integer 5)) 120) 31 | (check-natural (factorial (from-integer 10)) 3628800) 32 | -------------------------------------------------------------------------------- /tests/exercise-4.35-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-implicit-refs-lang.rkt") 5 | 6 | (check-equal? (run "let a = 3 7 | in let b = 4 8 | in let swap = proc (x) 9 | proc (y) 10 | let temp = deref(x) 11 | in begin setref(x, deref(y)); 12 | setref(y, temp) 13 | end 14 | in begin ((swap ref a) ref b); 15 | -(a, b) 16 | end") 17 | (num-val 1)) 18 | 19 | (check-equal? (run "let a = 3 20 | in let r1 = ref a 21 | in let r2 = ref a 22 | in begin setref(r1, 4); 23 | deref(r2) 24 | end") 25 | (num-val 4)) 26 | -------------------------------------------------------------------------------- /solutions/exercise-2.21.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.21 [★] Implement the data type of environments, as in section 2.2.2, using define-datatype. Then include 4 | ;; has-binding? of exercise 2.9. 5 | 6 | (define-datatype env-type env? 7 | [empty-env] 8 | [extend-env [var symbol?] 9 | [val always?] 10 | [env env?]]) 11 | 12 | (define apply-env 13 | (lambda (env search-var) 14 | (cases env-type env 15 | [empty-env () (eopl:error 'apply-env "No binding for ~s" search-var)] 16 | [extend-env (var val env) (if (eqv? var search-var) 17 | val 18 | (apply-env env search-var))]))) 19 | 20 | (define has-binding? 21 | (lambda (env search-var) 22 | (cases env-type env 23 | [empty-env () #f] 24 | [extend-env (var val env) (or (eqv? var search-var) 25 | (has-binding? env search-var))]))) 26 | 27 | (provide empty-env 28 | extend-env 29 | apply-env 30 | has-binding?) 31 | -------------------------------------------------------------------------------- /tests/exercise-2.15-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.15.rkt") 5 | 6 | (let ([var-exp-example (var-exp 'a)] 7 | [lambda-exp-example (lambda-exp 'a (var-exp 'b))] 8 | [app-exp-example (app-exp (var-exp 'a) (var-exp 'b))]) 9 | (check-true (var-exp? var-exp-example)) 10 | (check-false (var-exp? lambda-exp-example)) 11 | (check-false (var-exp? app-exp-example)) 12 | (check-false (lambda-exp? var-exp-example)) 13 | (check-true (lambda-exp? lambda-exp-example)) 14 | (check-false (lambda-exp? app-exp-example)) 15 | (check-false (app-exp? var-exp-example)) 16 | (check-false (app-exp? lambda-exp-example)) 17 | (check-true (app-exp? app-exp-example)) 18 | (check-eqv? (var-exp->var var-exp-example) 'a) 19 | (check-eqv? (lambda-exp->bound-var lambda-exp-example) 'a) 20 | (check-eqv? (var-exp->var (lambda-exp->body lambda-exp-example)) 'b) 21 | (check-eqv? (var-exp->var (app-exp->rator app-exp-example)) 'a) 22 | (check-eqv? (var-exp->var (app-exp->rand app-exp-example)) 'b)) 23 | -------------------------------------------------------------------------------- /tests/exercise-2.16-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.16.rkt") 5 | 6 | (let ([var-exp-example (var-exp 'a)] 7 | [lambda-exp-example (lambda-exp 'a (var-exp 'b))] 8 | [app-exp-example (app-exp (var-exp 'a) (var-exp 'b))]) 9 | (check-true (var-exp? var-exp-example)) 10 | (check-false (var-exp? lambda-exp-example)) 11 | (check-false (var-exp? app-exp-example)) 12 | (check-false (lambda-exp? var-exp-example)) 13 | (check-true (lambda-exp? lambda-exp-example)) 14 | (check-false (lambda-exp? app-exp-example)) 15 | (check-false (app-exp? var-exp-example)) 16 | (check-false (app-exp? lambda-exp-example)) 17 | (check-true (app-exp? app-exp-example)) 18 | (check-eqv? (var-exp->var var-exp-example) 'a) 19 | (check-eqv? (lambda-exp->bound-var lambda-exp-example) 'a) 20 | (check-eqv? (var-exp->var (lambda-exp->body lambda-exp-example)) 'b) 21 | (check-eqv? (var-exp->var (app-exp->rator app-exp-example)) 'a) 22 | (check-eqv? (var-exp->var (app-exp->rand app-exp-example)) 'b)) 23 | -------------------------------------------------------------------------------- /solutions/exercise-5.51.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | (define program 4 | "let buffer = 0 5 | in let mut = mutex() 6 | in let producer = proc (n) 7 | letrec wait1(k) = if zero?(k) 8 | then begin set buffer = n; 9 | signal(mut) 10 | end 11 | else begin print(-(k, -200)); 12 | (wait1 -(k, 1)) 13 | end 14 | in (wait1 5) 15 | in let consumer = proc (d) 16 | begin wait(mut); 17 | buffer 18 | end 19 | in begin wait(mut); 20 | spawn(proc (d) 21 | (producer 44)); 22 | print(300); 23 | (consumer 86) 24 | end") 25 | 26 | (provide program) 27 | -------------------------------------------------------------------------------- /tests/exercise-2.5-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.5.rkt") 5 | 6 | (check-eqv? (apply-env (extend-env 'a 7 (empty-env)) 'a) 7) 7 | 8 | (check-eqv? (apply-env (extend-env 'a 9 | 5 10 | (extend-env 'a 11 | 7 12 | (empty-env))) 13 | 'a) 14 | 5) 15 | 16 | (check-eqv? (apply-env (extend-env 'b 17 | 5 18 | (extend-env 'a 19 | 7 20 | (empty-env))) 21 | 'a) 22 | 7) 23 | 24 | (check-eqv? (apply-env (extend-env 'b 25 | 5 26 | (extend-env 'a 27 | 7 28 | (empty-env))) 29 | 'b) 30 | 5) 31 | -------------------------------------------------------------------------------- /tests/exercise-2.11-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.11.rkt") 5 | 6 | (check-eqv? (apply-env (extend-env 'a 7 (empty-env)) 7 | 'a) 8 | 7) 9 | 10 | (check-eqv? (apply-env (extend-env* '(a) '(7) (empty-env)) 11 | 'a) 12 | 7) 13 | 14 | (let ([env (extend-env* '(a b) '(7 4) (empty-env))]) 15 | (check-eqv? (apply-env env 'a) 7) 16 | (check-eqv? (apply-env env 'b) 4)) 17 | 18 | (let ([env (extend-env* '(a b c) '(7 4 12) (empty-env))]) 19 | (check-eqv? (apply-env env 'a) 7) 20 | (check-eqv? (apply-env env 'b) 4) 21 | (check-eqv? (apply-env env 'c) 12)) 22 | 23 | (let ([env (extend-env* '(b d e) 24 | '(7 4 12) 25 | (extend-env* '(a b c) 26 | '(9 6 19) 27 | (empty-env)))]) 28 | (check-eqv? (apply-env env 'a) 9) 29 | (check-eqv? (apply-env env 'b) 7) 30 | (check-eqv? (apply-env env 'c) 19) 31 | (check-eqv? (apply-env env 'd) 4) 32 | (check-eqv? (apply-env env 'e) 12)) 33 | -------------------------------------------------------------------------------- /tests/exercise-2.19-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.19.rkt") 5 | 6 | (check-equal? (number->bintree 13) '(13 () ())) 7 | 8 | (define t1 (insert-to-right 14 9 | (insert-to-left 12 10 | (number->bintree 13)))) 11 | 12 | (check-equal? t1 13 | '(13 14 | (12 () ()) 15 | (14 () ()))) 16 | 17 | (check-equal? (move-to-left-son t1) '(12 () ())) 18 | (check-equal? (move-to-right-son t1) '(14 () ())) 19 | (check-eqv? (current-element (move-to-left-son t1)) 12) 20 | (check-eqv? (current-element (move-to-right-son t1)) 14) 21 | (check-true (at-leaf? (move-to-right-son (move-to-left-son t1)))) 22 | 23 | (check-equal? (insert-to-left 15 t1) 24 | '(13 25 | (15 26 | (12 () ()) 27 | ()) 28 | (14 () ()))) 29 | 30 | (check-equal? (insert-to-right 15 t1) 31 | '(13 32 | (12 () ()) 33 | (15 34 | () 35 | (14 () ())))) 36 | -------------------------------------------------------------------------------- /tests/exercise-1.29-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.29.rkt") 5 | 6 | (check-equal? (sort '(8 2 5 2 3)) '(2 2 3 5 8)) 7 | (check-equal? (sort '()) '()) 8 | (check-equal? (sort '(1)) '(1)) 9 | (check-equal? (sort '(1 1)) '(1 1)) 10 | (check-equal? (sort '(1 1 1)) '(1 1 1)) 11 | (check-equal? (sort '(1 2)) '(1 2)) 12 | (check-equal? (sort '(1 2 3)) '(1 2 3)) 13 | (check-equal? (sort '(1 3 2)) '(1 2 3)) 14 | (check-equal? (sort '(2 1 3)) '(1 2 3)) 15 | (check-equal? (sort '(2 3 1)) '(1 2 3)) 16 | (check-equal? (sort '(3 1 2)) '(1 2 3)) 17 | (check-equal? (sort '(3 2 1)) '(1 2 3)) 18 | (check-equal? (sort '(3 2 1)) '(1 2 3)) 19 | (check-equal? (sort '(9 8 7 6 5 4 3 2 1 0)) '(0 1 2 3 4 5 6 7 8 9)) 20 | (check-equal? (sort '(9 8 5 7 6 5 4 3 5 2 1 0)) '(0 1 2 3 4 5 5 5 6 7 8 9)) 21 | (check-equal? (sort '(0 1 2 3 4 5 6 7 8 9)) '(0 1 2 3 4 5 6 7 8 9)) 22 | (check-equal? (sort '(9 5 2 7 5 5 9 7 1 9 0 0 9 8 1 1 0 2 7 9 3 0 6 9 4 7 1 2 0 2 8 7 0 7 4 7 9 8 5 9 9 8 4 9 7 7 8 1)) 23 | '(0 0 0 0 0 0 1 1 1 1 1 2 2 2 2 3 4 4 4 5 5 5 5 6 7 7 7 7 7 7 7 7 7 8 8 8 8 8 9 9 9 9 9 9 9 9 9 9)) 24 | -------------------------------------------------------------------------------- /tests/exercise-3.22-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.22.rkt") 5 | 6 | (check-equal? (run "(- 3 3)") (num-val 0)) 7 | (check-equal? (run "(- 3 4)") (num-val -1)) 8 | (check-equal? (run "(- 4 3)") (num-val 1)) 9 | (check-equal? (run "(zero? 0)") (bool-val #t)) 10 | (check-equal? (run "(zero? 4)") (bool-val #f)) 11 | (check-equal? (run "if (zero? 0) then 7 else 11") (num-val 7)) 12 | (check-equal? (run "if (zero? 2) then 7 else 11") (num-val 11)) 13 | (check-equal? (run "let x = 5 in x") (num-val 5)) 14 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 15 | 16 | (check-equal? (run "let f = proc (x) (- x 11) 17 | in (f (f 77))") 18 | (num-val 55)) 19 | 20 | (check-equal? (run "(proc (f) (f (f 77)) 21 | proc (x) (- x 11))") 22 | (num-val 55)) 23 | 24 | (check-equal? (run "let x = 200 25 | in let f = proc (z) (- z x) 26 | in let x = 100 27 | in let g = proc (z) (- z x) 28 | in (- (f 1) (g 1))") 29 | (num-val -100)) 30 | -------------------------------------------------------------------------------- /solutions/exercise-2.13.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.13 [★★] Extend the procedural representation to implement empty-env? by representing the environment by 4 | ;; a list of two procedures: one that returns the value associated with a variable, as before, and one that returns 5 | ;; whether or not the environment is empty. 6 | 7 | (define report-no-binding-found 8 | (lambda (search-var) 9 | (eopl:error 'apply-env "No binding for ~s" search-var))) 10 | 11 | (define empty-env 12 | (lambda () 13 | (list (lambda (search-var) 14 | (report-no-binding-found search-var)) 15 | (lambda () 16 | #t)))) 17 | 18 | (define empty-env? 19 | (lambda (env) 20 | ((cadr env)))) 21 | 22 | (define extend-env 23 | (lambda (saved-var saved-val saved-env) 24 | (list (lambda (search-var) 25 | (if (eqv? search-var saved-var) 26 | saved-val 27 | (apply-env saved-env search-var))) 28 | (lambda () 29 | #f)))) 30 | 31 | (define apply-env 32 | (lambda (env search-var) 33 | ((car env) search-var))) 34 | 35 | (provide empty-env empty-env? extend-env apply-env) 36 | -------------------------------------------------------------------------------- /tests/exercise-4.33-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-call-by-reference-lang.rkt") 5 | 6 | (check-equal? (run "let f = proc (x) 7 | set x = 4 8 | in let a = 6 9 | in begin (f a); 10 | a 11 | end") 12 | (num-val 4)) 13 | 14 | (check-equal? (run "let f = proc* (x) 15 | set x = 4 16 | in let a = 6 17 | in begin (f a); 18 | a 19 | end") 20 | (num-val 6)) 21 | 22 | (check-equal? (run "letrec f(x) = set x = 4 23 | in let a = 6 24 | in begin (f a); 25 | a 26 | end") 27 | (num-val 4)) 28 | 29 | (check-equal? (run "letrec* f(x) = set x = 4 30 | in let a = 6 31 | in begin (f a); 32 | a 33 | end") 34 | (num-val 6)) 35 | -------------------------------------------------------------------------------- /tests/exercise-3.20-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-proc-lang.rkt") 5 | 6 | (check-equal? (run "let f = proc (x) 7 | proc (y) 8 | -(x, -(0, y)) 9 | in ((f 0) 0)") 10 | (num-val 0)) 11 | 12 | (check-equal? (run "let f = proc (x) 13 | proc (y) 14 | -(x, -(0, y)) 15 | in ((f 0) 1)") 16 | (num-val 1)) 17 | 18 | (check-equal? (run "let f = proc (x) 19 | proc (y) 20 | -(x, -(0, y)) 21 | in ((f 1) 0)") 22 | (num-val 1)) 23 | 24 | (check-equal? (run "let f = proc (x) 25 | proc (y) 26 | -(x, -(0, y)) 27 | in ((f 1) 1)") 28 | (num-val 2)) 29 | 30 | (check-equal? (run "let f = proc (x) 31 | proc (y) 32 | -(x, -(0, y)) 33 | in ((f 3) 4)") 34 | (num-val 7)) 35 | -------------------------------------------------------------------------------- /solutions/exercise-2.28.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.28 [★] Write an unparser that converts the abstract syntax of an lc-exp into a string that matches the 4 | ;; second grammar in this section (page 52). 5 | 6 | (define identifier? symbol?) 7 | 8 | (define-datatype lc-exp lc-exp? 9 | [var-exp [var identifier?]] 10 | [lambda-exp [bound-var identifier?] 11 | [body lc-exp?]] 12 | [app-exp [rator lc-exp?] 13 | [rand lc-exp?]]) 14 | 15 | (define unparse-lc-exp 16 | (lambda (exp) 17 | (cases lc-exp exp 18 | [var-exp (var) (symbol->string var)] 19 | [lambda-exp (bound-var body) 20 | (string-append "(lambda (" 21 | (symbol->string bound-var) 22 | ") " 23 | (unparse-lc-exp body) 24 | ")")] 25 | [app-exp (rator rand) 26 | (string-append "(" 27 | (unparse-lc-exp rator) 28 | " " 29 | (unparse-lc-exp rand) 30 | ")")]))) 31 | 32 | (provide var-exp lambda-exp app-exp unparse-lc-exp) 33 | -------------------------------------------------------------------------------- /tests/exercise-4.26-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.26.rkt") 5 | 6 | (define (get-output string) 7 | (with-output-to-string 8 | (λ () 9 | (run string)))) 10 | 11 | (check-equal? (get-output "var even? = proc (num) 12 | if zero?(num) 13 | then 1 14 | else (odd? -(num, 1)), 15 | odd? = proc (num) 16 | if zero?(num) 17 | then 0 18 | else (even? -(num, 1)); 19 | { 20 | print (even? 0); 21 | print (even? 1); 22 | print (even? 2); 23 | print (even? 3); 24 | print (odd? 0); 25 | print (odd? 1); 26 | print (odd? 2); 27 | print (odd? 3) 28 | }") 29 | "1\n0\n1\n0\n0\n1\n0\n1\n") 30 | -------------------------------------------------------------------------------- /solutions/exercise-2.5.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.5 [★] We can use any data structure for representing environments, if we can distinguish empty 4 | ;; environments from non-empty ones, and in which one can extract the pieces of a non-empty environment. Implement 5 | ;; environments using a representation in which the empty environment is represented as the empty list, and in which 6 | ;; extend-env builds an environment that looks like 7 | ;; 8 | ;; ┌───┬───┐ 9 | ;; │ ╷ │ ╶─┼─► saved-env 10 | ;; └─┼─┴───┘ 11 | ;; ▼ 12 | ;; ┌───┬───┐ 13 | ;; │ ╷ │ ╷ │ 14 | ;; └─┼─┴─┼─┘ 15 | ;; ┌──┘ └───┐ 16 | ;; ▼ ▼ 17 | ;; saved-var saved-val 18 | ;; 19 | ;; This is called an a-list or association-list representation. 20 | 21 | (define empty-env 22 | (lambda () 23 | '())) 24 | 25 | (define apply-env 26 | (lambda (env search-var) 27 | (let ([head (car env)]) 28 | (if (eqv? (car head) search-var) 29 | (cdr head) 30 | (apply-env (cdr env) search-var))))) 31 | 32 | (define extend-env 33 | (lambda (var val env) 34 | (cons (cons var val) env))) 35 | 36 | (provide empty-env apply-env extend-env) 37 | -------------------------------------------------------------------------------- /tests/exercise-1.32-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.31.rkt") 5 | (require "../solutions/exercise-1.32.rkt") 6 | 7 | (define check-bin-tree-equal? 8 | (lambda (bin-tree-1 bin-tree-2) 9 | (if (leaf? bin-tree-1) 10 | (test-begin (check-true (leaf? bin-tree-2)) 11 | (check-eqv? (contents-of bin-tree-1) (contents-of bin-tree-2))) 12 | (test-begin (check-false (leaf? bin-tree-2)) 13 | (check-eqv? (contents-of bin-tree-1) (contents-of bin-tree-2)) 14 | (check-bin-tree-equal? (lson bin-tree-1) (lson bin-tree-2)) 15 | (check-bin-tree-equal? (rson bin-tree-1) (rson bin-tree-2)))))) 16 | 17 | (check-bin-tree-equal? (double-tree (leaf 0)) (leaf 0)) 18 | (check-bin-tree-equal? (double-tree (leaf 1)) (leaf 2)) 19 | (check-bin-tree-equal? (double-tree (leaf 2)) (leaf 4)) 20 | (check-bin-tree-equal? (double-tree (interior-node 'a (leaf 3) (leaf 4))) (interior-node 'a (leaf 6) (leaf 8))) 21 | (check-bin-tree-equal? (double-tree (interior-node 'a (interior-node 'b (leaf 5) (leaf 6)) (leaf 7))) 22 | (interior-node 'a (interior-node 'b (leaf 10) (leaf 12)) (leaf 14))) 23 | -------------------------------------------------------------------------------- /tests/exercise-3.43-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-lexaddr-lang.rkt") 5 | 6 | (check-equal? (run "let x = 3 7 | in let f = proc (y) 8 | -(y, x) 9 | in (f 13)") 10 | (num-val 10)) 11 | 12 | (check-equal? (run "let x = 5 13 | in let f = proc () 14 | x 15 | in let x = 3 16 | in (f)") 17 | (num-val 5)) 18 | 19 | (check-equal? (run "let x = 5 20 | in let f = proc () 21 | x 22 | in let y = 3 23 | in (f)") 24 | (num-val 5)) 25 | 26 | (check-equal? (run "let x = 7 27 | in let f = proc (y) 28 | -(y, x) 29 | in let y = 10 30 | in (f y)") 31 | (num-val 3)) 32 | 33 | (check-equal? (run "let f = 7 34 | in let f = proc () 35 | f 36 | in (f)") 37 | (num-val 7)) 38 | -------------------------------------------------------------------------------- /solutions/exercise-2.15.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.15 [★] Implement the lambda-calculus expression interface for the representation specified by the grammar 4 | ;; above. 5 | 6 | (define var-exp 7 | (lambda (var) 8 | var)) 9 | 10 | (define lambda-exp 11 | (lambda (bound-var body) 12 | `(lambda (,bound-var) 13 | ,body))) 14 | 15 | (define app-exp 16 | (lambda (operator operand) 17 | `(,operator ,operand))) 18 | 19 | (define var-exp? symbol?) 20 | 21 | (define lambda-exp? 22 | (lambda (exp) 23 | (and (pair? exp) 24 | (eqv? (car exp) 'lambda)))) 25 | 26 | (define app-exp? 27 | (lambda (exp) 28 | (and (pair? exp) 29 | (not (eqv? (car exp) 'lambda))))) 30 | 31 | (define var-exp->var 32 | (lambda (exp) 33 | exp)) 34 | 35 | (define lambda-exp->bound-var caadr) 36 | 37 | (define lambda-exp->body caddr) 38 | 39 | (define app-exp->rator car) 40 | 41 | (define app-exp->rand cadr) 42 | 43 | (provide var-exp 44 | lambda-exp 45 | app-exp 46 | var-exp? 47 | lambda-exp? 48 | app-exp? 49 | var-exp->var 50 | lambda-exp->bound-var 51 | lambda-exp->body 52 | app-exp->rator 53 | app-exp->rand) 54 | -------------------------------------------------------------------------------- /solutions/exercise-2.24.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.24 [★] Here is a definition of binary trees using define-datatype. 4 | ;; 5 | ;; (define-datatype bintree bintree? 6 | ;; (leaf-node 7 | ;; (num integer?)) 8 | ;; (interior-node 9 | ;; (key symbol?) 10 | ;; (left bintree?) 11 | ;; (right bintree?))) 12 | ;; 13 | ;; Implement a bintree-to-list procedure for binary trees, so that 14 | ;; (bintree-to-list (interior-node 'a (leaf-node 3) (leaf-node 4))) returns the list 15 | ;; 16 | ;; (interior-node 17 | ;; a 18 | ;; (leaf-node 3) 19 | ;; (leaf-node 4)) 20 | 21 | (define-datatype bintree bintree? 22 | [leaf-node [num integer?]] 23 | [interior-node [key symbol?] 24 | [left bintree?] 25 | [right bintree?]]) 26 | 27 | (define bintree-to-list 28 | (lambda (tree) 29 | (cases bintree tree 30 | [leaf-node (num) `(leaf-node ,num)] 31 | [interior-node (key left right) (list 'interior-node 32 | key 33 | (bintree-to-list left) 34 | (bintree-to-list right))]))) 35 | 36 | (provide bintree leaf-node interior-node bintree-to-list) 37 | -------------------------------------------------------------------------------- /tests/exercise-5.6-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-letrec-lang.rkt") 5 | 6 | (check-equal? (run "list()") (emptylist-val)) 7 | 8 | (check-equal? (run "list(1)") (pair-val (num-val 1) 9 | (emptylist-val))) 10 | 11 | (check-equal? (run "list(2, 3)") (pair-val (num-val 2) 12 | (pair-val (num-val 3) 13 | (emptylist-val)))) 14 | 15 | (check-equal? (run "list(5, 7, 9)") (pair-val (num-val 5) 16 | (pair-val (num-val 7) 17 | (pair-val (num-val 9) 18 | (emptylist-val))))) 19 | 20 | (check-equal? (run "list(11, 13, 17, 19)") (pair-val (num-val 11) 21 | (pair-val (num-val 13) 22 | (pair-val (num-val 17) 23 | (pair-val (num-val 19) 24 | (emptylist-val)))))) 25 | -------------------------------------------------------------------------------- /tests/exercise-5.25-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-letrec-lang-registers.rkt") 5 | 6 | (check-equal? (run "let f = proc () 7 | 3 8 | in (f)") 9 | (num-val 3)) 10 | 11 | (check-equal? (run "let f = proc (x, y) 12 | -(x, y) 13 | in (f 0 1)") 14 | (num-val -1)) 15 | 16 | (check-equal? (run "let f = proc (x, y, z) 17 | x 18 | in (f 2 3 5)") 19 | (num-val 2)) 20 | 21 | (check-equal? (run "let f = proc (x, y, z) 22 | y 23 | in (f 2 3 5)") 24 | (num-val 3)) 25 | 26 | (check-equal? (run "let f = proc (x, y, z) 27 | z 28 | in (f 2 3 5)") 29 | (num-val 5)) 30 | 31 | (check-equal? (run "letrec f() = 6 32 | in (f)") 33 | (num-val 6)) 34 | 35 | (check-equal? (run "letrec f(x) = -(x, 2) 36 | in (f 4)") 37 | (num-val 2)) 38 | 39 | (check-equal? (run "letrec f(x, y) = -(x, y) 40 | in (f 7 2)") 41 | (num-val 5)) 42 | -------------------------------------------------------------------------------- /tests/exercise-4.42-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-call-by-need-lang.rkt") 5 | 6 | (check-equal? (run "let* x = 3 7 | in x") 8 | (num-val 3)) 9 | 10 | (check-equal? (run "let* f = proc (x) 11 | x 12 | in (f 4)") 13 | (num-val 4)) 14 | 15 | (check-equal? (run "let x = 2 16 | in let* y = x 17 | in begin set y = 3; 18 | x 19 | end") 20 | (num-val 3)) 21 | 22 | (check-equal? (run "let x = 2 23 | in let y = begin set x = -(x, 1); 24 | x 25 | end 26 | in let a = x 27 | in let b = y 28 | in -(a, b)") 29 | (num-val 0)) 30 | 31 | (check-equal? (run "let x = 2 32 | in let* y = begin set x = -(x, 1); 33 | x 34 | end 35 | in let a = x 36 | in let b = y 37 | in -(a, b)") 38 | (num-val 1)) 39 | -------------------------------------------------------------------------------- /tests/exercise-3.40-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-lexaddr-lang.rkt") 5 | 6 | (check-equal? (run "letrec double(x) = if zero?(x) 7 | then 0 8 | else -((double -(x, 1)), -2) 9 | in (double 6)") 10 | (num-val 12)) 11 | 12 | (check-equal? (run "letrec even(x) = if zero?(x) then 1 else (odd -(x, 1)) 13 | odd(x) = if zero?(x) then 0 else (even -(x, 1)) 14 | in (even 7)") 15 | (num-val 0)) 16 | 17 | (check-equal? (run "letrec even(x) = if zero?(x) then 1 else (odd -(x, 1)) 18 | odd(x) = if zero?(x) then 0 else (even -(x, 1)) 19 | in (even 8)") 20 | (num-val 1)) 21 | 22 | (check-equal? (run "letrec even(x) = if zero?(x) then 1 else (odd -(x, 1)) 23 | odd(x) = if zero?(x) then 0 else (even -(x, 1)) 24 | in (odd 13)") 25 | (num-val 1)) 26 | 27 | (check-equal? (run "letrec even(x) = if zero?(x) then 1 else (odd -(x, 1)) 28 | odd(x) = if zero?(x) then 0 else (even -(x, 1)) 29 | in (odd 16)") 30 | (num-val 0)) 31 | -------------------------------------------------------------------------------- /tests/exercise-6.19-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-6.19.rkt") 5 | 6 | (define (is-tail-form? s) 7 | (tail-form? (scan&parse s))) 8 | 9 | (check-true (is-tail-form? "3")) 10 | (check-true (is-tail-form? "-(3, 4)")) 11 | (check-true (is-tail-form? "-(-(3, 4), 4)")) 12 | (check-true (is-tail-form? "-(3, -(3, 4))")) 13 | (check-true (is-tail-form? "zero?(3)")) 14 | (check-true (is-tail-form? "if x then y else z")) 15 | (check-true (is-tail-form? "if x then (y z) else w")) 16 | (check-true (is-tail-form? "x")) 17 | (check-true (is-tail-form? "let x = y in z")) 18 | (check-true (is-tail-form? "let x = y in (z w)")) 19 | (check-true (is-tail-form? "letrec x (y) = z in w")) 20 | (check-true (is-tail-form? "letrec x (y) = (y z) in w")) 21 | (check-true (is-tail-form? "proc (x) y")) 22 | (check-true (is-tail-form? "(x y z)")) 23 | 24 | (check-false (is-tail-form? "-((x y), z)")) 25 | (check-false (is-tail-form? "zero?((x y))")) 26 | (check-false (is-tail-form? "if (x y) then z else w")) 27 | (check-false (is-tail-form? "if x then ((y z) w) else u")) 28 | (check-false (is-tail-form? "let x = (y z) in w")) 29 | (check-false (is-tail-form? "letrec x (y) = ((y z) w) in u")) 30 | (check-false (is-tail-form? "proc (x) ((y z) w)")) 31 | (check-false (is-tail-form? "((y z) w)")) 32 | -------------------------------------------------------------------------------- /tests/exercise-1.34-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.34.rkt") 5 | 6 | (check-equal? (path 17 '(14 (7 () (12 () ())) 7 | (26 (20 (17 () ()) 8 | ()) 9 | (31 () ())))) 10 | '(right left left)) 11 | 12 | (check-equal? (path 7 '(7 () ())) '()) 13 | 14 | (check-equal? (path 14 '(14 (7 () (12 () ())) 15 | (26 (20 (17 () ()) 16 | ()) 17 | (31 () ())))) 18 | '()) 19 | 20 | (check-equal? (path 7 '(14 (7 () (12 () ())) 21 | (26 (20 (17 () ()) 22 | ()) 23 | (31 () ())))) 24 | '(left)) 25 | 26 | (check-equal? (path 12 '(14 (7 () (12 () ())) 27 | (26 (20 (17 () ()) 28 | ()) 29 | (31 () ())))) 30 | '(left right)) 31 | 32 | (check-equal? (path 31 '(14 (7 () (12 () ())) 33 | (26 (20 (17 () ()) 34 | ()) 35 | (31 () ())))) 36 | '(right right)) 37 | 38 | -------------------------------------------------------------------------------- /solutions/exercise-2.14.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.14 [★★] Extend the representation of the preceding exercise to include a third procedure that implements 4 | ;; has-binding? (see exercise 2.9). 5 | 6 | (define report-no-binding-found 7 | (lambda (search-var) 8 | (eopl:error 'apply-env "No binding for ~s" search-var))) 9 | 10 | (define empty-env 11 | (lambda () 12 | (list (lambda (search-var) 13 | (report-no-binding-found search-var)) 14 | (lambda () 15 | #t) 16 | (lambda (search-var) 17 | #f)))) 18 | 19 | (define empty-env? 20 | (lambda (env) 21 | ((cadr env)))) 22 | 23 | (define extend-env 24 | (lambda (saved-var saved-val saved-env) 25 | (list (lambda (search-var) 26 | (if (eqv? search-var saved-var) 27 | saved-val 28 | (apply-env saved-env search-var))) 29 | (lambda () 30 | #f) 31 | (lambda (search-var) 32 | (or (eqv? saved-var search-var) 33 | (has-binding? saved-env search-var)))))) 34 | 35 | (define apply-env 36 | (lambda (env search-var) 37 | ((car env) search-var))) 38 | 39 | (define has-binding? 40 | (lambda (env search-var) 41 | ((caddr env) search-var))) 42 | 43 | (provide empty-env empty-env? extend-env apply-env has-binding?) 44 | -------------------------------------------------------------------------------- /tests/exercise-3.31-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-letrec-lang.rkt") 5 | 6 | (check-equal? (run "let f = proc (x, y) -(x, y) 7 | in (f 0 0)") 8 | (num-val 0)) 9 | 10 | (check-equal? (run "let f = proc (x, y) -(x, y) 11 | in (f 0 1)") 12 | (num-val -1)) 13 | 14 | (check-equal? (run "let f = proc (x, y) -(x, y) 15 | in (f 1 0)") 16 | (num-val 1)) 17 | 18 | (check-equal? (run "let f = proc (x, y) -(x, y) 19 | in (f 1 1)") 20 | (num-val 0)) 21 | 22 | (check-equal? (run "let f = proc (x, y) -(x, y) 23 | in (f 7 4)") 24 | (num-val 3)) 25 | 26 | (check-equal? (run "letrec f(x, y) = -(x, y) 27 | in (f 0 0)") 28 | (num-val 0)) 29 | 30 | (check-equal? (run "letrec f(x, y) = -(x, y) 31 | in (f 0 1)") 32 | (num-val -1)) 33 | 34 | (check-equal? (run "letrec f(x, y) = -(x, y) 35 | in (f 1 0)") 36 | (num-val 1)) 37 | 38 | (check-equal? (run "letrec f(x, y) = -(x, y) 39 | in (f 1 1)") 40 | (num-val 0)) 41 | 42 | (check-equal? (run "letrec f(x, y) = -(x, y) 43 | in (f 7 4)") 44 | (num-val 3)) 45 | -------------------------------------------------------------------------------- /tests/exercise-3.35-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-letrec-lang-circular.rkt") 5 | 6 | (check-equal? (run "let f = proc (x, y) -(x, y) 7 | in (f 0 0)") 8 | (num-val 0)) 9 | 10 | (check-equal? (run "let f = proc (x, y) -(x, y) 11 | in (f 0 1)") 12 | (num-val -1)) 13 | 14 | (check-equal? (run "let f = proc (x, y) -(x, y) 15 | in (f 1 0)") 16 | (num-val 1)) 17 | 18 | (check-equal? (run "let f = proc (x, y) -(x, y) 19 | in (f 1 1)") 20 | (num-val 0)) 21 | 22 | (check-equal? (run "let f = proc (x, y) -(x, y) 23 | in (f 7 4)") 24 | (num-val 3)) 25 | 26 | (check-equal? (run "letrec f(x, y) = -(x, y) 27 | in (f 0 0)") 28 | (num-val 0)) 29 | 30 | (check-equal? (run "letrec f(x, y) = -(x, y) 31 | in (f 0 1)") 32 | (num-val -1)) 33 | 34 | (check-equal? (run "letrec f(x, y) = -(x, y) 35 | in (f 1 0)") 36 | (num-val 1)) 37 | 38 | (check-equal? (run "letrec f(x, y) = -(x, y) 39 | in (f 1 1)") 40 | (num-val 0)) 41 | 42 | (check-equal? (run "letrec f(x, y) = -(x, y) 43 | in (f 7 4)") 44 | (num-val 3)) 45 | -------------------------------------------------------------------------------- /tests/exercise-3.x-proc-lang-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-proc-lang.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | -------------------------------------------------------------------------------- /tests/exercise-5.8-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-letrec-lang.rkt") 5 | 6 | (check-equal? (run "let f = proc (x, y) 7 | -(x, y) 8 | in (f 0 0)") 9 | (num-val 0)) 10 | 11 | (check-equal? (run "let f = proc (x, y) 12 | -(x, y) 13 | in (f 0 1)") 14 | (num-val -1)) 15 | 16 | (check-equal? (run "let f = proc (x, y) 17 | -(x, y) 18 | in (f 1 0)") 19 | (num-val 1)) 20 | 21 | (check-equal? (run "let f = proc (x, y) 22 | -(x, y) 23 | in (f 1 1)") 24 | (num-val 0)) 25 | 26 | (check-equal? (run "let f = proc (x, y) 27 | -(x, y) 28 | in (f 7 4)") 29 | (num-val 3)) 30 | 31 | (check-equal? (run "let f = proc (x, y, z) 32 | x 33 | in (f 2 3 5)") 34 | (num-val 2)) 35 | 36 | (check-equal? (run "let f = proc (x, y, z) 37 | y 38 | in (f 2 3 5)") 39 | (num-val 3)) 40 | 41 | (check-equal? (run "let f = proc (x, y, z) 42 | z 43 | in (f 2 3 5)") 44 | (num-val 5)) 45 | -------------------------------------------------------------------------------- /tests/exercise-2.26-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.26.rkt") 5 | 6 | (check-equal? (mark-leaves-with-red-depth (red-node (blue-node (list (leaf-node 26) 7 | (leaf-node 12))) 8 | (red-node (leaf-node 11) 9 | (blue-node (list (leaf-node 117) 10 | (leaf-node 14)))))) 11 | (red-node (blue-node (list (leaf-node 1) (leaf-node 1))) 12 | (red-node (leaf-node 2) (blue-node (list (leaf-node 2) (leaf-node 2)))))) 13 | 14 | (check-equal? (mark-leaves-with-red-depth (leaf-node 0)) (leaf-node 0)) 15 | (check-equal? (mark-leaves-with-red-depth (leaf-node 1)) (leaf-node 0)) 16 | (check-equal? (mark-leaves-with-red-depth (leaf-node 2)) (leaf-node 0)) 17 | 18 | (check-equal? (mark-leaves-with-red-depth (blue-node (list (leaf-node 3) (leaf-node 4)))) 19 | (blue-node (list (leaf-node 0) (leaf-node 0)))) 20 | 21 | (check-equal? (mark-leaves-with-red-depth (blue-node (list (blue-node (list (leaf-node 5) (leaf-node 6))) 22 | (leaf-node 7)))) 23 | (blue-node (list (blue-node (list (leaf-node 0) (leaf-node 0))) 24 | (leaf-node 0)))) 25 | -------------------------------------------------------------------------------- /tests/exercise-3.x-lexaddr-lang-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-lexaddr-lang.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "let x = 4 38 | y = 7 39 | in -(y, x)") 40 | (num-val 3)) 41 | -------------------------------------------------------------------------------- /tests/exercise-3.15-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-let-lang.rkt") 5 | 6 | (define (check-result-and-output-equal? thunk expected-result expected-output) 7 | (let-values ([(result output) (let ([output-string-port (open-output-string)]) 8 | (parameterize ([current-output-port output-string-port]) 9 | (let* ([result (thunk)] 10 | [output (get-output-string output-string-port)]) 11 | (values result output))))]) 12 | (check-equal? result expected-result) 13 | (check-equal? output expected-output))) 14 | 15 | (check-result-and-output-equal? (λ () (run "print(7)")) 16 | (num-val 1) 17 | "7\n") 18 | 19 | (check-result-and-output-equal? (λ () (run "print(zero?(0))")) 20 | (num-val 1) 21 | "#t\n") 22 | 23 | (check-result-and-output-equal? (λ () (run "print(zero?(7))")) 24 | (num-val 1) 25 | "#f\n") 26 | 27 | (check-result-and-output-equal? (λ () (run "print(emptylist)")) 28 | (num-val 1) 29 | "()\n") 30 | 31 | (check-result-and-output-equal? (λ () (run "print(list(3, 4, 6))")) 32 | (num-val 1) 33 | "(3 4 6)\n") 34 | -------------------------------------------------------------------------------- /tests/exercise-4.38-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-call-by-need-lang.rkt") 5 | 6 | (check-equal? (run "let makerec = proc (f) 7 | let d = proc (x) 8 | (f (x x)) 9 | in (f (d d)) 10 | in let maketimes4 = proc (f) 11 | proc (x) 12 | if zero?(x) 13 | then 0 14 | else -((f -(x, 1)), -4) 15 | in let times4 = (makerec maketimes4) 16 | in (times4 3)") 17 | (num-val 12)) 18 | 19 | (check-equal? (run "let makerec = proc (f) 20 | let d = proc (x) 21 | proc (z) 22 | ((f (x x)) z) 23 | in proc (n) 24 | ((f (d d)) n) 25 | in let maketimes4 = proc (f) 26 | proc (x) 27 | if zero?(x) 28 | then 0 29 | else -((f -(x, 1)), -4) 30 | in let times4 = (makerec maketimes4) 31 | in (times4 3)") 32 | (num-val 12)) 33 | -------------------------------------------------------------------------------- /solutions/exercise-1.35.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.35 [★★★] Write a procedure number-leaves that takes a bintree, and produces a bintree like the original, 4 | ;; except the contents of the leaves are numbered starting from 0. For example, 5 | ;; 6 | ;; (number-leaves 7 | ;; (interior-node 'foo 8 | ;; (interior-node 'bar 9 | ;; (leaf 26) 10 | ;; (leaf 12)) 11 | ;; (interior-node 'baz 12 | ;; (leaf 11) 13 | ;; (interior-node 'quux 14 | ;; (leaf 117) 15 | ;; (leaf 14))))) 16 | ;; 17 | ;; should return 18 | ;; 19 | ;; (foo 20 | ;; (bar 0 1) 21 | ;; (baz 22 | ;; 2 23 | ;; (quux 3 4))) 24 | 25 | (require "exercise-1.31.rkt") 26 | 27 | (define number-leaves-helper 28 | (lambda (bin-tree n) 29 | (if (leaf? bin-tree) 30 | (cons (leaf n) (+ n 1)) 31 | (let* ([left-result (number-leaves-helper (lson bin-tree) n)] 32 | [right-result (number-leaves-helper (rson bin-tree) (cdr left-result))]) 33 | (cons (interior-node (contents-of bin-tree) 34 | (car left-result) 35 | (car right-result)) 36 | (cdr right-result)))))) 37 | 38 | (define number-leaves 39 | (lambda (bin-tree) 40 | (car (number-leaves-helper bin-tree 0)))) 41 | 42 | (provide number-leaves) 43 | -------------------------------------------------------------------------------- /tests/exercise-5.1-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.1.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /tests/exercise-5.15-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.15.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /tests/exercise-5.17-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.17.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /tests/exercise-5.18-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.18.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /tests/exercise-5.19-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.19.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /tests/exercise-5.2-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.2.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /tests/exercise-5.26-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.26.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /tests/exercise-6.7-inlined-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-6.7-inlined.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /tests/exercise-6.7-procedural-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-6.7-procedural.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /tests/exercise-3.x-letrec-lang-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-letrec-lang.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /tests/exercise-5.x-letrec-lang-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-letrec-lang.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /tests/exercise-3.x-letrec-lang-circular-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-letrec-lang-circular.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /solutions/exercise-4.9.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 4.9 [★] Implement the store in constant time by representing it as a Scheme vector. What is lost by using 4 | ;; this representation? 5 | 6 | (define (empty-store) 7 | (vector)) 8 | 9 | (define the-store 'uninitialized) 10 | 11 | (define (get-store) 12 | the-store) 13 | 14 | (define (initialize-store!) 15 | (set! the-store (empty-store))) 16 | 17 | (define (reference? v) 18 | (and (integer? v) 19 | (not (negative? v)))) 20 | 21 | (define (extend-store store val) 22 | (let* ([store-size (vector-length store)] 23 | [new-store (make-vector (+ store-size 1))]) 24 | (let loop ([i 0]) 25 | (if (< i store-size) 26 | (let ([val (vector-ref store i)]) 27 | (vector-set! new-store i val) 28 | (loop (+ i 1))) 29 | (vector-set! new-store i val))) 30 | (cons new-store store-size))) 31 | 32 | (define (newref val) 33 | (let* ([new-store-info (extend-store the-store val)] 34 | [new-store (car new-store-info)] 35 | [new-ref (cdr new-store-info)]) 36 | (set! the-store new-store) 37 | new-ref)) 38 | 39 | (define (deref ref) 40 | (vector-ref the-store ref)) 41 | 42 | (define (report-invalid-reference ref store) 43 | (eopl:error 'setref 44 | "illegal reference ~s in store ~s" 45 | ref 46 | store)) 47 | 48 | (define (setref! ref val) 49 | (if (and (reference? ref) 50 | (< ref (vector-length the-store))) 51 | (vector-set! the-store ref val) 52 | (report-invalid-reference ref the-store))) 53 | 54 | (provide initialize-store! newref deref setref!) 55 | -------------------------------------------------------------------------------- /tests/exercise-5.x-letrec-lang-registers-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-letrec-lang-registers.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /tests/exercise-5.x-letrec-lang-trampolined-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-letrec-lang-trampolined.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | -------------------------------------------------------------------------------- /tests/exercise-2.20-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-2.20.rkt") 5 | 6 | (check-equal? (number->bintree 13) '((13 () ()) . ())) 7 | 8 | (define t1 (insert-to-right 14 9 | (insert-to-left 12 10 | (number->bintree 13)))) 11 | 12 | (check-equal? t1 13 | '((13 14 | (12 () ()) 15 | (14 () ())) . ())) 16 | 17 | (check-equal? (move-to-left-son t1) '((12 () ()) . ((13 right (14 () ()))))) 18 | (check-equal? (move-to-right-son t1) '((14 () ()) . ((13 left (12 () ()))))) 19 | (check-eqv? (current-element (move-to-left-son t1)) 12) 20 | (check-eqv? (current-element (move-to-right-son t1)) 14) 21 | (check-true (at-leaf? (move-to-right-son (move-to-left-son t1)))) 22 | 23 | (check-equal? (insert-to-left 15 t1) 24 | '((13 25 | (15 26 | (12 () ()) 27 | ()) 28 | (14 () ()))) . ()) 29 | 30 | (check-equal? (insert-to-right 15 t1) 31 | '((13 32 | (12 () ()) 33 | (15 34 | () 35 | (14 () ()))) . ())) 36 | 37 | (check-eqv? (current-element t1) 13) 38 | (check-equal? (move-up (move-up (move-to-left-son (move-to-left-son t1)))) t1) 39 | (check-equal? (move-up (move-up (move-to-right-son (move-to-left-son t1)))) t1) 40 | (check-equal? (move-up (move-up (move-to-left-son (move-to-right-son t1)))) t1) 41 | (check-equal? (move-up (move-up (move-to-right-son (move-to-right-son t1)))) t1) 42 | (check-true (at-root? t1)) 43 | (check-false (at-root? (move-to-left-son t1))) 44 | -------------------------------------------------------------------------------- /solutions/exercise-1.33.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.33 [★★] Write a procedure mark-leaves-with-red-depth that takes a bintree (definition 1.1.7), and 4 | ;; produces a bintree of the same shape as the original, except that in the new tree, each leaf contains the number of 5 | ;; nodes between it and the root that contain the symbol red. For example, the expression 6 | ;; 7 | ;; (mark-leaves-with-red-depth 8 | ;; (interior-node 'red 9 | ;; (interior-node 'bar 10 | ;; (leaf 26) 11 | ;; (leaf 12)) 12 | ;; (interior-node 'red 13 | ;; (leaf 11) 14 | ;; (interior-node 'quux 15 | ;; (leaf 117) 16 | ;; (leaf 14))))) 17 | ;; 18 | ;; which is written using the procedures defined in exercise 1.31, should return the bintree 19 | ;; 20 | ;; (red 21 | ;; (bar 1 1) 22 | ;; (red 2 (quux 2 2))) 23 | 24 | (require "exercise-1.31.rkt") 25 | 26 | (define mark-leaves-with-red-depth-helper 27 | (lambda (bin-tree red-num) 28 | (if (leaf? bin-tree) 29 | (leaf red-num) 30 | (let* ([content (contents-of bin-tree)] 31 | [new-red-num (if (eqv? content 'red) (+ red-num 1) red-num)]) 32 | (interior-node content 33 | (mark-leaves-with-red-depth-helper (lson bin-tree) new-red-num) 34 | (mark-leaves-with-red-depth-helper (rson bin-tree) new-red-num)))))) 35 | 36 | (define mark-leaves-with-red-depth 37 | (lambda (bin-tree) 38 | (mark-leaves-with-red-depth-helper bin-tree 0))) 39 | 40 | (provide mark-leaves-with-red-depth) 41 | -------------------------------------------------------------------------------- /tests/exercise-3.25-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-proc-lang.rkt") 5 | 6 | (check-equal? (run "let makerec = proc (f) 7 | let d = proc (x) 8 | proc (z) 9 | ((f (x x)) z) 10 | in proc (n) 11 | ((f (d d)) n) 12 | in let maketimes4 = proc (f) 13 | proc (x) 14 | if zero?(x) 15 | then 0 16 | else -((f -(x, 1)), -4) 17 | in let times4 = (makerec maketimes4) 18 | in (times4 3)") 19 | (num-val 12)) 20 | 21 | (check-equal? (run "let makerec = proc (f) 22 | let maker = proc (maker) 23 | proc (x) 24 | let recurive-proc = (maker maker) 25 | in ((f recurive-proc) x) 26 | in (maker maker) 27 | in let maketimes4 = proc (f) 28 | proc (x) 29 | if zero?(x) 30 | then 0 31 | else -((f -(x, 1)), -4) 32 | in let times4 = (makerec maketimes4) 33 | in (times4 3)") 34 | (num-val 12)) 35 | -------------------------------------------------------------------------------- /solutions/exercise-2.26.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.26 [★★] Here is another version of exercise 1.33. Consider a set of trees given by the following 4 | ;; grammar: 5 | ;; 6 | ;; Red-blue-tree ::= Red-blue-subtree 7 | ;; Red-blue-subtree ::= (red-node Red-blue-subtree Red-blue-subtree) 8 | ;; ::= (blue-node {Red-blue-subtree}*) 9 | ;; ::= (leaf-node Int) 10 | ;; 11 | ;; Write an equivalent definition using define-datatype, and use the resulting interface to write a procedure that takes 12 | ;; a tree and builds a tree of the same shape, except that each leaf node is replaced by a leaf node that contains the 13 | ;; number of red nodes on the path between it and the root. 14 | 15 | (define-datatype red-blue-tree red-blue-tree? 16 | [red-node [lson red-blue-tree?] 17 | [rson red-blue-tree?]] 18 | [blue-node [sons (list-of red-blue-tree?)]] 19 | [leaf-node [num integer?]]) 20 | 21 | (define mark-leaves-with-red-depth-helper 22 | (lambda (tree red-num) 23 | (cases red-blue-tree tree 24 | [red-node (lson rson) (let ([new-red-num (+ red-num 1)]) 25 | (red-node (mark-leaves-with-red-depth-helper lson new-red-num) 26 | (mark-leaves-with-red-depth-helper rson new-red-num)))] 27 | [blue-node (sons) (blue-node (map (lambda (son) 28 | (mark-leaves-with-red-depth-helper son red-num)) 29 | sons))] 30 | [leaf-node (_) (leaf-node red-num)]))) 31 | 32 | (define mark-leaves-with-red-depth 33 | (lambda (tree) 34 | (mark-leaves-with-red-depth-helper tree 0))) 35 | 36 | (provide red-blue-tree red-node blue-node leaf-node mark-leaves-with-red-depth) 37 | -------------------------------------------------------------------------------- /solutions/exercise-2.1.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.1 [★] Implement the four required operations for bigits. Then use your implementation to calculate the 4 | ;; factorial of 10. How does the execution time vary as this argument changes? How does the execution time vary as the 5 | ;; base changes? Explain why. 6 | 7 | (define *base* 10) 8 | (define *base-sub-1* (- *base* 1)) 9 | 10 | (define zero 11 | (lambda () 12 | '())) 13 | 14 | (define is-zero? null?) 15 | 16 | (define successor 17 | (lambda (n) 18 | (if (null? n) 19 | '(1) 20 | (let ([lowest-digit (car n)]) 21 | (if (= lowest-digit *base-sub-1*) 22 | (cons 0 (successor (cdr n))) 23 | (cons (+ lowest-digit 1) (cdr n))))))) 24 | 25 | (define predecessor 26 | (lambda (n) 27 | (let ([lowest-digit (car n)] 28 | [rest-digits (cdr n)]) 29 | (if (= lowest-digit 0) 30 | (cons *base-sub-1* (predecessor rest-digits)) 31 | (if (and (= lowest-digit 1) (null? rest-digits)) 32 | '() 33 | (cons (- lowest-digit 1) (cdr n))))))) 34 | 35 | (define plus 36 | (lambda (m n) 37 | (if (is-zero? n) 38 | m 39 | (plus (successor m) (predecessor n))))) 40 | 41 | (define multiply-helper 42 | (lambda (base m n) 43 | (if (is-zero? n) 44 | base 45 | (multiply-helper (plus base m) m (predecessor n))))) 46 | 47 | (define multiply 48 | (lambda (m n) 49 | (multiply-helper (zero) m n))) 50 | 51 | (define factorial-helper 52 | (lambda (base n) 53 | (if (is-zero? n) 54 | base 55 | (factorial-helper (multiply base n) (predecessor n))))) 56 | 57 | (define factorial 58 | (lambda (n) 59 | (factorial-helper (successor (zero)) n))) 60 | 61 | (provide zero is-zero? successor predecessor factorial) 62 | -------------------------------------------------------------------------------- /tests/exercise-3.23-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-proc-lang.rkt") 5 | 6 | (check-equal? (run "let makemult = proc (maker) 7 | proc (x) 8 | if zero?(x) 9 | then 0 10 | else -(((maker maker) -(x, 1)), -4) 11 | in let times4 = proc (x) ((makemult makemult) x) 12 | in (times4 3)") 13 | (num-val 12)) 14 | 15 | (define (fact n) 16 | (run (format "(let maketimes = proc (maker) 17 | proc (x) 18 | proc (y) 19 | if zero?(x) 20 | then 0 21 | else -((((maker maker) -(x, 1)) y), -(0, y)) 22 | in let times = (maketimes maketimes) 23 | in let makefact = proc (maker) 24 | proc (x) 25 | if zero?(x) 26 | then 1 27 | else ((times x) ((maker maker) -(x, 1))) 28 | in (makefact makefact) 29 | ~a)" n))) 30 | 31 | (check-equal? (fact 0) (num-val 1)) 32 | (check-equal? (fact 1) (num-val 1)) 33 | (check-equal? (fact 2) (num-val 2)) 34 | (check-equal? (fact 3) (num-val 6)) 35 | (check-equal? (fact 4) (num-val 24)) 36 | (check-equal? (fact 5) (num-val 120)) 37 | (check-equal? (fact 6) (num-val 720)) 38 | (check-equal? (fact 7) (num-val 5040)) 39 | (check-equal? (fact 8) (num-val 40320)) 40 | (check-equal? (fact 9) (num-val 362880)) 41 | (check-equal? (fact 10) (num-val 3628800)) 42 | -------------------------------------------------------------------------------- /tests/exercise-4.11-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-explicit-refs-lang.rkt") 5 | 6 | (check-equal? (run "let x = 4 7 | in cons(x, 8 | cons(cons(-(x, 1), 9 | emptylist), 10 | emptylist))") 11 | (pair-val (num-val 4) 12 | (pair-val (pair-val (num-val 3) 13 | (emptylist-val)) 14 | (emptylist-val)))) 15 | 16 | (check-equal? (run "car(cons(2, 3))") (num-val 2)) 17 | (check-equal? (run "cdr(cons(2, 3))") (num-val 3)) 18 | (check-equal? (run "null?(emptylist)") (bool-val #t)) 19 | (check-equal? (run "null?(1)") (bool-val #f)) 20 | (check-equal? (run "null?(cons(2, 3))") (bool-val #f)) 21 | (check-equal? (run "list()") (emptylist-val)) 22 | (check-equal? (run "list(1)") (pair-val (num-val 1) (emptylist-val))) 23 | (check-equal? (run "list(3, 1)") (pair-val (num-val 3) (pair-val (num-val 1) (emptylist-val)))) 24 | 25 | (check-equal? (run "list(6, 8, 7)") (pair-val (num-val 6) 26 | (pair-val (num-val 8) 27 | (pair-val (num-val 7) 28 | (emptylist-val))))) 29 | 30 | (check-equal? (run "let x = 5 31 | in let y = 6 32 | in let z = 11 33 | in let w = newref(z) 34 | in list(y, x, deref(w))") 35 | (pair-val (num-val 6) 36 | (pair-val (num-val 5) 37 | (pair-val (num-val 11) 38 | (emptylist-val))))) 39 | -------------------------------------------------------------------------------- /solutions/exercise-2.7.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.7 [★] Rewrite apply-env in figure 2.1 to give a more informative error message. 4 | 5 | (define empty-env 6 | (lambda () 7 | '(empty-env))) 8 | 9 | (define extend-env 10 | (lambda (var val env) 11 | (list 'extend-env var val env))) 12 | 13 | (define apply-env 14 | (lambda (env search-var) 15 | (let loop ([env1 env]) 16 | (cond 17 | [(eqv? (car env1) 'empty-env) (report-no-binding-found search-var env)] 18 | [(eqv? (car env1) 'extend-env) (let ([saved-var (cadr env1)] 19 | [saved-val (caddr env1)] 20 | [saved-env (cadddr env1)]) 21 | (if (eqv? search-var saved-var) 22 | saved-val 23 | (loop saved-env)))] 24 | [else (report-invalid-env env1)])))) 25 | 26 | (define collect-bindings 27 | (lambda (env) 28 | (let loop ([base '()] 29 | [env env]) 30 | (let ([tag (car env)]) 31 | (cond [(eqv? tag 'empty-env) base] 32 | [(eqv? tag 'extend-env) (let ([saved-var (cadr env)] 33 | [saved-val (caddr env)] 34 | [saved-env (cadddr env)]) 35 | (loop (if (assv saved-var base) 36 | base 37 | (cons (cons saved-var saved-val) base)) 38 | saved-env))]))))) 39 | 40 | (define report-no-binding-found 41 | (lambda (search-var env) 42 | (eopl:error 'apply-env "No binding for ~s. All bindings: ~s" search-var (collect-bindings env)))) 43 | 44 | (define report-invalid-env 45 | (lambda (env) 46 | (eopl:error 'apply-env "Bad environment: ~s" env))) 47 | 48 | (provide empty-env extend-env apply-env) 49 | -------------------------------------------------------------------------------- /solutions/exercise-1.29.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.29 [★★] (sort loi) returns a list of the elements of loi in ascending order. 4 | ;; 5 | ;; > (sort '(8 2 5 2 3)) 6 | ;; (2 2 3 5 8) 7 | 8 | (define get-run 9 | (lambda (loi) 10 | (let ([head1 (car loi)] 11 | [tail1 (cdr loi)]) 12 | (if (null? tail1) 13 | (cons loi '()) 14 | (let ([head2 (car tail1)]) 15 | (if (<= head1 head2) 16 | (let ([tail-run (get-run tail1)]) 17 | (cons (cons head1 (car tail-run)) (cdr tail-run))) 18 | (cons (list head1) tail1))))))) 19 | 20 | (define merge 21 | (lambda (run1 run2) 22 | (let ([head1 (car run1)] 23 | [head2 (car run2)]) 24 | (if (<= head1 head2) 25 | (let ([tail1 (cdr run1)]) 26 | (if (null? tail1) 27 | (cons head1 run2) 28 | (cons head1 (merge tail1 run2)))) 29 | (let ([tail2 (cdr run2)]) 30 | (if (null? tail2) 31 | (cons head2 run1) 32 | (cons head2 (merge run1 tail2)))))))) 33 | 34 | (define collapse-all 35 | (lambda (stack run) 36 | (if (null? stack) 37 | run 38 | (collapse-all (cdr stack) (merge (cdar stack) run))))) 39 | 40 | (define collapse 41 | (lambda (stack level run) 42 | (if (null? stack) 43 | (list (cons level run)) 44 | (let ([top (car stack)]) 45 | (if (= (car top) level) 46 | (collapse (cdr stack) (+ level 1) (merge (cdr top) run)) 47 | (cons (cons level run) stack)))))) 48 | 49 | (define sort-helper 50 | (lambda (stack loi) 51 | (let* ([run-and-tail (get-run loi)] 52 | [run (car run-and-tail)] 53 | [tail (cdr run-and-tail)]) 54 | (if (null? tail) 55 | (collapse-all stack run) 56 | (sort-helper (collapse stack 0 run) tail))))) 57 | 58 | (define sort 59 | (lambda (loi) 60 | (if (null? loi) 61 | '() 62 | (sort-helper '() loi)))) 63 | 64 | (provide sort) 65 | -------------------------------------------------------------------------------- /solutions/exercise-2.29.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.29 [★] Where a Kleene star or plus (page 7) is used in concrete syntax, it is most convenient to use a 4 | ;; list of associated subtrees when constructing an abstract syntax tree. For example, if the grammar for 5 | ;; lambda-calculus expressions had been 6 | ;; 7 | ;; Lc-exp ::= Identifier 8 | ;; ┌───────────────┐ 9 | ;; │ var-exp (var) │ 10 | ;; └───────────────┘ 11 | ;; ::= (lambda ({Identifier}*) Lc-exp) 12 | ;; ┌──────────────────────────────┐ 13 | ;; │ lambda-exp (bound-vars body) │ 14 | ;; └──────────────────────────────┘ 15 | ;; ::= (Lc-exp {Lc-exp}*) 16 | ;; ┌───────────────────────┐ 17 | ;; │ app-exp (rator rands) │ 18 | ;; └───────────────────────┘ 19 | ;; 20 | ;; then the predicate for the bound-vars field could be (list-of identifier?), and the predicate for the rands field 21 | ;; could be (list-of lc-exp?). Write a define-datatype and a parser for this grammar that works in this way. 22 | 23 | (define identifier? 24 | (lambda (x) 25 | (and (symbol? x) 26 | (not (eqv? x 'lambda))))) 27 | 28 | (define-datatype lc-exp lc-exp? 29 | [var-exp [var identifier?]] 30 | [lambda-exp [bound-vars (list-of identifier?)] 31 | [body lc-exp?]] 32 | [app-exp [rator lc-exp?] 33 | [rands (list-of lc-exp?)]]) 34 | 35 | (define parse-expression 36 | (lambda (datum) 37 | (cond [(identifier? datum) (var-exp datum)] 38 | [(pair? datum) (if (eqv? (car datum) 'lambda) 39 | (lambda-exp (cadr datum) 40 | (parse-expression (caddr datum))) 41 | (app-exp (parse-expression (car datum)) 42 | (map parse-expression (cdr datum))))] 43 | [else (eopl:error 'parse-expression "Invalid expression: ~s" datum)]))) 44 | 45 | (provide lc-exp var-exp lambda-exp app-exp parse-expression) 46 | -------------------------------------------------------------------------------- /tests/exercise-4.29-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-mutable-pairs-lang.rkt") 5 | 6 | (check-equal? (run "let a = newarray(2, -99) 7 | p = proc (x) 8 | let v = arrayref(x, 1) 9 | in arrayset(x, 1, -(v, -1)) 10 | in begin arrayset(a, 1, 0); 11 | (p a); 12 | (p a); 13 | arrayref(a, 1) 14 | end") 15 | (num-val 2)) 16 | 17 | (check-equal? (run "arrayref(newarray(3, 2), 0)") (num-val 2)) 18 | (check-equal? (run "arrayref(newarray(3, 2), 1)") (num-val 2)) 19 | (check-equal? (run "arrayref(newarray(3, 2), 2)") (num-val 2)) 20 | 21 | (check-equal? (run "let a = newarray(3, 2) 22 | in begin arrayset(a, 0, 4); 23 | arrayref(a, 0) 24 | end") 25 | (num-val 4)) 26 | 27 | (check-equal? (run "let a = newarray(3, 2) 28 | in begin arrayset(a, 1, 4); 29 | arrayref(a, 0) 30 | end") 31 | (num-val 2)) 32 | 33 | (check-equal? (run "let a = newarray(3, 2) 34 | in begin arrayset(a, 2, 4); 35 | arrayref(a, 0) 36 | end") 37 | (num-val 2)) 38 | 39 | (check-equal? (run "let a = newarray(3, 2) 40 | in begin arrayset(a, 0, 4); 41 | arrayref(a, 1) 42 | end") 43 | (num-val 2)) 44 | 45 | (check-equal? (run "let a = newarray(3, 2) 46 | in begin arrayset(a, 1, 4); 47 | arrayref(a, 1) 48 | end") 49 | (num-val 4)) 50 | 51 | (check-equal? (run "let a = newarray(3, 2) 52 | in begin arrayset(a, 2, 4); 53 | arrayref(a, 1) 54 | end") 55 | (num-val 2)) 56 | -------------------------------------------------------------------------------- /tests/exercise-1.35-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.31.rkt") 5 | (require "../solutions/exercise-1.35.rkt") 6 | 7 | (define check-bin-tree-equal? 8 | (lambda (bin-tree-1 bin-tree-2) 9 | (if (leaf? bin-tree-1) 10 | (test-begin (check-true (leaf? bin-tree-2)) 11 | (check-eqv? (contents-of bin-tree-1) (contents-of bin-tree-2))) 12 | (test-begin (check-false (leaf? bin-tree-2)) 13 | (check-eqv? (contents-of bin-tree-1) (contents-of bin-tree-2)) 14 | (check-bin-tree-equal? (lson bin-tree-1) (lson bin-tree-2)) 15 | (check-bin-tree-equal? (rson bin-tree-1) (rson bin-tree-2)))))) 16 | 17 | (check-bin-tree-equal? (number-leaves (interior-node 'foo 18 | (interior-node 'bar 19 | (leaf 26) 20 | (leaf 12)) 21 | (interior-node 'baz 22 | (leaf 11) 23 | (interior-node 'quux 24 | (leaf 117) 25 | (leaf 14))))) 26 | (interior-node 'foo 27 | (interior-node 'bar 28 | (leaf 0) 29 | (leaf 1)) 30 | (interior-node 'baz 31 | (leaf 2) 32 | (interior-node 'quux 33 | (leaf 3) 34 | (leaf 4))))) 35 | 36 | (check-bin-tree-equal? (number-leaves (leaf 7)) (leaf 0)) 37 | -------------------------------------------------------------------------------- /solutions/exercise-2.19.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.19 [★] A binary tree with empty leaves and with interior nodes labeled with integers could be represented 4 | ;; using the grammar 5 | ;; 6 | ;; Bintree ::= () | (Int Bintree Bintree) 7 | ;; 8 | ;; In this representation, implement the procedure number->bintree, which takes a number and produces a binary tree 9 | ;; consisting of a single node containing that number. Also implement current-element, move-to-left-son, 10 | ;; move-to-right-son, at-leaf?, insert-to-left, and insert-to-right. For example, 11 | ;; 12 | ;; > (number->bintree 13) 13 | ;; (13 () ()) 14 | ;; > (define t1 (insert-to-right 14 15 | ;; (insert-to-left 12 16 | ;; (number->bintree 13)))) 17 | ;; > t1 18 | ;; (13 19 | ;; (12 () ()) 20 | ;; (14 () ())) 21 | ;; > (move-to-left-son t1) 22 | ;; (12 () ()) 23 | ;; > (current-element (move-to-left-son t1)) 24 | ;; 12 25 | ;; > (at-leaf? (move-to-right-son (move-to-left-son t1))) 26 | ;; #t 27 | ;; > (insert-to-left 15 t1) 28 | ;; (13 29 | ;; (15 30 | ;; (12 () ()) 31 | ;; ()) 32 | ;; (14 () ())) 33 | 34 | (define number->bintree 35 | (lambda (num) 36 | `(,num () ()))) 37 | 38 | (define current-element car) 39 | 40 | (define move-to-left-son cadr) 41 | 42 | (define move-to-right-son caddr) 43 | 44 | (define at-leaf? null?) 45 | 46 | (define insert-to-left 47 | (lambda (num bintree) 48 | (let ([root-value (car bintree)] 49 | [left-child (cadr bintree)] 50 | [right-child (caddr bintree)]) 51 | `(,root-value (,num ,left-child ()) ,right-child)))) 52 | 53 | (define insert-to-right 54 | (lambda (num bintree) 55 | (let ([root-value (car bintree)] 56 | [left-child (cadr bintree)] 57 | [right-child (caddr bintree)]) 58 | `(,root-value ,left-child (,num () ,right-child))))) 59 | 60 | (provide number->bintree 61 | current-element 62 | move-to-left-son 63 | move-to-right-son 64 | at-leaf? 65 | insert-to-left 66 | insert-to-right) 67 | -------------------------------------------------------------------------------- /solutions/exercise-1.30.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 1.30 [★★] (sort/predicate pred loi) returns a list of elements sorted by the predicate. 4 | ;; 5 | ;; > (sort/predicate < '(8 2 5 2 3)) 6 | ;; (2 2 3 5 8) 7 | ;; > (sort/predicate > '(8 2 5 2 3)) 8 | ;; (8 5 3 2 2) 9 | 10 | (define get-run 11 | (lambda (pred loi) 12 | (let ([head1 (car loi)] 13 | [tail1 (cdr loi)]) 14 | (if (null? tail1) 15 | (cons loi '()) 16 | (let ([head2 (car tail1)]) 17 | (if (pred head2 head1) 18 | (cons (list head1) tail1) 19 | (let ([tail-run (get-run pred tail1)]) 20 | (cons (cons head1 (car tail-run)) (cdr tail-run))))))))) 21 | 22 | (define merge 23 | (lambda (pred run1 run2) 24 | (let ([head1 (car run1)] 25 | [head2 (car run2)]) 26 | (if (pred head2 head1) 27 | (let ([tail2 (cdr run2)]) 28 | (if (null? tail2) 29 | (cons head2 run1) 30 | (cons head2 (merge pred run1 tail2)))) 31 | (let ([tail1 (cdr run1)]) 32 | (if (null? tail1) 33 | (cons head1 run2) 34 | (cons head1 (merge pred tail1 run2)))))))) 35 | 36 | (define collapse-all 37 | (lambda (pred stack run) 38 | (if (null? stack) 39 | run 40 | (collapse-all pred (cdr stack) (merge pred (cdar stack) run))))) 41 | 42 | (define collapse 43 | (lambda (pred stack level run) 44 | (if (null? stack) 45 | (list (cons level run)) 46 | (let ([top (car stack)]) 47 | (if (= (car top) level) 48 | (collapse pred (cdr stack) (+ level 1) (merge pred (cdr top) run)) 49 | (cons (cons level run) stack)))))) 50 | 51 | (define sort-helper 52 | (lambda (pred stack loi) 53 | (let* ([run-and-tail (get-run pred loi)] 54 | [run (car run-and-tail)] 55 | [tail (cdr run-and-tail)]) 56 | (if (null? tail) 57 | (collapse-all pred stack run) 58 | (sort-helper pred (collapse pred stack 0 run) tail))))) 59 | 60 | (define sort/predicate 61 | (lambda (pred loi) 62 | (if (null? loi) 63 | '() 64 | (sort-helper pred '() loi)))) 65 | 66 | (provide sort/predicate) 67 | -------------------------------------------------------------------------------- /solutions/exercise-2.3.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.3 [★★] Define a representation of all the integers (negative and nonnegative) as diff-trees, where a 4 | ;; diff-tree is a list defined by the grammar 5 | ;; 6 | ;; Diff-tree ::= (one) | (diff Diff-tree Diff-tree) 7 | ;; 8 | ;; The list (one) represents 1. If t1 represents n1 and t2 represents n2, then (diff t1 t2) is a representation of 9 | ;; n1 - n2. 10 | ;; 11 | ;; So both (one) and (diff (one) (diff (one) (one))) are representations of 1; (diff (diff (one) (one)) (one)) is a 12 | ;; representation of -1. 13 | ;; 14 | ;; 1. Show that every number has infinitely many representations in this system. 15 | ;; 2. Turn this representation of the integers into an implementation by writing zero, is-zero?, successor, and 16 | ;; predecessor, as specified on page 32, except that now the negative integers are also represented. Your procedures 17 | ;; should take as input any of the multiple legal representations of an integer in this scheme. For example, if your 18 | ;; successor procedure is given any of the infinitely many legal representations of 1, it should produce one of the 19 | ;; legal representations of 2. It is permissible for different legal representations of 1 to yield different legal 20 | ;; representations of 2. 21 | ;; 3. Write a procedure diff-tree-plus that does addition in this representation. Your procedure should be optimized 22 | ;; for the diff-tree representation, and should do its work in a constant amount of time (independent of the size of 23 | ;; its inputs). In particular, it should not be recursive. 24 | 25 | (define zero 26 | (lambda () 27 | '(diff (one) (one)))) 28 | 29 | (define interpret 30 | (lambda (n) 31 | (if (eqv? (car n) 'one) 32 | 1 33 | (- (interpret (cadr n)) 34 | (interpret (caddr n)))))) 35 | 36 | (define is-zero? 37 | (lambda (n) 38 | (zero? (interpret n)))) 39 | 40 | (define successor 41 | (lambda (n) 42 | (list 'diff n '(diff (diff (one) (one)) (one))))) 43 | 44 | (define predecessor 45 | (lambda (n) 46 | (list 'diff n '(one)))) 47 | 48 | (define diff-tree-plus 49 | (lambda (m n) 50 | (list 'diff m (list 'diff '(diff (one) (one)) n)))) 51 | 52 | (provide zero is-zero? successor predecessor diff-tree-plus) 53 | -------------------------------------------------------------------------------- /tests/exercise-4.13-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-explicit-refs-lang.rkt") 5 | 6 | (check-equal? (run "let x = newref(7) 7 | in let f = proc () 8 | setref(x, 5) 9 | in let y = deref(x) 10 | in begin (f); 11 | let z = deref(x) 12 | in -(y, z) 13 | end") 14 | (num-val 2)) 15 | 16 | (check-equal? (run "let plus = proc (x, y) 17 | -(x, -(0, y)) 18 | in (plus 3 (plus 4 (plus 5 6)))") 19 | (num-val 18)) 20 | 21 | (check-equal? (run "let f = proc (x, y, z) 22 | list(x, y, z) 23 | in (f 4 5 6)") 24 | (pair-val (num-val 4) 25 | (pair-val (num-val 5) 26 | (pair-val (num-val 6) 27 | (emptylist-val))))) 28 | 29 | (check-equal? (run "letrec reverse(values, tail) = if null?(values) 30 | then tail 31 | else (reverse cdr(values) 32 | cons(car(values), tail)) 33 | reverse-map(f, values, tail) = if null?(values) 34 | then tail 35 | else (reverse-map f 36 | cdr(values) 37 | cons((f car(values)), tail)) 38 | map(f, values) = (reverse (reverse-map f values emptylist) emptylist) 39 | double(x) = -(x, -(0, x)) 40 | in (map double 41 | list(4, 5, 6))") 42 | (pair-val (num-val 8) 43 | (pair-val (num-val 10) 44 | (pair-val (num-val 12) 45 | (emptylist-val))))) 46 | -------------------------------------------------------------------------------- /tests/exercise-1.33-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.31.rkt") 5 | (require "../solutions/exercise-1.33.rkt") 6 | 7 | (define check-bin-tree-equal? 8 | (lambda (bin-tree-1 bin-tree-2) 9 | (if (leaf? bin-tree-1) 10 | (test-begin (check-true (leaf? bin-tree-2)) 11 | (check-eqv? (contents-of bin-tree-1) (contents-of bin-tree-2))) 12 | (test-begin (check-false (leaf? bin-tree-2)) 13 | (check-eqv? (contents-of bin-tree-1) (contents-of bin-tree-2)) 14 | (check-bin-tree-equal? (lson bin-tree-1) (lson bin-tree-2)) 15 | (check-bin-tree-equal? (rson bin-tree-1) (rson bin-tree-2)))))) 16 | 17 | (check-bin-tree-equal? (mark-leaves-with-red-depth (interior-node 'red 18 | (interior-node 'bar 19 | (leaf 26) 20 | (leaf 12)) 21 | (interior-node 'red 22 | (leaf 11) 23 | (interior-node 'quux 24 | (leaf 117) 25 | (leaf 14))))) 26 | (interior-node 'red 27 | (interior-node 'bar (leaf 1) (leaf 1)) 28 | (interior-node 'red (leaf 2) (interior-node 'quux (leaf 2) (leaf 2))))) 29 | 30 | (check-bin-tree-equal? (mark-leaves-with-red-depth (leaf 0)) (leaf 0)) 31 | (check-bin-tree-equal? (mark-leaves-with-red-depth (leaf 1)) (leaf 0)) 32 | (check-bin-tree-equal? (mark-leaves-with-red-depth (leaf 2)) (leaf 0)) 33 | 34 | (check-bin-tree-equal? (mark-leaves-with-red-depth (interior-node 'a (leaf 3) (leaf 4))) 35 | (interior-node 'a (leaf 0) (leaf 0))) 36 | 37 | (check-bin-tree-equal? (mark-leaves-with-red-depth (interior-node 'a (interior-node 'b (leaf 5) (leaf 6)) (leaf 7))) 38 | (interior-node 'a (interior-node 'b (leaf 0) (leaf 0)) (leaf 0))) 39 | -------------------------------------------------------------------------------- /tests/exercise-1.30-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-1.30.rkt") 5 | 6 | (check-equal? (sort/predicate < '(8 2 5 2 3)) '(2 2 3 5 8)) 7 | (check-equal? (sort/predicate < '()) '()) 8 | (check-equal? (sort/predicate < '(1)) '(1)) 9 | (check-equal? (sort/predicate < '(1 1)) '(1 1)) 10 | (check-equal? (sort/predicate < '(1 1 1)) '(1 1 1)) 11 | (check-equal? (sort/predicate < '(1 2)) '(1 2)) 12 | (check-equal? (sort/predicate < '(1 2 3)) '(1 2 3)) 13 | (check-equal? (sort/predicate < '(1 3 2)) '(1 2 3)) 14 | (check-equal? (sort/predicate < '(2 1 3)) '(1 2 3)) 15 | (check-equal? (sort/predicate < '(2 3 1)) '(1 2 3)) 16 | (check-equal? (sort/predicate < '(3 1 2)) '(1 2 3)) 17 | (check-equal? (sort/predicate < '(3 2 1)) '(1 2 3)) 18 | (check-equal? (sort/predicate < '(3 2 1)) '(1 2 3)) 19 | (check-equal? (sort/predicate < '(9 8 7 6 5 4 3 2 1 0)) '(0 1 2 3 4 5 6 7 8 9)) 20 | (check-equal? (sort/predicate < '(9 8 5 7 6 5 4 3 5 2 1 0)) '(0 1 2 3 4 5 5 5 6 7 8 9)) 21 | (check-equal? (sort/predicate < '(0 1 2 3 4 5 6 7 8 9)) '(0 1 2 3 4 5 6 7 8 9)) 22 | (check-equal? (sort/predicate < '(9 5 2 7 5 5 9 7 1 9 0 0 9 8 1 1 0 2 7 9 3 0 6 9 4 7 1 2 0 2 8 7 0 7 4 7 9 8 5 9 9 8)) 23 | '(0 0 0 0 0 0 1 1 1 1 2 2 2 2 3 4 4 5 5 5 5 6 7 7 7 7 7 7 7 8 8 8 8 9 9 9 9 9 9 9 9 9)) 24 | (check-equal? (sort/predicate > '(8 2 5 2 3)) '(8 5 3 2 2)) 25 | (check-equal? (sort/predicate > '()) '()) 26 | (check-equal? (sort/predicate > '(1)) '(1)) 27 | (check-equal? (sort/predicate > '(1 1)) '(1 1)) 28 | (check-equal? (sort/predicate > '(1 1 1)) '(1 1 1)) 29 | (check-equal? (sort/predicate > '(1 2)) '(2 1)) 30 | (check-equal? (sort/predicate > '(1 2 3)) '(3 2 1)) 31 | (check-equal? (sort/predicate > '(1 3 2)) '(3 2 1)) 32 | (check-equal? (sort/predicate > '(2 1 3)) '(3 2 1)) 33 | (check-equal? (sort/predicate > '(2 3 1)) '(3 2 1)) 34 | (check-equal? (sort/predicate > '(3 1 2)) '(3 2 1)) 35 | (check-equal? (sort/predicate > '(3 2 1)) '(3 2 1)) 36 | (check-equal? (sort/predicate > '(3 2 1)) '(3 2 1)) 37 | (check-equal? (sort/predicate > '(9 8 7 6 5 4 3 2 1 0)) '(9 8 7 6 5 4 3 2 1 0)) 38 | (check-equal? (sort/predicate > '(9 8 5 7 6 5 4 3 5 2 1 0)) '(9 8 7 6 5 5 5 4 3 2 1 0)) 39 | (check-equal? (sort/predicate > '(0 1 2 3 4 5 6 7 8 9)) '(9 8 7 6 5 4 3 2 1 0)) 40 | (check-equal? (sort/predicate > '(9 5 2 7 5 5 9 7 1 9 0 0 9 8 1 1 0 2 7 9 3 0 6 9 4 7 1 2 0 2 8 7 0 7 4 7 9 8 5 9 9 8)) 41 | '(9 9 9 9 9 9 9 9 9 8 8 8 8 7 7 7 7 7 7 7 6 5 5 5 5 4 4 3 2 2 2 2 1 1 1 1 0 0 0 0 0 0)) 42 | -------------------------------------------------------------------------------- /solutions/exercise-2.11.rkt: -------------------------------------------------------------------------------- 1 | #lang eopl 2 | 3 | ;; Exercise 2.11 [★★] A naive implementation of extend-env* from the preceding exercise requires time proportional to 4 | ;; k to run. It is possible to represent environments so that extend-env* requires only constant time: represent the 5 | ;; empty environment by the empty list, and represent a non-empty environment by the data structure 6 | ;; 7 | ;; ┌───┬───┐ 8 | ;; │ ╷ │ ╶─┼─► saved-env 9 | ;; └─┼─┴───┘ 10 | ;; ▼ 11 | ;; ┌───┬───┐ 12 | ;; │ ╷ │ ╷ │ 13 | ;; └─┼─┴─┼─┘ 14 | ;; ┌───┘ └───┐ 15 | ;; ▼ ▼ 16 | ;; saved-vars saved-vals 17 | ;; 18 | ;; Such an environment might look like 19 | ;; 20 | ;; backbone 21 | ;; │ 22 | ;; ┌───┬───┐ ▼ ┌───┬───┐ ┌───┬───┐ 23 | ;; │ ╷ │ ╶─┼──────────►│ ╷ │ ╶─┼──────────►│ ╷ │ ╶─┼──────────► rest of environment 24 | ;; └─┼─┴───┘ └─┼─┴───┘ └─┼─┴───┘ 25 | ;; ▼ ▼ ▼ 26 | ;; ┌───┬───┐ ┌───┬───┐ ┌───┬───┐ 27 | ;; │ ╷ │ ╷ │ │ ╷ │ ╷ │ │ ╷ │ ╷ │ 28 | ;; └─┼─┴─┼─┘ └─┼─┴─┼─┘ └─┼─┴─┼─┘ 29 | ;; ┌──┘ └──┐ ┌──┘ └──┐ ┌──┘ └──┐ 30 | ;; ▼ ▼ ▼ ▼ ▼ ▼ 31 | ;; (a b c) (11 12 13) (x z) (66 77) (x y) (88 99) 32 | ;; 33 | ;; This is called the ribcage representation. The environment is represented as a list of pairs called ribs; each left 34 | ;; rib is a list of variables and each right rib is the corresponding list of values. 35 | ;; 36 | ;; Implement the environment interface, including extend-env*, in this representation. 37 | 38 | (define empty-env 39 | (lambda () 40 | '())) 41 | 42 | (define apply-env 43 | (lambda (env search-var) 44 | (let loop ([env env]) 45 | (let ([rib (car env)]) 46 | (let apply-rib ([vars (car rib)] 47 | [vals (cdr rib)]) 48 | (cond [(null? vars) (loop (cdr env))] 49 | [(eqv? (car vars) search-var) (car vals)] 50 | [else (apply-rib (cdr vars) (cdr vals))])))))) 51 | 52 | (define extend-env* 53 | (lambda (vars vals env) 54 | (cons (cons vars vals) env))) 55 | 56 | (define extend-env 57 | (lambda (var val env) 58 | (extend-env* (list var) (list val) env))) 59 | 60 | (provide empty-env apply-env extend-env extend-env*) 61 | -------------------------------------------------------------------------------- /tests/exercise-5.16-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.16.rkt") 5 | 6 | (define (get-output string) 7 | (with-output-to-string (λ () 8 | (run string)))) 9 | 10 | (check-equal? (get-output "var x, y; 11 | { 12 | x = 3; 13 | y = 4; 14 | print +(x, y) 15 | }") 16 | "7\n") 17 | 18 | (check-equal? (get-output "var x, y, z; 19 | { 20 | x = 3; 21 | y = 4; 22 | z = 0; 23 | while not(zero?(x)) 24 | { 25 | z = +(z, y); 26 | x = -(x, 1) 27 | }; 28 | print z 29 | }") 30 | "12\n") 31 | 32 | (check-equal? (get-output "var x; 33 | { 34 | x = 3; 35 | print x; 36 | var x; 37 | { 38 | x = 4; 39 | print x 40 | }; 41 | print x 42 | }") 43 | "3\n4\n3\n") 44 | 45 | (check-equal? (get-output "var f, x; 46 | { 47 | f = proc (x, y) *(x, y); 48 | x = 3; 49 | print (f 4 x) 50 | }") 51 | "12\n") 52 | 53 | (check-equal? (get-output "print 7") "7\n") 54 | (check-equal? (get-output "print zero?(0)") "#t\n") 55 | (check-equal? (get-output "print zero?(1)") "#f\n") 56 | (check-equal? (get-output "print zero?(0)") "#t\n") 57 | (check-equal? (get-output "print proc () 1") "\n") 58 | 59 | (check-equal? (get-output "{ 60 | print 3; 61 | print 4 62 | }") 63 | "3\n4\n") 64 | 65 | (check-equal? (get-output "if zero?(0) 66 | { 67 | print 3 68 | } 69 | { 70 | print 4 71 | }") 72 | "3\n") 73 | -------------------------------------------------------------------------------- /tests/exercise-4.22-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-4.x-statement-oriented-implicit-refs-lang.rkt") 5 | 6 | (define (get-output string) 7 | (with-output-to-string (λ () 8 | (run string)))) 9 | 10 | (check-equal? (get-output "var x, y; 11 | { 12 | x = 3; 13 | y = 4; 14 | print +(x, y) 15 | }") 16 | "7\n") 17 | 18 | (check-equal? (get-output "var x, y, z; 19 | { 20 | x = 3; 21 | y = 4; 22 | z = 0; 23 | while not(zero?(x)) 24 | { 25 | z = +(z, y); 26 | x = -(x, 1) 27 | }; 28 | print z 29 | }") 30 | "12\n") 31 | 32 | (check-equal? (get-output "var x; 33 | { 34 | x = 3; 35 | print x; 36 | var x; 37 | { 38 | x = 4; 39 | print x 40 | }; 41 | print x 42 | }") 43 | "3\n4\n3\n") 44 | 45 | (check-equal? (get-output "var f, x; 46 | { 47 | f = proc (x, y) *(x, y); 48 | x = 3; 49 | print (f 4 x) 50 | }") 51 | "12\n") 52 | 53 | (check-equal? (get-output "print 7") "7\n") 54 | (check-equal? (get-output "print zero?(0)") "#t\n") 55 | (check-equal? (get-output "print zero?(1)") "#f\n") 56 | (check-equal? (get-output "print zero?(0)") "#t\n") 57 | (check-equal? (get-output "print proc () 1") "\n") 58 | 59 | (check-equal? (get-output "{ 60 | print 3; 61 | print 4 62 | }") 63 | "3\n4\n") 64 | 65 | (check-equal? (get-output "if zero?(0) 66 | { 67 | print 3 68 | } 69 | { 70 | print 4 71 | }") 72 | "3\n") 73 | 74 | -------------------------------------------------------------------------------- /tests/exercise-3.24-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-3.x-proc-lang.rkt") 5 | 6 | (define (even? x) 7 | (run (format "(let false = zero?(1) 8 | in let true = zero?(0) 9 | in let makeeven = proc (makeeven) 10 | proc (makeodd) 11 | proc (x) 12 | if zero?(x) 13 | then true 14 | else (((makeodd makeeven) makeodd) -(x, 1)) 15 | in let makeodd = proc (makeeven) 16 | proc (makeodd) 17 | proc (x) 18 | if zero?(x) 19 | then false 20 | else (((makeeven makeeven) makeodd) -(x, 1)) 21 | in ((makeeven makeeven) makeodd) 22 | ~a)" x))) 23 | 24 | (define (odd? x) 25 | (run (format "(let false = zero?(1) 26 | in let true = zero?(0) 27 | in let makeeven = proc (makeeven) 28 | proc (makeodd) 29 | proc (x) 30 | if zero?(x) 31 | then true 32 | else (((makeodd makeeven) makeodd) -(x, 1)) 33 | in let makeodd = proc (makeeven) 34 | proc (makeodd) 35 | proc (x) 36 | if zero?(x) 37 | then false 38 | else (((makeeven makeeven) makeodd) -(x, 1)) 39 | in ((makeodd makeeven) makeodd) 40 | ~a)" x))) 41 | 42 | (check-equal? (even? 0) (bool-val #t)) 43 | (check-equal? (even? 1) (bool-val #f)) 44 | (check-equal? (even? 2) (bool-val #t)) 45 | (check-equal? (even? 3) (bool-val #f)) 46 | (check-equal? (even? 4) (bool-val #t)) 47 | (check-equal? (even? 5) (bool-val #f)) 48 | (check-equal? (odd? 0) (bool-val #f)) 49 | (check-equal? (odd? 1) (bool-val #t)) 50 | (check-equal? (odd? 2) (bool-val #f)) 51 | (check-equal? (odd? 3) (bool-val #t)) 52 | (check-equal? (odd? 4) (bool-val #f)) 53 | (check-equal? (odd? 5) (bool-val #t)) 54 | -------------------------------------------------------------------------------- /tests/exercise-5.35-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.35.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | 43 | (check-equal? (run "list()") (list-val '())) 44 | (check-equal? (run "list(2)") (list-val (list (num-val 2)))) 45 | (check-equal? (run "list(2, 3)") (list-val (list (num-val 2) (num-val 3)))) 46 | (check-equal? (run "list(2, 3, 5)") (list-val (list (num-val 2) (num-val 3) (num-val 5)))) 47 | (check-equal? (run "car(list(2, 3))") (num-val 2)) 48 | (check-equal? (run "cdr(list(2, 3))") (list-val (list (num-val 3)))) 49 | (check-equal? (run "null?(list())") (bool-val #t)) 50 | (check-equal? (run "null?(list(1))") (bool-val #f)) 51 | 52 | (check-equal? (run "try 2 53 | catch (x) x") 54 | (num-val 2)) 55 | 56 | (check-equal? (run "try raise 3 57 | catch (x) x") 58 | (num-val 3)) 59 | 60 | (check-equal? (run "try -(3, raise 5) 61 | catch (x) 5") 62 | (num-val 5)) 63 | 64 | (check-equal? (run "try try -(3, raise 5) 65 | catch (x) raise 7 66 | catch (y) y") 67 | (num-val 7)) 68 | -------------------------------------------------------------------------------- /tests/exercise-5.36-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.36.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | 43 | (check-equal? (run "list()") (list-val '())) 44 | (check-equal? (run "list(2)") (list-val (list (num-val 2)))) 45 | (check-equal? (run "list(2, 3)") (list-val (list (num-val 2) (num-val 3)))) 46 | (check-equal? (run "list(2, 3, 5)") (list-val (list (num-val 2) (num-val 3) (num-val 5)))) 47 | (check-equal? (run "car(list(2, 3))") (num-val 2)) 48 | (check-equal? (run "cdr(list(2, 3))") (list-val (list (num-val 3)))) 49 | (check-equal? (run "null?(list())") (bool-val #t)) 50 | (check-equal? (run "null?(list(1))") (bool-val #f)) 51 | 52 | (check-equal? (run "try 2 53 | catch (x) x") 54 | (num-val 2)) 55 | 56 | (check-equal? (run "try raise 3 57 | catch (x) x") 58 | (num-val 3)) 59 | 60 | (check-equal? (run "try -(3, raise 5) 61 | catch (x) 5") 62 | (num-val 5)) 63 | 64 | (check-equal? (run "try try -(3, raise 5) 65 | catch (x) raise 7 66 | catch (y) y") 67 | (num-val 7)) 68 | -------------------------------------------------------------------------------- /tests/exercise-5.41-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.41.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | 43 | (check-equal? (run "list()") (list-val '())) 44 | (check-equal? (run "list(2)") (list-val (list (num-val 2)))) 45 | (check-equal? (run "list(2, 3)") (list-val (list (num-val 2) (num-val 3)))) 46 | (check-equal? (run "list(2, 3, 5)") (list-val (list (num-val 2) (num-val 3) (num-val 5)))) 47 | (check-equal? (run "car(list(2, 3))") (num-val 2)) 48 | (check-equal? (run "cdr(list(2, 3))") (list-val (list (num-val 3)))) 49 | (check-equal? (run "null?(list())") (bool-val #t)) 50 | (check-equal? (run "null?(list(1))") (bool-val #f)) 51 | 52 | (check-equal? (run "try 2 53 | catch (x) x") 54 | (num-val 2)) 55 | 56 | (check-equal? (run "try raise 3 57 | catch (x) x") 58 | (num-val 3)) 59 | 60 | (check-equal? (run "try -(3, raise 5) 61 | catch (x) 5") 62 | (num-val 5)) 63 | 64 | (check-equal? (run "try try -(3, raise 5) 65 | catch (x) raise 7 66 | catch (y) y") 67 | (num-val 7)) 68 | -------------------------------------------------------------------------------- /tests/exercise-5.39-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.39.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | 43 | (check-equal? (run "list()") (list-val '())) 44 | (check-equal? (run "list(2)") (list-val (list (num-val 2)))) 45 | (check-equal? (run "list(2, 3)") (list-val (list (num-val 2) (num-val 3)))) 46 | (check-equal? (run "list(2, 3, 5)") (list-val (list (num-val 2) (num-val 3) (num-val 5)))) 47 | (check-equal? (run "car(list(2, 3))") (num-val 2)) 48 | (check-equal? (run "cdr(list(2, 3))") (list-val (list (num-val 3)))) 49 | (check-equal? (run "null?(list())") (bool-val #t)) 50 | (check-equal? (run "null?(list(1))") (bool-val #f)) 51 | 52 | (check-equal? (run "try 2 53 | catch (x) x") 54 | (num-val 2)) 55 | 56 | (check-equal? (run "try raise 3 57 | catch (x) x") 58 | (num-val 3)) 59 | 60 | (check-equal? (run "try -(3, raise 5) 61 | catch (x) 5") 62 | (num-val -2)) 63 | 64 | (check-equal? (run "try try -(3, raise 5) 65 | catch (x) raise 7 66 | catch (y) y") 67 | (num-val -4)) 68 | -------------------------------------------------------------------------------- /tests/exercise-6.8-inlined-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-6.8-inlined.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | 43 | (check-equal? (run "list()") (list-val '())) 44 | (check-equal? (run "list(2)") (list-val (list (num-val 2)))) 45 | (check-equal? (run "list(2, 3)") (list-val (list (num-val 2) (num-val 3)))) 46 | (check-equal? (run "list(2, 3, 5)") (list-val (list (num-val 2) (num-val 3) (num-val 5)))) 47 | (check-equal? (run "car(list(2, 3))") (num-val 2)) 48 | (check-equal? (run "cdr(list(2, 3))") (list-val (list (num-val 3)))) 49 | (check-equal? (run "null?(list())") (bool-val #t)) 50 | (check-equal? (run "null?(list(1))") (bool-val #f)) 51 | 52 | (check-equal? (run "try 2 53 | catch (x) x") 54 | (num-val 2)) 55 | 56 | (check-equal? (run "try raise 3 57 | catch (x) x") 58 | (num-val 3)) 59 | 60 | (check-equal? (run "try -(3, raise 5) 61 | catch (x) 5") 62 | (num-val 5)) 63 | 64 | (check-equal? (run "try try -(3, raise 5) 65 | catch (x) raise 7 66 | catch (y) y") 67 | (num-val 7)) 68 | -------------------------------------------------------------------------------- /tests/exercise-6.8-procedural-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-6.8-procedural.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | 43 | (check-equal? (run "list()") (list-val '())) 44 | (check-equal? (run "list(2)") (list-val (list (num-val 2)))) 45 | (check-equal? (run "list(2, 3)") (list-val (list (num-val 2) (num-val 3)))) 46 | (check-equal? (run "list(2, 3, 5)") (list-val (list (num-val 2) (num-val 3) (num-val 5)))) 47 | (check-equal? (run "car(list(2, 3))") (num-val 2)) 48 | (check-equal? (run "cdr(list(2, 3))") (list-val (list (num-val 3)))) 49 | (check-equal? (run "null?(list())") (bool-val #t)) 50 | (check-equal? (run "null?(list(1))") (bool-val #f)) 51 | 52 | (check-equal? (run "try 2 53 | catch (x) x") 54 | (num-val 2)) 55 | 56 | (check-equal? (run "try raise 3 57 | catch (x) x") 58 | (num-val 3)) 59 | 60 | (check-equal? (run "try -(3, raise 5) 61 | catch (x) 5") 62 | (num-val 5)) 63 | 64 | (check-equal? (run "try try -(3, raise 5) 65 | catch (x) raise 7 66 | catch (y) y") 67 | (num-val 7)) 68 | -------------------------------------------------------------------------------- /tests/exercise-5.x-exceptions-lang-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require rackunit) 4 | (require "../solutions/exercise-5.x-exceptions-lang.rkt") 5 | 6 | (check-equal? (run "2") (num-val 2)) 7 | (check-equal? (run "-(3, 3)") (num-val 0)) 8 | (check-equal? (run "-(3, 4)") (num-val -1)) 9 | (check-equal? (run "-(4, 3)") (num-val 1)) 10 | (check-equal? (run "zero?(0)") (bool-val #t)) 11 | (check-equal? (run "zero?(4)") (bool-val #f)) 12 | (check-equal? (run "if zero?(0) then 7 else 11") (num-val 7)) 13 | (check-equal? (run "if zero?(2) then 7 else 11") (num-val 11)) 14 | (check-equal? (run "let x = 5 in x") (num-val 5)) 15 | (check-equal? (run "let x = 5 in let x = 3 in x") (num-val 3)) 16 | 17 | (check-equal? (run "let f = proc (x) 18 | -(x, 11) 19 | in (f (f 77))") 20 | (num-val 55)) 21 | 22 | (check-equal? (run "(proc (f) 23 | (f (f 77)) 24 | proc (x) 25 | -(x, 11))") 26 | (num-val 55)) 27 | 28 | (check-equal? (run "let x = 200 29 | in let f = proc (z) 30 | -(z, x) 31 | in let x = 100 32 | in let g = proc (z) 33 | -(z, x) 34 | in -((f 1), (g 1))") 35 | (num-val -100)) 36 | 37 | (check-equal? (run "letrec double(x) = if zero?(x) 38 | then 0 39 | else -((double -(x, 1)), -2) 40 | in (double 6)") 41 | (num-val 12)) 42 | 43 | (check-equal? (run "list()") (list-val '())) 44 | (check-equal? (run "list(2)") (list-val (list (num-val 2)))) 45 | (check-equal? (run "list(2, 3)") (list-val (list (num-val 2) (num-val 3)))) 46 | (check-equal? (run "list(2, 3, 5)") (list-val (list (num-val 2) (num-val 3) (num-val 5)))) 47 | (check-equal? (run "car(list(2, 3))") (num-val 2)) 48 | (check-equal? (run "cdr(list(2, 3))") (list-val (list (num-val 3)))) 49 | (check-equal? (run "null?(list())") (bool-val #t)) 50 | (check-equal? (run "null?(list(1))") (bool-val #f)) 51 | 52 | (check-equal? (run "try 2 53 | catch (x) x") 54 | (num-val 2)) 55 | 56 | (check-equal? (run "try raise 3 57 | catch (x) x") 58 | (num-val 3)) 59 | 60 | (check-equal? (run "try -(3, raise 5) 61 | catch (x) 5") 62 | (num-val 5)) 63 | 64 | (check-equal? (run "try try -(3, raise 5) 65 | catch (x) raise 7 66 | catch (y) y") 67 | (num-val 7)) 68 | --------------------------------------------------------------------------------