Todo
4.10
4.16
Exercise 4.1
(define (list-of-value-l exps env)
(if (no-operands? exps)
'()
(let ((val (Eval (first-operand exps) env)))
(cons val
(list-of-values-l (rest-operands exps) env)))))
(define (list-of-values-r exps env)
(reverse (list-of-values-l (reverse exps) env)))
;;(define list-of-values list-of-vaules-l)
;;(define list-of-values list-of-values-r)
;; list と display と newline を primitive-procedures に登録して
;; list-of-values を list-of-values-l に変更すると
;;;M-Eval input:
(define (show x)
(display x) (newline) x)
;;;M-Eval value:
ok
;;;M-Eval input:
(define exps (list (show 1) (show 2) (show 3)))
1
2
3
;;;M-Eval value:
ok
;; list-of-values を list-of-values-r に変更すると
;;;M-Eval input:
(define exps (list (show 1) (show 2) (show 3)))
3
2
1
;;;M-Eval value:
ok
Exercise 4.2
;;a. application?の判定を(pair? exp)で行っているため(define x 3)もapplicationと判定される。
;;b. application?の判定と処理をassignment?の前に移動
;; application?, operator, operandsを次のように変更
(define (application? exp) (tagged-list? exp 'call))
(define (operator exp) (cadr exp))
(define (operands exp) (cddr exp))
;; + を primitive-procedures に登録して
;;;M-Eval input:
(call + 1 2)
;;;M-Eval value:
3
Exercise 4.3
(define (get tag) ((operation-table 'lookup-proc) '*eval* tag))
(define (put tag act) ((operation-table 'insert-proc!) '*eval* tag act))
(define (tag exp) (car exp))
(define (Evalx exp env)
;;(display exp)(newline)
(cond ((self-evaluating? exp) exp) ;ok
((variable? exp) (lookup-variable-value exp env)) ;ok
((get (tag exp)) ((get (tag exp)) exp env))
((application? exp) ;ok
(Apply (Eval (operator exp) env)
(list-of-values (operands exp) env)))
(else
#| (error "Unknowen expression type -- EVAL" exp) |#
(display "Unknowen expression type -- EVAL ") (display exp) (newline)
)))
(define Eval Evalx) ;; Evalx を Eval にする。
(define (text-of-quotationx exp env) (cadr exp))
(put 'quote text-of-quotationx)
(put 'set! eval-assignment)
(put 'define eval-definition)
(put 'if eval-if)
(define (eval-lambda exp env)
(make-procedure
(lambda-parameters exp)
(lambda-body exp)
env))
(put 'lambda eval-lambda)
(define (eval-begin exp env)
(eval-sequence (begin-actions exp) env))
(put 'begin eval-begin)
(define (eval-cond exp env)
(Eval (cond->if exp) env))
(put 'cond eval-cond)
;;;M-Eval input:
'(1 2 3)
;;;M-Eval value:
(1 2 3)
;;;M-Eval input:
(define a 1)
;;;M-Eval value:
ok
;;;M-Eval input:
a
;;;M-Eval value:
1
;;;M-Eval input:
(set! a 2)
;;;M-Eval value:
ok
;;;M-Eval input:
a
;;;M-Eval value:
2
;;;M-Eval input:
(if #t 1 2)
;;;M-Eval value:
1
;;;M-Eval input:
((lambda (x) (+ x 2)) 4)
;;;M-Eval value:
6
;;;M-Eval input:
(begin (display 1) (display 2))
12;;;M-Eval value:
#<undef>
;;;M-Eval input:
(cond ((eq? a 1) 'one) ((eq? a 2) 'two) (else '?))
;;;M-Eval value:
two
Exercise 4.4
;; syntax procedures & evaluation procedures
;; Evalのcond?の判定の次に、次の2つを追加
((and? exp) (eval-and exp env))
((or? exp) (eval-or exp env))
;;
(define (and? exp) (tagged-list? exp 'and))
(define (or? exp) (tagged-list? exp 'or))
(define (tests exp) (cdr exp))
(define (first-test tests) (car tests))
(define (rest-tests tests) (cdr tests))
(define (eval-and exp env)
(if (null? (tests exp))
true
(eval-logical 'and (tests exp) env)))
(define (eval-or exp env)
(if (null? (tests exp))
false
(eval-logical 'or (tests exp) env)))
(define (eval-logical op tests env)
(let ((val (Eval (first-test tests) env)))
(cond ((null? (rest-tests tests)) val)
((or (and (eq? op 'and) (not (eq? val false)))
(and (eq? op 'or) (eq? val false)))
(eval-logical op (rest-tests tests) env))
(else val))))
;;;M-Eval input:
(and)
;;;M-Eval value:
#t
;;;M-Eval input:
(and 1 2 3)
;;;M-Eval value:
3
;;;M-Eval input:
(and 1 false 3)
;;;M-Eval value:
#f
;;;M-Eval input:
(or)
;;;M-Eval value:
#f
;;;M-Eval input:
(or 1 2 3)
;;;M-Eval value:
1
;;;M-Eval input:
(or false 1)
;;;M-Eval value:
1
;;;M-Eval input:
(or false false)
;;;M-Eval value:
#f
;; derived expressions
;; Evalのcond?の判定の次に、次の2つを追加。上のtests, first-test, rest-testsも使用
((and? exp) (Eval (and->if (tests exp)) env))
((or? exp) (Eval (or->if (tests exp)) env))
;;
(define (and->if tests)
(cond ((null? tests) true)
((null? (rest-tests tests)) (first-test tests))
(else (make-if (first-test tests) (and->if (rest-tests test)) false))))
(define (or->if tests)
(cond ((null? tests) false)
((null? (rest-tests tests)) (first-test tests))
(else (cons (make-lambda (list 'result-test)
(list (make-if 'result-test
'result-test
(or->if (rest-tests tests)))))
(list (first-test tests))))))
;;;M-Eval input:
(and)
;;;M-Eval value:
#t
;;;M-Eval input:
(and 1 2 3)
;;;M-Eval value:
3
;;;M-Eval input:
(and 1 false 3)
;;;M-Eval value:
#f
;;;M-Eval input:
(or)
;;;M-Eval value:
#f
;;;M-Eval input:
(or 1 2 3)
;;;M-Eval value:
1
;;;M-Eval input:
(or false 1)
;;;M-Eval value:
1
;;;M-Eval input:
(or false false)
;;;M-Eval value:
#f
Exercise 4.5
;; expand-clauses の make-if の前に
(if (eq? (cond-actions first) '=>)
(cons (make-lambda (list 'testr)
(list (make-if 'testr
(list (cadr (cond-actions first)) 'testr)
(expand-clauses rest))))
(list (cond-predicate first)))
;; を追加
;;;M-Eval input:
(cond ((assoc 'b '((a 1) (b 2))) => cadr) (else false))
;;;M-Eval value:
2
Exercise 4.6
;; Eval の cond? の判定の次に、次の判定を追加
((let? exp) (Eval (let->combination exp) env))
;;
(define (let? exp) (tagged-list? exp 'let))
(define (let-bindings exp) (cadr exp))
(define (let-body exp) (cddr exp))
(define (let->combination exp)
(let ((bindings (let-bindings exp)))
(cons (make-lambda (map car bindings)
(let-body exp))
(map cadr bindings))))
;;;M-Eval input:
(let ((x 2) (y 3)) (+ x y))
;;;M-Eval value:
5
Exercise 4.7
;; (let* ((<var1> <exp1>) (<var2> <exp2>) ... (<varn> <expn>)) <body>)
;; =>(let ((<var1> <exp1>)) (let ((<var2> <exp2)) ( ...
;; (let ((<varn> <expn>)) <body>) ... )))
;; Eval の let? の次に、次の判定を追加
((let*? exp) (Eval (let*->nested-lets exp) env))
;;
(define (let*? exp) (tagged-list? exp 'let*))
(define (make-let bindings letbody)
(cons 'let (cons bindings letbody)))
(define (let*->nested-lets exp)
(define (rec bindings)
(if (eq? (length bindings) 1)
(make-let bindings (let-body exp))
(let ((first (car bindings))
(rest (cdr bindings)))
(make-let (list first) (list (rec rest))))))
(rec (let-bindings exp)))
;;;M-Eval input:
(let* ((x 3) (y (+ x 2)) (z (+ x y 5))) (* x z))
;;;M-Eval value:
39
Exercise 4.8
;; (let <var> ((<var1> <exp1>) ... (<varn> <expn)) <body>)
;; =>((lambda () (define (<var> <var1> ... <varn>) <body>)
;; (<var> <exp1> ... <expn>)))
;; selector の追加
(define (nlet-bindings exp) (caddr exp))
(define (nlet-body exp) (cdddr exp))
(define (nlet-name exp) (cadr exp))
;; let->combination の変更
(define (let->combination exp)
(if (pair? (cadr exp))
;; normal-let
(let ((bindings (let-bindings exp)))
(cons (make-lambda (map car bindings)
(let-body exp))
(map cadr bindings)))
;; named-let
(let ((bindings (nlet-bindings exp))
(name (nlet-name exp)))
(list (make-lambda '()
(list
(cons
'define
(cons
(cons name (map car bindings))
(nlet-body exp)))
(cons name (map cadr bindings))))
))
))
;;;M-Eval input:
(define (fib n)
(let fib-iter ((a 1)
(b 0)
(count n))
(if (= count 0)
b
(fib-iter (+ a b) a (- count 1)))))
;;;M-Eval value:
ok
;;;M-Eval input:
(fib 6)
;;;M-Eval value:
8
Exercise 4.9
;; (do ((<ver1> <ini1> <step1>) ... (<vern> <inin> <stepn>))
;; (<test> <exp1> ... <expn>)
;; <cmd1> ... <cmdn>)
;;=> (let iter ((<ver1> <ini1>) ... (<vern> <inin>))
;; (if <test>
;; (begin <exp1> ... <expn>)
;; (begine <cmd1> ... <cmdn> (iter <step1> ... <stepn>))))
;; Eval に次を追加
((do? exp) (Eval (do->nlet exp) env))
;;
(define (make-nlet name bindings exps)
(list 'let name bindings exps))
(define (do? exp) (tagged-list? exp 'do))
(define (do-bindings exp) (cadr exp))
(define (do-test-c exp) (caddr exp))
(define (do-cmds exp) (cdddr exp))
(define (do->nlet exp)
(make-nlet 'iter
(map (lambda (x) (list (car x) (cadr x))) (do-bindings exp))
(make-if
(car (do-test-c exp))
(make-begin (cdr (do-test-c exp)))
(make-begin (append (do-cmds exp)
(list (cons
'iter
(map (lambda (x) (if (eq? (cddr x) '())
(car x)
(caddr x)))
(do-bindings exp)))))))))
;; primitive-procedures に make-vector と vector-set! を登録して
;;;M-Eval input:
(do ((vec (make-vector 5))
(i 0 (+ i 1)))
((= i 5) vec)
(vector-set! vec i i))
;;;M-Eval value:
#(0 1 2 3 4)
;;;M-Eval input:
(let ((x '(1 3 5 7 9)))
(do ((x x (cdr x))
(sum 0 (+ sum (car x))))
((null? x) sum)))
;;;M-Eval value:
25
Exercise 4.10
Exercise 4.11
;; 4.1.3 の encloseing-environment から define-variable! を以下で置換え
(define (enclosing-environment env) (cdr env))
(define (first-frame env) (car env))
(define the-empty-environment '())
(define (make-frame variables values)
(map cons variables values))
(define (add-binding-to-frame! var val frame)
(set-cdr! frame (cons (car frame) (cdr frame)))
(set-car! frame (cons var val)))
(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))))
;; frame を var で scan し、あれば部分リストを返す。
(define (scan-frame var frame)
(cond ((null? frame) #f)
((eq? var (caar frame)) frame)
(else (scan-frame var (cdr frame)))))
(define (scan-env var env)
(if (eq? env the-empty-environment)
#f
(let ((frame (scan-frame var (first-frame env))))
(if (eq? frame #f)
(scan-env var (enclosing-environment env))
frame))))
(define (lookup-variable var env)
(let ((frame (scan-env var env)))
(if (eq? frame #f)
(error "Unbound variable" var)
(cdar frame))))
(define (set-variable-value! var val env)
(let ((frame (scan-env var env)))
(if (eq? frame #f)
(error "Unbound variable -- SET!" val)
(set-cdr! (car frame) val))))
(define (define-variable! var val env)
(let ((frame (scan-frame var (first-frame env))))
(if (eq? frame #f)
(add-binding-to-frame! var val (first-frame env))
(set-cdr! (car frame) val))))
;;
;;
(define env1 (extend-environment '(a b c) '(1 2 3) the-empty-environment))
(define env (extend-environment '(e f g a) '(4 5 6 7) env1))
;;gosh> (lookup-variable 'a env)
;;7
;;gosh> (lookup-variable 'e env)
;;4
;;gosh> (lookup-variable 'b env)
;;2
;;gosh> (set-variable-value! 'b 8 env)
;;#<undef>
;;gosh> (set-variable-value! 'e 9 env)
;;#<undef>
;;gosh> (lookup-variable 'b env)
;;8
;;gosh> (lookup-variable 'e env)
;;9
;;gosh> (define-variable! 'c 10 env)
;;#<undef>
;;gosh> (define-variable! 'e 11 env)
;;#<undef>
;;gosh> env
;;(((c . 10) (e . 11) (f . 5) (g . 6) (a . 7)) ((a . 1) (b . 8) (c . 3)))
Exercise 4.12
;; 4.1.3 の encloseing-environment から define-variable! を以下で置換え
(define (enclosing-environment env) (cdr env))
(define (first-frame env) (car env))
(define the-empty-environment '())
;; for variable-list & value-list
(define (first-var frame)
(caar frame))
(define (first-val frame)
(cadr frame))
(define (set-first-val! frame val)
(set-car! (cdr frame) val))
(define (rest-frame frame)
(cons (cdar frame) (cddr frame)))
(define (empty-frame? frame)
(equal? frame (cons '() '())))
(define (make-frame variables values)
(cons variables values))
(define (add-binding-to-frame! var val frame)
(set-car! frame (cons var (car frame)))
(set-cdr! frame (cons val (cdr frame))))
#|
;; for valiable & value pair-list
(define (first-var frame)
(caar frame))
(define (first-val frame)
(cdar frame))
(define (set-first-val! frame val)
(set-cdr! (car frame) val))
(define (rest-frame frame)
(cdr frame))
(define (empty-frame? frame)
(eq? frame '()))
(define (make-frame variables values)
(map cons variables values))
(define (add-binding-to-frame! var val frame)
(set-cdr! frame (cons (car frame) (cdr frame)))
(set-car! frame (cons var val)))
|#
(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))))
;; frame を var で scan し、あれば部分リストを返す。
(define (scan-frame var frame)
(cond ((empty-frame? frame) #f)
((eq? var (first-var frame)) frame)
(else (scan-frame var (rest-frame frame)))))
(define (scan-env var env)
(if (eq? env the-empty-environment)
#f
(let ((frame (scan-frame var (first-frame env))))
(if (eq? frame #f)
(scan-env var (enclosing-environment env))
frame))))
(define (lookup-variable var env)
(let ((frame (scan-env var env)))
(if (eq? frame #f)
(error "Unbound variable" var)
(first-val frame))))
(define (set-variable-value! var val env)
(let ((frame (scan-env var env)))
(if (eq? frame #f)
(error "Unbound variable -- SET!" val)
(set-first-val! frame val))))
(define (define-variable! var val env)
(let ((frame (scan-frame var (first-frame env))))
(if (eq? frame #f)
(add-binding-to-frame! var val (first-frame env))
(set-first-val! frame val))))
;;
;;
(define env1 (extend-environment '(a b c) '(1 2 3) the-empty-environment))
(define env (extend-environment '(e f g a) '(4 5 6 7) env1))
;;gosh> (lookup-variable 'a env)
;;7
;;gosh> (lookup-variable 'e env)
;;4
;;gosh> (lookup-variable 'b env)
;;2
;;gosh> (set-variable-value! 'b 8 env)
;;#<undef>
;;gosh> (set-variable-value! 'e 9 env)
;;#<undef>
;;gosh> (lookup-variable 'b env)
;;8
;;gosh> (lookup-variable 'e env)
;;9
;;gosh> (define-variable! 'c 10 env)
;;#<undef>
;;gosh> (define-variable! 'e 11 env)
;;#<undef>
;;gosh> env
;;(((c e f g a) 10 11 5 6 7) ((a b c) 1 8 3))
;;(((e . 11) (c . 10) (e . 9) (f . 5) (g . 6) (a . 7)) ((a . 1) (b . 8) (c . 3)))
Exercise 4.13
;; (make-unbound! <var>)
;; a: make-unboud! を呼び出したブロックで var が定義されていたら、その定義を
;; 削除しその値を返す。var が定義されていなければ、#f を返す。
;; b: make-unboud! を呼び出したスコープで var が定義されていたら、その最初の
;; 定義を削除しその値を返す。var が定義されていなければ、#fを返す。
;; 他人に使ってもらうなら、安全性の観点から ａ だけど、何の役に立つのか???
;;
;; Eval の ((definition? exp) (eval-definition exp env)) の次に以下を追加
((unbound? exp) (eval-unbound exp env))
;;
(define (unbound? exp) (tagged-list? exp 'make-unbound!))
(define (unboud-variable exp) (cadr exp))
(define (eval-unbound exp env)
(make-unbound! (unboud-variable exp) env))
(define (make-unbound!a var env)
(let* ((frame (first-frame env))
(bind (scan-frame var frame)))
(if (eq? bind #f)
#f
(begin (set-car! (car bind) '*undef*)
(cadr bind)))))
(define (make-unbound!b var env)
(let ((bind (scan-env var env)))
(if (eq? bind #f)
#f
(begin (set-car! (car bind) '*undef*)
(cadr bind)))))
(define make-unbound! make-unboud!a)
;; var を frame 内で scan し、あれば部分リスト(frame)を返す。
(define (scan-frame var frame)
(cond ((null? frame) #f)
((eq? var (caar frame)) frame)
(else (scan-frame var (cdr frame)))))
;; var を env 内で scan し、あれば部分リスト(frame)を返す。
(define (scan-env var env)
(if (eq? env the-empty-environment)
#f
(let ((frame (scan-frame var (first-frame env))))
(if (eq? frame #f)
(scan-env var (enclosing-environment env))
frame))))
;; a
;;;M-Eval input:
(define a 1)
;;;M-Eval value:
ok
;;;M-Eval input:
(define (p)
(define a 2)
(display a)
(display (make-unbound! a))
(display a)
(display (make-unbound! a))
(display a)
(display (make-unbound! a))
(display a))
;;;M-Eval value:
ok
;;;M-Eval input:
(p)
221#f1#f1;;;M-Eval value:
#<undef>
;;;M-Eval input:
(make-unbound! b)
;;;M-Eval value:
#f
;; b
;;;M-Eval input:
(define a 1)
;;;M-Eval value:
ok
;;;M-Eval input:
(define (p)
(define a 2)
(display a)
(display (make-unbound! a))
(display a)
(display (make-unbound! a))
(display a)
(display (make-unbound! a))
(display a))
;;;M-Eval value:
ok
;;;M-Eval input:
(p)
2211
#!# Error: Unbound variable a
;;;M-Eval input:
Exercise 4.14
;; map は手続きを引数にとる。
;; ベースシステムの map は手続きもベースシステムの形式であることを期待していると思われるが、
;; mapをprimitive-proceduresに登録した場合は、与えられる手続きはSICP-schemeの形式であるため、
;; 正常に動作できない。
;;;M-Eval input:
(map car '((1 2) (3 4)))
*** ERROR: invalid application: ((primitive #<subr car>) (1 2))
;;;M-Eval input:
(map (lambda (x) x) '(1 2 3))
*** ERROR: invalid application: ((procedure (x) (x) (((false true car cdr cons null? eq? list cadr + - * = >= assoc make-vector vector-set! display newline map) #f #t (primitive #<subr car>) (primitive #<subr cdr>) (primitive #<subr cons>) (primitive #<subr null?>) (primitive #<subr eq?>) (primitive #<subr list>) (primitive #<subr cadr>) (primitive #<subr +>) (primitive #<subr ->) (primitive #<subr *>) (primitive #<subr =>) (primitive #<subr >=>) (primitive #<subr assoc>) (primitive #<subr make-vector>) (primitive #<subr vector-set!>) (primitive #<subr display>) (primitive #<subr newline>) (primitive #<subr map>)))) 1)
Exercise 4.15
;;halt? が定義できるとすると
;;(try try) を実行すると、
;;オブジェクト try を引数とした手続き try が halt（値を返す）なら
;;(run-forever)、すなわち永久にループし
;;haltでない（エラーまたは永久にループする）なら、’halted を返す
;;をいう矛盾した結果となる手続き try が定義できる。
;;従って、 どのような 手続きとオブジェクトの組合せにも 正しく動作
;;する halt? は定義できない。
Exercise 4.16
Exercise 4.17
#|
(lambda <vars>
(define u <e1>)
(define v <e2>)
<e3>)
の<e3>評価時の環境は
g.e.[ ]
↑
[<vars> : ????]
|u : <e1>|
env→ [v : <e2>]
(lambda <vars>
(let ((u '*unassigned*)
(v '*unassigned*))
(set! u <e1>)
(set! v <e2>)
<e3>))
の<e3>評価時の環境は
g.e.[ ]
↑
[<vars> : ????]
↑
[u : <e1>]
env→ [v : <e2>]
define は現在の環境(フレーム)に新たな binding を追加するが、
letは新たなフレームを作成しそこに bindingを追加するため2つの環境は異なる。
しかし look-up-value は現在の環境から g.e. に向かってリストをたどりながら
var を探すために結果に差がでない。
新たなフレームを作らずに"simultaneous"scop rule を満足させるには
(lambda <vars>
(define u '*unassigned*)
(define v '*unassigend*)
(set! u <e1>)
(set! v <e2>)
<e3>)
とする。
|#
Exercise 4.18
(define (solve-a f y0 dt)
(define y (integral (delay dy) y0 dt))
(define dy (stream-map f y))
y)
;; exercise方式
(define (solve-b f y0 dt)
(let ((y '*unassigned*)
(dy '*unassigned*))
(let ((*sysval1* (integral (delay dy) y0 dt))
(*sysval2* (stream-map f y))) ;←
(set! y *sysval1*)
(set! dy *sysval2*)
y)))
;;←の部分でｙの評価が必要になりsymbolにcarを作用させようとして正しく動作しない。
;; text方式
(define (solve-c f y0 dt)
(let ((y '*unassigned*)
(dy '*unassigned*))
(set! y (integral (delay dy) y0 dt))
(set! dy (stream-map f y))
y))
;;正しく動作する。
(define (solve-d f y0 dt)
(define dy (stream-map f y))
(define y (integral (delay dy) y0 dt))
y)
;;gosh> (stream-ref (solve-a (lambda (y) y) 1 0.001) 1000)
;;*** ERROR: pair required, but got #<undef>
;;Stack Trace:
;;_______________________________________
;; 0 (map stream-car argstreams)
;; At line 562 of ".//SICP3.scm"
;; 1 (stream-map f y)
;; At line 4 of "f:/cygwin/home/xxxxx/SICP/3/w.scm"
;; 2 (solve-a (lambda (y) y) 1 0.001)
;; At line 34 of "(stdin)"
;;gosh> (stream-ref (solve-b (lambda (y) y) 1 0.001) 1000)
;;*** ERROR: pair required, but got *unassigned*
;;Stack Trace:
;;_______________________________________
;; 0 (map stream-car argstreams)
;; At line 562 of ".//SICP3.scm"
;; 1 (stream-map f y)
;; At line 11 of "f:/cygwin/home/xxxxx/SICP/3/w.scm"
;; 2 (solve-b (lambda (y) y) 1 0.001)
;; At line 35 of "(stdin)"
;;gosh> (stream-ref (solve-c (lambda (y) y) 1 0.001) 1000)
;;2.716923932235896
;;gosh> (stream-ref (solve-d (lambda (y) y) 1 0.001) 1000)
;;2.716923932235896
Exercise 4.19
;; 脚注に答えが・・・
Exercise 4.20
; a
;; (letrec ((<var1> <exp1>) (<var2> <exp2>) ... (<varn> <expn>)) <body>)
;; =>(let ((<var1> '*unassigned*) (<var2> '*unassigned*) ... (<varn> '*unassigned*))
;; (set! <var1> <exp1>) (set! <var2> <exp2>) ... (set! <varn> <expn>)
;; <body>)
;; Eval の let*? の次に、次の判定を追加
((letrec? exp) (Eval (letrec->let exp) env))
;;
(define (letrec? exp) (tagged-list? exp 'letrec))
(define (letrec->let exp)
(let ((bindings (map (lambda (x) (list (car x) '*unassigned*)) (let-bindings exp)))
(set!s (map (lambda (x) (make-set! (car x) (cadr x))) (let-bindings exp))))
(make-let bindings (append set!s (let-body exp)))))
;;;M-Eval input:
(letrec ((even?
(lambda (n)
(if (= n 0)
true
(odd? (- n 1)))))
(odd?
(lambda (n)
(if (= n 0)
false
(even? (- n 1))))))
(even? 3)
;;;M-Eval value:
#f
; b
(define (f x)
(let ((evenx? (lambda (n) (if (= n 0) true (oddx? (- n 1)))))
(oddx? (lambda (n) (if (= n 0) false (evenx? (- n 1))))))
(evenx? x)))
;;;;< | > :手続きを表す。<パラメタ・本体へのポインタ|環境へのポインタ>
;;letrec の場合の (f 3) 実行時の環境
;;g.e. [f : ]
;; ↑
;; [x :3 ]
;; ↑
;; [enenx? : +]→<↓|←>
;; | | p:n
;; | | b:(if (= n O) ... (oddx? (- n 1)))))
;;env [oddx? : +]→<↓|←>
;; p:n
;; b:(if (= n 0) ... (evenx? (-n 1)))))
;;
;;let の場合の (f 3) 実行時の環境
;;g.e. [f : ]
;; ↑
;; [x :3 ]
;; ↑ ↑ ↑
;; [enenx? : +]→<↓ |+ > |
;; | | p:n |
;; | | b:(if (= n O) ... (oddx? (- n 1)))))
;;env [oddx? : +]→<↓ | +>
;; p:n
;; b:(if (= n 0) ... (evenx? (-n 1)))))
;;
;;letrec を let とした時の evenx?、oddx? それぞれに設定される手続きの環境は
;;let の変数の初期値は let と同じ環境で評価されるため、
;;、引数 x に 3 が設定された環境（とグローバル環境）となる。
;;そこには、evenx?、oddx?は束縛されていない。
;;一方、letrec の場合は、evenx?、oddx? それぞれに設定される手続きの環境は
;;evenx?、oddx?に '*unassigned* が（set!後は手続きに）格納されている環境と
;;なる。従って、letrec では変数の評価をしないような定義の仕方であれば、相互
;;再帰的に定義できる。
;;答えになっているか???
Exercise 4.21
;; a
;;;M-Eval input:
((lambda (n)
((lambda (fib)
(fib fib n))
(lambda (fb k)
(if (or (= k 1) (= k 2))
1
(+ (fb fb (- k 1))
(fb fb (- k 2)))))))
10)
;;;M-Eval value:
55
;; b
(define (f x)
((lambda (even? odd?)
(even? even? odd? x))
(lambda (ev? od? n)
(if (= n 0) true (od? ev? od? (- n 1))))
(lambda (ev? od? n)
(if (= n 0) false (ev? ev? od? (- n 1))))))
;;;M-Eval input:
(f 1)
;;;M-Eval value:
#f
;;;M-Eval input:
(f 2)
;;;M-Eval value:
#t
Exercise 4.22
;; analyze の cond に 以下を加える
((let? exp) (analyze (let->combination exp)))
;;;A-Eval input:
(let ((x 3) (y 4)) (display (+ x y)) (newline) (* x y))
7
;;;A-Eval value:
12
Exercise 4.23
;;exp を解析(analyze)したものを a_exp とすると (eval exp env) は (a_exp env) で得ることができる。(定義そのまま)
;; exp を
;; a: (begin (exp1)) b: (begin (exp1) (exp2)) c: (begin (exp1) (exp2) (exp3))
;; とすれば a_exp は
;; text-version では
;; a: a_exp1 b: (lambda (env) (a_exp1 env) (a_exp2 env))
;; c: (lambda (env) ((lambda (env) (a_exp1 env) (a_exp2 env)) env) (a_exp3 env))
;; となり、
;; Alyssa-version ではどれも (lambda (env) (execute-sequence procs env)) であり、
;; procsが a: (a_exp1) b: (a_exp1 a_exp2) c: (a_exp1 a_exp2 a_exp3)
;; となる。
;; 従って (a_exp env) の評価では text-version では lambda による各手続きの実行、Alyssa-version では execute-sequence の制御の元での各手続きの1つ１つの順次実行となり、text-versionのほうが実行時間が短いと推測できる。
Exercise 4.24
;;;M-Eval input:
(time (fib 1000))
#:real -time:0.393
#:user -time:0.391
#:system-time:0.0
;;;M-Eval value:
43466557686937456435688527675040625802564660517371780402481729089536555417949051890403879840079255169295922593080322634775209689623239873322471161642996440906533187938298969649928516003704476137795166849228875
;;;A-Eval input:
(time (fib 1000))
#:real -time:0.22
#:user -time:0.21999999999999975
#:system-time:0.0
;;;A-Eval value:
43466557686937456435688527675040625802564660517371780402481729089536555417949051890403879840079255169295922593080322634775209689623239873322471161642996440906533187938298969649928516003704476137795166849228875
;;50%弱が構文解析に使われている？
最終更新：2008年12月14日 15:11
