SICP 読み (199) 4.2.2 遅延評価の解釈系

脱出の糸口はイズコか。なんとなく体調も悪いよ。

問題 4.33

以下の試験。

      (assert-equal 1 (actual-value '(car (quote (1 2 3))) env))
      (assert-equal 2 (actual-value '(car (cdr (quote (1 2 3)))) env))
      (assert-equal 3 (actual-value '(car (cdr (cdr (quote (1 2 3))))) env))
      (assert-equal '() (actual-value '(cdr (cdr (cdr (quote (1 2 3))))) env))

いっちゃんケツで NG。

*** ERROR: Unknown expression type -- EVAL ()

eval で () を評価しようとしている模様。順に見てみます。
まず、(cdr (cdr (cdr (quote (1 2 3))))) な式の先頭の cdr が actual-value されて (procedure (z) (z (lambda (p q) q)) ) になってから apply に渡されます。続いて、(z (lambda (p q) q)) を z が (thunk (cdr (cdr (quote (1 2 3)))) env) に束縛された環境で eval されます。ここで z が actual-value され、thunk のカワを剥いだ後に再度 actual-value されます。
これは (cdr (cdr (quote (1 2 3)))) を eval する事になるので、ここからしばらく繰り返しになるな。ここでも先頭の cdr が actual-value されて (procedure (z) (z (lambda (p q) q)) ) が戻って apply に渡されます。この手続き (z (lambda (p q) q)) を z が (thunk (cdr (quote (1 2 3))) env) に束縛された環境で eval し、apply に渡す前に z が actual-value されて (中略) (cdr (quote (1 2 3))) が eval される、と。
次も先頭の cdr が actual-value されて (procedure (z) (z (lambda (p q) q)) ) が戻って apply に渡され、(z (lambda (p q) q)) を z が (thunk (quote (1 2 3)) env) に束縛された環境で eval し、apply に渡す前に z が actual-value されて (中略) (quote (1 2 3)) が eval されます。
これは (cons 1 (cons 2 (cons 3 '()))) を actual-value したソレを戻しますが、戻ってくるのは何かとゆーと、cons 手続きを 1 と (cons 2 (cons 3 ())) を渡して eval した結果を force-it した結果になります。長いけど落ち着いて続けると、まず cons が actual-value されて (procedure (m) (lambda (m) (m x y)) ) が戻って apply に渡されます。この手続き (lambda (m) (m x y)) を x が (thunk 1 env)、y が (thunk (cons 2 (cons 3 ())) env) に束縛された環境で eval します。これは手続き (procedure (m) (m x y) ) を戻しますので、z はこの手続きになる (??) 事になります。
この手続きの引数は (lambda (p q) q) になっており、actual-value によって手続きになった後、apply されます。引数は delay 済みですがさらに delay されるのかな。現時点ではこの手続きの戻りは (thunk (thunk (cons 2 (cons 3 ())) env) env) でしょうか。thunk は入れ子になっていても actual-value において thunk のガワがある限りハガす処理になっているので心配ナシ。
で、中略しますが、最終的に (cons 3 ()) が z になって () を eval して上記のメセジが eval から発信されて途中終了とゆーのが原因となります。

対処

text-of-quotation 手続きを以下に。

(define (text-of-quotation exp env)
  (define (make-cons exp)
    (if (null? (cdr exp))
        (list 'cons (car exp) (list 'quote ()))
        (list 'cons (car exp) (make-cons (cdr exp)))))
  (let ((target (cadr exp)))
    (if (pair? target)
        (actual-value (make-cons target) env)
        target)))

ってなってれば良いのだろうか。盛り込んでみて試験してみたらパス。別途、昨晩ヒリ出したリストのリストな修正も盛り込んで試験してみます。

つづき

昨晩のソレはダウトだった模様。理由を解析するリキが無い。以下が正常動作したナニ。

(define (text-of-quotation exp env)
  (define (make-cons exp)
    (if (null? (cdr exp))
	(list 'cons (car exp) (list 'quote '()))
;	(list 'cons (car exp) (make-cons (cdr exp)))))
	(if (pair? (car exp))
	    (list 'cons 
		  (make-cons (car exp))
		  (make-cons (cdr exp)))
	    (list 'cons (car exp) (make-cons (cdr exp))))))

  (let ((target (cadr exp)))
    (if (pair? target)
	(actual-value (make-cons target) env)
	target)))

試験は以下。

  ("4.33 (2)"
   ("(quote (1 2 (3 4) 5))"
    (let ((env (setup-environment)))
      (actual-value '(define (cons x y) (lambda (m) (m x y))) env)
      (actual-value '(define (car z) (z (lambda (p q) p))) env)
      (actual-value '(define (cdr z) (z (lambda (p q) q))) env)

      (assert-equal 1 (actual-value 
		       '(car (quote (1 2 (3 4) 5))) env))
      (assert-equal 2 (actual-value 
		       '(car (cdr (quote (1 2 (3 4) 5)))) env))
      (assert-equal 3 (actual-value 
		       '(car (car (cdr (cdr (quote (1 2 (3 4) 5)))))) env))
      (assert-equal 4 (actual-value 
		       '(car (cdr (car (cdr (cdr (quote (1 2 (3 4) 5))))))) env))
      (assert-equal 5 (actual-value 
		       '(car (cdr (cdr (cdr (quote (1 2 (3 4) 5)))))) env))
      (assert-equal '() (actual-value 
			 '(cdr (cdr (cdr (cdr (quote (1 2 (3 4) 5)))))) env))
      )
    )
   )

見にくいなあ。とりあえずヨシとさせて下さひ。

問題 4.34

引き続き次の問題の検討に着手。とりあえず現状の出力を確認。

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

;;; L-Eval value:
ok

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

;;; L-Eval value:
ok

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

;;; L-Eval value:
ok

;;; L-Eval input:
(cons 1 2)

;;; L-Eval value:
(compound-procedure (m) ((m x y)) <procedure-env>)

;;; L-Eval input:
(cons 1 (cons 2 (cons 3 '())))

;;; L-Eval value:
(compound-procedure (m) ((m x y)) <procedure-env>)

;;; L-Eval input:
(define l (cons 1 (cons 2 '())))

;;; L-Eval value:
ok

;;; L-Eval input:
l

;;; L-Eval value:
(compound-procedure (m) ((m x y)) <procedure-env>)

;;; L-Eval input:
(car l)

;;; L-Eval value:
1

うーん。cons で作られる procedure の表現を、なんでしょうがどうしたものやら。

つづき (問題 4.34)

遅延対は cons 手続きでのみ作られる、というのを前提とすると

(procedure (m) (m x y) 

なソレは cons と見て良いのかなぁ。遅延対を評価器デフォルトと見るのであれば、これらも評価器に組込む必要があると思うんですが、そうでもないのかなぁ。
今の時点では

• make-procedure 手続きにて parameters が (m) で body が (m x y) だったら遅延対認定して cons とかで始まるリストにする
• compound-procedure? 手続きにて 'cons で始まるリストも procedure 認定

で目印は付くかなぁ、と。あとは announce-output で先頭が cons なソレはリストな形で display してあげれば良いのでしょうか。

でもどうやって

評価器の外だったら car しながらナニなんでしょうが。中で、とゆーのは微妙だな。actual-value しながら繰返せば良いのだろうか。遅延対の切り分けはできそうですが、中でどうやってパースすりゃ良いのかが微妙。

(define (driver-loop)
  (prompt-for-input input-prompt)
  (let ((input (read)))
    (let ((output (eval input the-global-environment)))
      (announce-output output-prompt)
      (user-print output)))
  (driver-loop))

ってコトは、user-print がナニですか。

(define (user-print object)
  (if (compound-procedure? object)
      (display (list 'compound-procedure
                     (procedure-parameters object)
                     (procedure-body object)
                     '<procedure-env>))
      (display object)))

むむ。まだ、あっちとこっちが整理できてないんだろうな。さくっとイメージできん。