三分 的个人资料3fen's Notebook照片日志列表更多 ![]() | 帮助 |
|
8月25日 SICP 4.2Section 4.2.1 4.25 用非特殊形式的unless计算factorial会出现死循环,这是由于(factorial n)会不断的计算(factorial (- n 1))、(factorial (- (- n 1) 1))...而在此之前不会考虑过程体里面的if过程。 在正则序语言中可以。其实所谓正则序语言,并不是全部过程都不优先对参数求值(那样就永远得不到结果了...),也是要有一些严格的基本过程做基础如if/cond等。这样在调用unless时对condition/usual-value/exception-value都会延迟求值,直到(= n 1)的判断时才会对n求值进而做判断是要执行usual-value还是exception-value。这样(factorial n)就能正常工作了。 4.26 实现: (define (eval-unless exp env) (eval (make-if (unless-pred exp) (unless-exception exp) (unless-usual exp)) env)) (define (unless-pred exp) (cadr exp)) (define (unless-exception exp) (cadddr exp)) (define (unless-usual exp) (caddr exp)) 然后加入安装包(put 'eval 'unless eval-unless) 但是如此生成为特殊形式,在环境中是不会有unless这个变量的。 比如定义这个过程,定义一个unless过程就是必要的: (define (if-or-unless operator pred consequent alternative) (operator pred consequent alternative)) 这里operator可以取if或者unless(可能把if生成表达式也是件麻烦事)。 Section 4.2.2 4.27 ;;; L-Eval input: count ;;; L-Eval output: 1 ;;; L-Eval input: w ;;; L-Eval output: 10 ;;; L-Eval input: count ;;; L-Eval output: 2 与应用序不同之处在(define w (id (id 10)))之后,count变为1而不是2. 原因是只有外层的id被执行了,而内层的id被延迟到求w时才得到执行。如果用带有记忆功能的force-it,以后再求值w时count不会变,否则每次count加1. 4.28 两者的不同之处就在于操作符的求值,所以找个操作符需要求值的例子: (define (foo x) x) ((foo +) 10 20) 如果按照题中的做法,用eval而不是actual-value求(foo +)的值,会得到一个以'thunk开始的list,而不是(primitive +),结果就是使apply报错。 4.29 主要不同体现在执行完(square (id 10))后count的值上。 有记忆功能的force-it会显示1,否则是2. 开始对这个save功能有些误解,以为可以实现类似ex 3.27中memorize的功能,使得诸如(fib 10)的求值过程在不同的调用中只执行一次。后来发现错了,这里的记忆功能只限于某个过程之内,只有当其参数被求值不止一次时,速度优势才会显现出来。 比如factorial: (define (fact n) (if (= n 1) 1 (* n (- n 1)))) 这里之所以能提高效率,是因为过程中对n的调用有3次。这样没有记忆功能的force-it就会对('thunk n)进行三次eval的求值,而有记忆功能的force-it只执行一次,之后两次就是简单的取thunk-value即可。 4.30 a) 争议部分在于(proc (car items))这一句,如果它得不到执行,那么就是Ben理解的Cy的意思;反之则是Ben反驳Cy的观点。跟踪一下for-each的执行过程可以发现,在这句执行时,其环境中proc的值应该是('thunk (lambda(x) (newline) (display x)) <env>)。通过eval对application部分的实现可知,这里proc作为操作符是要经过actual-value后才传给apply,所以此句可以执行并且得到执行。 b) 用原来的eval-sequence,(p1 1)和(p2 1)分别返回(1 2)和1。 (p1 1)返回(1 2)的原因与for-each类似,而(p2 1)中赋值语句没有得到执行的原因是(set! x (cons x '(2)))被放在了参数的位置上,而不是像proc那样放在操作数的位置上——参数是会被延迟求值的,又因为eval-sequence中对每个过程使用eval而不是actual-value求值,这里(eval e env)的结果是('thunk (set! x (cons x '(2))) <env>)。 如果应用的Cy的建议,那么两者都会返回(1 2)。对于(p2 1),与原来不同的是eval-sequence对每个过程用了actual-value。那么执行到e时,实际的求值语句是(force-it (eval e env)),也就是对('thunk (set! x (cons x '(2))) <env>)进行了force-it操作。 c) 因为force-it语句中对参数是否为thunk有判断,对于没有thunk标签的过程也可以得到正确执行。 d) 个人感觉Cy的更好一些。首先Cy的过程没有违反惰性求值的要求——对象只有在需要时才求值,而且改正了原过程在某些情况下会犯的错误。比如(p2 1),其中e在被需要时得到求值,但是我们并不希望某个变量求值以后得到的结果会是带有thunk头的这种内部形式,这样来看,原过程实际上可以认为是有错误的。 4.31 正则序和应用序在本章实现的解释器上主要区别就在与apply中一般过程(compound-procedure)中参数部分的处理:是list-of-true-value还是list-of-delayed-value。本题把这种不同变得更加一般化,那就是使一列参数中的不同个体可以用不同策略,而不是全部actual-value或者delay。 所以,我们只要控制不同的参数加入环境中的值即可,再由force-it根据环境中的值来决定采取何种策略来返回。 我通过(helper hvars hvals env)过程读入形参和实参,经过判断、求值返回一个序对,car和cdr就是可以直接加入环境的值。 ;-----apply-helper------- (define (helper hvars hvals env) (if (= (length hvars) (length hvals)) (let ((new-vars (map (lambda (var) (cond ((lazy-memo? var) (car var)) ((lazy? var) (car var)) ((not (pair? var)) var) (else (error "Wrong parameter " var)))) hvars)) (new-vals (map (lambda(var val) (cond ((lazy-memo? var) (delay-it-memo val env)) ((lazy? var) (delay-it val env)) (else (actual-value val env)))) hvars hvals))) (cons new-vars new-vals)) (if (< (length hvars) (length hvals)) (error "Too Many vals" hvars hvals) (error "Too Few vals" hvars hvals)))) (define (lazy-memo? var) (and (pair? var) (eq? (cadr var) 'lazy-memo))) (define (lazy? var) (and (pair? var) (eq? (cadr var) 'lazy))) 这样可以把apply修改为: (define (apply procedure args env) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure (list-of-true-value args env))) ((compound-procedure? procedure) (let ((env-result (helper (procedure-parameters procedure) args env))) (eval-sequence (procedure-body procedure) (extend-environment (car env-result) (cdr env-result) (procedure-environment procedure))))) (else (error "Unknown procedure type--APPLY" procedure)))) 稍微修改一下force-it: (define (force-it obj) (cond ((thunk? obj) (actual-value (thunk-exp obj) (thunk-env obj))) ((thunk-memo? obj) (let ((result (actual-value (thunk-exp obj) (thunk-env obj)))) (set-car! obj 'evaluated-thunk) (set-car! (cdr obj) result) (set-cdr! (cdr obj) '()) result)) ((evaluated-thunk? obj) (thunk-value obj)) (else obj))) (define (thunk-memo? obj) (tagged-list? obj 'thunk-memo)) (define (delay-it-memo exp env) (list 'thunk-memo exp env)) 测试用例: 1. (try 0 (/ 1 0))对于下面定义的执行情况: (define (try a b) (if (= a 0) 1 b)) (define (try a (b lazy)) (if (= a 0) 1 b)) 2. 比较执行(factorial 1000)速度 (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (define (factorial (n lazy)) (if (= n 1) 1 (* n (factorial (- n 1))))) (define (factorial (n lazy-memo)) (if (= n 1) 1 (* n (factorial (- n 1))))) ps: 开始看到参数中(b lazy),lazy没有加上引号觉得奇怪,后来明白参数是直接传过去不经过求值的,也就不可以加上引用符号。 Section 4.2.3 可以用类似下面的方式来安装这些过程: (define (install-compound-procs) (actual-value '(begin (define (cons x y) (lambda(m) (m x y))) (define (car x) (x (lambda(p q) p))) (define (cdr x) (x (lambda(p q) q)))) the-global-environment) ‘done) 4.32 巧了,第三章讨论过所谓的odd/even stream,也就和这里提到的"更加惰性"的表一样。 4.33 用的是类似于之前cond->if的派生表达式的做法,把'(1 2 3)改写为嵌套的cons,然后在环境中求值。 (define (text-of-quotation exp env) (define (helper x) (if (not (pair? x)) x (list 'cons (car x) (helper (cdr x))))) (if (not (pair? (cadr exp))) (cadr exp) (actual-value (helper (cadr exp)) env))) (put 'eval 'quote (lambda(exp env) (text-of-quotation exp env))) 4.34 比预想的要麻烦... 对于序对的表示,我只把car打印出来,这样有穷或是无穷的序对对此来说也没什么不同了。Drscheme本身的解释器功能比较强大,能打印出有环的序列。 大体思路是这样的:首先让解释器能识别出cons生成的过程与一般的过程的区别,然后在user-print中对其用car进行调用,得出结果打印。 为了让解释器分清cons与一般过程的不同,我新定义了一种语法形式special-lambda,相应的make-special-proc (define (make-special-procedure name parameters body env) (list (cons 'special-procedure name) parameters body env)) 可以看到,这里多出一个name参数,使得它有一定的扩展性,而不只是检测cons这一个特殊过程。这样定义,也可以沿用原来的procedure-parameters和procedure-body过程。 相关的选择过程: (define (special-procedure? proc) (if (pair? proc) (if (pair? (car proc)) (eq? (caar proc) 'special-procedure) false) false)) (define (name-of-special-proc s-proc) (cdr (car s-proc))) 加入求值器: (put 'eval 'special-lambda (lambda(exp env) (make-special-procedure (special-lambda-name exp) (special-lambda-parameters exp) (special-lambda-body exp) env))) (define (special-lambda-name exp) (cadr exp)) (define (special-lambda-parameters exp) (caddr exp)) (define (special-lambda-body exp) (cdddr exp)) 这样就可以这样定义cons: (define (cons x y) (special-lambda cons (m) (m x y))) apply过程需要修改,以便于识别special-procedure: (define (apply procedure args env) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure (list-of-true-value args env))) ((special-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) (list-of-delayed-args args env) (procedure-environment procedure)))) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) (list-of-delayed-args args env) (procedure-environment procedure)))) (else (error "Unknown procedure type--APPLY" procedure)))) 现在定义的cons已经可以运行,下面是打印过程的修改(只修改user-print即可): (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) '<procedure-env>)) (if (special-procedure? object) (if (eq? (name-of-special-proc object) 'cons) (display (list (force-it (apply object '((lambda(p q) p)) the-global-environment)) 'cdr-promise)) (display object))))) 效果: ;;; L-Eval input: (cons 1 2) ;;; L-Eval output: (1 cdr-promise) ;;; L-Eval input: integers ;;; L-Eval output: (1 cdr-promise) ;;; L-Eval input: (cdr integers) ;;; L-Eval output: (2 cdr-promise) 8月19日 SICP 4.1.4 - 4.1.7这第一章写了三个星期…… Section 4.1.4 4.14 Louis同学直接引入的map不能使用的原因,是由于忽略了所求值语言和所用的scheme语言两者实现的不同。 考察这个过程: (map (lambda(x) (+ 1 x)) '(1 2 3)) 我们写的eval过程把它转换成 (apply (eval (operator exp) env) (list-of-values (operands exp) env)) 在operator这部分并没有出现问题,即把map当作primitive-procedure进行匹配;问题出在参数上,参数按照我们写的解释器中的语法求值,而map调用的确实我们编程环境所用的scheme的语法规则。在这里,这个不同具体体现在过程的表示上,我们写的解释器表示过程用的是('procedure <args> <body> <env>)的形式,而scheme看起来实际上并不是恰好这样表示的(比如('closure <args> <body> <env>)之类的)。这就是map直接安装为primitive-procedure出错的原因。 这也解释了如果我们简单写一个(define (add-1 x) (+ 1 x)),而把add-1作为primitive-procedure安装到求值器中,运行结果正常的现象。 Section 4.1.5 4.15 如果(try try)能停止,即(halts? try try)那么根据try的定义,它将run-forever;如果(try try)无限运行,则(halts? try try)为假,也就可以停机。矛盾出现。 Section 4.1.6 4.16 a) 添一句(if (eq? result '*unassigned*) (error "Unbound variable" var) 就ok了 b) scan-out-defines是用来改写lambda表达式中的body的。 (define (scan-out-defines procs) (let ((defines (exp-defines procs))) (if (null? defines) procs (let ((vars (defines-vars defines)) (bodies (defines-bodies defines))) (list (make-let (map (lambda(x) (list x ''*unassigned*)) vars) ;*unassigned*需要两个引号 (make-begin (append (map (lambda(var val) (list 'set! var val)) vars bodies) (exp-body procs))))))))) (define (exp-defines procs) (filter definition? procs)) (define (exp-body procs) (filter (lambda(x) (not (definition? x))) procs)) (define (defines-vars defs) (map definition-variable defs)) (define (defines-bodies defs) (map definition-value defs)) c) 评定安装在那个位置好的标准定为哪种方案重复执行的次数最少。 推测放在eval中和放在make-procedure是一样的,而放在procedure-body中会执行的多一些。 写了一个测试执行时间的程序: (define eval-easy (lambda(x) (eval x the-global-environment))) (define (test-eval proc) (start-test proc (current-inexact-milliseconds))) (define (start-test proc time) (eval-easy proc) (- (current-inexact-milliseconds) time)) (define (test-eval-n proc n) (if (= n 0) 0 (+ (test-eval proc) (test-eval-n proc (- n 1))))) 用一个求乘方的过程来比较三者的效率: (test-eval-n '(begin (define (expt-x xx) (define (expt x n) (if (= 0 n) 1 (* x (expt x (- n 1))))) (define x 12345) (expt 12345 xx)) (expt-x 10000)) 100) 发现放入解释器和放入make-procedure结果是差不多的,而放入procedure-body会慢一些,符合预测。 4.17 图不画了。顺序执行的情况,u和v都是直接定义在所处环境里面,而通过scan-out-defines后u和v是作为参数应用到<e3>里,所以多了一层环境。 如果不构造额外的框架,那么就直接把u和v用define放进环境里面: (define (scan-out-defines procs) (let ((defines (exp-defines procs))) (if (null? defines) procs (let ((vars (defines-vars defines)) (bodies (defines-bodies defines))) (append (map (lambda(x) (make-definition x ''*unassigned*)) vars) (append (map (lambda(var val) (list 'set! var val)) vars bodies) (exp-body procs))))))) 4.18 推测本题的过程不能用,而原文中的可以。那个a和b的“中转”作用,我认为是可以和直接set!等价的,问题出在顺序上。 (define (solve f y0 dt) (define y (integral (delay dy) y0 dt)) (define dy (stream-map f y)) y) 当时在第三章中试过,由于y定义中有(delay dy),而dy定义中没有(delay y),这样如果交换y和dy的定义顺序,程序是不能运行的。原文中是先给u赋值,再给v赋值;而本题我们知道同一层let中定义的变量相互是不可见的,所以在(a <e1>)没问题,当(b <e2>)时,所需要的u并不是(integral (delay dy) y0 dt),而是*unassigned*,出错。如果把let改为let*,我想是可以成功的。 4.19 正像脚注所说的,Ben的观点是错误的,而Eva的观点实现起来有难度。 或许下面解决方案可行: 如果同一框架中有n个definition,那么就先用4.16中的方法给每个变量赋值*unassigned*。然后按下列规则扫描n次这些define语句:如果某条语句中变量全部能找到值,则执行该语句;如果某变量找到的值为*unassigned*,则此轮跳过该语句;否则报错。这样本题中问题就可以的到解决:首轮跳过b的定义,经过首轮内部a定义为5后,第二轮获得b的正确结果。 就是代价太高了。 4.20 a) 巧了,这里恰好可以用之前写得那个let*->defs过程,就是把let*写成一个个的define。 (define (eval-letrec exp env) (eval (letrec->defs exp) env)) (define (letrec-defs exp) (cadr exp)) (define (letrec-body exp) (caddr exp)) (define (letrec-defs->definitions defs) (if (null? defs) '() (let ((first (car defs))) (cons (make-definition (car first) (cadr first)) (letrec-defs->definitions (cdr defs)))))) (define (letrec->defs exp) (cons 'begin (append (letrec-defs->definitions (letrec-defs exp)) (list (letrec-body exp))))) 添加到eval安装包: (put 'eval 'letrec eval-letrec) b) 主要原因是let不允许递归(用letrec解决),而且同一级let的变量之间相互不是可见的(用let*解决)。 4.21 a) "递归程序设计的诡计",怎么想出来的呢。还有那个Y运算符,目的是用Y来实现用有限的过程表示无限的递归调用,而如果所要调用的函数存在不动点,则用Y可以求出来。 (define (fibnacci n) ((lambda(fib) (fib fib n)) (lambda(fb k) (cond ((= k 0) 1) ((= k 1) 1) (else (+ (fb fb (- k 1)) (fb fb (- k 2)))))))) b) 照猫画虎了... (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)))))) Section 4.1.7 4.22 这种语法分析与运行的分离感觉挺巧妙的,文中做的很是简单,大部分代码都能原封不动的继续用。我感觉需要稍微注意一下的地方就是analyze-assignment/analyze-definition中的变量名部分是不需要analyze的,而vproc部分在写进环境的不是语法分析的结果,而是需要应用到env上的结果。 写这个let跟4.6差不多: (define (analyze-let exp) (let ((vars (map car (let-bindings exp))) (vals (map cadr (let-bindings exp))) (body (let-body exp))) (analyze (cons (make-lambda vars (list body)) vals)))) (define (let-bindings x) (cadr x)) (define (let-body x) (caddr x)) 加入到包中:(put 'analyze 'let analyze-let) 4.23 试了几个例子,发现两者得出的结果是一样的,就有些困惑了。分析了一遍两者的运行过程,隐约觉得文中的舒服些,这里的有些别扭。后来看了下Eli的答案,原来区别不在于结果上。 比如一个过程序列(P1 P2 P3),文中的analyze-sequence会直接把它分析为: (lambda(env) ((lambda(env) ((lambda(env) (P1 env)) env) (P2 env)) env) (P3 env)) 然后直接在eval中应用到env上; 而本题的过程,语法分析和运行两者交织在一起,没有env时,execute-sequence是不能运行的。 也就是说,区别在于求值的过程,而不在于求值的结果。 4.24 用的4.16中的那个简单的整体测时间程序,用乘方来做实例: (test-eval '(begin (define (expt-x xx) (define (expt x n) (if (= 0 n) 1 (* x (expt x (- n 1))))) (define x 12345) (expt 12345 xx)) (expt-x 10000))) 元循环求值器用了1300ms左右, 这里用了750ms 至于评估各种过程……设计实例太麻烦了,因为一句话的过程两者的运行时间都是0.0 8月14日 SICP 4.1.3先播放一个通知:ocaml.cn关闭,取而代之的是个叫做"babelnova.net"的新社区——就换了个名字,里面内容好像没怎么变。 这个"babel"指的是巴别塔,来源于圣经的一个小故事:大洪水过后,人们从方舟上下来闲的蛋疼,想建立一座通天塔,用来显示人类的力量和团结,这就是巴别塔。神们为了自己尊贵的地位,开始阻挠巴别塔的修建。手段就是让原本只说一种语言的人类交流不通,产生了N种不同的语言,最终成功组织了塔的通天。 Section 4.1.3 4.11 挺多过程都需要改: (define (make-frame vars vals) (map list vars vals)) ;make-frame在extend-environment中还要用到 (define (add-binding-to-frame! var val frame) (set-cdr! frame (cons (car frame) (cdr frame))) (set-car! frame (list var val))) (define (frame-var binding) (car binding)) (define (frame-val binding) (cadr binding)) lookup-variable-value/set-variable-value!/define-variable! 这三个过程都需要修改 (define (lookup-variable-value var env) (define (env-loop env) (define (scan bindings) (cond ((null? bindings) (env-loop (enclosing-environment env))) ((eq? var (frame-var (car bindings))) (frame-val (car bindings))) (else (scan (cdr bindings))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan frame)))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan bindings) (cond ((null? bindings) (env-loop (enclosing-environment env))) ((eq? var (frame-var (car bindings))) (set-car! (cdr (car bindings)) val)) (else (scan (cdr bindings))))) (if (eq? env the-empty-environment) (error "Unbound variable--SET!" var) (let ((frame (first-frame env))) (scan frame)))) (env-loop env)) (define (define-variable! var val env) ;只在当前frame里面活动,所以没有env-loop (let ((frame (first-frame env))) (define (scan bindings) (cond ((null? bindings) (add-binding-to-frame! var val frame)) ((eq? var (frame-var (car bindings))) (set-car! (cdr (car bindings)) val)) (else (scan (cdr bindings))))) (scan frame))) 而初始环境the-global-environment不需要修改的原因就是构造过程已经抽象为make-frame了。 4.12 本题采用的frame表示为原文的表示方法,而不是4.11中的。 开始只想到把scan抽象出来,至于返回值或者赋值的选择作为一个参数传过去;写出来后觉得相当丑陋,思路不清。从Eli那里看到一个比较清晰的抽象:对frame的两个操作——查找和赋值。 (define (lookup-frame var vars values) ;找到了返回相应值, 否则返回next,不简单的用'()是因为(car values)可能为'() (cond ((null? vars) 'next) ((eq? var (car vars)) (car values)) (else (lookup-frame var (cdr vars) (cdr values))))) (define (set-frame-binding! var val vars values) ;找到了改变其值,并返回新值,否则返回next (cond ((null? vars) 'next) ((eq? var (car vars)) (begin (set-car! values val) val)) (else (set-frame-binding! var val (cdr vars) (cdr values))))) 这样改写这三个过程: (define (lookup-variable-value var env) (define (env-loop env) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (let ((result (lookup-frame var (frame-variables frame) (frame-values frame)))) (if (not (eq? result 'next)) result (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 variable--SET!" var) (let ((frame (first-frame env))) (let ((result (set-frame-binding! var val (frame-variables frame) (frame-values frame)))) (if (not (eq? result 'next)) result (env-loop (enclosing-environment env))))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (let ((result (set-frame-binding! var val (frame-variables frame) (frame-values frame)))) (if (not (eq? result 'next)) result (add-binding-to-frame! var val frame))))) 这样写出来整齐多了,美~ 4.13 觉得define与set!不同,添加define的时候是只改变当前框架中的定义,类似的删除一个define也应只在当前框架内进行。 (define (make-unbound! var env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (begin (display "not found") '())) ((eq? var (car vars)) (begin (set-car! vars (cadr vars)) (set-cdr! vars (cddr vars)) 'done)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (eval-undefine! exp env) (make-unbound! (eval (cdr exp) env) env)) 最后在install-package中加入eval-undefine!: (put 'eval 'undefine! eval-undefine!) 8月11日 SICP 4.1.1-4.1.2猛地碰上一大段东西就不想看了……像2.5的通用算数、3.3.4中的数字电路,这次的Meta循环更是如此。其实难度倒是不深,就是东西太多了。 本小节的视频里头,Sussman大叔再讲完eval-apply循环后摇身一变,穿上袍子拿起火柴棍做了个魔法师的扮相。很有意思。 --08.8.18修改:4.6中let的错误 --08.8.19修改 : 随着let衍生的let* /name-let 等错误 Section 4.1.1 4.1 用let把值先求出来就好了 (define (list-of-values exps env) (if (no-operands? exps) '() (let ((rest-result (list-of-values (rest-operands exps) env))) (cons (eval (first-operand exps) env) rest-result)))) Section 4.1.2 4.2 a) 出错:Unbound variable: define b) 由于整个系统模块化做的很好,所以修改一下appplication?及其选择函数就行。 (define (application? exp) (tagged-list? exp 'call)) (define (operator exp) (cadr exp)) (define (operands exp) (cddr exp)) 需要注意的是以后即使是primitive-procedrue也要加上call。比如平方和过程: (define (square x) (call * x x)) (define (sum-sq x y) (call + (call square x) (call square y))) 4.3 就像2.73里面一样,由于self-evaluating和variable都没有tag用来标记,所以需要写在cond中;而application也是没有tag,而且存在4.2中所说的顺序问题,所以加载special-form的数据导向分派的后面。运行driver-loop前先加载install-eval-package。 (define (eval exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((get 'eval (get-tag exp)) ((get 'eval (get-tag exp)) exp env)) ((application? exp) (apply (eval (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type--EVAL" exp)))) (define (install-eval-package) (put 'eval 'if eval-if) (put 'eval 'quote (lambda(exp env) (text-of-quotation exp))) (put 'eval 'set! eval-assignment) (put 'eval 'define eval-definition) (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))) 'done) (define (get-tag x) (if (pair? x) (car x) (error "Not a pair--get-tag" x))) 4.4 a) (define (eval-and exp env) (if (null? (and-clauses exp)) (error "No args--AND" exp) (let ((first (first-clause (and-clauses exp)))) (cond ((last-exp? (and-clauses exp)) (eval first env)) ((false? (eval first env)) false) (else (eval-and (rest-clauses exp) env)))))) ;;最后一句(else (eval-and (rest-clauses exp) env)) 道理上有些不对,不过实际上结果是正确的。 (define (eval-or exp env) (if (null? (or-clauses exp)) (error "No args--AND" exp) (let ((first (first-clause (or-clauses exp)))) (cond ((last-exp? (or-clauses exp)) (eval first env)) ((true? (eval first env)) true) (else (eval-or (rest-clauses exp) env)))))) (define (and-clauses exp) (cdr exp)) (define (or-clauses exp) (cdr exp)) (define (first-clause clauses) (car clauses)) (define (rest-clauses clauses) (cdr clauses)) 然后在eval包中加入: (put 'eval 'and eval-and) (put 'eval 'or eval-or) b) 派生表达式: (define (eval-and-if exp env) (eval (and->if (and-clauses exp) env) env)) (define (and->if clauses env) (if (null? clauses) 'true (let ((first (car clauses))) (if (last-exp? clauses) first (make-if first (and->if (rest-clauses clauses) env) 'false))))) (define (eval-or-if exp env) (eval (or->if (or-clauses exp) env) env)) (define (or->if clauses env) (if (null? clauses) 'true (let ((first (car clauses))) (if (last-exp? clauses) first (make-if first 'true (or->if (rest-clauses clauses) env)))))) 同样,在eval包中加入 (put 'eval 'and eval-and-if) (put 'eval 'or eval-or-if) 4.5 只修改cond-actions过程即可,cond->if和expand都不用改。 (define (recipient? clause) (eq? (cadr clause) '=>)) (define (cond-actions clause) (if (recipient? clause) (list (list (caddr clause) (cond-predicate clause))) ;因为后面是sequence->exp (cdr clause))) 4.6 (define (eval-let exp env) (eval (let->combination exp) env)) (define (let->combination exp) (cons (make-lambda (let-vars exp) ;是cons 而不是list (let-body exp)) (let-bindings exp))) (define (let-var-clauses exp) (cadr exp)) (define (let-body exp) (cddr exp)) (define (let-vars exp) (map car (let-var-clauses exp))) (define (let-bindings exp) (map cadr (let-var-clauses exp))) 最后在eval包中加入eval-let: (put 'eval 'let eval-let) 4.7 08/8/18修改:(define (let*-body exp) (caddr exp)) let*的两个条件:1)同一环境 2)由左至右约束可见。这也就相当于一层层的扩充一个环境,可以用嵌套let或者一系列的define来实现。 (define (eval-let* exp env) (eval (let*->nested-lets exp) env)) (define (let*->nested-lets exp) (if (null? (let*-defs exp)) (let*-body exp) (let ((first (car (let*-defs exp))) (rest (cdr (let*-defs exp)))) (make-let (list first) (let*->nested-lets (make-let* rest (let*-body exp))))))) (define (let*-defs exp) (cadr exp)) (define (let*-body exp) (caddr exp)) (define (make-let* definitions body) (list 'let definitions body)) 加入eval包: (put 'eval 'let* eval-let*) ps: 后来又写了一个把let*转为一堆define的过程,试了几个结果也都正确。 (define (eval-let* exp env) (eval (let*->defs exp) env)) (define (let*-defs exp) (cadr exp)) (define (let*-body exp) (caddr exp)) (define (let*-defs->definitions defs) (if (null? defs) '() (let ((first (car defs))) (cons (make-definition (car first) (cadr first)) (let*-defs->definitions (cdr defs)))))) (define (let*->defs exp) (cons 'begin (append (let*-defs->definitions (let*-defs exp)) (list (let*-body exp))))) 4.8 ;name-let: (let <var> <bindings> <body>)-------- 实现方法是先define一个名字是<var>的过程(调用自身),然后调用<bindings>中的形参和实参。 修改后的let->combination (define (let->combination exp) (if (name-let? exp) (let ((def-name (make-definition (name-let-var exp) (make-lambda (name-let-binding-vars exp) (list (name-let-body exp))))) (values (name-let-binding-values exp))) (make-begin (list def-name (cons (name-let-var exp) values)))) (cons (make-lambda (let-vars exp) (list (let-body exp))) (let-bindings exp)))) ;一些选择函数 (define (name-let? exp) (and (not (null? (cadr exp))) (not (pair? (cadr exp))))) (define (name-let-binding-vars exp) (map car (caddr exp))) (define (name-let-binding-values exp) (map cadr (caddr exp))) (define (name-let-body exp) (cdddr exp)) ;不是cadddr 而是cdddr (define (name-let-var exp) (cadr exp)) 4.9 while比较简单: ;---------while ::=(while <cond> <body>)------ (define (eval-while exp env) (eval (while->combination exp) env)) (define (while->combination exp) (make-if (while-cond exp) (make-begin (list (while-body exp) (make-while (while-cond exp) (while-body exp)))) ''done)) ;需要两层引用 (define (while-cond exp) (cadr exp)) (define (while-body exp) (cddr exp)) (define (make-while condition body) (list 'while condition body)) 之后加入eval包(put 'eval 'while eval-while) ;test ;;; M-Eval input: (define x 10) (while (> x 0) (begin (set! x (- x 1)) (display x))) 9876543210 ;;; M-Eval output: done 再写个for:用的是let的嵌套来实现每次循环后for中变量的变化。感觉用set!也是可以的 ;-------for ::=(for <primitive> <condition> <change> <body>) (define (eval-for exp env) (eval (for->combination exp) env)) (define (for->combination exp) (make-let (list (for-primitive exp)) (make-if (for-cond exp) (make-begin (list (for-body exp) (make-for (list (car (for-primitive exp)) (list (for-change exp) (cadr (for-primitive exp)))) (for-cond exp) (for-change exp) (for-body exp)))) ''done))) (define (for-primitive exp) (cadr exp)) (define (for-cond exp) (caddr exp)) (define (for-change exp) (cadddr exp)) (define (for-body exp) (cddddr exp)) (define (make-for primitive condition change body) (list 'for primitive condition change body)) 加入eval包:(put 'eval 'for eval-for) ;test ;;; M-Eval input: (for (i 0) (< i 10) (lambda(x) (+ x 1)) (begin (newline) (for (j 0) (< j 10) (lambda(x) (+ x 1)) (display '*)))) ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ;;; M-Eval output: done ——效果还不错! 4.10 题中所说的"一种新的语法形式",我认为也就是S-expression中元素顺序变变,至于把类似把括号去掉这种语法上的改动当前是不能实现的。 例子的话,之前EX 4.2中Louis同学的(call factorial 3)就可以算作一个了。 |
|
|