第四章习题 4.1 - 4.15 的解答。从本章开始使用 mit-scheme 9.1.1。

E-4.1: 题目的意思是，函数 list-of-values 对参数列表的求值顺序依赖于解析器的实现。如果解析器对参数列表的求值顺序是从右往左的，那么 list-of-values 的求值顺序也是从右往左的，也就是说，对于 list-of-values 中的“(cons ...)”，会先算“(list-of-values (rest-operands ...))”这部分，后算“(eval (first-operand ...))”，也就是从右往左了；如果解析器的求值顺序是从左往右，那么 list-of-values 的求值顺序也是从左往右。

(define (list-of-values-lr exps env) ; evaluates from left to right
  (if (no-operands? exps)
    '()
    (let ((first-value (eval (first-operand exps) env)))
      (cons first-value
            (list-of-values (rest-operands exps) env)))))

(define (list-of-values-rl exps env) ; evaluates from right to left
  (if (no-operands? exps)
    '()
    (let ((rest-exp (rest-operands exps)))
      (cons (eval (first-operand exps) env)
            (list-of-values rest-exp env)))))

E-4.2: (a) 如果先判断是否 application?，那么“(define x 3)”会被当成是函数来执行，结果会出错。 (b) 把 application? 的定义修改为

(define (application? expression) (tagged-list? expression 'call))

其它几个和 application? 相关的函数也要修改。

E-4.3:

(define (my-eval expression env)
  (cond
    ((self-evaluating? expression)
     expression)
    (else
      ((get 'my-eval (operator expression)) (operands expression) env))))

E-4.4:

(define (and? expression)
  (tagged-list? expression 'and))

(define (eval-and expression env)
  (define (and-true? arglist)
    (if (no-operands? arglist)
      #t
      (and (my-eval (first-operand arglist) env)
           (and-true? (rest-operands arglist)))))

  (and-true? (cdr expression)))

(define (or? expression)
  (tagged-list? expression 'or))

(define (eval-or expression env)
  (define (or-true? arglist)
    (if (no-operands? arglist)
      #f
      (or (first-operand arglist)
          (eval-or (rest-operands arglist) env))))

  (or-true? (cdr expression)))

E-4.5: 先判断是否扩展形式，如果是的话就直接解析，否则转成 if 的形式。

(define (cond=>? expression)
  (let ((first (car expression))
        (rest (cdr expression)))
    (if (null? rest)
      #f
      (if (pair? rest)
        (if (eq? (car rest) '=>)
          #t
          #f)
        #f))))

(define (eval-cond=> expression env)
  (let ((result (my-eval (car expression) env))
        (recipient (cddr expression)))
    (if result
      (my-eval (recipient result) env))))

(define (eval-cond expression env)
  (if (cond=>? expression)
    (eval-cond=> expression env)
    (my-eval (cond->if expression))))

E-4.6:

(load "4.1-the.metacircular.evaluator.scm")

(define (let->combination expression)
  (let ((let-list (cadr expression))
        (let-body (cddr expression)))
    (let ((var-list (map car let-list))
          (exp-list (map cadr let-list)))
      (cons (make-lambda var-list let-body)
            exp-list))))

; ------------------------------------------------------------

(define str '(let ((a 1) (b 2) (c 3))
               (+ a b)))

(let->combination str)
</pre>

E-4.7: 题目中的定义转化为下面的形式：

<pre lang='scheme' line='1'>
(let ((x 3)) 
  (let ((y (+ x 2)))
    (let ((z (+ x y 5)))
      (* x z))))

转换程序为：

(define (let*->nested-lets expression)

  (let ((let*-list (cadr expression))
        (let*-body (cddr expression)))

    (define (make-nested-lets var-list)
      (if (null? (cdr var-list))
        (append (list 'let)
                (list (list (car var-list)))
                let*-body)
        (list 'let
              (list (car var-list))
              (make-nested-lets (cdr var-list)))))

    (make-nested-lets let*-list)))

; -----------------------------------------------------------

(define str '(let* ((x 3)
                    (y (+ x 2))
                    (z (+ x y 5)))
               (* x z)
               (+ y z)))

(let*->nested-lets str)

转换后的结果可以使用E-4.6的程序验证。

E-4.8: 将题目中的定义变为以下形式（参考资料 [1]）：

(define (fib n)
 (let ((fib-iter
        (lambda (a b count)
         (if (= count 0)
          b
          (fib-iter (+ a b) a (- c 1))))))
  (fib-iter 1 0 n)))

因此转换函数为：

(load "4.1-the.metacircular.evaluator.scm")

(define (named-let? expression)
  (and (pair? expression)
       (not (pair? (cadr expression)))))

(define (named-let->combination expression)
  (let* ((var-name (cadr expression))
         (let-list (caddr expression))
         (arg-list (map car let-list))
         (arg-init (map cadr let-list))
         (let-body (cdddr expression)))
    (list 'let
          (list (list var-name
                      (make-lambda arg-list let-body)))
          (cons var-name arg-init))))

; ------------------------------------------------------------

(define str '(let fib-iter ((a 1)
                            (b 0)
                            (count n))
               (if (= count 0)
                 b
                 (fib-iter (+ a b) a (- count 1)))))

(named-let->combination str)

E-4.9: 跳过。

E-4.10: 随便选择一个语句（例如 assignment），修改其相关的函数定义即可。

E-4.11: 只实现了开头几个函数，后面几个接口改动都比较少，就不写了。

(define (make-frame variables values)
  (if (null? variables)
    '()
    (if (null? values)
      (append (list (list (car variables) #f))
              (make-frame (cdr variables) values))
      (append (list (list (car variables) (car values)))
              (make-frame (cdr variables) (cdr values))))))

(define (frame-variables frame)
  (map car frame))

(define (frame-values frame)
  (map cadr frame))

(define (add-binding-to-frame! var val frame)
  (let ((new-rest (map (lambda (x) x) frame)))
    (set-car! frame (list var val))
    (set-cdr! frame new-rest)))

; --------------------------------------------------------------

(make-frame (list 'a 'b 'c 'd) (list 1 2 3 4 5))
(make-frame (list 'a 'b 'c 'd) (list 1 2))

(define testframe (make-frame (list 'a 'b 'c 'd) (list 1 2 3 4 5)))

(frame-variables testframe)
(frame-values testframe)
(add-binding-to-frame! 'e 5 testframe)
(add-binding-to-frame! 'f 8 testframe)

E-4.12:

(load "4.1-the.metacircular.evaluator.scm")

(define (scan var frame eq-procedure)
  (define (recur vars vals)
    (cond ((null? vars) #f)
          ((eq? var (car vars))
           (eq-procedure vars vals))
          (else (recur (cdr vars) (cdr vals)))))

  (recur (frame-variables frame) (frame-values frame)))

(define (env-loop var env eq-procedure)
  (if (eq? env the-empty-environment)
    #f
    (let ((result (scan var (first-frame env) eq-procedure)))
      (if (eq? result #f)
        (env-loop var (enclosing-environment env) eq-procedure)
        result))))

(define (lookup-variable-value2 var env)
  (env-loop var env (lambda (vars vals) (car vals))))

(define (set-variable-value! var val env)
  (env-loop var env (lambda (vars vals) (set-car! vals val))))

(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (if (eq? (scan var frame (lambda (vars vals) (set-car! vals val))) #f)
      (add-binding-to-frame! var val frame))))

; -------------------------------------------------------------------------

(define testenv (list (make-frame '(d e f) '(10 20 30)) (make-frame '(a b c d) '(1 2 3 4))))

(lookup-variable-value2 'f testenv)
testenv
(set-variable-value! 'f 101 testenv)
testenv
(define-variable! 'x '100 testenv)
testenv

因为不知道如何将单个元素的“引用”传递给函数，只好将找到 var 之后的 vars 和 vals 都传给两个函数。

E-4.13: 这里的实现还有问题，当去掉最后的变量时会留下一个空的列表。

(load "4.12.scm")
(load "utils.scm")

(define (make-unbound! var env)
  (env-loop var env
            (lambda (vars vals)
              (remove-first! vars)
              (remove-first! vals)
              #t)))

; -------------------------------------------

testenv
(make-unbound! 'f testenv)
testenv

其中使用到的 remove-first! 函数定义在 utils.scm 中：

(define (remove-first! array)
  (if (not (null? array)) ; '(x)
    (if (not (null? (cdr array))) ; '(x y z)
      (begin (set-car! array (cadr array)) ; '(y y z)
             (if (null? (cddr array)) ; (y y)
               (set-cdr! array '()) ; '(y)
               (remove-first! (cdr array))))
      (set-car! array '()))))

(define (remove-first!))
(define (remove! element array)
  (define (recur rest)
    (if (null? rest)
      '()
      (if (eq? element (car rest))
        (remove-first! rest)
        (recur (cdr rest)))))

  (recur array))

E-4.14: 如果使用系统的 map，传给 map 的函数参数使用的是解析器定义的 procedure 格式（以“procedure”开始的list），因此 map 会报错。

E-4.15: 执行“(try try)”，如果 try 可以停的话（也就是说“(halts? try try)”为真），就会执行“(run-forever)”，结果是不会停的；如果“(halts? try try)”为假，最后“(try try)”却停了（输出了“halted”）。这样就产生悖论了。

参考资料

[1] 练习 4.8