Jade Dungeon

ch04 元语言抽象 part01

元循环求值器

元循环求值器

「元循环」（metacircular）：用与被求值语言相同的语言写求值器。比如：

用Python写Python解释器
用Scheme写Scheme解释器

求值（eval）与应用（apply）循环：

表达式在环境中求值被归约为对实际参数的应用。
对实际参数的应用又被归约为对表达式在「新的环境」中求值。

求值器应该用谓词来检查语法形式，而不是用约定：

约定的方法：规定!结尾的是赋值操作，如：set!。
谓词检查：实现一个谓词assignment?去检查是否是赋值操作。

求值器的内核

求值器的内核可以总结为eval和apply之间的相互调用。

eval

eval过程需要两个参数：「表达式」和「环境」。

主要工作是对表达式进行「分类」，每个分类有一个谓词进行检测。

(define (eval exp env)
  (cond
    ;; 自求值，如各种数值。直接返回表达式本身
    ((self-evaluating? exp) exp)

    ;; 变量，要在环境里找到它的值
    ((variable? exp) (lookup-variable-value exp env))

    ;; 引号，符号表达式。返回被引用的表达式
    ((quoted? exp) (text-of-quotation exp))

    ;; 赋值。递归地用eval与该变量相关的值
    ;; 然后修改环境，才能建立变量约束
    ((assignment? exp) (eval-assignment exp env))

    ;; 定义与上面的赋值类似
    ((definition? exp) (eval-definition exp env))

    ;; if表达式有短路特性，要特别处理
    ((if? exp) (eval-if exp env))

    ;; lambda要转为一个可以应用的过程，
    ;; 实现方法就是把lambda的参数、过程体与环境包起来
    ((lambda? exp)
     (make-procedure (lambda-parameters exp)
                     (lambda-body exp)
                     env))

    ;; begin表达式要按一系列表达式的顺序求值。
    ((begin? exp) 
     (eval-sequence (begin-actions exp) env))

    ;; cond转为一系列嵌套的if
    ((cond? exp) (eval (cond->if exp) env))

    ;; 对于一个过程，要递归地求值组合式的「运算符」部分与「对象对象」
    ;; 然后把得到的过程和参数交给apply处理实际的应用
    ((application? exp)
     (apply (eval (operator exp) env)
            (list-of-values (operands exp) env)))

    ;; 未定义情况，报错
    (else
     (error "Unknown expression type -- EVAL" exp))))

这里的eval用一系列的条件分支，这样有了新的条件就要修改eval过程。大部分实现里用的是数据导向的方式（练习 4.3）。

apply

apply过程把实参应用到过程上。它有两个参数：「过程」和对应的「实参列表」。

(define (apply procedure arguments)
  (cond
    ;; 如果是基本过程
    ((primitive-procedure? procedure)
      ;; apply-primitive-procedure 直接把实参应用过过程
      (apply-primitive-procedure procedure arguments))
    
    ;; 如果是复合过程
    ((compound-procedure? procedure)
      ;; 顺序地执行过程体
      (eval-sequence                       
        (procedure-body procedure)         ;; 取得过程体
        (extend-environment                ;; 建立对应的环境
          (procedure-parameters procedure)
          arguments
          (procedure-environment procedure))))

    ;; 其他情况作为异常
    (else (error "Unknown procedure type -- APPLY" procedure))))

过程参数

eval过程中要用list-of-values来生成实际参数表。它以组合式的运算对象为参数，求值各个运算对象，返回这些值的表：

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

条件

条件带有短路特性：

(define (eval-if exp env)
  (if (true? (eval (if-predicate exp) env))
      (eval (if-consequent exp) env)
      (eval (if-alternative exp) env)))

注意上面的if-predicate是在被实现的语言里求值，产生的结果经过谓词true?转为 Scheme语言中条件表达式中的真与假。

序列

eval-sequence用于按顺序求值表达式：

apply中需要按照顺序求值过程体中的表达式序列。
eval中需要按顺序求值begin表达式里的表达式序列。

它以一个表达式序列和一个环境为参数，并返回最后一个表达式的值。

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

赋值与定义

赋值与定义都以符号'ok作为返回值。

赋值给变量的过程中，它调用eval找出需要赋值的值，通过set-variable-value! 过程将变量和得到的值传给指定的环境：

(define (eval-assignment exp env)
  (set-variable-value! (assignment-variable exp)
                       (eval (assignment-value exp) env)
                       env)
  'ok)

变量的定义也类似：

(define (eval-definition exp env)
  (define-variable! (definition-variable exp)
                    (eval (definition-value exp) env)
                    env)
  'ok)

练习 4.1

对于参数列表里的参数，求值的顺序是从左到右还是从右到左是从Lisp里继承来的。如果在list-of-values里cons从左到右那么顺序也是从左到右，反之亦然。请分别现实两种版本的list-of-values：

从左到右：

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

从右到左：

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

表达式求值

表达式

自求值表达式

自求值表达式只有数和字符串：

(define (self-evaluating? exp)
  (cond ((number? exp) true)
        ((string? exp) true)
        (else false)))

变量

变量用符号表示：

(define (variable? exp) (symbol? exp))

引号表达式

引号表达式的形式是(quote <text-fo-quotation>)，对应2.3.1节描述的，求值器看到的引号表达式的形式是quote开头的表，如'a实际上是(quote a)。检查是否为引用实现的过程为：

;; 谓词，检查是否为符号
(define (quoted? exp)
  (tagged-list? exp 'quote)) ;; 检查表是否以`'quote`开头

;; 取符号
(define (text-of-quotation exp) (cadr exp))

符号表达式

tagged-list?检查表是否以指定的符号开头，quoted?过程里就有用到它：

(define (tagged-list? exp tag)
  (if (pair? exp)
      (eq? (car exp) tag)
      false))

赋值

赋值的形式为(set! <var> <value>)：

(define (assignment? exp)
  (tagged-list? exp 'set!))

(define (assignment-variable exp) (cadr exp))

(define (assignment-value exp) (caddr exp))

定义

定义的形式为：

(define <var> <value>)

def-var

其中对于过程的定义比较复杂：

(define <var>
  (lambda (<parameter1> ... <parametern>)
    <body>))

def-procedure

在这里用语法包装为以下形式：

(define (<var> <parameter1> ... <parametern>)
   <body>)

def-procedure02

实现：

(define (definition? exp)
  (tagged-list? exp 'define)) ;; A1 与 B1 都必须是 `define`

(define (definition-variable exp)
  (if (symbol? (cadr exp))       ;; 检查　A2 或 B2
      (cadr exp)                 ;; A2 是变量名
      (caadr exp)))              ;; B2 是过程名

(define (definition-value exp)
  (if (symbol? (cadr exp))       ;; A3 还是 B3
      ;; A3 是变量值
      (caddr exp)                
      ;; B3 是过程，用它生成lambda
      (make-lambda (cdadr exp)   ;; B4 是参数列表
                   (cddr exp)))) ;; B5 是过程体

lambda

lambda表达式由符号lambda开始：

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

(define (lambda-parameters exp) (cadr exp))

(define (lambda-body exp) (cddr exp))

lambda还需要一个构造函数，因为在之前definition-value过程里需要构造一个lambda：

(define (make-lambda parameters body)
  (cons 'lambda (cons parameters body)))

if表达式

if表达式。Scheme没有规定当缺少else部分的时候返回值，这里用false：

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

(define (if-predicate exp) (cadr exp))

(define (if-consequent exp) (caddr exp))

(define (if-alternative exp)
  (if (not (null? (cdddr exp)))
      (cadddr exp)
      'false))

if表达式也需要一个构造函数，因为把cond表达式转为if表达式的cond->if过程里需要：

(define (make-if predicate consequent alternative)
  (list 'if predicate consequent alternative))

begin表达式

begin表达式序列，需要选择函数返回第一个表达式和其余的表达式：

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

(define (begin-actions exp) (cdr exp))

(define (last-exp? seq) (null? (cdr seq)))

(define (first-exp seq) (car seq))

(define (rest-exps seq) (cdr seq))

begin表达式还需要构造过程，因为在cond->if过程里需要把序列变换为begin表达式，（如果需要的话给序列加上begin作为开头）：

(define (sequence->exp seq)
  (cond ((null? seq) seq)
        ((last-exp? seq) (first-exp seq))
        (else (make-begin seq))))

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

过程应用

过程应用不属于述的各种表达式。这种表达式的car是运算符，car是运算对象的表：

(define (application? exp) (pair? exp))

(define (operator exp) (car exp))

(define (operands exp) (cdr exp))

(define (no-operands? ops) (null? ops))

(define (first-operand ops) (car ops))

(define (rest-operands ops) (cdr ops))

派生表达式 cond

有些形式的表达式可以用其他的形式定义出来，比如cond可以定义为嵌套的if。

cond表达式：

(cond ((> x 0) x)
      ((= x 0) (display 'zero) 0)
      (else (- x)))

可以归约为：

(if (> x 0)
    x
    (if (= x 0)
        (begin (display 'zero)
               0)
        (- x)))

为了实现cond表达式，需要提取cond表达式中各个部分，还要用cond->if过程把cond表达式转为if表达式。

一个分情况分析以cond开始，并包含「谓词」到「动作」子句的表。如果一个子句的符号是else，那么就是一个else子句（空else子句默认为假）。

(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-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                          ; no else clause
      (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))
            (make-if (cond-predicate first)
                     (sequence->exp (cond-actions first))
                     (expand-clauses rest))))))

练习 4.2

调整eval过程中各个cond子句的顺序安排，把「过程应用」子句的放在了「赋值」前，

a) 这样可不可以（从define x 3的处理方式入手）？

错误在于对过程语句位置的调整：

当一个表达式到达过程语句的检测时，无论它是否是一个过程调用，它都会被当作过程调用来执行。

比如执行：(define x 3)，eval会认为define是一个过程，并在环境里寻找名为define的过程，并试图将x和3作为参数赋值给它。

b) 实际上是不可以，如果不计代价地要让求值器在检查大部分表达式前就识别出应用过程，需要修改求值语言的语法，让每个应用都以call开始，比如不能用(factorial 3)，而是要写(call factorial 3)。也不能写(+ 1 2)，要写(call + 1 2)。

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

(define (operator exp) (cadr exp))

(define (operands exp) (cddr exp))

(define (eval exp env)
  (cond
    ((self-evaluating? exp) exp)
    ((variable? exp) (lookup-variable-value exp env))
    ((quoted? exp) (text-ofquotation exp))
    ((if? exp) (eval-if exp env))
    ((lambda ? exp)
      (make-procedure
        (lambda-parameters exp)
        (lambda-body exp)
        env))
    ((begin? exp)
      (eval-sequence (begin-actions exp) env))
    ((cond? exp) (eval (cond->if exp) env))
    ((application? exp)
      (apply
        (eval (operator exp) env)
        (list-of-values (operands exp) env)))
    ((assignment? exp) (eval-assignment exp env))
    ((definition? exp) (eval-definition exp env))
    (else
      (error "unknown expression type -- EVAL" exp))))

练习 4.3 数据导向形式的`eval`

用数据导向形式实现分派风格的eval。

(include "g_getput.scm")
(include "4.1.scm")

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

(put 'op 'quote     text-of-quotation)
(put 'op 'set!      eval-assignment)
(put 'op 'define    eval-definition)
(put 'op 'if        eval-if)
(put 'op
     'lambda
     (lambda (x y)
       (make-procedure (lambda-parameters x) (lambda-body x) y)))

(put 'op
     'begin
     (lambda (x y)
       (eval-sequence (begin-sequence x) y)))

(put 'op 'cond      (lambda (x y) (evaln (cond-if x) y)))

(define (evaln expr env)
    (cond
        ((self-evaluating? expr) expr)
        ((variable? expr) (lookup-variable-value expr env))
        ((get 'op (car expr))
            (applyn (get 'op (car expr)) (list expr env)))
        ((application? expr)
            (applyn (evaln (operator expr) env)
                    (list-of-values (operands expr) env)))
        (else
            (error "unknown expression type -- EVAL" expr))))

g_getput.scm：

(define (make-table)
    (let ((local-table (list '*table*)))
        (define (lookup key-1 key-2)
            (let ((subtable (assoc key-1 (cdr local-table))))
                (if subtable
                    (let ((record (assoc key-2 (cdr subtable))))
                        (if record
                            (cdr record)
                            #f))
                    #f)))
        (define (insert! key-1 key-2 value)
            (let ((subtable (assoc key-1 (cdr local-table))))
                (if subtable
                    (let ((record (assoc key-2 (cdr subtable))))
                        (if record
                            (set-cdr! record value)
                            (set-cdr! subtable
                                (cons (cons key-2 value) (cdr subtable)))))
                    (set-cdr! local-table
                        (cons
                            (list key-1 (cons key-2 value))
                            (cdr local-table)))))
            'ok)
        (define (dispatch m)
            (cond
                ((eq? m 'lookup-proc) lookup)
                ((eq? m 'insert-proc!) insert!)
                (else (error "unknown operation -- TABLE: " m))))
        dispatch))

(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

练习 4.4 and和or的短路特性

实现带短路特性的eval-and和evan-or过程，并把对应的and操作和or操作加到 eval过程中去。

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

(define (and-cases exp) (cdr exp))

; exp should be (and-cases exp)
(define (eval-and exp env)
  (if (null? exp)
    true
    (if (true? (eval (car exp) env))
      (eval-and (cdr exp) env)
      false)))

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

(define (or-cases exp) (cdr exp))

; exp should be (or-cases exp)
(define (eval-or exp env)
  (if (null? exp)
    true
    (if (true? (eval (car exp) env))
      true
      (eval-or (cdr exp) env))))

(define (eval exp env)
  (cond
    ((self-evaluating? exp) exp)
    ;.....
    ((and? exp)
      (eval-and (and-cases exp) env))
    ((or? exp)
      (eval-or (or-cases exp) env))
    ;.....
    ((application? exp)
      (apply
        (eval (operator exp) env)
        (list-of-values (operands exp) env)))
    (else
      (error "unknown expression type -- EVAL" exp))))

用派生表达式的方式实现and和or：

(define (expand-and exp)
  (if (null? exp)
    true
    (let ((first (car exp))
        (rest  (cdr exp)))
      (make-if
        first
        (if (null? rest)
          true
          (expand-and rest))
        false))))

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

(define (expand-or exp)
  (if (null? exp)
    true
    (let ((first (car exp))
        (rest  (cdr exp)))
      (make-if
        first
        true
        (if (null? rest)
          true
          (expand-or rest))))))

(define (or->if exp)
  (expor-or (or-cases exp)))

练习 4.5 `cond`另一种形式

cond子句的另一种形式：(<test> => <recipient>)：

如果test为真，就对recipient求值。
recipient的值必须是一个只有单个形参的过程。
把这个过程应用于test，作为cond表达式的结果。

例：

(cond ((assoc 'b '((a 1) (b 2))) => cadr)
      (else false))
;; result is 2

实现：

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

(define (expand-clauses clauses)
  (if (null? clauses)
    'false                               ; clause else no
    (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))
        (make-if
          (cond-predicate first)
          (if (extended-cond? first)
            (list (cadr actions) (cond-predicate first))
            (sequence->exp (cond-actions first)))
          (expand-clauses rest))))))

练习 4.6 let作为派生表达式的实现

let表达式也是语法糖，设计一个过程let->combination把以下形式的let表达式：

(let ((<var1> <exp1>)
      ...
      (<varn> <expn>))
  <body>)

转为：

((lambda (<var1> ... <varn>)
    <body>)
  <exp1>
  ...
  <expn>)

(include "4.1.scm")

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

(define (let-parameters-list exp) (cadr exp))

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

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

在eval过程的application?之前添加：

((let? exp)
  (eval (let->combination exp) env))

练习 4.7 嵌套的 let

let*与let类似，不同之处是从左到右每个约束可以得到前一个约束：

(let* ((x 3)            ;; x is 3
       (y (+ x 2))      ;; y is 5
       (z (+ x y 5)))   ;; z is 13
  (* x z))

;; result is 39

实现过程let*->nested-lets把它转为嵌套形式的let。

(let* ((x 3)
       (y (+ x 2))
       (z (+ x y 5)))
  (* x z))

等价于

((lambda (x)
    ((lambda (y)
        ((lambda (z) (* x z))
          (+ x y 5)))
      (+ x 2)))
  3)

(include "4-06.scm")

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

;; 展开成lambda
(define (let*->nested-lets exp)
    (let ((parameters (let-parameters-list exp))
          (body (let-body exp)))
        (define (expand-let* rest-parameters)
            (let ((first-var (car rest-parameters)))
                (cons
                    (make-lambda
                        (list (car first-var))
                        (if (last-exp? rest-parameters)
                            body
                            (expand-let* (cdr rest-parameters) body)))
                    (cdr first-var))))
        (expand-let* parameters)))

;; 展开成let
(define (let*->nested-lets exp)
    (let ((parameters (let-parameters-list exp))
          (body (let-body exp)))
        (define (make-lets rest-parameters)
            (if (null? rest-parameters)
                body
                (list 'let (list (car rest-parameters)) (make-lets (cdr rest-parameters)))))
        (make-lets parameters)))

在eval过程的application?之前添加：

((let? exp)
  (eval (let*->nested-lets exp) env))

练习 4.8

let的另一种形式被称为「命名let」:

(let <var> <bindings> <body>)

在这种形式中，过程体body中所有参数值都在bindings里绑定，这样就可以通过变量名var反复调用过程了，例如下面这个斐波那契的例子：

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

修改练习 4.6里的let->combination以支持这一特性。

(include "4.1.scm")

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

(define (let-parameters-list exp) (cadr exp))

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

(define (naming-let? exp) (symbol? (cadr exp)))
(define (naming-let-name exp) (cadr exp))
(define (naming-let-parameters-list exp) (caddr exp))
(define (naming-let-body exp) (cadddr exp))

(define (let->combination exp)
    (if (naming-let? exp)
        (let ((name (naming-let-name exp))
              (parameters (naming-let-parameters-list exp)))
            (sequence->exp
                (list
                    (list 'define name
                        (make-lambda
                            (map car parameters)
                            (naming-let-body exp)))
                    (cons name (map cadr parameters)))))
        (let ((parameters  (let-parameters-list exp)))
            (cons
                (make-lambda
                    (map car parameters)
                    (let-body exp))
                (map cadr parameters)))))

eval过程要在application?之前添加：

((let? exp) (eval (let->combination exp) env))

练习 4.9 实现迭代

Scheme中没有内置的do、for、while和until等结构。请实现并给出例子。

以do结构为例子，根据R5RS，do的定义如下：

(do ((<variable1> <init1> <step1>)
     ...)
    (<test1> <expression1> ...)
    <command> ...)

它可以转换为：

(define (iter <var1> <var2> ... <varN>)
    (cond ((<test1> <expression1>)
           (<test1> <expression1>)
           ...
           (else
            (iter (<step1> <var1>)
                  (<step2> <var2>)
                  ...
                  (<stepN> <varN>))))))

(iter <init1> <init2> ... <initN>)

其中的iter必须是一个随机产生的，无重复的名字（gensym？）

另一个while的实现：

#|

(define i 0)

(while (< i 10)
    (display i)
    (set! i (+ i 1)))

|#

实现while：

(include "4.1.scm")

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

(define (while-condition exp) (cadr exp))

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

(define (eval-while exp env)
    (let ((condition (while-condition exp))
          (body (sequence->exp (while-body exp))))
        (define (loop)
            (if (true? (eval condition env))
                (begin
                    (eval body env)
                    (loop))))
        (loop)))

(define (while->combination exp)
    ; (begin (define (loop) (if condition (begin body (loop)))) (loop))
    (sequence->exp
        (list
            (list 'define (list 'loop)
                (make-if
                    (while-condition exp)
                    (sequence->exp
                        (append (while-body exp) (list 'loop)))
                    'end-of-while))
            (list 'loop))))

eval中添加：

((while? exp) (eval-while exp env))

或：

((while? exp) (eval (while-condition exp) env))

练习 4.10 独立于语法的求值

设计一种新的语法，并且实现新语法不用修改eval和apply。

如另一种语法是将函数名放在最后:

(1 2 3 +)

实现：

(define (last-element lst)
    (if (null? (cdr lst))
        (car lst)
        (last-element (cdr lst))))

(define (all-except-last lst)
    (if (null? (cdr lst))
        '()
        (cons (car lst) (all-except-last (cdr lst)))))

(define (tagged-list? exp sym)
    (if (pair? exp)
        (let ((last (last-element exp)))
            (eq? last sym))
        #f))

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

(define (if-predicate exp) (car exp))

(define (if-consequent exp) (cadr exp))

(define (if-alternative exp)
    (if (= (length exp) 4)
        (caddr exp)
        'false))

求值器的数据结构

求值器除了要实现对「语法形式」的定义，还需要对求值器内部「所操作的数据结构」的定义。如：

定义过程和环境的表示形式。
「真」和「假」的表示方式。

谓词检测

false以外的一切都定义为真：

(define (true? x)
  (not (eq? x false)))

(define (false? x)
  (eq? x false))

过程的表示

检查对象是否为「基本过程」（具体实现在以后讨论）：

(primitive-procedure? <proc>)

把[「基本过程」proc应用于表args里的值：

(apply-primitive-procedure <proc> <args>)

「复合过程」的构造函数如下，它需要「形式参数」、「过程体」、「环境」：

(define (make-procedure parameters body env)
  (list 'procedure parameters body env))

「复合过程」的选择函数：

(define (compound-procedure? p)
  (tagged-list? p 'procedure))

(define (procedure-parameters p) (cadr p))

(define (procedure-body p) (caddr p))

(define (procedure-environment p) (cadddr p))

对环境的操作

3.2节中解释过，环境就是栈帧的序列。栈帧就是记录变量与值之间约束关系的表格。在程序语言中与环境相关的操作有：

;; 在指定的环境`evn`中查找变量`var`的值：
(lookup-variable-value <var> <env>)

;; 在外围环境`base-env`的基础上，`variables`里的符号约束取`values`的值，
;; 从而产生新的环境作为返回值：
(extend-environment <variables> <values> <base-env>)

;; 在环境`env`里加入一个新约束：
(define-variable! <var> <value> <env>)

;; 改变约束的值：
(set-variable-value! <var> <value> <env>)

接下来看如何实现它们。

首先要把环境表示为一个栈帧的表：

;; 外部环境，就是上一个环境
(define (enclosing-environment env) (cdr env))

;; 第一帧，就是当前帧
(define (first-frame env) (car env))

;; 空环境，就是空
(define the-empty-environment '())

环境里的每一帧都是一对表形成的序对：「所有变量」的表和「所有变量的值」的表。实现：

;; 创建一个栈帧
(define (make-frame variables values)
  (cons variables values))

;; 当前帧中所有的变量
(define (frame-variables frame) (car frame))

;; 当前帧中所有的变量的值
(define (frame-values frame) (cdr frame))

;; 在栈帧中增加变量和它的值
(define (add-binding-to-frame! var val frame)
  (set-car! frame (cons var (car frame)))
  (set-cdr! frame (cons val (cdr frame))))

从外部环境生成一个子环境的方法。注意：由于变量和变量的值是分开在两个表里的，所以如果检查到两个表里的成员个数不一样就要报错。

(define (extend-environment vars vals base-env)
  (if (= (length vars) (length vals))
      (cons (make-frame vars vals) 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 (env-loop env)
    (define (scan vars vals)
      (cond ((null? vars)
             (env-loop (enclosing-environment env)))
            ((eq? var (car vars))
             (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))

;; 设置变量的值
(define (set-variable-value! var val env)
  (define (env-loop env)
    (define (scan vars vals)
      (cond ((null? vars)
             (env-loop (enclosing-environment env)))
            ((eq? var (car vars))
             (set-car! vals val))
            (else (scan (cdr vars) (cdr vals)))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable -- SET!" var)
        (let ((frame (first-frame env)))
          (scan (frame-variables frame)
                (frame-values frame)))))
  (env-loop env))

定义变量时，如果在当前框架里找到就修改；当前框架没有就新增：

(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (define (scan vars vals)
      (cond ((null? vars)
             (add-binding-to-frame! var val frame))
            ((eq? var (car vars))
             (set-car! vals val))
            (else (scan (cdr vars) (cdr vals)))))
    (scan (frame-variables frame)
          (frame-values frame))))

这里的实现为了逻辑简单牺牲了效率。在生产环境中求值器的环境操作（尤其是查找变量）速度对系统性能有着重要的影响，所以会采用更加高效的实现方式。

练习 4.11 以「键值序对」实现变量名与变量值的约束

重写环境过程，以「键值序对」实现变量名与变量值的约束：

(include "4.1.scm")

;SKIP(no change):
;   enclosing-environment
;   first-frame
;   the-empty-environment

(define (make-frame variables values)
    (cons 
        'table
        (map cons variables values)))

(define (frame-pairs frame) (cdr frame-pairs))

(define (add-biding-to-frame! var val frame)
    (set-cdr! frame
        (cons (cons var val) (frame-pairs frame))))

;SKIP:
;   extend-environment

(define (lookup-variable-value var env)
  (define (env-loop env)
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (let ((ret (assoc var (frame-pairs (first-frame env)))))
             (if ret
                 (cdr ret)
                 (env-loop (enclosing-environment env))))))
  (env-loop env))

(define (set-variable-value! var val env)
  (define (env-loop env)
    (if (eq? env the-empty-environment)
        (error "Unbound variables -- SET!" var)
        (let ((ret (assoc var (frame-pairs (first-frame env)))))
             (if ret
                 (set-cdr! ret val)
                 (env-loop (enclosing-environment env))))))
  (env-loop env))

(define (define-variable! var val env)
  (let* ((frame (first-frame env))
         (ret (assoc var (frame-pairs frame))))
      (if ret
          (set-cdr! ret val)
          (add-biding-to-frame! var val frame))))

练习 4.12 进一步抽象对变量的操作

set-variable-value!、define-variable和lookup-variable-value 这三个过程中有着相似的模式，请定义更加抽象的遍历逻辑来优化这三个过程：

(include "4-11.scm")

(define (lookup-in-current-level var env)
  (if (eq? env the-empty-environment)
      #f
      (assoc var (frame-pairs (first-frame env)))))

(define (lookup-variable-pair var env)
  (if (eq? env the-empty-environment)
      #f
      (let ((ret (lookup-in-current-level var env)))
          (if ret
              ret
              (lookup-variable-pair var (enclosing-environment env))))))

(define (lookup-variable-value var env)
  (let ((ret (lookup-variable-pair var env)))
      (if ret
          (cdr ret)
          (error "Unbound variable" var))))

(define (set-variable-value! var val env)
  (let ((ret (lookup-variable-pair var env)))
      (if ret
          (set-cdr! ret val)
          (error "Unbound variable" var))))

(define (define-variable! var val env)
  (let ((ret (lookup-in-current-level var env)))
      (if ret
          (set-cdr! ret val)
          (add-biding-to-frame! var val (first-frame env)))))

练习 4.13 删除变量约束

定义make-unbound!过程删除变量的约束。并说明是删除操作否应该只删除第一个环境，为什么？

删除的变量应该是第一个遇到给定符号的环境，这和 let 之类的语句也对应。

(include "4.1.scm")

; 以书上的版本为准，忽略4-11/4-12

(define (unbound? exp) (tagged-list? exp 'unbound!))
(define (unbound-variable exp) (cadr exp))

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

作为程序运行求值器

实现了求值器以后，接下来要实现如何用求值器调用Lisp的来模拟程序执行。

必须建立「基本过程的名字」与它对应的「运行对象」之间的约束。这样才能把实际要运算的对象传递给apply过程。所以首先要建立一个初始环境，其中包含了基本过程与唯一对象的关联，还有true和false这样的约束：

;; 创建新的环境
(define (setup-environment)
  (let ((initial-env
          (extend-environment (primitive-procedure-names)
                              (primitive-procedure-objects)
                              the-empty-environment)))
    (define-variable! 'true true initial-env)
    (define-variable! 'false false initial-env)
    initial-env))

;; 每个`the-global-enviroment`都是一个新的环境
(define the-global-environment (setup-environment))

在这里约定基本过程都是以primitive开头的表：

;; 检查是否是基本过程
;; 列表的第一个元素为`'primitive`就是基本过程
(define (primitive-procedure? proc)
  (tagged-list? proc 'primitive))

;; 取得基本过程的具体实现
(define (primitive-implementation proc)
  (cadr proc))

setup-environment可以从一个表里得到基本过程的名字和对应的实现。在基础Lisp里定义过的过程都可以用作这个无循环求值器的基本过程。求值器里用到的名字不必与在基础Lisp系统里的名字一样，这里采用相同的名字是因为无循环求值器是用来实现Scheme自身的。举例来说，在这里可以把(list 'first car)或(list 'square (lambda (x) (* x x)) 放到primitive-procedure。

在这里，定义基本过程名与其对应实现过程的列表如下：

;; 基本过程名与实现的组合列表
(define primitive-procedures
  (list (list 'car car)
        (list 'cdr cdr)
        (list 'cons cons)
        (list 'null? null?)
        <more primitives>
        ))

;; 所有基本过程的名字
(define (primitive-procedure-names)
  (map car
       primitive-procedures))

;; 所有基本过程的实现
(define (primitive-procedure-objects)
  (map (lambda (proc) (list 'primitive (cadr proc)))
       primitive-procedures))

用scheme实现对一个基本过程的应用非常方便，只要把实现的「过程体」应用到「实参」就行：

(define (apply-primitive-procedure proc args)
  (apply-in-underlying-scheme
    (primitive-implementation proc) args))

注意上面的apply-in-underlying-scheme操作就对应了eval-apply循环中的apply 阶段。在这里其实调用就是MIT-Scheme中对应的是apply过程：

(define apply-in-underlying-scheme apply)

然后为了让这个元循环求值器「循环」起来，要再提供一个「驱动循环」来模拟REPL环境：

显示一个提示符。
读取用户输入的表达式
在全局环境中对表示式求值
打印输出结果

为了区分原来Scheme的输出，我们实现的求值器每个输出结果前都会多放一个提示符。

基本过程「read」等待用户的输入一个完整的表达式。例如：

用户输入的是(+ 23 x)，read返回的「符号+」、「23」、「符号x」
三个元素的列表。
如果用户输入的是'x，返回的是「符号quote」和「符号x」。

(define input-prompt ";;; M-Eval input:")

(define output-prompt ";;; M-Eval value:")

(define (driver-loop)
  (prompt-for-input input-prompt)
  (let ((input (read)))
    (let ((output (eval input the-global-environment)))
      (announce-output output-prompt)
      (user-print output)))
  (driver-loop))

(define (prompt-for-input string)
  (newline) (newline) (display string) (newline))

(define (announce-output string)
  (newline) (display string) (newline))

用到的user-print过程是为了防止打印出复合过程的环境部分（那可能会是一个非常长的表……）：

(define (user-print object)
  (if (compound-procedure? object)
      (display (list 'compound-procedure
                     (procedure-parameters object)
                     (procedure-body object)
                     '<procedure-env>))
      (display object)))

现在只要初始化全局环境，并启动刚刚实现的驱动循环，就可以运行空上求值器。比如这样：

;; 初始化全局环境
(define the-global-environment (setup-environment))

;; 启动驱动循环
(driver-loop)

接下来出现提示符，可以输入我们的程序了：

;;; M-Eval input:
(define (append x y)
  (if (null? x)
      y
      (cons (car x)
            (append (cdr x) y))))
;;; M-Eval value:
ok

;;; M-Eval input:
(append '(a b c) '(d e f))
;;; M-Eval value:
(a b c d e f)

练习 4.14 scheme原生map出错

如果输入一个map的实现，可以正常工作；但是如果把系统原生的map作为基本过程安装到元循环求值器中就会出错，为什么？

例如：

(map display (list 1 2))

map接受到的参数为：

(list
    (list 'primitive {[procedure display]} )
    (list 1 2))

scheme原生的map会把第一个参数(display)当成一个「原生函数」直接作用于后续参数，因此会出错。

而自定义的map会再次调用apply来执行display函数，因此可以正常工作。

将数据作为程序

可以把求值器作为「通用计算机」，任何机器只要能描述成Lisp程序，它就可以模拟。（图灵机的「可计算」问题）。

除了之前我们实现的eval基本过程，Scheme自己还带了一个现成的eval基本过程。以一个表达式和一个环境作为参数可以进行求值。比如以下两个值都是25：

(eval '(* 5 5) user-initial-environment)                ;; 25

(eval (cons '* (list 5 5)) user-initial-environment)    ;; 25

练习4.15 停机问题

有一个单参数的过程p和一个对象a。如果表达式(p a)能返回一个值（即不会抛错，也不会永远地运行下去），则称过程p对a「终止」。

求证不可能有一个过程halts?可以正确地判断是否终止。提示思路如下：

如果能有这样一个过程，就可以实现以下程序：

(define (run-forever) (run-forever))

(define (try p)
  (if (halts? p p)
      (run-forever)
      'halted))

现在求表达式(try try)，并说明无论终止或是永远运行都违背所确定的halts?行为。

假设停机问题可解，即存在过程H使(H P I)可以判定程序P在输入I的情况下是否可停机。假设P在输入I的情况下可停机，则H输出true（停机），否则输出false（死循环），即可导出矛盾：

由于程序本身可以当作数据，因此可以被当作输入；故H应该可以判定将P作为P的输入时，P是否会停机。所以假设过程K:

(define (K P)
    (if (H P P)
        false
        true))

即(K P)与(H P P)的行为相反。

现在假设求(K K)，若(H K K)输出停机，则(K K)为死循环，而二者矛盾。因为(H K K)的定义就是(K K)的行为，因此停机问题不可解。

内部定义

块结构有两个方法的定义相互依赖的情况。例如：

(define (f x)

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

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

  <rest of body of f>)

过程odd?和even?相互依赖，无论先实现哪一个，都要依赖到另外一个。而另一个又没有定义。所以这两个定义应该同时加入到环境中。总的来说，在块结构里，一个局部名字的作用域，应该是相应define的求值所在的整个过程体。

为了解决这个问题，需要在对表达式求值前，在当前环境里建立起所有的局部变量。具体的实现方案不止一种。其中一个方案是通过lambda表达式的语法转换：

在求值lambda表达式的过程体之前，先删除过程体中所有的内部定义。
用let创建被删除的内部定义的变量。
通过赋值给变量赋予过程体。

例如，以下过程：

(lambda <vars>
  (define u <e1>)
  (define v <e2>)
  <e3>)

被转换为：

(lambda <vars>
  (let ((u '*unassigned*)
        (v '*unassigned*))
    (set! u <e1>)
    (set! v <e2>)
    <e3>))

其中*unassigned*是一个特殊符号，在查找一个变量，企图去使用一个尚未赋值的变量的值时，它将导致发出一个错误信号。

练习 4.16 内部过程「同时性」作用域

假设已经实现了对let的支持（参见练习 4.6）

a) 修改4.1.3节中的lookup-variable-value，让它在遇到值为*unassigned*时抛错。

(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))
              (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)))))
  (let ((ret (env-loop env)))
    (if (eq? ret '*unassigned*)
      (error "unassigned variable:" var)
      ret)))

b) 定义过程scan-out-defines，它以一个过程体为参数，返回不包含内部定义的等价表达式。

(define (scan-out-defines seq)
  (define (no-defs seq)
    (if (null? seq)
      '()
      (let ((exp (car seq)))
        (if (definition? exp)
          (no-defs (cdr seq))
          (cons exp (no-defs (cdr seq)))))))

  (define (defs seq)
    (if (null? seq)
      '()
      (let ((exp (car seq)))
        (if (definition? exp)
          (cons exp (defs (cdr seq)))
          (defs (cdr seq))))))

  (cons 'let
        (cons (map (lambda (x) (list x '*unassigned*))
		    	         (map cadr (defs seq)))
              (append
                (map (lambda (x) (cons 'set! (cdr x)))
		    				     (defs seq))
                (no-defs seq)))))

(display
  (scan-out-defines '((define x 1) (define y 2) (+ x y) (display x))))

c) 把scan-out-defines安装到解释器里，或是装到make-procedure里，或是装到4.1.3节的procedure-body，这三个里哪个最合适？

安装在make-procedure更好，因为它只会被调用一次，而procedure-body 在每次调用同一个函数时都会被调用，效率低。

(define (make-procedure parameters body env)
    (list 'procedure parameters (scan-out-defines body) env))

练习 4.17 内部定义的变换模型

a) 描述变换时的环境模型，并解释为什么变换后会多出一个框架。

env-mod

因为使用了let，会被翻译成lambda，导致到一层框架

b) 为什么环境结构的差异不会改变程序的行为？用什么方法即可以实现局部过程的「同时性」作用域，又不需要构造额外的框架。

把所有的define都提到前面来。

练习 4.18

另一种扫描定义的方式，把正文里的例子转为：

(lambda <vars>
  (let ((u '*unassigned*)
        (v '*unassigned*))
    (let ((a <e1>)
          (b <e2>))
      (set! u a)
      (set! v b))
    <e3>))

与正文里的区别是解释器自动生成了新的变量a和b。

结合3.5.4节中的resolve过程，分别采用两种不同的扫描方式有什么区别：

(define (solve f y0 dt)
  (define y (integral (delay dy) y0 dt))
  (define dy (stream-map f y))
  y)

正文的版本可以正常工作，题中的版本不行：

y：*unassigned*
dy：*unassigned*
a：(integral (delay dy) y0 dt)

此时dy = *unassigned*，解释器会报错。

练习 4.19

对于以下程序：

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

有四种观点：

define的顺序规则能得到结果，b定义为11，a定义为5，最后结果是16。
相互递归要求内部过程有同时性作用域，计算b时a还没有赋值。所以会出错。
如果a与b是同时的，那么a的值为5可以用在b的求值中。所以b为15，结果是20。

哪个观点正确？

mit-scheme的实现为第二种。虽然从原则上来说方案三正确，但很难有一种机制来实现它。所以最好就是抛错。

如何实现方案3？

使用延迟求值：解释器的行为类似下面的代码，当定义的新变量并不直接求值，而是在需要时再求值。

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

练习 4.20 用`letrec`实现同时定义

letrec为同时为变量建立约束，并且有相同的作用域。语法介绍：

(letrec ((<var1> <exp1>)
				 ...
				 (<varn> <expn>))
  <body>)

由于约束具有同时性，这样就可以在约束中递归。

这样过程f可以写成没有内部定义的形式，但具有相同的意义：

(define (f x)
  (letrec ((even?
            (lambda (n)
              (if (= n 0)
                  true
                  (odd? (- n 1)))))
           (odd?
            (lambda (n)
              (if (= n 0)
                  false
                  (even? (- n 1))))))
    <rest of body of f>))

在约束中递归的例子有：even?和odd?相互递归，或是以下求10的阶乘的程序：

(letrec ((fact
          (lambda (n)
            (if (= n 1)
                1
                (* n (fact (- n 1)))))))
  (fact 10))

a) 把letrec实现为一种派生表达式：

;(define (letrec? expr) (tagged-list? expr 'letrec)

(define (letrec-defs expr) (cadr expr))

(define (letrec-body expr) (cddr expr))

(define (letrec->let expr)
  (list 'let
    (map
      (lambda (def) (list (car def) '*unassigned'))
      (letrec-defs expr))
    (cons 'begin
          (append
            (map
              (lambda (def) (cons 'set def))
              (letrec-defs expr))
            (letrec-body expr)))))

;; test it
(display

  (letrec->let
    '(letrec (
      (even?  (lambda (n)
                (if (= n 0)
                  #t
                  (odd? (- n 1)))))
      (odd?  (lambda (n)
               (if (= n 0)
                 #f
                 (even? (- n 1))))))
                  (even? x)))

)

b) 把f定义中的letrec换成let

(define (f x)
  (letrec ((even?
            (lambda (n)
              (if (= n 0)
                #t
                (odd? (- n 1)))))
           (odd?
            (lambda (n)
              (if (= n 0)
                #f
                (even? (- n 1))))))
    (even? x)))

#|
(f 5) =>
  (even? 5) =>
    (odd? 4) =>
      (even? 3) =>
        (odd? 2) =>
          (even? 1) =>
            (odd? 0) => #f
|#

练习 4.21 Y-Combinator

Y-Combinator可以用来实现递归运算的一个「纯\(\lambda\)演算」实现：

\[ \begin{equation} Y = \lambda f.(\lambda x.(f(x \ x))\lambda x.(f(x \ x))) \end{equation} \]

不用letrec和define也能描述出递归过程，如以下递归求10的阶乘：

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

a) 如何确定这个表达式确实能算出阶乘。再设计一个可以算斐波纳契数列的表达式。

求阶乘的过程：

(fact fact 10)
  (* 10 (ft ft 9))
    (* 9 (ft ft 8))
      (* 8 (ft ft 7))
        ...
        (* 2 (ft ft 1))
          1

斐波纳契数列的表达式：

(display 

  ((lambda (i)
    ((lambda (fib)
      (fib fib i))
     (lambda (f i)
      (if (<= i 2)
        1
        (+ (f f (- i 1))
          (f f (- i 2)))))))
 10)

) (newline)

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))

完成填空，以不用内部定义也不用letrec的方式实现以下程序：

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

答，完整的程序：

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

(display (f 2))
(display (f 3))
(display (f 4))
(display (f 5))

将语法分析与执行分离

到目前为止，所实现的求值器把语法的分析与执行交织在一起，一个重复执行多次的程序也会进行重复多次的语法分析。

优化方案是把eval过程分为两部分：

analyze以表达式作为参数，对其进行语法分析，返回一个新的过程：「执行程序」。
执行程序以一个环境作为参数，并完成实际的工作。

这样分开以后，新的eval就成了：

(define (eval exp env)
  ((analyze exp) env))

analyze的具体实现和之前的eval相似，主要区别是其中分派过程只执行分析工作，不进行完全的求值：

(define (analyze exp)
  (cond ((self-evaluating? exp) 
           (analyze-self-evaluating exp))
        ((quoted? exp) (analyze-quoted exp))
        ((variable? exp) (analyze-variable exp))
        ((assignment? exp) (analyze-assignment exp))
        ((definition? exp) (analyze-definition exp))
        ((if? exp) (analyze-if exp))
        ((lambda? exp) (analyze-lambda exp))
        ((begin? exp) (analyze-sequence (begin-actions exp)))
        ((cond? exp) (analyze (cond->if exp)))
        ((application? exp) (analyze-application exp))
        (else
          (error "Unknown expression type -- ANALYZE" exp))))

对于自求值表达式的简单分析过程，它只需要返回一个忽略环境的执行过程，直接返回相应的表达式：

(define (analyze-self-evaluating exp)
  (lambda (env) exp))

对于引号表达式，在分析进提取出被引用的表达式，返岗不是在执行中去做的方式。因为这个操作只要做一次，不需要重复：

(define (analyze-quoted exp)
  (let ((qval (text-of-quotation exp)))
    (lambda (env) qval)))

查看变量的值需要依赖所有的环境，所以只能在执行过程时进行。（虽然如以后在5.5.6节中描述，变量搜索的大部分工作也可以在语法分析阶段完成，可以在环境结构中确定能找到变量的值的位置，这样就可以不用查找整个环境了）

(define (analyze-variable exp)
  (lambda (env) (lookup-variable-value exp env)))

虽然analyze-assignment也必须在求执阶段才能得到对变量赋值的环境，但是因为在分析阶段已经递归地完成了对assignment-value表达式的分析，所以效率已经有很大的提高了。

(define (analyze-assignment exp)
  (let ((var (assignment-variable exp))
        (vproc (analyze (assignment-value exp))))
    (lambda (env)
      (set-variable-value! var (vproc env) env)
      'ok)))

(define (analyze-definition exp)
  (let ((var (definition-variable exp))
        (vproc (analyze (definition-value exp))))
    (lambda (env)
      (define-variable! var (vproc env) env)
      'ok)))

对于if表达式，需要在分析过程是提取谓词、推理、替代部分：

(define (analyze-if exp)
  (let ((pproc (analyze (if-predicate exp)))
        (cproc (analyze (if-consequent exp)))
        (aproc (analyze (if-alternative exp))))
    (lambda (env)
      (if (true? (pproc env))
          (cproc env)
          (aproc env)))))

lambda表达式的分析只需要对lambda体只要分析一次：

(define (analyze-lambda exp)
  (let ((vars (lambda-parameters exp))
        (bproc (analyze-sequence (lambda-body exp))))
    (lambda (env) (make-procedure vars bproc env))))

表达式序列（begin或是lambda表达式的体，练习4.23继续讨论）中每个表达式都要被分析，产生一个执行过程。这些执行过程被组合为一个执行过种，然后以一个环境为参数，顺序地调用各个独立地执行过程：

(define (analyze-sequence exps)
  (define (sequentially proc1 proc2)
    (lambda (env) (proc1 env) (proc2 env)))
  (define (loop first-proc rest-procs)
    (if (null? rest-procs)
        first-proc
        (loop (sequentially first-proc (car rest-procs))
              (cdr rest-procs))))
  (let ((procs (map analyze exps)))
    (if (null? procs)
        (error "Empty sequence -- ANALYZE"))
    (loop (car procs) (cdr procs))))

为了分析一个过程应用，就需要分析其中的运算符（即运算过程）和运算对象（即参数）。然后一起交给execute-application，这一过程与4.1.1节的apply过程类似，主要区别是作为复合过程已经分析过了，不用再进一步分析了，只需要在扩充的环境里调用过程体的执行程序：

(define (analyze-application exp)
  (let ((fproc (analyze (operator exp)))
        (aprocs (map analyze (operands exp))))
    (lambda (env)
      (execute-application (fproc env)
                           (map (lambda (aproc) (aproc env))
                                aprocs)))))

(define (execute-application proc args)
  (cond ((primitive-procedure? proc)
           (apply-primitive-procedure proc args))
        ((compound-procedure? proc)
          ((procedure-body proc)
             (extend-environment (procedure-parameters proc)
                                 args
                                 (procedure-environment proc))))
        (else
          (error "Unknown procedure type -- EXECUTE-APPLICATION"
                 proc))))

其他的部分如数据结构、语法过程、运行支持过程与4.1.2节、4.1.3节、4.1.4节中一样。

练习 4.22 实现let

参考练习4.6，实现let。

在application?判断之前加上：

    ((let? exp) (analyze (let->combination exp)))

练习 4.23

以下版本的analyze-sequence有什么问题？

(define (analyze-sequence exps)
  (define (execute-sequence procs env)
    (cond ((null? (cdr procs)) ((car procs) env))
          (else ((car procs) env)
                (execute-sequence (cdr procs) env))))
  (let ((procs (map analyze exps)))
    (if (null? procs)
        (error "Empty sequence -- ANALYZE"))
    (lambda (env) (execute-sequence procs env))))

问题在于并没有去调用内部建立的各个求值过程，它只是循环地通过一个过程去调用它们，看起来每个表达式都经过了分析，但是并没有分析整个序列本身。

当序列中只有一个表达式时，两个版本所产生的执行过程是怎么样的？

(analyze-sequence '((foo))) =>
    (define procs (map analyze exps)) =>
        procs:
            (list (analyze '(foo)))
        (loop (car procs) (cdr procs)) =>
            first-proc: [(analyze '(foo))]
            rest-procs: '()

;返回: first-proc

有问题的版本：

(analyze-sequence '((foo))) =>
    (define procs (map analyze exps)) =>
        procs:
            (list (analyze '(foo)))

;返回: (lambda (env) (execute-sequence procs env))

当序列中有两个表达式时，两个版本所产生的执行过程是怎么样的？

(analyze-sequence '((foo) (bar))) =>
    (define procs (map analyze exps)) =>
        procs:
            (list (analyze '(foo)) (analyze '(bar)))
            (list analyzed-foo analyzed-bar)
        (loop (car procs) (cdr procs)) =>
            (loop
                (lambda (env) (analyzed-foo env) (analyzed-bar env))
                '())

;返回: (lambda (env) (analyzed-foo env) (analyzed-bar env))