第四章

写在前面：本章代码并没有实际运行检查过（前三章基本没问题），并不保证 bug-free。

  1. 建立新语言是在工程设计中控制复杂性的一种威力强大的工作策略，我们常常能通过 采用一种新语言而提升处理复杂问题的能力，因为新语言可能使我们以一种完全不同 的方式，利用不同的原语，不同的组合方式和抽象方式去描述（因此也是思考）所面 对的问题，而这些都是为了手头需要处理的问题而专门打造的；
  2. 元语言抽象就是建立新的语言；
  3. 把这一点看作是程序设计中最基本的思想一点也不过分: 求值器决定了一个程序设计 语言中各种表达式的意义而它本身也不过就是另一个程序;
  4. 处理大规模计算系统的技术，与构造新的程序设计语言的技术有着紧密的联系，而计 算机科学本身不过（也不更少）就是有关如何构造适当的描述语言的学科；

元循环求值器

  1. 用与被求值的语言同样的语言写出的求值器被称为 元循环;
  2. 从根本上说，元循环求值器也就是 3.2 节所描述求值的环境模形的一个 scheme 表 达形式，该模形包括两个部分：
    1. 在求值一个组合式（一个不是特殊形式的复合表达式）时，首先求值其中的子表 达式，而后将运算符子表达式的值作用于运算对象子表达式的值；
    2. 在将一个复合过程应用于一集实际参数时，我们在一个新的环境里求值这个过程 的体，构造这一环境的方式就是用一个框架扩充该过程对象的环境部分，框架中 包含的是这个过程的各个形式参数与这一过程应用的各个实际参数的约束；
  3. 上述两条规则描述了求值过程的核心部分，也就是它的基本循环，在这一循环中，表 达式在环境中的求值被归约到过程对实际参数的应用，而这种应用又被规约到新的表 达式在新的环境中的求值，如此下去，直至我们下降到符号（其值可以在环境中找到） 或者基本过程（它们可以直接应用）；

求值器的内核

  1. 求值过程可以描述为两个过程 eval 和 apply 之间的相互作用；
  2. eval 的参数是一个表达式和一个环境，eval 对表达式进行分类，依次引导自己的 求值工作，eval 的构造就像是一个针对被求值表达式的语法类型的分情况分析；
  3. apply 有两个参数，一个是过程，一个是该过程应该去应用的实际参数的表；
  4. 看懂代码就能理解。

练习 4.1

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17

;; the one always computes the value from left to right

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

;; the one always computes the value from right to left

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

表达式的表示

  1. 注意派生表达式的逻辑；

练习 4.2-4.10

  • 4.2

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14

    ;; a

;; 检查过程语法形式的谓词过程
(define (application? exp) (pair? exp))
;; 而很多不是过程调用的表达式其实都是序对，但不能用过程调用的形式处理

;; b

(define (application? exp) (tagged-list? exp 'call))
(define (operator exp) (cadr exp))
(define (operands exp) (cddr exp))
(define (no-operands? ops) (null? ops))
(define (first-operand ops) (car ops))
(define (rest-operands ops) (cdr ops))

  • 4.3

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

    (define (type-tag datum)
  (if (pair? datum)
      (car datum)
      (error "Bad tagged datum -- TYPE-TAG" datum)))

(define (eval exp env)
  (let ((tag (type-tag exp)))
    (let ((proc (get 'eval tag)))
      (if proc
      (proc exp env)
      (error "Unknown expression type -- EVAL"
         exp)))))

;; number: scheme-number
;; string: scheme-string
(define (eval-self-evaluation exp env)
  (cadr exp))

(put 'eval 'scheme-number eval-self-evaluation)
(put 'eval 'scheme-string eval-self-evaluation)

;; variable: 'quote
(define (eval-variable exp env)
  (text-of-quotation exp))

(put 'eval 'quote eval-variable)

;; assignment: set!

;; the original eval-assignment
(put 'eval 'set! eval-assignment)

;; definition: define

;; the original eval-definition
(put 'eval 'define eval-definition)

;; lambda: lambda

;; should modify the original make-procedure
(define (make-procedure-lambda exp env)
  (let ((parameters (lambda-parameters exp))
    (body (lambda-body exp)))
    (make-procedure parameters body env)))

(put 'eval 'lambda make-procedure-lambda)

;; if: if

;; the original eval-if
(put 'eval 'if eval-if)

;; begin: begin

;; should modify the original eval-sequence
(define (eval-sequence-begin exp env)
  (let ((actions (begin-actons exp)))
    (eval-sequence actions env)))

(put 'eval 'begin eval-sequence-begin)

;; cond: cond
;; should modify the original handle method
(define (eval-cond exp env)
  (let ((transfer (cond->if exp)))
    (eval transfer env)))

(put 'eval 'cond eval-cond)

;; application: call
;; based on the procedures defined in exercise 4.2 b
(define (eval-application exp env)
  (apply (eval (operator exp) env)
     (list-of-values (operands exp) env)))

(put 'eval 'call eval-application)

  • 4.4

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

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

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

(define (all-predicates exp)
  (cdr exp))

(define (first-predicate predicates)
  (car predicates))

(define (rest-predicates predicates)
  (cdr predicates))

(define (eval-and exp env)
  (let ((predicates (all-predicates exp)))
    (let ((first (first-predicate predicates))
      (rest (rest-predicates predicates)))
      (let ((result (eval first env)))
    (cond ((not result) false)
          ((and (null? rest) result) result)
          (result (eval-and rest env)))))))

(define (eval-or exp env)
  (let ((predicates (all-predicates exp)))
    (let ((first (first-predicate predicates))
      (rest (rest-predicates predicates)))
      (let ((result (eval first env)))
    (cond (result true)
          (and (null? rest) (not result) false)
          ((not result) eval-or rest env))))))

;; derived expression based on if

(define (make-and predicates)
  (list 'and predicates))

(define (make-or predicates)
  (list 'or predicates))

(define (and->if exp)
  (let ((predicates (all-predicates exp)))
    (let ((first (first-predicate predicates))
      (rest (rest-predicates predicates)))
      (make-if
       first
       (make-and rest)
       first))))

(define (or->cond exp)
  (let ((predicates (all-predicates exp)))
    (let ((first (first-predicate predicates))
      (rest (rest-predicates predicates)))
      (make-if
       first
       first
       (make-or rest)))))

(define (eval-and exp env)
  (eval (and->if exp) env))

(define (eval-or exp env)
  (eval (or->if exp) env))

;; so just implement the eval-and and eval-or in
;; the original eval procedure

  • 4.5

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

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

(define (cond-clauses exp) (cdr exp))

(define (cond-else-clause? clause)
  (eq? (cond-predicate clause) 'else))

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

(define (cond-special-clause-proc clause)
  (caddr clause))

(define (cond-predicate clause) (car clause))

(define (cond-actions clause)
  (cdr clause))

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

(define (expand-clauses clauses)
  (if (null? clauses)
      'false
      (let ((first (car clauses))
        (rest (cdr clauses)))
    (if (cond-else-clause? first)
        (if (null? rest)
        (sequence->exp (cond-actions first))
        (error "ELSE clause isn't last -- COND->IF"
               clauses))
        (let ((p (cond-predicate first)))
          (make-if
           p
           (if (cond-special-clause? first)
           (list (cond-special-clause-proc first) p)
           (sequence->exp (cond-actions first)))
           (expand-clauses rest)))))))

  • 4.6

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

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

(define (let-exps exp)
  (cdr exp))

(define (let-bindings exp)
  (car exp))

(define (let-body exp)
  (cdr exp))

(define (var binding)
  (car binding))

(define (expression binding)
  (cadr binding))

(define (let->application exp)
  (transfer (let-exps exp)))

(define (transfer exp)
  (let ((bindings (let-bindings exp))
    (body (let-body exp)))
    (let ((var-list (map var bindings))
      (exp-list (map expression bindings)))
      (let ((proc (make-lambda var-list body)))
    (list proc exp-list)))))

(define (eval-let exp env)
  (eval (let->application exp) env))

;; implement let? and eval-let in eval

  • 4.7

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

    ;; all bacause of the environment bindings' update & access

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

(define (let*-exps exp)
  (cdr exp))

(define (let*-bindings exp)
  (car exp))

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

(define (make-let binding body)
  (cons 'let (list binding) body))

(define (make-neseted-lets bindings body)
  (if (null? (cdr bindings))
      (make-let (car bindings) body)
      (make-let (car bindings)
        (make-neseted-lets
         (cdr bindings)
         body))))

(define (let*->nested-lets exp)
  (make-neseted-lets
   (let*-bindings (let*-exps exp))
   (let*-body (let*-exps exp))))

(define (eval-let* exp env)
  (eval (let*->nested-lets exp) env))
;; nested-let makes no difference when compared with let*
;; thanks to the environment structure

;; just implement let*? and eval-let* in eval

  • 4.8

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68

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

(define (let-exps exp)
  (cdr exp))

(define (let-procedure? exp)
  (symbol? (car exp)))

(define (let-procedure-var exp)
  (car exp))

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

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

(define (make-begin seq)
  (cons 'begin seq))

(define (make-define-p v p b)
  (cons 'define (cons v p) b))

(define (let-bindings exp)
  (car exp))

(define (let-body exp)
  (cdr exp))

(define (var binding)
  (car binding))

(define (expression binding)
  (cadr binding))

(define (let->application exp)
  (transfer (let-exps exp)))

(define (transfer exp)
  (let ((let-p? (let-procedure? exp)))
    (let ((bindings
       (if let-p?
           (let-procedure-bindings exp)
           (let-bindings exp)))
      (body
       (if let-p?
           (let-procedure-body exp)
           (let-body exp))))
      (let ((var-list
         (map var bindings))
        (exp-list
         (map expression bindings)))
    (if let-p?
        (make-begin
         (list (make-define-p
           (let-procedure-var exp)
           var-list
           body)
          (cons (let-procedure-var exp)
            exp-list)))
        (cons (make-lambda var-list body)
          exp-list))))))

(define (eval-let exp env)
  (eval (let->application exp) env))

;; implement let? and eval-let in eval

  • 4.9

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

    ;; first eval self-defined special procedure through eval procedure

;; show the structure of while by making a definition
(define (while exp proc)
  (if exp
      (begin proc
         (while exp proc))
      'finished))
;; so while is composed of if and begin

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

(define (while-predicate exp)
  (cadr exp))

(define (while-actions exp)
  (make-begin
   (list (caddr exp)
     exp)))

(define while-alternative
  'finished)

(define (while-transfer exp)
  (make-if
   (while-predicate exp)
   (while-actions exp)
   while-alternative))

(define (eval-while exp env)
  (eval (while-transfer exp) env))

;; just implement while? and eval-while in eval

  • 4.10

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14

    ;; 复合表达式中运算符表达式在最后一个，前面所有的都是运算对象表达式
(define (last-one lst)
  (if (null? (cdr lst))
      (car lst)
      (last-one (cdr lst))))

(define (operator exp)
  (last-one exp))

(define (operands exp)
  (if (null? (cdr exp))
      '()
      (cons (car exp)
        (operands (cdr exp)))))

求值器数据结构

  1. 理解代码就没问题；

练习 4.11-4.13

  • 4.11

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

    (define (make-frame bindings)
  bindings)

(define (make-binding var val)
  (cons var val))

(define (make-bindings vars vals)
  (map make-binding vars vals))

(define (bindings-frame frame)
  frame)

(define (set-value! binding value)
  (set-cdr! binding value))

(define (first-binding bindings)
  (car bindings))

(define (rest-bindings bindings)
  (cdr bindings))

(define (null-bindings? bindings)
  (null? bindings))

(define (binding-variable binding)
  (car binding))

(define (binding-value binding)
  (cdr binding))

(define (add-binding-to-frame! var val frame)
  (let ((new-binding (make-binding val frame)))
    (cons new-binding frame)))

(define (extend-environment vars vals base-env)
  (if (= (length vars) (length vals))
      (let ((bindings (make-bindings vars vals)))
    (cons (make-frame bindings) base-env))
      (if (< (length vars) (length vals))
      (error "Too many arguments supplied" vars vals)
      (error "Too few arguments supplied" vars vals))))

(define (lookup-variable-value var env)
  (define (lookup var bindings)
    (if (null-bindings? bindings)
    false
    (let ((first (first-binding bindings)))
      (if (eq? var (binding-variable first))
          (binding-value first)
          (lookup var (rest-bindings bindings))))))
  (if (eq? env the-empty-environment)
      (error "Unbound variable" var)
      (let ((frame (first-frame env))
        (base-env (enclosing-environment env)))
    (let ((result (lookup var (bindings-frame frame))))
      (if result
          result
          (lookup-variable-value var base-env))))))

(define (set-variable-value! var val env) ;the former one has too many lets, try another style
  (define (env-loop env)
    (define (scan bindings)
      (cond ((null-bindings? bindings)
         (env-loop (enclosing-environment env)))
        ((eq? var (binding-variable (first-binding bindings)))
         (set-value! (first-binding bindings) val))
        (else (scan (rest-bindings bindings)))))
    (if (eq? env the-empty-environment)
    (error "Unbound variable -- SET!" var)
    (let ((frame (first-frame env)))
      (scan (bindings-frame frame)))))
  (env-loop env))

(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (define (scan bindings)
      (cond ((null-bindings? bindings)
         (add-binding-to-frame! var val frame))
        ((eq? var (binding-variable (first-binding bindings)))
         (set-value! (first-binding bindings) val))
        (else (scan (rest-bindings bindings)))))
    (scan (bindings-frame frame))))

  • 4.12

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

    (define (scan vars vals var)
  (cond ((null? vars) false)
    ((eq? (car vars) var)
     vals)
    (else (scan (cdr vars) (cdr vals) var))))

(define (env-loop env proc)
  (if (eq? env the-empty-environment)
      false
      (let ((frame (first-frame env)))
    (let ((result (scan (frame-variables frame)
                (frame-values frame)
                var)))
      (if result
          (proc result)
          (env-loop (enclosing-environment env)))))))

(define (lookup-variable-value var env)
  (let ((result (env-loop env car)))
    (if result
    result
    (error "Unbound variable" var))))

(define (set-variable-value! var val env)
  (define (set-value! vals)
    (set-car! vals val))
  (let ((result (env-loop env set-value!)))
    (if (not result)            ;though set-car! returns unspecific return value, (not result) is false
    (error "Unbound variable" var))))

(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (let ((result (scan (frame-variables frame)
            (frame-values frame)
            var)))
      (if result
      (set-car! result val)
      (add-binding-to-frame! var val frame)))))

  • 4.13

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

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

(define (unbound-var exp)
  (cadr exp))

(define (make-unbound! var)
  (list 'unbound var))

(define (eval-unbound exp env)
  (unbound-variable! (unbound-var exp) env))

(define (unbound-variable! var env)
  (let ((frame (first-frame env)))
    (define (scan vars vals)
      (cond ((null? vars)
         'ok)
        ((eq? var (car vars))
         (begin (set! vars (cdr vars))
            (set! vals (cdr vals))))
        (else (scan (cdr vars) (cdr vals)))))
    (scan (frame-variables frame)
      (frame-values frame))))

;; only delete the matched binding in the current environment
;; cause that the same-name binding in outside environments
;; may be utilized by other procedures
;; it is a disaster for these procedures if all unbounded

作为程序运行这个求值器

  1. 只要看明白代码；

练习 4.14

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16

;; eva's way is passed because the map definition is implemented in eval
;; so when this map procedure is applied, eval looks for its definition binding
;; then applies arguments and env to the map definition body

;; louis takes the map procedure as the original primitive procedure in eval
;; so when the map application is processed
;; since it is a primitive procedure
;; the apply internal result is like
;; (apply-primitive-procedure procedure arguments)
;; for example
;; '(map '* (1 2 3) (4 5 6))
;; but in the internal result
;; (apply-in-underlying-scheme map (list 'primitive *) (1 2 3) (4 5 6))
;; apply (list 'primitive *) to args in eval would fall into application branch
;; but at last 'primitive is a symbol with no binding
;; so it's failed

将数据作为程序

  1. 关于程序意义的一种操作式观点，就是将程序看作一种抽象的（可能无穷大的）机 器的一个描述，我们也可以把求值器看作是一部非常特殊的机器，它要求以一部机 器的描述作为输入，给定了一个输入以后，求值器就能够规划自己的行为，模拟被 描述机器的执行过程；
  2. 求值器的另一惊人方面，在于它就像是我们的程序设计语言所操作的数据对象和这 个程序设计语言本身之间的一座桥梁；

练习 4.15

1
2
3
4
5

;; 引起悖论
;; (try try) 如果可以终止，在 try 的过程体那将执行 (run-forever);
;; 如果不可以终止，将返回 'halted。

;; 所以不可能写出一个过程 halts?

内部定义

  1. 存在一些处理内部定义的方法，可以使内部名字的定义真正具有同样的作用域（不 然就会对代码形式有一些限制）；

练习 4.16-4.21

  • 4.16

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

    ;; a

(define (lookup-variable-value var env)
  (define (env-loop env)
    (define (scan vars vals)
      (cond ((null? vars)
         (env-loop (enclosing-environment env)))
        ((eq? var (car vars))
         (if (eq? (car vals) '*unassigned*)
         (error "Unassigned variable" var)
         (car vals)))
        (else (scan (cdr vars) (cdr vals)))))
    (if (eq? env the-empty-environment)
    (error "Unbound variable" var)
    (let ((frame (first-frame env)))
      (scan (frame-variables frame)
        (frame-values frame)))))
  (env-loop env))

;; b

(define (transfer-defines-let vars bodys)
  (let ((attached-unassigned (map (lambda (i) (list i '*unassigned*)) vars))
    (transfer-set!-body (map (lambda (i j) (list 'set! i j)) vars bodys)))
    (cons 'let attached-unassigned transfer-set!-body)))

(define (internal-defines body)
  (if (null? body)
      '()
      (if (definition? (car body))
      (cons (car body)
        (internal-defines (cdr body))))))

(define (internal-body body)
  (if (not (definition? (car body)))
      body
      (internal-body (cdr body))))

(define (scan-out-defines body)
  (let ((define-vars (map definition-variable (internal-defines body)))
    (define-bodys (map definition-value (internal-defines body)))
    (inside-body (internal body)))
    (if (null? define-vars)
    inside-body
    (append (transfer-defines-let define-vars define-bodys)
        (scan-out-defines inside-body)))))

;; c

;; prefer to implement it in the make-procedure
;; since most procedures defined would be utilized more than one time
;; so it's more efficient
;; when implement it in procedure-body
;; it would transfer the body every time when call it

  • 4.17

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15

    ;; when the first form is utilized
;; the current env is like that
;; (cons (cons (list 'u 'v) (list e1 e2)) base-env)


;; whe the second form is utilized
;; the current env is like that
;; (cons (cons (list 'u 'v) (list e1 e2)) (cons '() base-env))
;; cause that let is another form of lambda
;; the extend-environment is called twice

;; there is no difference of behaviours between both forms
;; for they're able to fetch the same desired key-value bindings

;; for now I could not figure out how to solve this

  • 4.18

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15

    ;; the way defined in this exercise won't work
;; the way defined in context will work

;; just transfer the way defined in this exercise to lambda form

(define (solve f y0 dt)
  ((lambda (y dy)
     ((lambda (a b)
    (set! y a)
    (set! dy b))
      (integral (delay dy) y0 dt)
      (stream f y))         ;this will fail due to the y is still '*unassigned here
     y)
   '*unassigned*
   '*unassigned*))

  • 4.19

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

    ;; ben

((lambda (a)
   (define (f x)
     (define b (+ a x))
     (define a 5)
     (+ a b))
   (f 10))
 1)

;; in this way the output is 16

;; alysssa

((lambda (a)
   (define (f x)
     (let ((b '*unassigned*)
       (a '*unassigned*))
       (set! b (+ a x))
       (set! a 5)
       (+ a b)))
   (f 10))
 1)

;; in this way an error occurred

;; in theory eva is right, but it is hard to implement
;; then alysssa's idea is more reasonable than ben's
;; if simultaneous internal definitions are necessary and desired

;; the output of ben's way is false
;; reporting an error like alysssa's way is more acceptable.
;; fot that an error is always better than a false result

  • 4.20

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

    ;; a

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

;; based on exercise 4.16
;; transfer it to the let with 'unassigned & set!

(define (letrec-exps exp)
  (cdr exp))

(define (letrec-bindings exp)
  (car exp))

(define (letrec-body exp)
  (cdr exp))

(define (var binding)
  (car binding))

(define (expression binding)
  (cadr binding))

(define (letrec->let exp)
  (transfer (letrec-exps exp)))

(define (transfer exp)
  (let ((bindings (letrec-bindings exp))
    (body (letrec-body exp)))
    (let ((var-list (map var bindings))
      (exp-list (map expression bindings)))
      (append (list 'let (map (lambda (var) (list var 'unassigned)) var-list))
          (append  (map
            (lambda (var expression) (list 'set! var expression))
            var-list exp-list)
               body)))))

(define (eval-letrec exp env)
  (eval (letrec->let) env))

;; implement letrec? and eval-letrec in eval


;; b

;; The lambda in `let' is evaluated in the context of the enclosing environment,
;; in which the bindings of the lambda itself are not in place.
;; save the illustrations.

  • 4.21

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

    (lambda (n)
  ((lambda (fact)
     (fact fact n))
   (lambda (ft k)
     (if (= k 1)
     1
     (* k (ft ft (- k 1))))))
  10)

;; a

((lambda (n)
   ((lambda (fib)
      (fib fib n))
    (lambda (fb k)
      (cond ((= k 0) 0)
        ((= k 1) 1)
        (else
         (+ (fb fb (- k 1))
        (fb fb (- k 2))))))))
 3)

;; b

(define (f x)
  (define (even? n)
    (if (=n 0)
    true
    (odd? (- n 1))))
  (define (odd? n)
    (if (= n 0)
    false
    (even? (- n 1))))
  (even? x))

(define (f x)
  ((lambda (even? odd?)
     (even? even? odd? x))
   (lambda (ev? od? n)
     (if (= n 0) true (od? ev? od? (- n 1))))
   (lambda (ev? od? n)
     (if (= n 0) false (ev? ev? od? (- n 1))))))

将语法分析与执行分离

  1. 前面实现的求值器确实很简单，但却也非常低效，因为有关表达式的语法分析与它 们的执行交织在一起，如果一个程序要执行许多次，对于它的语法分析也就需要做 许多次，可以对这个求值器做一些变换，使它的效率大大提高，采用的方法就是重 新安排其中的工作，使有关的语法分析只进行一次；

练习 4.22-4.24

  • 4.22

     1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

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

(define (let-exps exp)
  (cdr exp))

(define (let-bindings exp)
  (car exp))

(define (let-body exp)
  (cdr exp))

(define (var binding)
  (car binding))

(define (expression binding)
  (cadr binding))

(define (let->application exp)
  (transfer (let-exps exp)))

(define (analyze-let exp)
  (let ((bindings (let-bindings exp))
    (body (let-body exp)))
    (let ((var-list (map var bindings))
      (exp-list (map expression bindings)))
      (let ((proc (make-lambda var-list body)))
    (analyze-application
     (cons proc exp-list))))))

  • 4.23

    1
2
3
4
5

    ;; the version in text unrolls all the procs of the sequence exps by utilizing procedure sequentially

;; while the version defined by Alyssa unrolls the procs in runtime, not in the analyze time
;; due to the recursive pattern of procedure execute-sequence and the return lambda result of analyze-sequence
;; it would unroll the procs everytime when we apply the analyzed result

  • 4.24

    1
2

    ;; 显然本节所给出的版本效率更高；
;; 评估就不做了。