SICP 読み (290) 5.4 積極制御評価器

うーん。随分前のエントリで同じコトしてる (DRY) かもしれんがヤッてみる。

検証その 1

大失敗の原因は read した式を actual-value ではなく単純に eval してた点。まず、これがどのような式を戻すのか、について検証。
基本的に以下の式の評価について検討してみます。

(define (cons x y) (lambda (m) (m x y)))
(define (car z) (z (lambda (p q) p)))
(define l (cons 1 2))
(car l)

cons も car も l も基本的には compound な手続き。以下のようなカンジ。

(compound-procedure (x y) ((lambda (m) (m x y))) <procedure-env>)
(compound-procedure (z) ((z (lambda (p q) p))) <procedure-env>)
(compound-procedure (m) ((m x y)) <procedure-env>)

で、最後の (car l) を評価器の read が読み込んで eval に渡します。どうなるか、というと

• application 認定
  • operator が actual-value された結果と operands が apply に渡る
  • actual-value は eval した式が thunk だったらカワを剥ぐ
  • actual-value から戻る式は上記の真ん中のリスト
• apply の中
  • compound 手続き認定
  • eval-sequence には *1( ) なリストが束縛されて拡張された環境が渡される
• eval-sequence が戻すソレが eval が戻す式になる

ってコトで何が具体的に戻されるのか、というと (z (lambda (p q) p)) が eval されたものが戻る、という作りになってるハズ。4.2 の手続きによればそうです。5.4 の評価器もそうなっていると信じたいです。(何
もう少しリストで先の式を eval してみると

• application 認定
  • z が actual-value されます。

で、むむむと唸る。よく見ると違うぞ。間違えを残したまんまで再度。

• (car l) が eval に渡される
• eval の中で application 認定
• car が actual-value されて (compound-procedure ..) になって apply に
• (l) はそのまんまで apply に
• apply の中では compound 認定
• eval-sequence に渡される式は )((z (lambda (p q) p)))(
• eval-sequence に渡される環境は z に (thunk l ) が束縛され拡張されたもの

が正しいハズ。本当かなぁ。

• (z (lambda (p q) p)) は application 認定
• z が actual-value される
• eval したら (thunk l ) が戻るので force-it でカワを剥いで再度 actual-value
• 戻ってくるのは compound な手続き
• apply に渡されるのは上記の最後の手続きと ((lambda (p q) p)) というリスト
• apply では compound 認定される
• eval-sequence に渡されるのは ((m x y)) という手続きと m に (thunk (lambda (p q) p)) が束縛され拡張された環境

段々嫌になってきたなぁ。頑張って続ける。

• eval-sequence で (m x y) が eval される
• これは勿論 application 認定
• m が actual-value される。eval した後のリストから thunk を取り除いた (lambda (p q) p) をさらに eval
• lambda 認定で make-procedure される
• (procedure (p q) (p) ) なリスト (compound な手続き) が戻る

はあはあ。で、何処に戻るんだっけ??

• apply されるんだった。上記のリストと (x y) が apply に渡る。ちなみに x と y は既に 1 と 2 に束縛されている状態のはず
• apply においては compound な手続き認定
• eval-sequence に渡されるのは (p) という手続き (??) と p と q が (thunk x ) と (thunk y ) に束縛され拡張された環境
• eval-sequence の中で p は eval される。
• 束縛されているのは (thunk x ) でそれが戻る

thunk が戻って評価器が困る (困らないか) のは分かりますが、何故にこれがループなんだろうか。環境が馬鹿デカ杉でループに見えただけなの??
それとも環境の中に循環参照なリストがある、とか??

微妙に尻切れ状態だし。(とほほ

追記

上記の検討が正しいかどうかも含め、別途検証してみます。

うーん

guile に一連の手続きを吸わせて (car l) したら以下のようなリストが出てきた。

(thunk 
 x 
 (((m) 
   (thunk (lambda (p q) p) 
	  (((z) 
	    (thunk l 
		   (((l false true car cdr cons null? + - * = / > <) 
		     (procedure (m) ((m x y)) 
				(((x y) (thunk 1 #-12#) (thunk 2 #-13#)) . #-7#)) 
		     #f 
		     #t 
		     (procedure (z) ((z (lambda (p q) p))) #-9#) 
		     (primitive #<primitive-procedure cdr>) 
		     (procedure (x y) ((lambda (m) (m x y))) #-11#) 
		     (primitive #<primitive-procedure null?>) 
		     (primitive #<primitive-generic +>) 
		     (primitive #<primitive-generic ->) 
		     (primitive #<primitive-generic *>) 
		     (primitive #<primitive-generic =>) 
		     (primitive #<primitive-generic />) 
		     (primitive #<primitive-generic >>) 
		     (primitive #<primitive-generic <>))))) 
	   ((l false true car cdr cons null? + - * = / > <) 
	    (procedure (m) ((m x y)) (((x y) (thunk 1 #-12#) (thunk 2 #-13#)) . #-7#)) 
	    #f 
	    #t 
	    (procedure (z) ((z (lambda (p q) p))) #-9#) 
	    (primitive #<primitive-procedure cdr>) 
	    (procedure (x y) ((lambda (m) (m x y))) #-11#) 
	    (primitive #<primitive-procedure null?>) 
	    (primitive #<primitive-generic +>) 
	    (primitive #<primitive-generic ->) 
	    (primitive #<!primitive-generic *>) 
	    (primitive #<primitive-generic =>) 
	    (primitive #<primitive-generic />) 
	    (primitive #<primitive-generic >>) 
	    (primitive #<primitive-generic <>))))) 
  ((x y) 
   (thunk 1 (((l false true car cdr cons null? + - * = / > <) 
	      (procedure (m) ((m x y)) #-12#) 
	      #f 
	      #t 
	      (procedure (z) ((z (lambda (p q) p))) #-9#) 
	      (primitive #<primitive-procedure cdr>) 
	      (procedure (x y) ((lambda (m) (m x y))) #-11#) 
	      (primitive #<primitive-procedure null?>) 
	      (primitive #<primitive-generic +>) 
	      (primitive #<primitive-generic ->) 
	      (primitive #<primitive-generic *>) 
	      (primitive #<primitive-generic =>) 
	      (primitive #<primitive-generic />) 
	      (primitive #<primitive-generic >>) 
	      (primitive #<primitive-generic <>)))) 
   (thunk 2 (((l false true car cdr cons null? + - * = / > <) 
	      (procedure (m) ((m x y)) #-13#) 
	      #f 
	      #t 
	      (procedure (z) ((z (lambda (p q) p))) #-9#) 
	      (primitive #<primitive-procedure cdr>) 
	      (procedure (x y) ((lambda (m) (m x y))) #-11#) 
	      (primitive #<primitive-procedure null?>) 
	      (primitive #<primitive-generic +>) 
	      (primitive #<primitive-generic ->) 
	      (primitive #<primitive-generic *>) 
	      (primitive #<primitive-generic =>) 
	      (primitive #<primitive-generic />) 
	      (primitive #<primitive-generic >>) 
	      (primitive #<primitive-generic <>))))) 
  ((l false true car cdr cons null? + - * = / > <) 
   (procedure (m) ((m x y)) #-7#) 
   #f 
   #t 
   (procedure (z) ((z (lambda (p q) p))) #-9#) 
   (primitive #<primitive-procedure cdr>) 
   (procedure (x y) ((lambda (m) (m x y))) #-11#) 
   (primitive #<primitive-procedure null?>) 
   (primitive #<primitive-generic +>) 
   (primitive #<primitive-generic ->) 
   (primitive #<primitive-generic *>) 
   (primitive #<primitive-generic =>) 
   (primitive #<primitive-generic />) 
   (primitive #<primitive-generic >>) 
   (primitive #<primitive-generic <>))))

一応、(thunk x ) なリストが戻ってきている模様。何故に gosh で segmentation fault だったのか、は中身を見てみないと分かりませんな。

評価

4.2.3 節のソレを試してみる。

;;; EC-Eval input:
(define (cons x y)
  (lambda (m) (m x y)))

(total-pushes = 4 maximum-depth = 4)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(define (car z)
  (z (lambda (p q) p)))

(total-pushes = 4 maximum-depth = 4)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(define (cdr z)
  (z (lambda (p q) q)))

(total-pushes = 4 maximum-depth = 4)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(define (list-ref items n)
  (if (= n 0)
      (car items)
      (list-ref (cdr items) (- n 1))))

(total-pushes = 4 maximum-depth = 4)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(define (map proc items)
  (if (null? items)
      '()
      (cons (proc (car items))
            (map proc (cdr items)))))

(total-pushes = 4 maximum-depth = 4)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(define (scale-list items factor)
  (map (lambda (x) (* x factor))
       items))

(total-pushes = 4 maximum-depth = 4)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(define (add-lists list1 list2)
  (cond ((null? list1) list2)
        ((null? list2) list1)
        (else (cons (+ (car list1) (car list2))
                    (add-lists (cdr list1) (cdr list2))))))

(total-pushes = 4 maximum-depth = 4)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(define ones (cons 1 ones))

(total-pushes = 14 maximum-depth = 9)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(define integers (cons 1 (add-lists ones integers)))

(total-pushes = 14 maximum-depth = 9)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(list-ref integers 17)
*** ERROR: Unbound variable cond
Stack Trace:
_______________________________________
  0  (map (lambda (p) (p)) aprocs)
        At line 385 of "./ch5-regsim.scm"
  1  value-proc

  2  (set-contents! target (value-proc))
        At line 258 of "./ch5-regsim.scm"
  3  (instruction-execution-proc (car insts))
        At line 139 of "./ch5-regsim.scm"
$

ぐは (吐血
先に気づかないかなぁ。5.23 の解を盛り込む必要あり。一応 cond->if はあるから何とかなるな、と言いつつ cond のみ盛り込み。リトライ。手続きの定義は略

;;; EC-Eval input:
(list-ref integers 17)

だんまり。top とか見てみたら CPU を 97% くらい使って一生懸命お仕事をされている様子。頑張れよー、と言いつつ我慢。
処理時間が 10 分を越えましたが、未だレスポンス無し。

戻ってきた

;;; EC-Eval input:
(list-ref integers 17)

(total-pushes = 25691416 maximum-depth = 141)
;;; EC-Eval value:
18

;;; EC-Eval input:

30分はかかってるはず。iKnow のレッスンひとつ終わった時点で見たら戻ってきていた。iKnow のレッスン開始時点で 25 分は経過していたはず。push の回数凄いな。

*1:z (lambda (p q) p))) と z に thunk された (compound-procedure (m) )((m x y