ch04 元语言抽象 part02
Scheme的变形：惰性求值
正则序和应用序
「正则序」把过程参数的求值操作延迟到最后的时刻（即被基本操作实际需要它们的时候） ，也被称为「惰性求值」。
- 如果某参数不用在进入过程体前完成求值，则称该过程相对于该参数是「非严格」的。
- 如果某参数需要在进入过程体前完成求值，则称该过程对于该参数是「严格」的。
(define (try a b) (if (= a 0) 1 b)) (try 0 (/ 1 0)) ;; 应用序时报错，正则序时返回1
对于以下的检查被除数不能为0的unless过程：
(define (unless condition usual-value exceptional-value) (if condition exceptional-value usual-value))
是无法正常工作的，因为Scheme是应用序的；如果它是正则序的， 那么对于以下的调用就可以对两个参数延迟求值，从而实现对异常参数的检查：
(unless (= b 0)
(/ a b)
(begin (display "exception: returning 0")
0))
练习 4.25
如果用应用序的unless来实现factorial过程：
(define (factorial n)
(unless (= n 1)
(* n (factorial (- n 1)))
1))
在参数为5时会有什么问题？在正则序语言里能正常工作么？
在应用序的scheme里，(* n (factorial (- n 1)))会被不断展开直到栈溢出。
在正则序中则会在(= n 1)时才回溯展开，直到得出结果：
n = 5
(= n 1)
(* n (factorial (- n 1)))
n' = (- n 1) = 4
(= n' 1)
(* n' (factorial (- n' 1)))
........
n'''' = (- (- (- (- n 1) 1) 1) 1) = 1
(= n'''' 1)
1
(* n''' 1) ; n''' = 2
(* n'' 2) ; n'' = 3
(* n' 6) ; n' = 4
(* n 24) ; n = 5
120
练习 4.26 惰性求值的实现方案
为了实现惰性求值的unless过程，可以把它合为一个特殊语法形式。
而这种特殊的语法形式是否会影响unless作为一个过程与高阶过程结合？
证明如何把unless实现为一种像cond和let一样的派生表达式，
再证明在哪些情况下，可以以过程而不是特殊形式实现。
作为特殊语法形式实现：
(define-syntax unless
(syntax-rules ()
[(unless condition usual-value exceptional-value)
(if condition
exceptional-value
usual-value)]))
(let ((a 10) (b 0))
(unless
(= b 0)
(display (/ a b))
(display "b = 0!")))
(newline)
在scheme方言guile的实现里，作为高阶函数map的参数会出错：
(map
unless
(list #t #f)
(list 1 2)
(list 0 0))
(define dont-run 1)
(include "4.1.scm")
(define old-eval eval)
(define (eval expr env)
(cond
((unless? expr) (eval (unless->if expr) env))
(else
(old-eval expr env))))
(define (unless? expr) (tagged-list? expr 'unless))
(define (unless-condition expr) (cadr expr))
(define (unless-usual-value expr) (caddr expr))
(define (unless-exceptional-value expr) (cadddr expr))
(define (unless->if expr)
(make-if
(unless-condition expr)
(unless-exceptional-value expr)
(unless-usual-value expr)))
(driver-loop)
一个采用惰性求值的解释器
修改4.1.1节的求值器：
- 复合过程的任何参数都是非严格的。
- 基本过程的任何参数都是严格的。
基本思路：
- 当应用一个过程时，解释器必须确定哪些参数需要求值，哪些需要延时求值。
- 不对延时求值的参数求值，而是将之变换为名叫「槽」（thunk）的对象。
- 槽里包含对该参数求值所需要的所有信息：参数表达式、相关环境。
对槽内表达式求值的过程被称为「强迫」，强迫求值的情况有：
- 传递给基本过程，而且基本过程需要求值。
- 作为条件表达式的谓词的值时。
- 作为运算符的值。
槽的「记忆性」：第一次强迫求值的结果保存起来，以后就不用重复算了。
- 「按需调用」的参数传递：带有记忆性的惰性求值。
- 「按名调用」的参数传递：不带记忆性的惰性求值。
练习4.27与练习4.29会讨论记忆性带来的问题。
修改求值器
在4.1.1节的基础上修改求值器。
eval过程里的application?部分用对象表达式去调用apply，而不是求出来的实参。
为了延时求值需要有环境，在这里也要作为参数传递。因为apply需要对具体过程应用，
所以还要对运算符求值，以便根据其类型去分派并应用它：
((application? exp)
(apply (actual-value (operator exp) env)
(operands exp)
env))
当需要表达式的实际值，不能用eval，而是要用actual-value。
如果表达式的值是一个槽，它就会被强迫求值出来。
新版本的apply表示把未求值的运算对象表达式传给eval过程：
- 对于基本过程是严格的，在应用这些过程前求值相关的参数。
- 对一复合过程是非严格的，应用这些过程时拖延对所有参数的求值。
(define (apply procedure arguments env)
(cond ((primitive-procedure? procedure)
(apply-primitive-procedure
procedure
(list-of-arg-values arguments env))) ; changed
((compound-procedure? procedure)
(eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-parameters procedure)
(list-of-delayed-args arguments env) ; changed
(procedure-environment procedure))))
(else
(error
"Unknown procedure type -- APPLY" procedure))))
类似4.1.1节里的list-of-values，新的list-of-delayed-args也会延时相关参数：
(define (list-of-delayed-args exps env)
(if (no-operands? exps)
'()
(cons (delay-it (first-operand exps) env)
(list-of-delayed-args (rest-operands exps)
env))))
而且list-of-arg-values用的是actual-value而不是eval：
(define (list-of-arg-values exps env)
(if (no-operands? exps)
'()
(cons (actual-value (first-operand exps) env)
(list-of-arg-values (rest-operands exps)
env))))
对if的处理也需要修改，用actual-value代替eval，便能在测试真假前得到谓词的值
：
(define (eval-if exp env)
(if (true? (actual-value (if-predicate exp) env))
(eval (if-consequent exp) env)
(eval (if-alternative exp) env)))
修改dirver-loop过程，用actual-value代替eval，这样在延时求值的值传播到
「读、求值、打印」循环中时，在打印之前将强迫对它们求值。另外还修改了提示符，
以表明这是一个惰性求值器：
(define input-prompt ";;; L-Eval input:")
(define output-prompt ";;; L-Eval value:")
(define (driver-loop)
(prompt-for-input input-prompt)
(let ((input (read)))
(let ((output
(actual-value input the-global-environment)))
(announce-output output-prompt)
(user-print output)))
(driver-loop))
启动求值器并测试它，调用4.2.1节里的try表达式：
(define the-global-environment (setup-environment)) (driver-loop) ;;; L-Eval input: (define (try a b) (if (= a 0) 1 b)) ;;; L-Eval value: ok ;;; L-Eval input: (try 0 (/ 1 0)) ;;; L-Eval value: 1
槽的表示
把过程应用于参数时并不对参数求值，而是创建相应的槽。以后强制求值时对槽求值：
- 槽必须包装为「一个表达式」和「一个环境」，以后才能生成实参。
-
强制求值时，从槽中取出表达式和环境。使用
actual-value而不是eval来求值。 - 如果表达式本身还是一个槽，那么继续对这个槽强制求值，直到得到某个不是槽的东西。
强制求值的过程实现：
(define (force-it obj)
(if (thunk? obj)
(actual-value (thunk-exp obj) (thunk-env obj))
obj))
把表达式和环境包装起来最方便的实现是用表，所以槽的封装如下：
(define (delay-it exp env) (list 'thunk exp env)) (define (thunk? obj) (tagged-list? obj 'thunk)) (define (thunk-exp thunk) (cadr thunk)) (define (thunk-env thunk) (caddr thunk))
以上的delay-it过程对于有记忆或没有记忆的情况都能工作。
当槽被强制求值时，它的表达式部分被值取代，并改变它的tunk标志，
表示它是一个已经被求值的槽。这样的实现就带有了记忆性：
(define (evaluated-thunk? obj)
(tagged-list? obj 'evaluated-thunk))
(define (thunk-value evaluated-thunk) (cadr evaluated-thunk))
(define (force-it obj)
(cond ((thunk? obj)
(let ((result (actual-value
(thunk-exp obj)
(thunk-env obj))))
(set-car! obj 'evaluated-thunk)
(set-car! (cdr obj) result) ; replace exp with its value
(set-cdr! (cdr obj) '()) ; forget unneeded env
result))
((evaluated-thunk? obj)
(thunk-value obj))
(else obj)))
为了节约内存空间，求值以后还可以用把env部分设置为空表'()的方式丢弃引用，
让无引用的对象被垃圾回收。
练习 4.27
如果把以下定义传给惰性求值器：
(define count 0) (define (id x) (set! count (+ count 1)) x)
应该怎么填空：
(define w (id (id 10))) ;;; L-Eval input: count ;;; L-Eval value: <response> ;;; L-Eval input: w ;;; L-Eval value: <response> ;;; L-Eval input: count ;;; L-Eval value: <response>
(define count 0)
(define (id x)
(set! count (+ count 1))
x)
(define w (id (id 10)))
; 此时 w 对应的值是 (list 'thunk '(id 10) env), 而count = 1
;input count
;value 1
;input w
;value 10
;input count
;value 2
练习 4.28
为了强迫求值「运算符」的「值」，eval在把运算符传给apply前要用actual-value
而不是eval求值。举例说明这里必须强迫求值。
(define (f x) (lambda (t) (+ x t))) (define (g f) (lambda (t) (f t))) (display (((g f) 3) 4)) ; (g f) => ; (lambda (t) ( ; (list 'thunk (lambda (t) (+ x t)) env) ; t))
练习 4.29
用一个程序来演示没有记忆功能会让速度慢很多。
另外，考虑以下交互，其中id过程在练习4.27里定义，count从0开始：
(define (square x) (* x x)) ;;; L-Eval input: (square (id 10)) ;;; L-Eval value: <response> ;;; L-Eval input: count ;;; L-Eval value: <response>
a) 有记忆：0.43s, 没记忆：9.3s
(define (fib i)
(if (<= i 2)
1
(+ (fib (- i 1)) (fib (- i 2)))))
(define (test x)
(define (iter t)
(if (= t 0)
0
(+ x (iter (- t 1)))))
(iter 10))
(test (fib 20))
(exit)
b)
(define count 0) (define (id x) (set! count (+ 1 count)) x) (define (square x) (* x x)) ;input (square (id 10)) ;value 100 ;input count ;value
-
有记忆，
(id 10)只会被eval一次 - 没记忆
练习 4.30
Fect认为有些副作用根本就不能实现，因为参数可能没有被用到所以来会被强制求值。
所以在求值一个序列时必须强迫序列中除了最后表达式外所有的表示式求值。
Fect认为应该修改4.1.1节中的eval-sequence，其中采用acutal-value而不是eval：
(define (eval-sequence exps env)
(cond ((last-exp? exps) (eval (first-exp exps) env))
(else (actual-value (first-exp exps) env)
(eval-sequence (rest-exps exps) env))))
a)Ben认为Fect的看法不对，以2.23节中带有副作用的for-each过程为例：
(define (for-each proc items)
(if (null? items)
'done
(begin (proc (car items))
(for-each proc (cdr items)))))
用本节正文中的求值器eval-sequence能够正常处理，比如用以下参数调用：
;;; L-Eval input: (for-each (lambda (x) (newline) (display x)) (list 57 321 88)) 57 321 88 ;;; L-Eval value: done
为什么Ben的说法是正确的？
解释：x是传递给primitive procedure(display)的，所以会被求值。
b) Fect认为存在另一种情况，比如在惰性求值器里定义了以下两个过程：
(define (p1 x)
(set! x (cons x '(2)))
x)
(define (p2 x)
(define (p e)
e
x)
(p (set! x (cons x '(2)))))
对于本节正文中的eval-sequence，(p1 1)和(p2 1)的值是什么？
对于修改后的eval-sequence又会是什么？
原eval-sequence：
(p1 1) => (list 1 2) ;因为set!是primitive procedure
(p2 1)
(eval (p (set! x (cons x '(2)))) ENV[x=1])
;ENV1[e:(list 'thunk '(cons x '(2)) ENV[x=1])] --> ENV[x=1]
(eval 'e ENV1) => (list 'thunk '(cons x '(2)) ENV[x=1])
;ENV1[e:(list 'thunk '(cons x '(2)) ENV[x=1])] --> ENV[x=1]
x => 1
新eval-sequence：
(p1 1) => (list 1 2)
(p2 1)
(eval (p (set! x (cons x '(2)))) ENV[x=1])
;ENV1[e:(list 'thunk '(cons x '(2)) ENV[x=1])] --> ENV[x=1]
(actual-value 'e ENV1) => 'done
;ENV1[e:(list 'evaluated-thunk 'done), x:(list 1 2)] --> ENV[x=1]
x => (list 1 2)
c) 证明修改后的eval-sequence不会对问题「a」中的情况有影响。
解释：新版本的eval-sequence与旧版本的区别在于如果序列中任意语句的返回值是槽，
都会被求值。a中代码display的返回值显然不是thunk，因此不受影响。
d) 你认为惰性求值器里应该如何处理序列瓿？是Fect的方法还是Ben的方法还是别的方法？
似乎Fect的方法更加合理。
另一个观点： I prefer the original style. In my opinion (and this is an opinion question), a normal order interpreter should ONLY force a thunk that is needed. Since only the final value of the sequence is used (returned) the others are not needed and should not be forced. This is for consistency.
练习 3.31
本节对求值器的修改与Scheme原生的语法不兼容，更加理想的惰性求值实现应该是 「向上兼容」的：原来的Scheme还是用应用序，用户可以控制是否让参数延时求值。 更进一步可以让用户选择是否在参数延时求值时启用记忆性。如下例：
(define (f a (b lazy) c (d lazy-memo)) ...)
这样在四个参数里：
-
b的lazy声明采用延时求值。 -
d的lazy-memo声明采用带有记忆性的延时求值。
请实现这样的特性：
不写lazy-memo了，太麻烦了。。。
(define (apply procedure arguments env)
(cond
((primitive-procedure? procedure)
(apply-primitive-procedure
procedure
(list-of-arg-values arguments env)))
((compound-procedure? procedure)
(eval-compound-procedure procedure arguments env))
(else
(error "Unknown procedure type -- APPLY" procedure))))
(define (eval-compound-procedure procedure arguments env)
(define (iter-args formal-args actual-args)
(if (null? formal-args)
'()
(cons
(let ((this-arg (car formal-args)))
(if (and (pair? this-arg)
(pair? (cdr this-arg)) ; avoid error if arg is
; 1 element list.
(eq? (cadr this-arg) 'lazy))
(delay-it (car actual-args) env)
;force the argument if it is not lazy.
(actual-value (car actual-args) env)))
(iter-args (cdr formal-args) (cdr actual-args)))))
(define (procedure-arg-names parameters)
(map (lambda (x) (if (pair? x) (car x) x)) parameters))
(eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-arg-names (procedure-parameters procedure))
(iter-args
(procedure-parameters procedure)
arguments)
(procedure-environment procedure))))
(driver-loop)
;; test ;;
;
; M-Eval input:
;(define x 1)
;
; M-Eval value:
;ok
;
; M-Eval input:
;(define (p (e lazy)) e x)
;
; M-Eval value:
;ok
;
; M-Eval input:
;(p (set! x (cons x '(2))))
;
; M-Eval value:
;1
;
; M-Eval input:
;(exit)
;
将流作为惰性的表
之前实现的惰性示值表引入了特殊形式delay和cons-stream。这有两个缺点：
- 特殊形式不是过程，所以不能与高阶过程一起使用（所以练习4.26是有问题的）。
- 创建的流与表不是同一类对象，为了让流实现表的所有功能，还要重新实现一遍。
在有了惰性求值以后，就不需要特殊形式了，还可以直接用表来作为流。
所要做的工作就是让cons成为非严格的。实现的方法有两种：
-
扩充惰性求值器，允许非严格的基本过程，再把
cons实现为其中的一个。 -
更简单的方式是结合2.1.3节的内容，不把
cons实现为基本过程， 而是把序对表示为基本过程。
把序对实现为基本过程的实现如下：
(define (cons x y) (lambda (m) (m x y))) (define (car z) (z (lambda (p q) p))) (define (cdr z) (z (lambda (p q) q)))
从本质上来说，任何过程性表示都可以用这种方式实现（例如，消息传递实现）。
可以简单地把这些定义放进驱动循环里，从而将它们安装到惰性求值里。
如果已经将cons、car、cdr作为全局环境里的基本过程，就重新定义他们了。
用这种序对实现的表也可以作为无穷的表（或流），例如以下操作：
(define (list-ref items n)
(if (= n 0)
(car items)
(list-ref (cdr items) (- n 1))))
(define (map proc items)
(if (null? items)
'()
(cons (proc (car items))
(map proc (cdr items)))))
(define (scale-list items factor)
(map (lambda (x) (* x factor))
items))
(define (add-lists list1 list2)
(cond ((null? list1) list2)
((null? list2) list1)
(else (cons (+ (car list1) (car list2))
(add-lists (cdr list1) (cdr list2))))))
(define ones (cons 1 ones))
(define integers (cons 1 (add-lists ones integers)))
;;; L-Eval input:
(list-ref integers 17)
;;; L-Eval value:
18
注意这里的表比第三章里实现的更加惰性：不光cdr是延时的，连car也是延时的。
惰性求值对于3.5.4节中使用流所引起的问题也有帮助。当时用循环做出系统的流模型时，
除了用cons-stream提供的delay操作以外，还要在其他的地方加上delay操作。
而有了惰性求值以后，所有的参数都延时了。
例如用3.5.4节所希望的方式做表的积分，从而示解微分方程：
(define (integral integrand initial-value dt)
(define int
(cons initial-value
(add-lists (scale-list integrand dt)
int)))
int)
(define (solve f y0 dt)
(define y (integral dy y0 dt))
(define dy (map f y))
y)
;;; L-Eval input:
(list-ref (solve (lambda (x) x) 1 0.001) 1000)
;;; L-Eval value:
2.716924
练习 4.32
举例说明第3章的流与这里「更惰性」的表之间的区别，以及如何利用这些多出来的惰性？
本节的「更惰性」表现在一个序对的car也是被延迟求值的。例如以下程序不会出错：
(cons (/ 1 0) (/ 1 1))
利用：可以用来建立二叉树，树的左右节点都是延迟求值的。例如：
对一个区间进行不断的二分
(define (interval low high)
(let ((mid (/ (+ low high) 2)))
(cons
(cons low high)
(cons
(interval low mid)
(interval mid high)))))
练习 4.33 惰性的引号表达式
读入一个引号表达式面得到的「表」与cons、car、cdr的新定义操作的表是不同的， 所以以下表达式在惰性求值时会出错：
(car '(a b c))
修改求值器，让驱动循环读入引号表达式也能道德出惰性的表。
较差的实现：依赖于cons的实现：
(define dont-run-now 1)
(include "4.2.3-full.scm")
(define (text-of-quotation expr)
(define (new-list pair)
(if (null? pair)
'()
(make-procedure
'(m)
(list (list 'm 'car-value 'cdr-value))
(extend-environment
(list 'car-value 'cdr-value)
(list (car pair) (new-list (cdr pair)))
the-empty-environment))))
(let ((text (cadr expr)))
(if (not (pair? text))
text
(new-list text))))
meteorgan's solution @ http://community.schemewiki.org/?sicp-ex-4.33
不依赖于cons的具体实现，更好：
(define prev-eval eval)
(define (eval expr env)
(if (quoted? expr)
(text-of-quotation expr env)
(prev-eval expr env)))
(define (text-of-quotation expr env)
(let ((text (cadr expr)))
(if (pair? text)
(eval (make-list text) env)
text)))
(define (make-list expr)
(if (null? expr)
(list 'quote '())
(list 'cons
(list 'quote (car expr))
(make-list (cdr expr)))))
(if (not (defined? 'dont-run-any))
(driver-loop)
)
练习 4.34 打印惰性表
修改驱动循环，打印出惰性的表。如果是无穷表怎么片？ 可能还要修改惰性序对，才能让示值器识别它们。
(define dont-run-any 1)
(include "4-33.scm")
(map (lambda (name obj)
(define-variable! name (list 'primitive obj) the-global-environment))
(list 'raw-cons 'raw-car 'raw-cdr)
(list cons car cdr))
;#|
(actual-value
'(begin
(define (cons x y)
(raw-cons 'cons (lambda (m) (m x y))))
(define (car z)
((raw-cdr z) (lambda (p q) p)))
(define (cdr z)
((raw-cdr z) (lambda (p q) q)))
)
the-global-environment)
;|#
(define (disp-cons obj depth)
(letrec ((user-car (lambda (z)
(force-it (lookup-variable-value 'x (procedure-environment (cdr z))))))
(user-cdr (lambda (z)
(force-it (lookup-variable-value 'y (procedure-environment (cdr z)))))))
(cond
((>= depth 10)
(display "... )"))
((null? obj)
(display ""))
(else
(let ((cdr-value (user-cdr obj)))
(display "(")
(display (user-car obj))
(if (tagged-list? cdr-value 'cons)
(begin
(display " ")
(disp-cons cdr-value (+ depth 1)))
(begin
(display " . ")
(display cdr-value)))
(display ")"))))))
(define (user-print object)
(if (compound-procedure? object)
(display
(list 'compound-procedure
(procedure-parameters object)
(procedure-body object)
'<procedure-env>))
(if (tagged-list? object 'cons)
(disp-cons object 0)
(display object))))
(driver-loop)