SICP 読み (292) 5.4 積極制御評価器
ワケワカなままでは悔しいので無理矢理ナカミを見てみる事に。
問題 5.26
以下の手続きを使えば allcode なソレ達が gosh 上で動作する。手動評価器。
gosh> (add-load-path ".") gosh> (load "load-eceval") gosh> (define the-global-environment (setup-environment)) gosh> ((((eceval 'get-register) 'env) 'set) the-global-environment) gosh> ((((eceval 'get-register) 'continue) 'set) '()) gosh> ((((eceval 'get-register) 'exp) 'set) '(define (factorial n) (define (iter product counter) (if (> counter n) product (iter (* counter product) (+ counter 1)))) (iter 1 1))) gosh> (start eceval) gosh> ((eceval 'stack) 'initialize) gosh> ((((eceval 'get-register) 'continue) 'set) '()) gosh> ((((eceval 'get-register) 'exp) 'set) '(factorial 1)) gosh> (start eceval) gosh> (((eceval 'get-register) 'val) 'get) 1 gosh>
最後以外の出力は略しております。で、ch5-regsim.scm を問題 5.19 のデバッガ入りのアセンブラにすれば中身が見れるはず。
gosh> ((eceval 'stack) 'initialize) done gosh> ((((eceval 'get-register) 'continue) 'set) '()) () gosh> ((((eceval 'get-register) 'exp) 'set) '(factorial 2)) (factorial 2) gosh> (start eceval) done gosh> (((eceval 'get-register) 'val) 'get) 2 gosh> ((eceval 'stack) 'initialize) done gosh> ((((eceval 'get-register) 'continue) 'set) '()) () gosh> ((((eceval 'get-register) 'exp) 'set) '(factorial 3)) (factorial 3) gosh> (start eceval) done gosh> (((eceval 'get-register) 'val) 'get) 6 gosh>
相当無理矢理だな。ちなみに ch5-eceval.scm の eceval を define している先頭部分がこんなカンジになっております。
(define eceval (make-machine '(exp env val proc argl continue unev) eceval-operations '( ;;SECTION 5.4.4 read-eval-print-loop ; (perform (op initialize-stack)) ; (perform ; (op prompt-for-input) (const ";;; EC-Eval input:")) ; (assign exp (op read)) ; (assign env (op get-global-environment)) ; (assign continue (label print-result)) ; (goto (label eval-dispatch)) print-result ;;**following instruction optional -- if use it, need monitored stack ; (perform (op print-stack-statistics)) ; (perform ; (op announce-output) (const ";;; EC-Eval value:")) ; (perform (op user-print) (reg val)) ; (goto (label read-eval-print-loop)) unknown-expression-type ; (assign val (const unknown-expression-type-error)) ; (goto (label signal-error)) unknown-procedure-type ; (restore continue) ; (assign val (const unknown-procedure-type-error)) ; (goto (label signal-error)) signal-error ; (perform (op user-print) (reg val)) ; (goto (label read-eval-print-loop)) ;;SECTION 5.4.1 eval-dispatch (test (op self-evaluating?) (reg exp)) (branch (label ev-self-eval)) ;; 以下略
無茶するなあ。で、5.19 の ch5-regsim.scm をコピッてリトライ。
gosh> (add-load-path ".")
("." "/usr/share/gauche/site/lib" "/usr/share/gauche/0.8.7/lib")
gosh> (load "load-eceval")
#t
gosh> (define the-global-environment (setup-environment))
the-global-environment
gosh> ((((eceval 'get-register) 'env) 'set) the-global-environment)
(((false true car cdr cons null? + - * = / > <)
#f
#t
(primitive #<subr car>)
(primitive #<subr cdr>)
(primitive #<subr cons>)
(primitive #<subr null?>)
(primitive #<subr +>)
(primitive #<subr ->)
(primitive #<subr *>)
(primitive #<subr =>)
(primitive #<subr />)
(primitive #<subr >>)
(primitive #<subr <>)))
gosh> ((((eceval 'get-register) 'continue) 'set) '())
()
gosh> ((((eceval 'get-register) 'exp) 'set) '(define (factorial n)
(define (iter product counter)
(if (> counter n)
product
(iter (* counter product)
(+ counter 1))))
(iter 1 1)))
(define (factorial n)
(define (iter product counter)
(if (> counter n)
product
(iter (* counter product) (+ counter 1))))
(iter 1 1))
gosh> (start eceval)
done
gosh> ((eceval 'stack) 'initialize)
done
gosh> ((((eceval 'get-register) 'continue) 'set) '())
()
gosh> ((((eceval 'get-register) 'exp) 'set) '(factorial 1))
(factorial 1)
gosh> ((eceval 'set-break) 'ev-sequence 1)
((ev-sequence 1))
gosh> (start eceval)
(break ev-sequence 1)
gosh>出力は若干整形しております。で、止また。
gosh> (((eceval 'get-register) 'env) 'get) ((#0=(n) 1) . #1=(((factorial false true car cdr cons null? + - * = / > <) (procedure #0# ((define (iter product counter) (if (> counter n) product (iter (* counter product) (+ counter 1)))) (iter 1 1)) #1#) #f #t (primitive #<subr car>) (primitive #<subr cdr>) (primitive #<subr cons>) (primitive #<subr null?>) (primitive #<subr +>) (primitive #<subr ->) (primitive #<subr *>) (primitive #<subr =>) (primitive #<subr />) (primitive #<subr >>) (primitive #<subr <>)))) gosh>
ええと、これは factorial な手続きの一つ目の define な式を評価する直前だと見て良いのかな。
gosh> (((eceval 'get-register) 'unev) 'get)
((define (iter product counter)
(if (> counter n)
product
(iter (* counter product) (+ counter 1))))
(iter 1 1))
gosh> くく。バッチリ。てーコトはも一度 ev-sequence に戻るハズなんで、その時の環境を見てあげれば良いのかなぁ。いや。ev-sequence-continue でも止めた方が良さげ。
gosh> ((eceval 'set-break) 'ev-sequence-continue 1)
((ev-sequence-continue 1) (ev-sequence 1))
gosh> (eceval 'proceed)
(break ev-sequence-continue 1)
gosh> (((eceval 'get-register) 'env) 'get)
#0=(((iter . #1=(n))
(procedure #2=(product counter)
#3=((if (> counter n)
product
(iter (* counter product)
(+ counter 1)))) #0#) 1) .
#4=(((factorial false true car cdr cons null? + - * = / > <)
(procedure #1# ((define (iter . #2#) . #3#) (iter 1 1)) #4#)
#f
#t
(primitive #<subr car>)
(primitive #<subr cdr>)
(primitive #<subr cons>)
(primitive #<subr null?>)
(primitive #<subr +>)
(primitive #<subr ->)
(primitive #<subr *>)
(primitive #<subr =>)
(primitive #<subr />)
(primitive #<subr >>)
(primitive #<subr <>))))超見にくい。一応先頭のフレームに iter と n な束縛が見える。stack の中が見たい。
gosh> (eceval 'stack) #<closure (make-stack dispatch)> gosh>
とほほほ。proceed して env を見てみよう。
gosh> (eceval 'proceed)
(break ev-sequence 1)
gosh> (((eceval 'get-register) 'env) 'get)
#0=(((iter . #1=(n))
(procedure #2=(product counter)
#3=((if (> counter n)
product
(iter (* counter product)
(+ counter 1)))) #0#) 1) .
#4=(((factorial false true car cdr cons null? + - * = / > <)
(procedure #1# ((define (iter . #2#) . #3#) (iter 1 1)) #4#)
#f
#t
(primitive #<subr car>)
(primitive #<subr cdr>)
(primitive #<subr cons>)
(primitive #<subr null?>)
(primitive #<subr +>)
(primitive #<subr ->)
(primitive #<subr *>)
(primitive #<subr =>)
(primitive #<subr />)
(primitive #<subr >>)
(primitive #<subr <>))))同じである。ま、こうなってないと駄目なんですが。絶対何かもの凄いボケをぶちカマしてるはずだなぁ。カギとしては define-variable! が使ってる add-binding-to-frame! なんでしょうか。
なんかリスト操作なソレが全然分かってない、ってのがモロバレじゃん。てーコトで見てみる事に。面倒なので allcode な ch5 で色々試験。
gosh> (add-load-path ".") #t gosh> (define env (setup-environment)) env gosh> env (((false true car cdr cons null? + - * = / > <) #f #t (primitive #<subr car>) (primitive #<subr cdr>) (primitive #<subr cons>) (primitive #<subr null?>) (primitive #<subr +>) (primitive #<subr ->) (primitive #<subr *>) (primitive #<subr =>) (primitive #<subr />) (primitive #<subr >>) (primitive #<subr <>))) gosh> (define ex-env (extend-environment '(a b) '(1 2) env)) ex-env gosh> (define stack '()) stack gosh> (set! stack (cons ex-env stack)) ((((a b) 1 2) ((false true car cdr cons null? + - * = / > <) #f #t (primitive #<subr car>) (primitive #<subr cdr>) (primitive #<subr cons>) (primitive #<subr null?>) (primitive #<subr +>) (primitive #<subr ->) (primitive #<subr *>) (primitive #<subr =>) (primitive #<subr />) (primitive #<subr >>) (primitive #<subr <>)))) gosh> (define-variable! 'x 5 ex-env) #<undef> gosh> ex-env (((x a b) 5 1 2) ((false true car cdr cons null? + - * = / > <) #f #t (primitive #<subr car>) (primitive #<subr cdr>) (primitive #<subr cons>) (primitive #<subr null?>) (primitive #<subr +>) (primitive #<subr ->) (primitive #<subr *>) (primitive #<subr =>) (primitive #<subr />) (primitive #<subr >>) (primitive #<subr <>))) gosh> stack ((((x a b) 5 1 2) ((false true car cdr cons null? + - * = / > <) #f #t (primitive #<subr car>) (primitive #<subr cdr>) (primitive #<subr cons>) (primitive #<subr null?>) (primitive #<subr +>) (primitive #<subr ->) (primitive #<subr *>) (primitive #<subr =>) (primitive #<subr />) (primitive #<subr >>) (primitive #<subr <>)))) gosh>
わはははは。って笑うしかないな。ヤッてる途中からこんなこったろうとは思っていましたよ、はい。どうも今一つリストな操作のソレを理解できてないのかどうなのか。情無いッス。(とほほほ
