三分 的个人资料3fen's Notebook照片日志列表更多 工具 帮助

日志


8月25日

SICP 4.2

Section 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)就可以算作一个了。