EFanZh’s Blog

Essentials of Programming Languages Exercises

Codes

Code for the exercises can be found here.

Exercises

Exercise 0.1 [β˜…] We often use phrases like β€œsome languages have property X.” For each such phrase, find one or more languages that have the property and one or more languages that do not have the property. Feel free to ferret out this information from any descriptive book on programming languages (say Scott (2005), Sebesta (2007), or Pratt & Zelkowitz (2001)).

Skipped for now.

Exercise 1.1 [β˜…] Write inductive definitions of the following sets. Write each definition in all three styles (top-down, bottom-up, and rules of inference). Using your rules, show the derivation of some sample elements of each set.

  1. Do not mention squaring in your rules. As a hint, remember the equation .
    • Top-down:

      if

      • , or
    • Bottom-up:

      is the smallest set that satisfying the following two properties:

      • , and
      • If , then
    • Rules of inference:

    • Top-down:

      if

      • , or
      • , or
    • Bottom-up:

      is the smallest set that satisfying the following two properties:

      • , and
      • If , then , and
      • If , then
    • Rules of inference:

    • Top-down:

      if

      • and , or
    • Bottom-up:

      is the smallest set that satisfying the following two properties:

      • , and
      • If , then
    • Rules of inference:

    • Top-down:

      if

      • and , or
    • Bottom-up:

      is the smallest set that satisfying the following two properties:

      • , and
      • If , then
    • Rules of inference:

Exercise 1.2 [β˜…β˜…] What sets are defined by the following pairs of rules? Explain why.

  1. [β˜…β˜…β˜…]

Exercise 1.3 [β˜…β˜…β˜…] Find a set of natural numbers such that , and whenever , then , but , where is the set defined in definition 1.1.2.

Let .

Exercise 1.4 [β˜…] Write a derivation from List-of-Int to (-7 . (3 . (14 . ()))).

List-of-Int
β‡’ (Int . List-of-Int)
β‡’ (-7 . List-of-Int)
β‡’ (-7 . (Int . List-of-Int))
β‡’ (-7 . (3 . List-of-Int))
β‡’ (-7 . (3 . (Int . List-of-Int)))
β‡’ (-7 . (3 . (14 . List-of-Int)))
β‡’ (-7 . (3 . (14 . ())))

Exercise 1.5 [β˜…β˜…] Prove that if e ∈ LcExp, then there are the same number of left and right parentheses in e.

By induction on the structre of LcExp.

If e is of Identifier form, it has left parenthesis and right parenthesis, the hypothesis holds.

If e is of (lambda (Identifier) LcExp) form, the Identifier has parenthese. By induction, LcExp has the same number of left and right parentheses. Let the number be , then e has left parentheses and right parentheses. The hypothesis holds.

If e is of (LcExp LcExp) form, let be the number of left or right parentheses in the first LcExp, let be the number of left or right parentheses in the second LcExp, then e has left parentheses and right parentheses. The hypothesis holds.

Exercise 1.6 [β˜…] If we reversed the order of the tests in nth-element, what would go wrong?

car may be applied to empty list.

Exercise 1.7 [β˜…β˜…] The error message from nth-element is uninformative. Rewrite nth-element so that it produces a more informative error message, such as β€œ(a b c) does not have 8 elements.”

(define report-list-too-short
  (lambda (lst n)
    (eopl:error 'nth-element
                "~s does not have ~s elements.~%" lst (+ n 1))))

(define nth-element-helper
  (lambda (lst n current-list i)
    (if (null? current-list)
        (report-list-too-short lst n)
        (if (zero? i)
            (car current-list)
            (nth-element-helper lst n (cdr current-list) (- i 1))))))

(define nth-element
  (lambda (lst n)
    (nth-element-helper lst n lst n)))

Exercise 1.8 [β˜…] In the definition of remove-first, if the last line were replaced by (remove-first s (cdr los)), what function would the resulting procedure compute? Give the contract, including the usage statement, for the revised procedure.

remove-first : Sym Γ— Listof(Sym) β†’ Listof(Sym)

usage: (remove-first s los) returns a sub of list from los, starting from the symbol after the first s. If los doesn’t contain s, an empty list is returned.

(define remove-first
  (lambda (s los)
    (if (null? los)
        '()
        (if (eqv? (car los) s)
            (cdr los)
            (remove-first s (cdr los))))))

Exercise 1.9 [β˜…β˜…] Define remove, which is like remove-first, except that it removes all occurrences of a given symbol from a list of symbols, not just the first.

(define remove
  (lambda (s los)
    (if (null? los)
        '()
        (if (eqv? (car los) s)
            (remove s (cdr los))
            (cons (car los) (remove s (cdr los)))))))

Exercise 1.10 [β˜…] We typically use β€œor” to mean β€œinclusive or”. What other meanings can β€œor” have?

Exclusive or.

Exercise 1.11 [β˜…] In the last line of subst-in-s-exp, the recursion is on sexp and not a smaller substructure. Why is the recursion guaranteed to halt?

Because subst recurs on smaller substructure. We can replace the call to subst-in-s-exp with the body of subst-in-s-exp, then subst becomes a normal recursive on a smaller substructure.

Exercise 1.12 [β˜…] Eliminate the one call to subst-in-s-exp in subst by replacing it by its definition and simplifying the resulting procedure. The result will be a version of subst that does not need subst-in-s-exp. This technique is called inlining, and is used by optimizing compilers.

(define subst
  (lambda (new old slist)
    (if (null? slist)
        '()
        (cons (let ([sexp (car slist)])
                (if (symbol? sexp)
                    (if (eqv? sexp old) new sexp)
                    (subst new old sexp)))
              (subst new old (cdr slist))))))

Exercise 1.13 [β˜…β˜…] In our example, we began by eliminating the Kleene star in the grammar for S-list. Write subst following the original grammar by using map.

(define subst-in-s-exp
  (lambda (new old sexp)
    (if (symbol? sexp)
        (if (eqv? sexp old) new sexp)
        (subst new old sexp))))

(define subst
  (lambda (new old slist)
    (map (lambda (sexp) (subst-in-s-exp new old sexp))
         slist)))

Exercise 1.14 [β˜…β˜…] Given the assumption 0 ≀ n < length(v), prove that partial-vector-sum is correct.

Since 0 ≀ n < length(v), we know that length(v) is at leat 1, so that v contains at least one element. We prove partial-vector-sum is correct by induction over n.

Base case: if n equals to 0, (partial-vector-sum v n) equals to (vector-ref v 0), which equals to , the claim holds.

Inductive case: if n β‰  0, n (partial-vector-sum v n) equals to (add (vector-ref v n) (partial-vector-sum v (- n 1))), which equals to , which equals to , the claim holds.

Exercise 1.15 [β˜…] (duple n x) returns a list containing n copies of x.

> (duple 2 3)
(3 3)
> (duple 4 '(ha ha))
((ha ha) (ha ha) (ha ha) (ha ha))
> (duple 0 '(blah))
()
(define duple-helper
  (lambda (lst n x)
    (if (zero? n)
        lst
        (duple-helper (cons x lst) (- n 1) x))))

(define duple
  (lambda (n x)
    (duple-helper '() n x)))

Exercise 1.16 [β˜…] (invert lst), where lst is a list of 2-lists (lists of length two), returns a list with each 2-list reversed.

> (invert '((a 1) (a 2) (1 b) (2 b)))
((1 a) (2 a) (b 1) (b 2))
(define invert
  (lambda (lst)
    (map (lambda (x) (list (cadr x) (car x)))
         lst)))

Exercise 1.17 [β˜…] (down lst) wraps parentheses around each top-level element of lst.

> (down '(1 2 3))
((1) (2) (3))
> (down '((a) (fine) (idea)))
(((a)) ((fine)) ((idea)))
> (down '(a (more (complicated)) object))
((a) ((more (complicated))) (object))
(define down
  (lambda (lst)
    (map (lambda (x) (list x))
         lst)))

Exercise 1.18 [β˜…] (swapper s1 s2 slist) returns a list the same as slist, but with all occurrences of s1 replaced by s2 and all occurrences of s2 replaced by s1.

> (swapper 'a 'd '(a b c d))
(d b c a)
> (swapper 'a 'd '(a d () c d))
(d a () c a)
> (swapper 'x 'y '((x) y (z (x))))
((y) x (z (y)))
(define swapper
  (lambda (s1 s2 slist)
    (map (lambda (sexp)
           (if (symbol? sexp)
               (if (eqv? sexp s1)
                   s2
                   (if (eqv? sexp s2)
                       s1
                       sexp))
               (swapper s1 s2 sexp)))
         slist)))

Exercise 1.19 [β˜…] (list-set lst n x) returns a list like lst, except that the n-th element, using zero-based indexing, is x.

> (list-set '(a b c d) 2 '(1 2))
(a b (1 2) d)
> (list-ref (list-set '(a b c d) 3 '(1 5 10)) 3)
(1 5 10)
(define list-set
  (lambda (lst n x)
    (if (zero? n)
        (cons x (cdr lst))
        (cons (car lst) (list-set (cdr lst) (- n 1) x)))))

Exercise 1.20 [β˜…] (count-occurrences s slist) returns the number of occurrences of s in slist.

> (count-occurrences 'x '((f x) y (((x z) x))))
3
> (count-occurrences 'x '((f x) y (((x z) () x))))
3
> (count-occurrences 'w '((f x) y (((x z) x))))
0
(define count-occurrences-sexp
  (lambda (s sexp)
    (if (symbol? sexp)
        (if (eqv? sexp s) 1 0)
        (count-occurrences s sexp))))

(define count-occurrences
  (lambda (s slist)
    (if (null? slist)
        0
        (+ (count-occurrences-sexp s (car slist))
           (count-occurrences s (cdr slist))))))

Exercise 1.21 [β˜…β˜…] (product sos1 sos2), where sos1 and sos2 are each a list of symbols without repetitions, returns a list of 2-lists that represents the Cartesian product of sos1 and sos2. The 2-lists may appear in any order.

> (product '(a b c) '(x y))
((a x) (a y) (b x) (b y) (c x) (c y))
(define product-symbol
  (lambda (tail s sos)
    (if (null? sos)
        tail
        (product-symbol (cons (list s (car sos)) tail) s (cdr sos)))))

(define product-helper
  (lambda (tail sos1 sos2)
    (if (null? sos1)
        tail
        (product-helper (product-symbol tail (car sos1) sos2)
                        (cdr sos1)
                        sos2))))

(define product
  (lambda (sos1 sos2)
    (product-helper '() sos1 sos2)))

Exercise 1.22 [β˜…β˜…] (filter-in pred lst) returns the list of those elements in lst that satisfy the predicate pred.

> (filter-in number? '(a 2 (1 3) b 7))
(2 7)
> (filter-in symbol? '(a (b c) 17 foo))
(a foo)
(define filter-in
  (lambda (pred lst)
    (if (null? lst)
        '()
        (let ([element (car lst)]
              [tail (filter-in pred (cdr lst))])
          (if (pred element)
              (cons element tail)
              tail)))))

Exercise 1.23 [β˜…β˜…] (list-index pred lst) returns the 0-based position of the first element of lst that satisfies the predicate pred. If no element of lst satisfies the predicate, then list-index returns #f.

> (list-index number? '(a 2 (1 3) b 7))
1
> (list-index symbol? '(a (b c) 17 foo))
0
> (list-index symbol? '(1 2 (a b) 3))
#f
(define list-index-helper
  (lambda (n pred lst)
    (if (null? lst)
        #f
        (if (pred (car lst))
            n
            (list-index-helper (+ n 1) pred (cdr lst))))))

(define list-index
  (lambda (pred lst)
    (list-index-helper 0 pred lst)))

Exercise 1.24 [β˜…β˜…] (every? pred lst) returns #f if any element of lst fails to satisfy pred, and returns #t otherwise.

> (every? number? '(a b c 3 e))
#f
> (every? number? '(1 2 3 5 4))
#t
(define every?
  (lambda (pred lst)
    (if (null? lst)
        #t
        (and (pred (car lst))
             (every? pred (cdr lst))))))

Exercise 1.25 [β˜…β˜…] (exists? pred lst) returns #t if any element of lst satisfies pred, and returns #f otherwise.

> (exists? number? '(a b c 3 e))
#t
> (exists? number? '(a b c d e))
#f
(define exists?
  (lambda (pred lst)
    (if (null? lst)
        #f
        (or (pred (car lst))
            (exists? pred (cdr lst))))))

Exercise 1.26 [β˜…β˜…] (up lst) removes a pair of parentheses from each top-level element of lst. If a top-level element is not a list, it is included in the result, as is. The value of (up (down lst)) is equivalent to lst, but (down (up lst)) is not necessarily lst. (See exercise 1.17.)

> (up '((1 2) (3 4)))
(1 2 3 4)
> (up '((x (y)) z))
(x (y) z)
(define extend-head
  (lambda (tail head)
    (if (null? head)
        tail
        (cons (car head) (extend-head tail (cdr head))))))

(define up-element
  (lambda (tail element)
    (if (list? element)
        (extend-head tail element)
        (cons element tail))))

(define up
  (lambda (lst)
    (if (null? lst)
        '()
        (up-element (up (cdr lst)) (car lst)))))

Exercise 1.27 [β˜…β˜…] (flatten slist) returns a list of the symbols contained in slist in the order in which they occur when slist is printed. Intuitively, flatten removes all the inner parentheses from its argument.

> (flatten '(a b c))
(a b c)
> (flatten '((a) () (b ()) () (c)))
(a b c)
> (flatten '((a b) c (((d)) e)))
(a b c d e)
> (flatten '(a b (() (c))))
(a b c)
(define flatten-element
  (lambda (tail element)
    (if (list? element)
        (flatten-helper tail element)
        (cons element tail))))

(define flatten-helper
  (lambda (tail slist)
    (if (null? slist)
        tail
        (flatten-element (flatten-helper tail (cdr slist))
                         (car slist)))))

(define flatten
  (lambda (slist)
    (flatten-helper '() slist)))

Exercise 1.28 [β˜…β˜…] (merge loi1 loi2), where loi1 and loi2 are lists of integers that are sorted in ascending order, returns a sorted list of all the integers in loi1 and loi2.

> (merge '(1 4) '(1 2 8))
(1 1 2 4 8)
> (merge '(35 62 81 90 91) '(3 83 85 90))
(3 35 62 81 83 85 90 90 91)
(define merge-helper
  (lambda (loi1 loi2)
    (if (null? loi1)
        loi2
        (let ([i1 (car loi1)]
              [i2 (car loi2)])
          (if (< i1 i2)
              (cons i1 (merge-helper (cdr loi1) loi2))
              (cons i2 (merge-helper (cdr loi2) loi1)))))))

(define merge
  (lambda (loi1 loi2)
    (if (null? loi1)
        loi2
        (merge-helper loi2 loi1))))

Exercise 1.29 [β˜…β˜…] (sort loi) returns a list of the elements of loi in ascending order.

> (sort '(8 2 5 2 3))
(2 2 3 5 8)
(define get-run
  (lambda (loi)
    (let ([head1 (car loi)]
          [tail1 (cdr loi)])
      (if (null? tail1)
          (cons loi '())
          (let ([head2 (car tail1)])
            (if (<= head1 head2)
                (let ([tail-run (get-run tail1)])
                  (cons (cons head1 (car tail-run)) (cdr tail-run)))
                (cons (list head1) tail1)))))))

(define merge
  (lambda (run1 run2)
    (let ([head1 (car run1)]
          [head2 (car run2)])
      (if (<= head1 head2)
          (let ([tail1 (cdr run1)])
            (if (null? tail1)
                (cons head1 run2)
                (cons head1 (merge tail1 run2))))
          (let ([tail2 (cdr run2)])
            (if (null? tail2)
                (cons head2 run1)
                (cons head2 (merge run1 tail2))))))))

(define collapse-all
  (lambda (stack run)
    (if (null? stack)
        run
        (collapse-all (cdr stack) (merge (cdar stack) run)))))

(define collapse
  (lambda (stack level run)
    (if (null? stack)
        (list (cons level run))
        (let ([top (car stack)])
          (if (= (car top) level)
              (collapse (cdr stack) (+ level 1) (merge (cdr top) run))
              (cons (cons level run) stack))))))

(define sort-helper
  (lambda (stack loi)
    (let* ([run-and-tail (get-run loi)]
           [run (car run-and-tail)]
           [tail (cdr run-and-tail)])
      (if (null? tail)
          (collapse-all stack run)
          (sort-helper (collapse stack 0 run) tail)))))

(define sort
  (lambda (loi)
    (if (null? loi)
        '()
        (sort-helper '() loi))))

Exercise 1.30 [β˜…β˜…] (sort/predicate pred loi) returns a list of elements sorted by the predicate.

 > (sort/predicate < '(8 2 5 2 3))
(2 2 3 5 8)
> (sort/predicate > '(8 2 5 2 3))
(8 5 3 2 2)
(define get-run
  (lambda (pred loi)
    (let ([head1 (car loi)]
          [tail1 (cdr loi)])
      (if (null? tail1)
          (cons loi '())
          (let ([head2 (car tail1)])
            (if (pred head2 head1)
                (cons (list head1) tail1)
                (let ([tail-run (get-run pred tail1)])
                  (cons (cons head1 (car tail-run)) (cdr tail-run)))))))))

(define merge
  (lambda (pred run1 run2)
    (let ([head1 (car run1)]
          [head2 (car run2)])
      (if (pred head2 head1)
          (let ([tail2 (cdr run2)])
            (if (null? tail2)
                (cons head2 run1)
                (cons head2 (merge pred run1 tail2))))
          (let ([tail1 (cdr run1)])
            (if (null? tail1)
                (cons head1 run2)
                (cons head1 (merge pred tail1 run2))))))))

(define collapse-all
  (lambda (pred stack run)
    (if (null? stack)
        run
        (collapse-all pred (cdr stack) (merge pred (cdar stack) run)))))

(define collapse
  (lambda (pred stack level run)
    (if (null? stack)
        (list (cons level run))
        (let ([top (car stack)])
          (if (= (car top) level)
              (collapse pred (cdr stack) (+ level 1) (merge pred (cdr top) run))
              (cons (cons level run) stack))))))

(define sort-helper
  (lambda (pred stack loi)
    (let* ([run-and-tail (get-run pred loi)]
           [run (car run-and-tail)]
           [tail (cdr run-and-tail)])
      (if (null? tail)
          (collapse-all pred stack run)
          (sort-helper pred (collapse pred stack 0 run) tail)))))

(define sort/predicate
  (lambda (pred loi)
    (if (null? loi)
        '()
        (sort-helper pred '() loi))))

Exercise 1.31 [β˜…] Write the following procedures for calculating on a bintree (definition 1.1.7): leaf and interior-node, which build bintrees, leaf?, which tests whether a bintree is a leaf, and lson, rson, and contents-of, which extract the components of a node. contents-of should work on both leaves and interior nodes.

(define leaf
  (lambda (num)
    num))

(define interior-node
  (lambda (symbol left-child right-child)
    (cons symbol (cons left-child right-child))))

(define leaf? integer?)

(define lson cadr)

(define rson cddr)

(define contents-of
  (lambda (bin-tree)
    (if (leaf? bin-tree)
        bin-tree
        (car bin-tree))))

Exercise 1.32 [β˜…] Write a procedure double-tree that takes a bintree, as represented in definition 1.1.7, and produces another bintree like the original, but with all the integers in the leaves doubled.

(define double-tree
  (lambda (bin-tree)
    (if (leaf? bin-tree)
        (leaf (* (contents-of bin-tree) 2))
        (interior-node (contents-of bin-tree)
                       (double-tree (lson bin-tree))
                       (double-tree (rson bin-tree))))))

Exercise 1.33 [β˜…β˜…] Write a procedure mark-leaves-with-red-depth that takes a bintree (definition 1.1.7), and produces a bintree of the same shape as the original, except that in the new tree, each leaf contains the number of nodes between it and the root that contain the symbol red. For example, the expression

(mark-leaves-with-red-depth
 (interior-node 'red
                (interior-node 'bar
                               (leaf 26)
                               (leaf 12))
                (interior-node 'red
                               (leaf 11)
                               (interior-node 'quux
                                              (leaf 117)
                                              (leaf 14)))))

which is written using the procedures defined in exercise 1.31, should return the bintree

(red
 (bar 1 1)
 (red 2 (quux 2 2)))
(define mark-leaves-with-red-depth-helper
  (lambda (bin-tree red-num)
    (if (leaf? bin-tree)
        (leaf red-num)
        (let* ([content (contents-of bin-tree)]
               [new-red-num (if (eqv? content 'red) (+ red-num 1) red-num)])
          (interior-node content
                         (mark-leaves-with-red-depth-helper (lson bin-tree) new-red-num)
                         (mark-leaves-with-red-depth-helper (rson bin-tree) new-red-num))))))

(define mark-leaves-with-red-depth
  (lambda (bin-tree)
    (mark-leaves-with-red-depth-helper bin-tree 0)))

Exercise 1.34 [β˜…β˜…β˜…] Write a procedure path that takes an integer n and a binary search tree bst (page 10) that contains the integer n, and returns a list of lefts and rights showing how to find the node containing n. If n is found at the root, it returns the empty list.

> (path 17 '(14 (7 () (12 () ()))
                (26 (20 (17 () ())
                        ())
                    (31 () ()))))
(right left left)
(define path
  (lambda (n bst)
    (let ([head (car bst)])
      (if (< n head)
          (cons 'left (path n (cadr bst)))
          (if (= n head)
              '()
              (cons 'right (path n (caddr bst))))))))

Exercise 1.35 [β˜…β˜…β˜…] Write a procedure number-leaves that takes a bintree, and produces a bintree like the original, except the contents of the leaves are numbered starting from 0. For example,

(number-leaves
 (interior-node 'foo
                (interior-node 'bar
                               (leaf 26)
                               (leaf 12))
                (interior-node 'baz
                               (leaf 11)
                               (interior-node 'quux
                                              (leaf 117)
                                              (leaf 14)))))

should return

(foo
 (bar 0 1)
 (baz
  2
  (quux 3 4)))
(define number-leaves-helper
  (lambda (bin-tree n)
    (if (leaf? bin-tree)
        (cons (leaf n) (+ n 1))
        (let* ([left-result (number-leaves-helper (lson bin-tree) n)]
               [right-result (number-leaves-helper (rson bin-tree) (cdr left-result))])
          (cons (interior-node (contents-of bin-tree)
                               (car left-result)
                               (car right-result))
                (cdr right-result))))))

(define number-leaves
  (lambda (bin-tree)
    (car (number-leaves-helper bin-tree 0))))

Exercise 1.36 [β˜…β˜…β˜…] Write a procedure g such that number-elements from page 23 could be defined as

(define number-elements
  (lambda (lst)
    (if (null? lst) '()
        (g (list 0 (car lst)) (number-elements (cdr lst))))))
(define g
  (lambda (head tail)
    (cons head
          (map (lambda (item)
                 (list (+ (car item) 1) (cadr item)))
               tail))))

Exercise 2.1 [β˜…] Implement the four required operations for bigits. Then use your implementation to calculate the factorial of 10. How does the execution time vary as this argument changes? How does the execution time vary as the base changes? Explain why.

(define *base* 10)
(define *base-sub-1* (- *base* 1))

(define zero
  (lambda ()
    '()))

(define is-zero? null?)

(define successor
  (lambda (n)
    (if (null? n)
        '(1)
        (let ([lowest-digit (car n)])
          (if (= lowest-digit *base-sub-1*)
              (cons 0 (successor (cdr n)))
              (cons (+ lowest-digit 1) (cdr n)))))))

(define predecessor
  (lambda (n)
    (let ([lowest-digit (car n)]
          [rest-digits (cdr n)])
      (if (= lowest-digit 0)
          (cons *base-sub-1* (predecessor rest-digits))
          (if (and (= lowest-digit 1) (null? rest-digits))
              '()
              (cons (- lowest-digit 1) (cdr n)))))))

(define plus
  (lambda (m n)
    (if (is-zero? n)
        m
        (plus (successor m) (predecessor n)))))

(define multiply-helper
  (lambda (base m n)
    (if (is-zero? n)
        base
        (multiply-helper (plus base m) m (predecessor n)))))

(define multiply
  (lambda (m n)
    (multiply-helper (zero) m n)))

(define factorial-helper
  (lambda (base n)
    (if (is-zero? n)
        base
        (factorial-helper (multiply base n) (predecessor n)))))

(define factorial
  (lambda (n)
    (factorial-helper (successor (zero)) n)))

When the argument of factorial becomes larger, the execution time becomes longer. Obviously.

The execution time becomes shorter when the base becomes larger. I think that’s because fewer allocations are needed when the base becomes larger.

Exercise 2.2 [β˜…β˜…] Analyze each of these proposed representations critically. To what extent do they succeed or fail in satisfying the specification of the data type?

  1. Unary representation. Too much space consumed.
  2. Scheme number representation. Not every language has native big integer support.
  3. Bignum representation. Not easy to implement.

Exercise 2.3 [β˜…β˜…] Define a representation of all the integers (negative and nonnegative) as diff-trees, where a diff-tree is a list defined by the grammar

Diff-tree ::= (one) | (diff Diff-tree Diff-tree)

The list (one) represents 1. If represents and represents , then (diff t1 t2) is a representation of .

So both (one) and (diff (one) (diff (one) (one))) are representations of 1; (diff (diff (one) (one)) (one)) is a representation of -1.

  1. Show that every number has infinitely many representations in this system.
  2. Turn this representation of the integers into an implementation by writing zero, is-zero?, successor, and predecessor, as specified on page 32, except that now the negative integers are also represented. Your procedures should take as input any of the multiple legal representations of an integer in this scheme. For example, if your successor procedure is given any of the infinitely many legal representations of 1, it should produce one of the legal representations of 2. It is permissible for different legal representations of 1 to yield different legal representations of 2.
  3. Write a procedure diff-tree-plus that does addition in this representation. Your procedure should be optimized for the diff-tree representation, and should do its work in a constant amount of time (independent of the size of its inputs). In particular, it should not be recursive.
  1. 0 has infinitely many representations: (diff (one) (one)), (diff (diff (one) (one)) (diff (one) (one))), and so on. n can be represented as (diff n 0), since 0 has infinitely many representations, n has infinitely many representations.
  2. (define zero
      (lambda ()
        '(diff (one) (one))))
    
    (define interpret
      (lambda (n)
        (if (eqv? (car n) 'one)
            1
            (- (interpret (cadr n))
               (interpret (caddr n))))))
    
    (define is-zero?
      (lambda (n)
        (zero? (interpret n))))
    
    (define successor
      (lambda (n)
        (list 'diff n '(diff (diff (one) (one)) (one)))))
    
    (define predecessor
      (lambda (n)
        (list 'diff n '(one))))
    
  3. (define diff-tree-plus
      (lambda (m n)
        (list 'diff m (list 'diff '(diff (one) (one)) n))))
    

Exercise 2.4 [β˜…β˜…] Consider the data type of stacks of values, with an interface consisting of the procedures empty-stack, push, pop, top, and empty-stack?. Write a specification for these operations in the style of the example above. Which operations are constructors and which are observers?

Constructors: empty-stack, push and pop.

Observers: top and empty-stack?.

Exercise 2.5 [β˜…] We can use any data structure for representing environments, if we can distinguish empty environments from non-empty ones, and in which one can extract the pieces of a non-empty environment. Implement environments using a representation in which the empty environment is represented as the empty list, and in which extend-env builds an environment that looks like

      β”Œβ”€β”€β”€β”¬β”€β”€β”€β”
      β”‚ β•· β”‚ ╢─┼─► saved-env
      β””β”€β”Όβ”€β”΄β”€β”€β”€β”˜
        β–Ό
      β”Œβ”€β”€β”€β”¬β”€β”€β”€β”
      β”‚ β•· β”‚ β•· β”‚
      β””β”€β”Όβ”€β”΄β”€β”Όβ”€β”˜
    β”Œβ”€β”€β”€β”˜   └───┐
    β–Ό           β–Ό
saved-var   saved-val

This is called an a-list or association-list representation.

(define empty-env
  (lambda ()
    '()))

(define apply-env
  (lambda (env search-var)
    (let ([head (car env)])
      (if (eqv? (car head) search-var)
          (cdr head)
          (apply-env (cdr env) search-var)))))

(define extend-env
  (lambda (var val env)
    (cons (cons var val) env)))

Exercise 2.6 [β˜…] Invent at least three different representations of the environment interface and implement them.

Deferred.

Exercise 2.7 [β˜…] Rewrite apply-env in figure 2.1 to give a more informative error message.

(define empty-env
  (lambda ()
    '(empty-env)))

(define extend-env
  (lambda (var val env)
    (list 'extend-env var val env)))

(define apply-env
  (lambda (env search-var)
    (let loop ([env1 env])
      (cond
        [(eqv? (car env1) 'empty-env) (report-no-binding-found search-var env)]
        [(eqv? (car env1) 'extend-env) (let ([saved-var (cadr env1)]
                                             [saved-val (caddr env1)]
                                             [saved-env (cadddr env1)])
                                         (if (eqv? search-var saved-var)
                                             saved-val
                                             (loop saved-env)))]
        [else (report-invalid-env env1)]))))

(define collect-bindings
  (lambda (env)
    (let loop ([base '()]
               [env env])
      (let ([tag (car env)])
        (cond [(eqv? tag 'empty-env) base]
              [(eqv? tag 'extend-env) (let ([saved-var (cadr env)]
                                            [saved-val (caddr env)]
                                            [saved-env (cadddr env)])
                                        (loop (if (assv saved-var base)
                                                  base
                                                  (cons (cons saved-var saved-val) base))
                                              saved-env))])))))

(define report-no-binding-found
  (lambda (search-var env)
    (eopl:error 'apply-env "No binding for ~s. All bindings: ~s" search-var (collect-bindings env))))

(define report-invalid-env
  (lambda (env)
    (eopl:error 'apply-env "Bad environment: ~s" env)))

Exercise 2.8 [β˜…] Add to the environment interface an observer called empty-env? and implement it using the a-list representation.

(emtpy-env? ⌈fβŒ‰) = #t if f = βˆ…, #f otherwise.

(define empty-env? null?)

Exercise 2.9 [β˜…] Add to the environment interface an observer called has-binding? that takes an environment env and a variable s and tests to see if s has an associated value in env. Implement it using the a-list representation.

(has-binding? ⌈fβŒ‰) = #t if f(var) = val for some var and val, #f otherwise.

(define has-binding?
  (lambda (env search-var)
    (cond [(null? env) #f]
          [(eqv? (caar env) search-var) #t]
          [else (has-binding? (cdr env) search-var)])))

Exercise 2.10 [β˜…] Add to the environment interface a constructor extend-env*, and implement it using the a-list representation. This constructor takes a list of variables, a list of values of the same length, and an environment, and is specified by

(extend-env* (var1 … vark) (val1 … valk) ⌈fβŒ‰) = ⌈gβŒ‰, where g(var) = vali if var = vari for some i such that 1 ≀ i ≀ k, f(var) otherwise.

(define extend-env*
  (lambda (vars vals env)
    (if (null? vars)
        env
        (extend-env* (cdr vars)
                     (cdr vals)
                     (cons (cons (car vars) (car vals)) env)))))

Exercise 2.11 [β˜…β˜…] A naive implementation of extend-env* from the preceding exercise requires time proportional to k to run. It is possible to represent environments so that extend-env* requires only constant time: represent the empty environment by the empty list, and represent a non-empty environment by the data structure

      β”Œβ”€β”€β”€β”¬β”€β”€β”€β”
      β”‚ β•· β”‚ ╢─┼─► saved-env
      β””β”€β”Όβ”€β”΄β”€β”€β”€β”˜
        β–Ό
      β”Œβ”€β”€β”€β”¬β”€β”€β”€β”
      β”‚ β•· β”‚ β•· β”‚
      β””β”€β”Όβ”€β”΄β”€β”Όβ”€β”˜
    β”Œβ”€β”€β”€β”˜   └───┐
    β–Ό           β–Ό
saved-vars  saved-vals

Such an environment might look like

               backbone
                  β”‚
    β”Œβ”€β”€β”€β”¬β”€β”€β”€β”     β–Ό     β”Œβ”€β”€β”€β”¬β”€β”€β”€β”           β”Œβ”€β”€β”€β”¬β”€β”€β”€β”
    β”‚ β•· β”‚ ╢─┼──────────►│ β•· β”‚ ╢─┼──────────►│ β•· β”‚ ╢─┼──────────► rest of environment
    β””β”€β”Όβ”€β”΄β”€β”€β”€β”˜           β””β”€β”Όβ”€β”΄β”€β”€β”€β”˜           β””β”€β”Όβ”€β”΄β”€β”€β”€β”˜
      β–Ό                   β–Ό                   β–Ό
    β”Œβ”€β”€β”€β”¬β”€β”€β”€β”           β”Œβ”€β”€β”€β”¬β”€β”€β”€β”           β”Œβ”€β”€β”€β”¬β”€β”€β”€β”
    β”‚ β•· β”‚ β•· β”‚           β”‚ β•· β”‚ β•· β”‚           β”‚ β•· β”‚ β•· β”‚
    β””β”€β”Όβ”€β”΄β”€β”Όβ”€β”˜           β””β”€β”Όβ”€β”΄β”€β”Όβ”€β”˜           β””β”€β”Όβ”€β”΄β”€β”Όβ”€β”˜
   β”Œβ”€β”€β”˜   └──┐         β”Œβ”€β”€β”˜   └──┐         β”Œβ”€β”€β”˜   └──┐
   β–Ό         β–Ό         β–Ό         β–Ό         β–Ό         β–Ό
(a b c)  (11 12 13)  (x z)    (66 77)    (x y)    (88 99)

This is called the ribcage representation. The environment is represented as a list of pairs called ribs; each left rib is a list of variables and each right rib is the corresponding list of values.

Implement the environment interface, including extend-env*, in this representation.

(define empty-env
  (lambda ()
    '()))

(define apply-env
  (lambda (env search-var)
    (let loop ([env env])
      (let ([rib (car env)])
        (let apply-rib ([vars (car rib)]
                        [vals (cdr rib)])
          (cond [(null? vars) (loop (cdr env))]
                [(eqv? (car vars) search-var) (car vals)]
                [else (apply-rib (cdr vars) (cdr vals))]))))))

(define extend-env*
  (lambda (vars vals env)
    (cons (cons vars vals) env)))

(define extend-env
  (lambda (var val env)
    (extend-env* (list var) (list val) env)))

Exercise 2.12 [β˜…] Implement the stack data type of exercise 2.4 using a procedural representation.

(define empty-stack
  (lambda ()
    (lambda (command)
      (cond [(eqv? command 'empty?) #t]))))

(define push
  (lambda (stack val)
    (lambda (command)
      (cond [(eqv? command 'empty?) #f]
            [(eqv? command 'pop) stack]
            [(eqv? command 'top) val]))))

(define pop
  (lambda (stack)
    (stack 'pop)))

(define top
  (lambda (stack)
    (stack 'top)))

(define empty-stack?
  (lambda (stack)
    (stack 'empty?)))

Exercise 2.13 [β˜…β˜…] Extend the procedural representation to implement empty-env? by representing the environment by a list of two procedures: one that returns the value associated with a variable, as before, and one that returns whether or not the environment is empty.

(define report-no-binding-found
  (lambda (search-var)
    (eopl:error 'apply-env "No binding for ~s" search-var)))

(define empty-env
  (lambda ()
    (list (lambda (search-var)
            (report-no-binding-found search-var))
          (lambda ()
            #t))))

(define empty-env?
  (lambda (env)
    ((cadr env))))

(define extend-env
  (lambda (saved-var saved-val saved-env)
    (list (lambda (search-var)
            (if (eqv? search-var saved-var)
                saved-val
                (apply-env saved-env search-var)))
          (lambda ()
            #f))))

(define apply-env
  (lambda (env search-var)
    ((car env) search-var)))

Exercise 2.14 [β˜…β˜…] Extend the representation of the preceding exercise to include a third procedure that implements has-binding? (see exercise 2.9).

(define report-no-binding-found
  (lambda (search-var)
    (eopl:error 'apply-env "No binding for ~s" search-var)))

(define empty-env
  (lambda ()
    (list (lambda (search-var)
            (report-no-binding-found search-var))
          (lambda ()
            #t)
          (lambda (search-var)
            #f))))

(define empty-env?
  (lambda (env)
    ((cadr env))))

(define extend-env
  (lambda (saved-var saved-val saved-env)
    (list (lambda (search-var)
            (if (eqv? search-var saved-var)
                saved-val
                (apply-env saved-env search-var)))
          (lambda ()
            #f)
          (lambda (search-var)
            (or (eqv? saved-var search-var)
                (has-binding? saved-env search-var))))))

(define apply-env
  (lambda (env search-var)
    ((car env) search-var)))

(define has-binding?
  (lambda (env search-var)
    ((caddr env) search-var)))

Exercise 2.15 [β˜…] Implement the lambda-calculus expression interface for the representation specified by the grammar above.

(define var-exp
  (lambda (var)
    var))

(define lambda-exp
  (lambda (bound-var body)
    `(lambda (,bound-var)
       ,body)))

(define app-exp
  (lambda (operator operand)
    `(,operator ,operand)))

(define var-exp? symbol?)

(define lambda-exp?
  (lambda (exp)
    (and (pair? exp)
         (eqv? (car exp) 'lambda))))

(define app-exp?
  (lambda (exp)
    (and (pair? exp)
         (not (eqv? (car exp) 'lambda)))))

(define var-exp->var
  (lambda (exp)
    exp))

(define lambda-exp->bound-var caadr)

(define lambda-exp->body caddr)

(define app-exp->rator car)

(define app-exp->rand cadr)

Exercise 2.16 [β˜…] Modify the implementation to use a representation in which there are no parentheses around the bound variable in a lambda expression.

(define lambda-exp
  (lambda (bound-var body)
    `(lambda ,bound-var ,body)))

(define lambda-exp->bound-var cadr)

Remaining implementations are the same as the ones in exercise 2.15.

Exercise 2.17 [β˜…] Invent at least two other representations of the data type of lambda-calculus expressions and implement them.

Skipped for now.

Exercise 2.18 [β˜…] We usually represent a sequence of values as a list. In this representation, it is easy to move from one element in a sequence to the next, but it is hard to move from one element to the preceding one without the help of context arguments. Implement non-empty bidirectional sequences of integers, as suggested by the grammar

NodeInSequence ::= (Int Listof(Int) Listof(Int))

The first list of numbers is the elements of the sequence preceding the current one, in reverse order, and the second list is the elements of the sequence after the current one. For example, (6 (5 4 3 2 1) (7 8 9)) represents the list (1 2 3 4 5 6 7 8 9), with the focus on the element 6.

In this representation, implement the procedure number->sequence, which takes a number and produces a sequence consisting of exactly that number. Also implement current-element, move-to-left, move-to-right, insert-to-left, insert-to-right, at-left-end?, and at-right-end?.

For example:

> (number->sequence 7)
(7 () ())
> (current-element '(6 (5 4 3 2 1) (7 8 9)))
6
> (move-to-left '(6 (5 4 3 2 1) (7 8 9)))
(5 (4 3 2 1) (6 7 8 9))
> (move-to-right '(6 (5 4 3 2 1) (7 8 9)))
(7 (6 5 4 3 2 1) (8 9))
> (insert-to-left 13 '(6 (5 4 3 2 1) (7 8 9)))
(6 (13 5 4 3 2 1) (7 8 9))
> (insert-to-right 13 '(6 (5 4 3 2 1) (7 8 9)))
(6 (5 4 3 2 1) (13 7 8 9))

The procedure move-to-right should fail if its argument is at the right end of the sequence, and the procedure move-to-left should fail if its argument is at the left end of the sequence.

(define number->sequence
  (lambda (num)
    (list num '() '())))

(define current-element car)

(define move-to-left
  (lambda (node)
    (let ([before (cadr node)])
      (if (null? before)
          (eopl:error 'move-to-left "Cannot move to left when at left end.")
          (let ([num (car node)]
                [after (caddr node)])
            (list (car before) (cdr before) (cons num after)))))))

(define move-to-right
  (lambda (node)
    (let ([after (caddr node)])
      (if (null? after)
          (eopl:error 'move-to-right "Cannot move to right when at right end.")
          (let ([num (car node)]
                [before (cadr node)])
            (list (car after) (cons num before) (cdr after)))))))

(define insert-to-left
  (lambda (num node)
    (let ([current (car node)]
          [before (cadr node)]
          [after (caddr node)])
      (list current (cons num before) after))))

(define insert-to-right
  (lambda (num node)
    (let ([current (car node)]
          [before (cadr node)]
          [after (caddr node)])
      (list current before (cons num after)))))

(define at-left-end?
  (lambda (node)
    (null? (cadr node))))

(define at-right-end?
  (lambda (node)
    (null? (caddr node))))

Exercise 2.19 [β˜…] A binary tree with empty leaves and with interior nodes labeled with integers could be represented using the grammar

Bintree ::= () | (Int Bintree Bintree)

In this representation, implement the procedure number->bintree, which takes a number and produces a binary tree consisting of a single node containing that number. Also implement current-element, move-to-left-son, move-to-right-son, at-leaf?, insert-to-left, and insert-to-right. For example,

> (number->bintree 13)
(13 () ())
> (define t1 (insert-to-right 14
                              (insert-to-left 12
                                              (number->bintree 13))))
> t1
(13
 (12 () ())
 (14 () ()))
> (move-to-left-son t1)
(12 () ())
> (current-element (move-to-left-son t1))
12
> (at-leaf? (move-to-right-son (move-to-left-son t1)))
#t
> (insert-to-left 15 t1)
(13
 (15
  (12 () ())
  ())
 (14 () ()))
(define number->bintree
  (lambda (num)
    `(,num () ())))

(define current-element car)

(define move-to-left-son cadr)

(define move-to-right-son caddr)

(define at-leaf? null?)

(define insert-to-left
  (lambda (num bintree)
    (let ([root-value (car bintree)]
          [left-child (cadr bintree)]
          [right-child (caddr bintree)])
      `(,root-value (,num ,left-child ()) ,right-child))))

(define insert-to-right
  (lambda (num bintree)
    (let ([root-value (car bintree)]
          [left-child (cadr bintree)]
          [right-child (caddr bintree)])
      `(,root-value ,left-child (,num () ,right-child)))))

Exercise 2.20 [β˜…β˜…β˜…] In the representation of binary trees in exercise 2.19 it is easy to move from a parent node to one of its sons, but it is impossible to move from a son to its parent without the help of context arguments. Extend the representation of lists in exercise 2.18 to represent nodes in a binary tree. As a hint, consider representing the portion of the tree above the current node by a reversed list, as in exercise 2.18.

In this representation, implement the procedures from exercise 2.19. Also implement move-up and at-root?.

(define number->bintree
  (lambda (num)
    (cons `(,num () ()) '())))

(define current-element caar)

(define move-to-left-son
  (lambda (bintree)
    (let* ([current (car bintree)]
           [value (car current)]
           [left-son (cadr current)]
           [right-son (caddr current)]
           [parents (cdr bintree)])
      (cons left-son
            (cons (list value 'right right-son)
                  parents)))))

(define move-to-right-son
  (lambda (bintree)
    (let* ([current (car bintree)]
           [value (car current)]
           [left-son (cadr current)]
           [right-son (caddr current)]
           [parents (cdr bintree)])
      (cons right-son
            (cons (list value 'left left-son)
                  parents)))))

(define at-leaf?
  (lambda (bintree)
    (null? (car bintree))))

(define insert-to-left
  (lambda (num bintree)
    (let* ([current (car bintree)]
           [value (car current)]
           [left-son (cadr current)]
           [right-son (caddr current)]
           [parents (cdr bintree)])
      (cons `(,value (,num ,left-son ()) ,right-son)
            parents))))

(define insert-to-right
  (lambda (num bintree)
    (let* ([current (car bintree)]
           [value (car current)]
           [left-son (cadr current)]
           [right-son (caddr current)]
           [parents (cdr bintree)])
      (cons `(,value ,left-son (,num () ,right-son))
            parents))))

(define move-up
  (lambda (bintree)
    (let* ([current (car bintree)]
           [parents (cdr bintree)]
           [parent (car parents)]
           [parent-value (car parent)]
           [parent-other-branch (cadr parent)]
           [parent-other-son (caddr parent)]
           [rest-parents (cdr parents)])
      (if (eqv? parent-other-branch 'left)
          (cons (list parent-value parent-other-son current)
                rest-parents)
          (cons (list parent-value current parent-other-son)
                rest-parents)))))

(define at-root?
  (lambda (bintree)
    (null? (cdr bintree))))

Exercise 2.21 [β˜…] Implement the data type of environments, as in section 2.2.2, using define-datatype. Then include has-binding? of exercise 2.9.

(define-datatype env-type env?
  (empty-env)
  (extend-env [var symbol?]
              [val always?]
              [env env?]))

(define apply-env
  (lambda (env search-var)
    (cases env-type env
      [empty-env () (eopl:error 'apply-env "No binding for ~s" search-var)]
      [extend-env (var val env) (if (eqv? var search-var)
                                    val
                                    (apply-env env search-var))])))

(define has-binding?
  (lambda (env search-var)
    (cases env-type env
      [empty-env () #f]
      [extend-env (var val env) (or (eqv? var search-var)
                                    (has-binding? env search-var))])))

Exercise 2.22 [β˜…] Using define-datatype, implement the stack data type of exercise 2.4.

(define-datatype stack-type stack?
  (empty-stack)
  (push [saved-stack stack?]
        [val always?]))

(define pop
  (lambda (stack)
    (cases stack-type stack
      [empty-stack () (eopl:error 'pop "Can not pop an empty stack.")]
      [push (saved-stack val) saved-stack])))

(define top
  (lambda (stack)
    (cases stack-type stack
      [empty-stack () (eopl:error 'pop "Can not top an empty stack.")]
      [push (saved-stack val) val])))

(define empty-stack?
  (lambda (stack)
    (cases stack-type stack
      [empty-stack () #t]
      [push (saved-stack val) #f])))

Exercise 2.23 [β˜…] The definition of lc-exp ignores the condition in definition 1.1.8 that says β€œIdentifier is any symbol other than lambda.” Modify the definition of identifier? to capture this condition. As a hint, remember that any predicate can be used in define-datatype, even ones you define.

(define identifier?
  (lambda (value)
    (and (symbol? value)
         (not (eqv? value 'lambda)))))

Exercise 2.24 [β˜…] Here is a definition of binary trees using define-datatype.

(define-datatype bintree bintree?
  (leaf-node
   (num integer?))
  (interior-node
   (key symbol?)
   (left bintree?)
   (right bintree?)))

Implement a bintree-to-list procedure for binary trees, so that (bintree-to-list (interior-node 'a (leaf-node 3) (leaf-node 4))) returns the list

(interior-node
 a
 (leaf-node 3)
 (leaf-node 4))
(define bintree-to-list
  (lambda (tree)
    (cases bintree tree
      [leaf-node (num) `(leaf-node ,num)]
      [interior-node (key left right) (list 'interior-node
                                            key
                                            (bintree-to-list left)
                                            (bintree-to-list right))])))

Exercise 2.25 [β˜…β˜…] Use cases to write max-interior, which takes a binary tree of integers (as in the preceding exercise) with at least one interior node and returns the symbol associated with an interior node with a maximal leaf sum.

> (define tree-1
    (interior-node 'foo (leaf-node 2) (leaf-node 3)))
> (define tree-2
    (interior-node 'bar (leaf-node -1) tree-1))
> (define tree-3
    (interior-node 'baz tree-2 (leaf-node 1)))
> (max-interior tree-2)
foo
> (max-interior tree-3)
baz

The last invocation of max-interior might also have returned foo, since both the foo and baz nodes have a leaf sum of 5.

(define-datatype bintree-info bintree-info?
  [leaf-info [num integer?]]
  [interior-info [sum integer?]
                 [max-sum integer?]
                 [max-key symbol?]])

(define max-interior-helper
  (lambda (tree)
    (cases bintree tree
      [leaf-node (num)
                 (leaf-info num)]
      [interior-node (key left right)
                     (let ([left-info (max-interior-helper left)]
                           [right-info (max-interior-helper right)])
                       (cases bintree-info left-info
                         [leaf-info (left-num)
                                    (cases bintree-info right-info
                                      [leaf-info (right-num)
                                                 (let ([sum (+ left-num right-num)])
                                                   (interior-info sum
                                                                  sum
                                                                  key))]
                                      [interior-info (right-sum right-max-sum right-max-key)
                                                     (let ([sum (+ left-num right-sum)])
                                                       (if (< sum right-max-sum)
                                                           (interior-info sum
                                                                          right-max-sum
                                                                          right-max-key)
                                                           (interior-info sum
                                                                          sum
                                                                          key)))])]
                         [interior-info (left-sum left-max-sum left-max-key)
                                        (cases bintree-info right-info
                                          [leaf-info (right-num)
                                                     (let ([sum (+ left-sum right-num)])
                                                       (if (< sum left-max-sum)
                                                           (interior-info sum
                                                                          left-max-sum
                                                                          left-max-key)
                                                           (interior-info sum
                                                                          sum
                                                                          key)))]
                                          [interior-info (right-sum right-max-sum right-max-key)
                                                         (let* ([sum (+ left-sum right-sum)]
                                                                [max-sum-and-key (if (< left-max-sum right-max-sum)
                                                                                     (cons right-max-sum right-max-key)
                                                                                     (cons left-max-sum left-max-key))]
                                                                [max-sum (car max-sum-and-key)]
                                                                [max-key (cdr max-sum-and-key)])
                                                           (if (< sum max-sum)
                                                               (interior-info sum
                                                                              max-sum
                                                                              max-key)
                                                               (interior-info sum
                                                                              sum
                                                                              key)))])]))])))

(define max-interior
  (lambda (tree)
    (cases bintree-info (max-interior-helper tree)
      [leaf-info (num) (eopl:error 'max-interior "~s is not an interior node" tree)]
      [interior-info (sum max-sum max-key) max-key])))

Exercise 2.26 [β˜…β˜…] Here is another version of exercise 1.33. Consider a set of trees given by the following grammar:

Red-blue-tree ::= Red-blue-subtree
Red-blue-subtree ::= (red-node Red-blue-subtree Red-blue-subtree)
Β  ::= (blue-node {Red-blue-subtree}βˆ—)
Β  ::= (leaf-node Int)

Write an equivalent definition using define-datatype, and use the resulting interface to write a procedure that takes a tree and builds a tree of the same shape, except that each leaf node is replaced by a leaf node that contains the number of red nodes on the path between it and the root.

(define-datatype red-blue-tree red-blue-tree?
  [red-node [lson red-blue-tree?]
            [rson red-blue-tree?]]
  [blue-node [sons (list-of red-blue-tree?)]]
  [leaf-node [num integer?]])

(define mark-leaves-with-red-depth-helper
  (lambda (tree red-num)
    (cases red-blue-tree tree
      [red-node (lson rson) (let ([new-red-num (+ red-num 1)])
                              (red-node (mark-leaves-with-red-depth-helper lson new-red-num)
                                        (mark-leaves-with-red-depth-helper rson new-red-num)))]
      [blue-node (sons) (blue-node (map (lambda (son)
                                          (mark-leaves-with-red-depth-helper son red-num))
                                        sons))]
      [leaf-node (_) (leaf-node red-num)])))

(define mark-leaves-with-red-depth
  (lambda (tree)
    (mark-leaves-with-red-depth-helper tree 0)))

Exercise 2.27 [β˜…] Draw the abstract syntax tree for the lambda calculus expressions

((lambda (a) (a b)) c)

(lambda (x)
  (lambda (y)
    ((lambda (x)
       (x y))
     x)))
((lambda (a) (a b)) c)
           β”Œβ”€β”€β”€β”€β”€β”€β”€β”€β”€β”
           β”‚ app-exp β”‚
           β””β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”˜
         β”Œβ”€β”€β”€β”€β”€β”€β”΄β”€β”€β”€β”€β”€β”€β”€β”
       rator           rand
   β”Œβ”€β”€β”€β”€β”€β”΄β”€β”€β”€β”€β”€β”€β”  β”Œβ”€β”€β”€β”€β”΄β”€β”€β”€β”€β”
   β”‚ lambda-exp β”‚  β”‚ var-exp β”‚
   β””β”€β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”€β”€β”˜  β””β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”˜
    β”Œβ”€β”€β”€β”€β”΄β”€β”€β”€β”€β”         β”‚
bound-var    body      var
  β”Œβ”€β”΄β”€β”  β”Œβ”€β”€β”€β”€β”΄β”€β”€β”€β”€β”  β”Œβ”€β”΄β”€β”
  β”‚ a β”‚  β”‚ app-exp β”‚  β”‚ c β”‚
  β””β”€β”€β”€β”˜  β””β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”˜  β””β”€β”€β”€β”˜
        β”Œβ”€β”€β”€β”€β”€β”΄β”€β”€β”€β”€β”€β”€β”
      rator         rand
   β”Œβ”€β”€β”€β”€β”΄β”€β”€β”€β”€β”  β”Œβ”€β”€β”€β”€β”΄β”€β”€β”€β”€β”
   β”‚ var-exp β”‚  β”‚ var-exp β”‚
   β””β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”˜  β””β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”˜
        β”‚            β”‚
       var          var
      β”Œβ”€β”΄β”€β”        β”Œβ”€β”΄β”€β”
      β”‚ a β”‚        β”‚ b β”‚
      β””β”€β”€β”€β”˜        β””β”€β”€β”€β”˜
(lambda (x)
  (lambda (y)
    ((lambda (x)
       (x y))
     x)))
   β”Œβ”€β”€β”€β”€β”€β”€β”€β”€β”€β”€β”€β”€β”
   β”‚ lambda-exp β”‚
   β””β”€β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”€β”€β”˜
    β”Œβ”€β”€β”€β”€β”΄β”€β”€β”€β”€β”€β”
bound-var     body
  β”Œβ”€β”΄β”€β”  β”Œβ”€β”€β”€β”€β”€β”΄β”€β”€β”€β”€β”€β”€β”
  β”‚ x β”‚  β”‚ lambda-exp β”‚
  β””β”€β”€β”€β”˜  β””β”€β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”€β”€β”˜
          β”Œβ”€β”€β”€β”€β”΄β”€β”€β”€β”€β”
      bound-var    body
        β”Œβ”€β”΄β”€β”  β”Œβ”€β”€β”€β”€β”΄β”€β”€β”€β”€β”
        β”‚ y β”‚  β”‚ app-exp β”‚
        β””β”€β”€β”€β”˜  β””β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”˜
             β”Œβ”€β”€β”€β”€β”€β”€β”΄β”€β”€β”€β”€β”€β”€β”€β”
           rator           rand
       β”Œβ”€β”€β”€β”€β”€β”΄β”€β”€β”€β”€β”€β”€β”  β”Œβ”€β”€β”€β”€β”΄β”€β”€β”€β”€β”
       β”‚ lambda-exp β”‚  β”‚ var-exp β”‚
       β””β”€β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”€β”€β”˜  β””β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”˜
        β”Œβ”€β”€β”€β”€β”΄β”€β”€β”€β”€β”         β”‚
    bound-var    body      var
      β”Œβ”€β”΄β”€β”  β”Œβ”€β”€β”€β”€β”΄β”€β”€β”€β”€β”  β”Œβ”€β”΄β”€β”
      β”‚ x β”‚  β”‚ app-exp β”‚  β”‚ x β”‚
      β””β”€β”€β”€β”˜  β””β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”˜  β””β”€β”€β”€β”˜
            β”Œβ”€β”€β”€β”€β”€β”΄β”€β”€β”€β”€β”€β”€β”
          rator         rand
       β”Œβ”€β”€β”€β”€β”΄β”€β”€β”€β”€β”  β”Œβ”€β”€β”€β”€β”΄β”€β”€β”€β”€β”
       β”‚ var-exp β”‚  β”‚ var-exp β”‚
       β””β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”˜  β””β”€β”€β”€β”€β”¬β”€β”€β”€β”€β”˜
            β”‚            β”‚
           var          var
          β”Œβ”€β”΄β”€β”        β”Œβ”€β”΄β”€β”
          β”‚ x β”‚        β”‚ y β”‚
          β””β”€β”€β”€β”˜        β””β”€β”€β”€β”˜

Exercise 2.28 [β˜…] Write an unparser that converts the abstract syntax of an lc-exp into a string that matches the second grammar in this section (page 52).

(define identifier? symbol?)

(define-datatype lc-exp lc-exp?
  [var-exp [var identifier?]]
  [lambda-exp [bound-var identifier?]
              [body lc-exp?]]
  [app-exp [rator lc-exp?]
           [rand lc-exp?]])

(define unparse-lc-exp
  (lambda (exp)
    (cases lc-exp exp
      [var-exp (var) (symbol->string var)]
      [lambda-exp (bound-var body)
                  (string-append "(lambda ("
                                 (symbol->string bound-var)
                                 ") "
                                 (unparse-lc-exp body)
                                 ")")]
      [app-exp (rator rand)
               (string-append "("
                              (unparse-lc-exp rator)
                              " "
                              (unparse-lc-exp rand)
                              ")")])))

Exercise 2.29 [β˜…] Where a Kleene star or plus (page 7) is used in concrete syntax, it is most convenient to use a list of associated subtrees when constructing an abstract syntax tree. For example, if the grammar for lambda-calculus expressions had been

Lc-exp ::= Identifier
Β  Β  var-exp (var)
Β  ::= (lambda ({Identifier}βˆ—) Lc-exp)
Β  Β  lambda-exp (bound-vars body)
Β  ::= (Lc-exp {Lc-exp}βˆ—)
Β  Β  app-exp (rator rands)

then the predicate for the bound-vars field could be (list-of identifier?), and the predicate for the rands field could be (list-of lc-exp?). Write a define-datatype and a parser for this grammar that works in this way.

(define identifier?
  (lambda (x)
    (and (symbol? x)
         (not (eqv? x 'lambda)))))

(define-datatype lc-exp lc-exp?
  [var-exp [var identifier?]]
  [lambda-exp [bound-vars (list-of identifier?)]
              [body lc-exp?]]
  [app-exp [rator lc-exp?]
           [rands (list-of lc-exp?)]])

(define parse-expression
  (lambda (datum)
    (cond [(identifier? datum) (var-exp datum)]
          [(pair? datum) (if (eqv? (car datum) 'lambda)
                             (lambda-exp (cadr datum)
                                         (parse-expression (caddr datum)))
                             (app-exp (parse-expression (car datum))
                                      (map parse-expression (cdr datum))))]
          [else (eopl:error 'parse-expression "Invalid expression: ~s" datum)])))

Exercise 2.30 [β˜…β˜…] The procedure parse-expression as defined above is fragile: it does not detect several possible syntactic errors, such as (a b c), and aborts with inappropriate error messages for other expressions, such as (lambda). Modify it so that it is robust, accepting any s-exp and issuing an appropriate error message if the s-exp does not represent a lambda-calculus expression.

(define identifier?
  (lambda (x)
    (and (symbol? x)
         (not (eqv? x 'lambda)))))

(define-datatype lc-exp lc-exp?
  [var-exp (var identifier?)]
  [lambda-exp [bound-var identifier?]
              [body lc-exp?]]
  [app-exp [rator lc-exp?]
           [rand lc-exp?]])

(define report-error
  (lambda (expected datum)
    (eopl:error 'parse-expression "Expect ~a, but got ~s." expected datum)))

(define parse-lambda-expression
  (lambda (datum)
    (let ([after-lambda (cdr datum)])
      (if (pair? after-lambda)
          (let ([bound-var-list (car after-lambda)]
                [after-bound-var-list (cdr after-lambda)])
            (if (pair? bound-var-list)
                (let ([bound-var (car bound-var-list)]
                      [after-bound-var (cdr bound-var-list)])
                  (if (identifier? bound-var)
                      (if (null? after-bound-var)
                          (if (pair? after-bound-var-list)
                              (let ([body (car after-bound-var-list)]
                                    [after-body (cdr after-bound-var-list)])
                                (if (null? after-body)
                                    (lambda-exp bound-var (parse-expression body))
                                    (report-error "null after body" after-body)))
                              (report-error "a pair after bound var list" after-bound-var-list))
                          (report-error "null after bound var" after-bound-var))
                      (report-error "an identifier" bound-var)))
                (report-error "a pair" bound-var-list)))
          (report-error "a pair after lambda" after-lambda)))))

(define parse-application-expression
  (lambda (datum)
    (let ([rator (car datum)]
          [after-rator (cdr datum)])
      (if (pair? after-rator)
          (let ([rand (car after-rator)]
                [after-rand (cdr after-rator)])
            (if (null? after-rand)
                (app-exp (parse-expression rator) (parse-expression rand))
                (report-error "null after rand" after-rand)))
          (report-error "a pair after rator" after-rator)))))

(define parse-expression
  (lambda (datum)
    (cond [(symbol? datum) (if (eqv? datum 'lambda)
                               (report-error "an identifier" datum)
                               (var-exp datum))]
          [(pair? datum) (if (eqv? (car datum) 'lambda)
                             (parse-lambda-expression datum)
                             (parse-application-expression datum))]
          [else (report-error "a symbol or pair" datum)])))

Exercise 2.31 [β˜…β˜…] Sometimes it is useful to specify a concrete syntax as a sequence of symbols and integers, surrounded by parentheses. For example, one might define the set of prefix lists by

Prefix-list ::= (Prefix-exp)
Prefix-exp ::= Int
Β  ::= - Prefix-exp Prefix-exp

so that (- - 3 2 - 4 - 12 7) is a legal prefix list. This is sometimes called Polish prefix notation, after its inventor, Jan Łukasiewicz. Write a parser to convert a prefix-list to the abstract syntax

(define-datatype prefix-exp prefix-exp?
  (const-exp
   (num integer?))
  (diff-exp
   (operand1 prefix-exp?)
   (operand2 prefix-exp?)))

so that the example above produces the same abstract syntax tree as the sequence of constructors

(diff-exp
 (diff-exp
  (const-exp 3)
  (const-exp 2))
 (diff-exp
  (const-exp 4)
  (diff-exp
   (const-exp 12)
   (const-exp 7))))

As a hint, consider writing a procedure that takes a list and produces a prefix-exp and the list of leftover list elements.

(define-datatype prefix-exp prefix-exp?
  [const-exp [num integer?]]
  [diff-exp [operand1 prefix-exp?]
            [operand2 prefix-exp?]])

(define parse-prefix-exp
  (lambda (prefix-list)
    (let ([head (car prefix-list)]
          [tail (cdr prefix-list)])
      (cond [(integer? head) (cons (const-exp head) tail)]
            [(eqv? head '-) (let* ([operand-1-and-rest-1 (parse-prefix-exp tail)]
                                   [operand-1 (car operand-1-and-rest-1)]
                                   [rest-1 (cdr operand-1-and-rest-1)]
                                   [operand-2-and-rest-2 (parse-prefix-exp rest-1)]
                                   [operand-2 (car operand-2-and-rest-2)]
                                   [rest-2 (cdr operand-2-and-rest-2)])
                              (cons (diff-exp operand-1 operand-2) rest-2))]
            [else (eopl:error 'parse-prefix-exp "Bad syntax: ~s." prefix-list)]))))

(define parse-prefix-list
  (lambda (prefix-list)
    (let* ([exp-and-rest (parse-prefix-exp prefix-list)]
           [exp (car exp-and-rest)]
           [rest (cdr exp-and-rest)])
      (if (null? rest)
          exp
          (eopl:error 'parse-prefix-list "Expect null after prefix-exp, but got: ~s." rest)))))

Exercise 3.1 [β˜…] In figure 3.3, list all the places where we used the fact that ⌊⌈nβŒ‰βŒ‹ = n.

Skipped for now.

Exercise 3.2 [β˜…β˜…] Give an expressed value val ∈ ExpVal for which ⌈⌊valβŒ‹βŒ‰ β‰  val.

Not sure, but maybe when val is constructed using a Bool?

Exercise 3.3 [β˜…] Why is subtraction a better choice than addition for our single arithmetic operation?

One reason I can think of, is that subtraction is not commutative, that is may not equal to . If our implementation of subtraction is incorrect, we can discover the error quickly.

Exercise 3.4 [β˜…] Write out the derivation of figure 3.4 as a derivation tree in the style of the one on page 5.

Exercise 3.5 [β˜…] Write out the derivation of figure 3.5 as a derivation tree in the style of the one on page 5.

Skipped for now.

Exercise 3.6 [β˜…] Extend the language by adding a new operator minus that takes one argument, n, and returns -n. For example, the value of minus(-(minus(5), 9)) should be 14.

Solution is too long, see the code repository.

Exercise 3.7 [β˜…] Extend the language by adding operators for addition, multiplication, and integer quotient.

Solution is too long, see the code repository.

Exercise 3.8 [β˜…] Add a numeric equality predicate equal? and numeric order predicates greater? and less? to the set of operations in the defined language.

Solution is too long, see the code repository.

Exercise 3.9 [β˜…β˜…] Add list processing operations to the language, including cons, car, cdr, null? and emptylist. A list should be able to contain any expressed value, including another list. Give the definitions of the expressed and denoted values of the language, as in section 3.2.2. For example,

let x = 4
in cons(x,
        cons(cons(-(x,1),
                  emptylist),
             emptylist))

should return an expressed value that represents the list (4 (3)).

Solution is too long, see the code repository.

Exercise 3.10 [β˜…β˜…] Add an operation list to the language. This operation should take any number of arguments, and return an expressed value containing the list of their values. For example,

let x = 4
in list(x, -(x,1), -(x,3))

should return an expressed value that represents the list (4 3 1).

Solution is too long, see the code repository.

Exercise 3.11 [β˜…] In a real language, one might have many operators such as those in the preceding exercises. Rearrange the code in the interpreter so that it is easy to add new operators.

Solution is too long, see the code repository.

Exercise 3.12 [β˜…] Add to the defined language a facility that adds a cond expression. Use the grammar

Expression ::= cond {Expression ==> Expression}βˆ— end

In this expression, the expressions on the left-hand sides of the ==>’s are evaluated in order until one of them returns a true value. Then the value of the entire expression is the value of the corresponding right-hand expression. If none of the tests succeeds, the expression should report an error.

Solution is too long, see the code repository.

Exercise 3.13 [β˜…] Change the values of the language so that integers are the only expressed values. Modify if so that the value 0 is treated as false and all other values are treated as true. Modify the predicates accordingly.

Solution is too long, see the code repository.

Exercise 3.14 [β˜…β˜…] As an alternative to the preceding exercise, add a new nonterminal Bool-exp of boolean expressions to the language. Change the production for conditional expressions to say

Expression ::= if Bool-exp then Expression else Expression

Write suitable productions for Bool-exp and implement value-of-bool-exp. Where do the predicates of exercise 3.8 wind up in this organization?

Solution is too long, see the code repository.

Exercise 3.15 [β˜…] Extend the language by adding a new operation print that takes one argument, prints it, and returns the integer 1. Why is this operation not expressible in our specification framework?

See the code repository for implementation.

Because print cause a side effect while our specification framework does not have something to do this.

Exercise 3.16 [β˜…β˜…] Extend the language so that a let declaration can declare an arbitrary number of variables, using the grammar

Expression ::= let {Identifier = Expression}βˆ— in Expression

As in Scheme’s let, each of the right-hand sides is evaluated in the current environment, and the body is evaluated with each new variable bound to the value of its associated right-hand side. For example,

let x = 30
in let x = -(x,1)
       y = -(x,2)
   in -(x,y)

should evaluate to 1.

Solution is too long, see the code repository.

Exercise 3.17 [β˜…β˜…] Extend the language with a let* expression that works like Scheme’s let*, so that

let x = 30
in let* x = -(x,1) y = -(x,2)
   in -(x,y)

should evaluate to 2.

Solution is too long, see the code repository.

Exercise 3.18 [β˜…β˜…] Add an expression to the defined language:

Expression ::= unpack {Identifier}βˆ— = Expression in Expression

so that unpack x y z = lst in ... binds x, y, and z to the elements of lst if lst is a list of exactly three elements, and reports an error otherwise. For example, the value of

let u = 7
in unpack x y = cons(u,cons(3,emptylist))
   in -(x,y)

should be 4.

Solution is too long, see the code repository.

Exercise 3.19 [β˜…] In many languages, procedures must be created and named at the same time. Modify the language of this section to have this property by replacing the proc expression with a letproc expression.

Skipped for now.

Exercise 3.20 [β˜…] In PROC, procedures have only one argument, but one can get the effect of multiple argument procedures by using procedures that return other procedures. For example, one might write code like

let f = proc (x) proc (y) ...
in ((f 3) 4)

This trick is called Currying, and the procedure is said to be Curried. Write a Curried procedure that takes two arguments and returns their sum. You can write x + y in our language by writing -(x, -(0, y)).

proc (x)
  proc (y)
    -(x, -(0, y))

Exercise 3.21 [β˜…β˜…] Extend the language of this section to include procedures with multiple arguments and calls with multiple operands, as suggested by the grammar

Expression ::= proc ({Identifier}βˆ—(,)) Expression
Expression ::= (Expression {Expression}βˆ—)

Solution is too long, see the code repository.

Exercise 3.22 [β˜…β˜…β˜…] The concrete syntax of this section uses different syntax for a built-in operation, such as difference, from a procedure call. Modify the concrete syntax so that the user of this language need not know which operations are built-in and which are defined procedures. This exercise may range from very easy to hard, depending on the parsing technology being used.

Solution is too long, see the code repository.

Exercise 3.23 [β˜…β˜…] What is the value of the following PROC program?

let makemult = proc (maker)
                proc (x)
                 if zero?(x)
                 then 0
                 else -(((maker maker) -(x,1)), -4)
in let times4 = proc (x) ((makemult makemult) x)
   in (times4 3)

Use the tricks of this program to write a procedure for factorial in PROC. As a hint, remember that you can use Currying (exercise 3.20) to define a two-argument procedure times.

Value of given program is 12.

The procedure of factorial:

let maketimes = proc (maker)
                  proc (x)
                    proc (y)
                      if zero?(x)
                      then 0
                      else -((((maker maker) -(x, 1)) y), -(0, y))
in let times = (maketimes maketimes)
   in let makefact = proc (maker)
                       proc (x)
                         if zero?(x)
                         then 1
                         else ((times x) ((maker maker) -(x, 1)))
      in (makefact makefact)

Exercise 3.24 [β˜…β˜…] Use the tricks of the program above to write the pair of mutually recursive procedures, odd and even, as in exercise 3.32.

odd:

let false = zero?(1)
in let true = zero?(0)
   in let makeeven = proc (makeeven)
                       proc (makeodd)
                         proc (x)
                           if zero?(x)
                           then true
                           else (((makeodd makeeven) makeodd) -(x, 1))
      in let makeodd = proc (makeeven)
                         proc (makeodd)
                           proc (x)
                             if zero?(x)
                             then false
                             else (((makeeven makeeven) makeodd) -(x, 1))
         in ((makeodd makeeven) makeodd)

even:

let false = zero?(1)
in let true = zero?(0)
   in let makeeven = proc (makeeven)
                       proc (makeodd)
                         proc (x)
                           if zero?(x)
                           then true
                           else (((makeodd makeeven) makeodd) -(x, 1))
      in let makeodd = proc (makeeven)
                         proc (makeodd)
                           proc (x)
                             if zero?(x)
                             then false
                             else (((makeeven makeeven) makeodd) -(x, 1))
         in ((makeeven makeeven) makeodd)

Exercise 3.25 [β˜…] The tricks of the previous exercises can be generalized to show that we can define any recursive procedure in PROC. Consider the following bit of code:

let makerec = proc (f)
               let d = proc (x)
                        proc (z) ((f (x x)) z)
               in proc (n) ((f (d d)) n)
in let maketimes4 = proc (f)
                     proc (x)
                      if zero?(x)
                      then 0
                      else -((f -(x,1)), -4)
   in let times4 = (makerec maketimes4)
      in (times4 3)

Show that it returns 12.

maketimes4 is a procedure that takes a times4 procedure and returns a times4 procedure. First we convert maketimes4 to a procedure maker that takes a maker and returns a times4 procedure (assume we use f to represent maketimes4):

proc (f)
  let maker = proc (maker)
                let recurive-proc = (maker maker)
                in (f recurive-proc)
  in ...

But the code would not work because once we call (maker maker), it will first call (maker maker) which will cause infinite recursion. We will fix this by wrapping (maker maker) inside another procedure:

proc (f)
  let maker = proc (maker)
                proc (x)
                  let recurive-proc = (maker maker)
                  in ((f recurive-proc) x)

  in ...

Now we get a maker, we call the maker with maker, we will get a recursive version of f:

proc (f)
  let maker = proc (maker)
                proc (x)
                  let recurive-proc = (maker maker)
                  in ((f recurive-proc) x)
  in (maker maker)

Let’s run the program:

let makerec = proc (f)
                let maker = proc (maker)
                              proc (x)
                                let recurive-proc = (maker maker)
                                in ((f recurive-proc) x)
                in (maker maker)
in let maketimes4 = proc (f)
                      proc (x)
                        if zero?(x)
                        then 0
                        else -((f -(x, 1)), -4)
   in let times4 = (makerec maketimes4)
      in (times4 3)

Yep, the result is also 12. Although it is a little different than the original one.

Exercise 3.26 [β˜…β˜…] In our data-structure representation of procedures, we have kept the entire environment in the closure. But of course all we need are the bindings for the free variables. Modify the representation of procedures to retain only the free variables.

Here is a function that filters free variables in the environment:

(define (filter-env env bound-vars exp)
  (let loop ([result (empty-env)]
             [bound-vars bound-vars]
             [exp exp])
    (cases expression exp
      [const-exp (num) result]
      [var-exp (var) (if (memv var bound-vars)
                         result
                         (extend-env var (apply-env env var) result))]
      [diff-exp (exp1 exp2) (loop (loop result bound-vars exp1) bound-vars exp2)]
      [zero?-exp (exp1) (loop result bound-vars exp1)]
      [if-exp (exp1 exp2 exp3) (loop (loop (loop result
                                                 bound-vars
                                                 exp1)
                                           bound-vars
                                           exp2)
                                     bound-vars
                                     exp3)]
      [let-exp (var exp1 body) (loop (loop result bound-vars exp1)
                                     (cons var bound-vars)
                                     body)]
      [proc-exp (vars body) (loop result (append vars bound-vars) body)]
      [call-exp (rator rands) (let loop2 ([result (loop result bound-vars rator)]
                                          [rands rands])
                                (if (null? rands)
                                    result
                                    (loop2 (loop result bound-vars (car rands))
                                           (cdr rands))))])))

Exercise 3.27 [β˜…] Add a new kind of procedure called a traceproc to the language. A traceproc works exactly like a proc, except that it prints a trace message on entry and on exit.

Solution is too long, see the code repository.

Exercise 3.28 [β˜…β˜…] Dynamic binding (or dynamic scoping) is an alternative design for procedures, in which the procedure body is evaluated in an environment obtained by extending the environment at the point of call. For example in

let a = 3
in let p = proc (x) -(x,a)
       a = 5
   in -(a,(p 2))

the a in the procedure body would be bound to 5, not 3. Modify the language to use dynamic binding. Do this twice, once using a procedural representation for procedures, and once using a data-structure representation.

Solution is too long, see the code repository. Also, only data-structure representation is implemented.

Exercise 3.29 [β˜…β˜…] Unfortunately, programs that use dynamic binding may be exceptionally difficult to understand. For example, under lexical binding, consistently renaming the bound variables of a procedure can never change the behavior of a program: we can even remove all variables and replace them by their lexical addresses, as in section 3.6. But under dynamic binding, this transformation is unsafe.

For example, under dynamic binding, the procedure proc (z) a returns the value of the variable a in its caller’s environment. Thus, the program

let a = 3
in let p = proc (z) a
   in let f = proc (x) (p 0)
      in let a = 5
         in (f 2)

returns 5, since a’s value at the call site is 5. What if f’s formal parameter were a?

The result should be 2.

Exercise 3.30 [β˜…] What is the purpose of the call to proc-val on the next-to-last line of apply-env?

When we are creating the desired recursive closure, we need an environment containing the closure, but we can not create the environment directly because we need the closure in order to create the environment. So we delay the creation of the closure in the environment so that we can create the environment without a closure. Then, when we need to use the closure, we create it by calling proc-val.

Exercise 3.31 [β˜…] Extend the language above to allow the declaration of a recursive procedure of possibly many arguments, as in exercise 3.21.

Solution is too long, see the code repository.

Exercise 3.32 [β˜…β˜…] Extend the language above to allow the declaration of any number of mututally recursive unary procedures, for example:

letrec
  even(x) = if zero?(x) then 1 else (odd -(x,1))
  odd(x) = if zero?(x) then 0 else (even -(x,1))
in (odd 13)

Solution is too long, see the code repository.

Exercise 3.33 [β˜…β˜…] Extend the language above to allow the declaration of any number of mutually recursive procedures, each of possibly many arguments, as in exercise 3.21.

Solution is too long, see the code repository.

Exercise 3.34 [β˜…β˜…β˜…] Implement extend-env-rec in the procedural representation of environments from section 2.2.3.

Skipped for now.

Exercise 3.35 [β˜…] The representationswe have seen so far are inefficient, because they build a new closure every time the procedure is retrieved. But the closure is the same every time. We can build the closures only once, by putting the value in a vector of length 1 and building an explicit circular structure, like

TODO: Add this figure later.

Here’s the code to build this data structure.

(define extend-env-rec
  (lambda (p-name b-var body saved-env)
    (let ((vec (make-vector 1)))
      (let ((new-env (extend-env p-name vec saved-env)))
        (vector-set! vec 0
          (proc-val (procedure b-var body new-env)))
        new-env))))

Complete the implementation of this representation by modifying the definitions of the environment data type and apply-env accordingly. Be sure that apply-env always returns an expressed value.

Solution is too long, see the code repository.

Exercise 3.36 [β˜…β˜…] Extend this implementation to handle the language from exercise 3.32.

Solution is too long, see the code repository.

Exercise 3.37 [β˜…] With dynamic binding (exercise 3.28), recursive procedures may be bound by let; no special mechanism is necessary for recursion. This is of historical interest; in the early years of programming language design other approaches to recursion, such as those discussed in section 3.4, were not widely understood. To demonstrate recursion via dynamic binding, test the program

let fact = proc (n) add1(n)
in let fact = proc (n)
               if zero?(n)
               then 1
               else *(n,(fact -(n,1)))
   in (fact 5)

using both lexical and dynamic binding. Write the mutually recursive procedures even and odd as in section 3.4 in the defined language with dynamic binding.

Skipped for now.

Exercise 3.38 [β˜…] Extend the lexical address translator and interpreter to handle cond from exercise 3.12.

Solution is too long, see the code repository.

Exercise 3.39 [β˜…] Extend the lexical address translator and interpreter to handle pack and unpack from exercise 3.18.

Solution is too long, see the code repository.

Exercise 3.40 [β˜…β˜…] Extend the lexical address translator and interpreter to handle letrec. Do this by modifying the context argument to translation-of so that it keeps track of not only the name of each bound variable, but also whether it was bound by letrec or not. For a reference to a variable that was bound by a letrec, generate a new kind of reference, called a nameless-letrec-var-exp. You can then continue to use the nameless environment representation above, and the interpreter can do the right thing with a nameless-letrec-var-exp.

Solution is too long, see the code repository.

Exercise 3.41 [β˜…β˜…] Modify the lexical address translator and interpreter to handle let expressions, procedures, and procedure calls with multiple arguments, as in exercise 3.21. Do this using a nameless version of the ribcage representation of environments (exercise 2.11). For this representation, the lexical address will consist of two nonnegative integers: the lexical depth, to indicate the number of contours crossed, as before; and a position, to indicate the position of the variable in the declaration.

Solution is too long, see the code repository.