SICP 読み (369) 5.5 翻訳系

SICP scheme

問題 5.50

とりあえず前のエントリの修正を盛り込んで不具合対応予定。
あと、

  • set-breakpoint
  • proceed-machine
  • cancel-breakpoint
  • cancel-all-breakpoints

も。冗長ですが同じ試験に以下を挿入。

  (cancel-all-breakpoints m)
  (test* "breakpoints register is ()"
	 '()
	 (get-contents ((m 'get-register) 'breakpoints)))
  (set-breakpoint m 'test-b 1)
  (test* "breakpoints register is ((test-b 1))"
	 '((test-b 1))
	 (get-contents ((m 'get-register) 'breakpoints)))
  (set-breakpoint m 'test-b 2)
  (test* "breakpoints register is ((test-b 2) (test-b 1))"
	 '((test-b 2) (test-b 1))
	 (get-contents ((m 'get-register) 'breakpoints)))

  (set-register-contents! m 'a 206)
  (set-register-contents! m 'b 40)
  (test* "stop (test-b 1)" '(break test-b 1) (start m))
  (test* "stop (test-b 2)" '(break test-b 2) (proceed-machine m))

あと、make-assign な試験に以下を追加。

  ;; (assign b (op rem) (reg a) (label gcd-done)) ??
  (let ((ope (make-assign '(assign a (op make-compiled-procedure) (label entry1) (reg env))
			  m
			  '((entry1 ()))
			  (m 'operations)
			  ((m 'get-register) 'pc))))
    (set-contents! ((m 'get-register) 'pc) '(() (gcd-done ())))
    (set-contents! ((m 'get-register) 'env) '())
    (ope)
    (test* "value of register a" '(compiled-procedure (()) ())
	   (get-contents ((m 'get-register) 'a)))
    )

うーん ... 醜い。
とりあえず、順に unbound variable なソレ達をツブしていこう。でも何をドコに、なんだったっけか。盛り込むのは ch5-eceval-compiler.scm の eceval-operation か。
なんか違うクサい。

(assign proc (op lookup-variable-value) (const cdddr) (reg env))

な式の (const cdddr) な lookup に失敗している模様。eceval-operation は (op なんたら) の cadr を解決するためのはず、かなぁ。const なソレはどうやってるんだったか。

(define (make-primitive-exp exp machine labels)
  (cond ((constant-exp? exp)
         (let ((c (constant-exp-value exp)))
           (lambda () c)))

assembler が戻すのは ch5-regsim の上記の部分だと思うんですが、戻る lambda 式を実際に評価するのは誰だ。
あ、そうか lookup の対象 (と言えば良いのか) は環境か。setup-environment を定義しているのは ch5-eceval-support.scm ですな。ここの primitive-procedure に追加すれば良いのかな。
良いみたいですが、次は caddr との事。で順に以下を盛り込んで

  • cdddr
  • caddr
  • cddr
  • cadr
  • assoc
  • min
  • max
  • even?
  • odd?
  • negative?
  • positive?
  • zero?
  • >=
  • <=
  • integer?
  • rational?
  • real?
  • complex?
  • number?
  • equal?
  • eq?
  • eqv?

再度原因不明の異常終了。とゆーのもスクロールバーでめくれる幅を越えてメセジが出力されているので、と思われる。仕方が無いので

(add-load-path ".")
(load "load-eceval-compiler")
(load "ch5-compiler")
(load "objectCode.txt")
(define true #t)
(define false #f)

(set! the-global-environment (setup-environment))
(set-register-contents! eceval 'val (assemble objectCode eceval))
(set-register-contents! eceval 'flag true)
;; insert debugger instruction
;;(set-breakpoint eceval 'entry0 1)
(start eceval)

なスクリプトで

$ gosh load-5.50.scm 2>err.log

で見てみた。

*** ERROR: invalid application: (略)
Stack Trace:
_______________________________________
  0  args

  1  (map (lambda (p) (p)) aprocs)
        At line 500 of "./ch5-regsim.scm"
  2  value-proc

  3  (set-contents! target (value-proc))
        At line 371 of "./ch5-regsim.scm"
  4  (instruction-execution-proc (car insts))
        At line 192 of "./ch5-regsim.scm"

との事。ちなみに先頭部分が

((compiled-procedure 
  ((((entry1337 1) assign env (op compiled-procedure-env) (reg proc)) . #<closure (make-assign make-assign)>)

みたいな感じ。これは make-compiled-procedure が作るリストだなぁ。あ、違うぞ。make-compiled- が作るリストを () で囲んで eval しようとしてるクサい。うーん。とりあえずな切り口としてはラベルか。
てコトで compile 済みなリストの entry1337 周辺を見てみると以下

after-lambda1331 
(perform (op define-variable!) (const primitive-procedure-names) (reg val) (reg env)) 
(assign val (const ok))
(assign val (op make-compiled-procedure) (label entry1335) (reg env))
(goto (label after-lambda1336))
entry1335
(assign env (op compiled-procedure-env) (reg proc))
(assign env (op extend-environment) (const ()) (reg argl) (reg env))
(assign proc (op lookup-variable-value) (const map) (reg env))
(assign val (op lookup-variable-value) (const primitive-procedures) (reg env))
(assign argl (op list) (reg val))
(assign val (op make-compiled-procedure) (label entry1337) (reg env))
(goto (label after-lambda1338))
entry1337
(assign env (op compiled-procedure-env) (reg proc))
(assign env (op extend-environment) (const (proc)) (reg argl) (reg env))
(assign proc (op lookup-variable-value) (const list) (reg env))

うーん。こっち見ても駄目そげ。現時点で何が悪いのか、が全然イメージできてません。明日、見るナニがあれば再度検証予定ってコトで寝ます。