计算机程序的构造和解释(SICP) 第4章 习题解析 Part1

这次回顾第四章第一部分习题。

学习资料：

https://ocw.mit.edu/courses/electrical-engineering-and-computer-science/6-001-structure-and-interpretation-of-computer-programs-spring-2005/index.htm

https://github.com/DeathKing/Learning-SICP

https://mitpress.mit.edu/sites/default/files/sicp/index.html

https://www.bilibili.com/video/BV1Xx41117tr?from=search&seid=14983483066585274454

参考资料：

https://sicp.readthedocs.io/en/latest

http://community.schemewiki.org/?SICP-Solutions

http://community.schemewiki.org/?sicp

4.1(p255)

从左到右求值只要先对当前元素求值即可，从右到左求值则先对剩余元素求值，代码如下：

(load "ch4.scm")

(define (list-of-values exps env)
    (if (no-operands? exps)
        '()
        (cons (eval (first-operand exps) env)
              (list-of-values (rest-operands exps) env))))

(define (list-of-values-left exps env)
    (if (no-operands? exps)
        '()
        (let ((t (eval (first-operand exps) env)))
             (cons t
                (list-of-values (rest-operands exps) env)))))

(define (list-of-values-right exps env)
    (if (no-operands? exps)
        '()
        (let ((t (list-of-values (rest-operands exps) env)))
             (cons (eval (first-operand exps) env)
                    t))))

4.2(p259)

参考资料：

https://sicp.readthedocs.io/en/latest/chp4/2.html

http://community.schemewiki.org/?sicp-ex-4.2

(a)

无论是赋值还是过程应用，都会被当成过程应用。

(b)

语法修改如下：

(load "ch4.scm")

(define (application? exp) (tagged-list? exp 'call))
(define (operator exp) (cadr exp))
(define (operands exp) (cddr exp))

4.3(p259)

参考资料：

https://sicp.readthedocs.io/en/latest/chp4/3.html

http://community.schemewiki.org/?sicp-ex-4.3

使用统一的格式，代码如下：

(define (install-eval-package)
    (put 'eval 'self (lambda (exp env) exp))
    (put 'eval 'variable lookup-variable-value)
    (put 'eval 'quoted? (lambda (exp env) (text-of-quotation exp)))
    (put 'eval 'assignment eval-assignment)
    (put 'eval 'definition eval-definition)
    (put 'eval 'if eval-if)
    (put 'eval 'lambda (lambda (exp env) 
                            (make-procedure 
                                (lambda-parameters exp)
                                (lambda-body exp)
                                env)))
    (put 'eval 'begin (lambda (exp env) (eval-sequence (begin-actions exp) env)))
    (put 'eval 'cond (lambda (exp env) (eval (cond->if exp) env)))
    (put 'eval 'application (lambda (exp env) 
                                (apply (eval (operator exp) env)
                                (list-of-values (operands exp) env))))
    'done)

(define (operator exp) (car exp))

(define (operands exp) (cdr exp))

(define (eval exp env)
    ((get 'eval (operator exp)) (operands exp) env))

4.4(p259)

参考资料：

http://community.schemewiki.org/?sicp-ex-4.4

https://sicp.readthedocs.io/en/latest/chp4/4.html

对于派生表达式的转换，利用如下事实即可：

and表达式

(and a b c) 

等价于

if a
	if b
		if c
			#t
		#f
	#f
#f

or表达式

(or a b c) 

等价于

if a
	#t
	else if b
		    #t
		    else if c
			        #t
		            else #f

完整代码如下：

(load "ch4.scm")

(define (eval-and exp env)
    (cond ((last-exp? exps) (eval (first-exp exps) env))
          ((false? (eval (first-exp exps) env)) false)
          (else (eval-and (rest-exps exps) env))))

(define (eval-or exp env)
    (cond ((last-exp? exps) (eval (first-exp exps) env))
          ((true? (eval (first-exp exps) env)) true)
          (else (eval-or (rest-exps exps) env))))

; and
(define (and-predicate clause) (car clause))
(define (and-clauses exp) (cdr exp))

(define (and->if exp)
  (expand-and-clauses (and-clauses exp)))

(define (expand-and-clauses clauses)
    (if (null? clauses)
        'false                          
        (let ((first (car clauses))
              (rest (cdr clauses)))
            (if (last-exp? exps) 
                (eval (first-exp exps) env)
                (make-if first
                        (expand-and-clauses rest)
                        #f)))))

; or
(define (or-predicate clause) (car clause))
(define (or-clauses exp) (cdr exp))

(define (or->if exp)
  (expand-or-clauses (or-clauses exp)))

(define (expand-or-clauses clauses)
    (if (null? clauses)
        'false                          
        (let ((first (car clauses))
              (rest (cdr clauses)))
            (if (last-exp? exps) 
                (eval (first-exp exps) env)
                (make-if first
                        #t
                        (expand-or-clauses rest))))))

4.5(p259)

(load "ch4.scm")

(define (cond-=>-clause? clause)
  (eq? (cadr clause) '=>))

(define (cond-=>-actions clause) (cddr clause))

(define (expand-clauses clauses env)
  (if (null? clauses)
      'false                          
      (let ((first (car clauses))
            (rest (cdr clauses)))
        (cond ((cond-else-clause? first) 
                (if (null? rest)
                    (sequence->exp (cond-actions first))
                    (error "ELSE clause isn't last -- COND->IF"
                        clauses)))
              ; add this
              ((cond-=>-clause? first)
                ; this step need env
                (let ((res (eval (cond-predicate first) env)))
                     (if (true? res)
                         (apply (cond-=>-actions first) res))))
              (else (make-if (cond-predicate first)
                     (sequence->exp (cond-actions first))
                     (expand-clauses rest)))))))

4.6(p259)

代码如下：

(load "ch4-mceval.scm")

(define (let? exp) (tagged-list? exp 'let))

(define (let-var-exp exp) (cadr exp))

(define (let-body exp) (cddr exp))

(define (get-var varexp)
    (if (null? varexp)
        '()
        (cons (caar varexp) (get-var (cdr varexp)))))

(define (get-exp varexp)
    (if (null? varexp)
        '()
        (cons (cadar varexp) (get-exp (cdr varexp)))))

(define (let->combination exp)
    (let ((varlist (get-var (let-var-exp exp)))
          (explist (get-exp (let-var-exp exp)))
          (body (let-body exp)))
         (cons (make-lambda varlist body) explist)))

(define (eval exp env)
    ; add
    (cond ((let? exp) (eval (let->combination exp) env))
            (else
            (error "Unknown expression type -- EVAL" exp))))

; test
(let->combination '(let ((x 1) (y 2)) (+ x y)))

((lambda (x y) (+ x y)) 1 2)

运行结果如下：

1 ]=> ; test
(let->combination '(let ((x 1) (y 2)) (+ x y)))
;Value 13: ((lambda (x y) (+ x y)) 1 2)

1 ]=> ((lambda (x y) (+ x y)) 1 2)
;Value: 3

4.7(p260)

注意到let*

(let* ((v1 e1)
       (v2 e2)
       ...
       (vn en))
  body)

等价于

(let ((v1 e1))
  	  (let ((v2 e2))
          ...
       	(let ((vn en))
             	  body))...) 

代码如下

(load "ch4-mceval.scm")

(define (make-let var body)
    (list 'let var body))

(define (let*-var-exp exp) (cadr exp))

(define (let*-body exp) (caddr exp))

(define (let*->nested-lets exp)
    (define (make-let* var-exp body)
        (if (equal? (cdr var-exp) '())
             (make-let (list (car var-exp)) body)
             (make-let (list (car var-exp)) (make-let* (cdr var-exp) body))))
    (let ((var-exp (let*-var-exp exp))
          (body (let*-body exp)))
         (make-let* var-exp body)))

; test
(let*->nested-lets 
    '(let* ((x 3)
            (y (+ x 2))
            (z (+ x y 5)))
           (* x z)))

; test whether let*->nested-lets is enough
(let ((x 1))
     (let ((y 2))
          (+ x y)))

(let*->nested-lets 
    '(let* ((x 1))
        (let* ((y 2))
          (+ x y))))

结果如下

1 ]=> ; test
(let*->nested-lets 
    '(let* ((x 3)
            (y (+ x 2))
            (z (+ x y 5)))
           (* x z)))
;Value 13: (let ((x 3)) (let ((y (+ x 2))) (let ((z (+ x y 5))) (* x z))))

1 ]=> (let*->nested-lets 
    '(let* ((x 1))
        (let* ((y 2))
          (+ x y))))
;Value 14: (let ((x 1)) (let* ((y 2)) (+ x y)))

该方法有些问题，因为$\mathrm{let^\star\rightarrow combination}$无法将嵌套$\mathrm{let^\star}$转换为纯$\mathrm{let}$表达式。

4.8(p260)

参考资料：

http://community.schemewiki.org/?sicp-ex-4.8

变换逻辑如下：

(let <var><bindings><body>)
<bindings> = ((var1 exp1) ... (varn expn))

(define (var var1 .... varn)
	body)
(var exp1 exp2 ... expn)

代码如下：

(load "ch4-mceval.scm")
(load "let.scm")

(define (let-bindings? exp)
    (not (equal? (cdddr exp) '())))

(define (let-bindings-name exp) (cadr exp))

(define (let-bindings-var-exp exp) (caddr exp))

(define (let-bindings-body exp) (cadddr exp))

(define (let-bindings-function name var body)
    (list 'define (cons name var) body))

(define (let-bindings->combination exp)
    (let ((name let-bindings-name)
          (varlist (get-var (let-bindings-var-exp exp)))
          (explist (get-exp (let-bindings-var-exp exp)))
          (body (let-bindings-body exp)))
         (sequence->exp 
            (list (let-bindings-function name varlist body)
                (cons name explist)))))

(define (let-no-bindings->combination exp)
    (let ((varlist (get-var (let-var-exp exp)))
          (explist (get-exp (let-var-exp exp)))
          (body (let-body exp)))
         (cons (make-lambda varlist body) explist)))

(define (let->combination exp)
    (if (let-bindings? exp)
        (let-bindings->combination exp)
        (let-no-bindings->combination exp)))

; test
(let->combination '(let ((x 1) (y 2)) (+ x y)))

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

结果如下：

1 ]=> (let->combination 
    '(let fib-iter 
        ((a 1)
         (b 0)
         (count n))
        (if (= count 0)
            b
            (fib-iter (+ a b) a (- count 1)))))
;Value 14: (begin (define (#[compound-procedure 15 let-bindings-name] a b count) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))) (#[compound-procedure 15 let-bindings-name] 1 0 n))

4.9(p260)

参考资料：

http://community.schemewiki.org/?sicp-ex-4.9

这题难度比较大，主要参考了别人的解答。

这里选择了while进行实现，基本实现如下：

(define (while predicate body)
    ((lambda ()
        (define (while-proc)
            (if (predicate)
                (sequence->exp 
                    (list body while-proc))))
        (while-proc))
     ()))

其中在最外层定义lambda函数，是为了在内部执行每轮循环中的body部分：

(sequence->exp (list body while-proc))

代码如下：

(load "ch4-mceval.scm")
(load "ch4.scm")

(define (while? exp) (tagged-list? exp 'while))

(define (while-pred exp)
    (cadr exp))

(define (while-body exp)
    (cddr exp))

(define (make-proc name par body)
    (cons 'define (list (cons name par) body)))

(define (call-proc proc par)
    (cons proc par))

(define (while->combination exp)
    (define (while-proc name)
        (make-proc 
            name 
            '()
            (make-if
                (while-pred exp)
                (sequence->exp 
                    (list 
                        (while-body exp) 
                        (call-proc name '())))
                '())))
    (call-proc 
        (make-lambda 
            '() 
            (list 
                (while-proc 'while-proc)
                (call-proc 'while-proc '())))
        '()))

; test
(while->combination 
    '(while (< i 10) (display i) (let i (+ i 1))))

结果如下：

(while->combination 
    '(while (< i 10) (display i) (let i (+ i 1))))
;Value 13: ((lambda () (define (while-proc) (if (< i 10) (begin ((display i) (let i (+ i 1))) (while-proc)) ())) (while-proc)))

4.10(p260)

例如使用后缀表示，修改对应lookup-variable-value等函数即可，无需修改eval, apply。