SICP 読み (357) 5.5 翻訳系

問題 5.48

昨晩なエントリによれば ch5-eceval-compiler.scm の eval-dispatch を

eval-dispatch
  (test (op self-evaluating?) (reg exp))
  (branch (label ev-self-eval))
  (test (op variable?) (reg exp))
  (branch (label ev-variable))
  (test (op quoted?) (reg exp))
  (branch (label ev-quoted))
  (test (op assignment?) (reg exp))
  (branch (label ev-assignment))
  (test (op definition?) (reg exp))
  (branch (label ev-definition))
  (test (op if?) (reg exp))
  (branch (label ev-if))
  (test (op lambda?) (reg exp))
  (branch (label ev-lambda))
  (test (op begin?) (reg exp))
  (branch (label ev-begin))
;;
  (test (op compile-and-run?) (reg exp))
  (branch (label ev-compile-and-run))
;;
  (test (op application?) (reg exp))
  (branch (label ev-application))
  (goto (label unknown-expression-type))

という分岐を追加して jmp 先を

ev-compile-and-run
;; compile->assemble したリストを val にセットして
  (assign val (op compie->assemble) (reg exp))
;; initialize-stack して
  (perform (op initialize-stack))
;; env に get-global-environment セットして
  (assign env (op get-global-environment))
;; continue に print-result セットして
  (assign continue (label print-result))
;; (goto (reg val))
  (goto (reg val))

みたいな感じにすれば良いのだろうか。
ちょっと気になるのが stack と env を初期化して良いのかどうか、という事。なんとなくヤリ杉な感じがしてるんですが ..
あとは compile->assemble な手続きは

(define (compile->assemble exp)
  (assemble (statements (compile (cadr exp) 'val 'return)) eceval))

で、eceval-operations には compile->assemble が追加されてりゃ OK かな。とゆーコトでやってみた。

gosh> (add-load-path ".")
("." "/usr/share/gauche/site/lib" "/usr/share/gauche/0.8.7/lib")
gosh> (load "load-eceval-compiler")
#t
gosh> (load "ch5-compiler")
#t
gosh> (define true #t)
true
gosh> (define false #f)
false
gosh> (compile-and-go '(define (f n) (g n)))

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

;;; EC-Eval input:
(define (factorial n) (if (= n 1) 1 (* (factorial (- n 1)) n)))  

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

;;; EC-Eval input:
(factorial 1)
*** ERROR: Empty stack -- POP
Stack Trace:
_______________________________________
  0  (pop stack)
        At line 330 of "./ch5-regsim.scm"
  1  (set-contents! reg (pop stack))
        At line 330 of "./ch5-regsim.scm"
  2  (instruction-execution-proc (car insts))
        At line 139 of "./ch5-regsim.scm"
gosh> 

実は上記に至るまでにも紆余曲折がありまして

• 試験はしてませんが stack 初期化と env 初期化はナシ
• compile-and-run? 手続きの定義と eceval-operation への追加

なんかをしとります。で、上記ですがおそらくは compiled-apply の restore がクサい。テキスト p.362 によれば

• 評価器では apply-dispatch で継続が stack のてっぺんにある
• 翻訳したコードの入口では継続が continue になければ駄目 (??)

うーん。とりあえず (factorial 1) が評価された瞬間の処理を昨日方式で見てみる。まずこの式は eval-dispatch では application 認定。なので ev-application に jmp するんですが、この時の stack の状態はどうなってるんだっけ。read-eval-print-loop で初期化されてると見て jmp 先から順に以下。

ev-application
  (save continue)
  (save env)
  (assign unev (op operands) (reg exp))
  (save unev)
  (assign exp (op operator) (reg exp))
  (assign continue (label ev-appl-did-operator))
  (goto (label eval-dispatch))

ええと、continue には print-result が入ってるんで上記の手続きを経て eval-dispatch に jmp する瞬間の stack の状態は

(label print-result) - <env> - (1)

みたいなカンジでしょうか。右側がてっぺんです。で、factorial を lookup したソレを val に置いて ev-appl-did-operator に戻ってきて以下

ev-appl-did-operator
  (restore unev)
  (restore env)
  (assign argl (op empty-arglist))
  (assign proc (reg val))
  (test (op no-operands?) (reg unev))
  (branch (label apply-dispatch))
  (save proc)
ev-appl-operand-loop
  (save argl)
  (assign exp (op first-operand) (reg unev))
  (test (op last-operand?) (reg unev))
  (branch (label ev-appl-last-arg))

これも引数一つだから上記で ev-appl-last-arg にすぐ jmp するはず。ってココまで見た時点でボケに気づく。ヤバいヤバい。上記は抹消せずにそのまま続けますが、リトライして失敗してます。以下。

gosh> (add-load-path ".")
("." "/usr/share/gauche/site/lib" "/usr/share/gauche/0.8.7/lib")
gosh> (load "load-eceval-compiler")
#t
gosh> (load "ch5-compiler")
#t
gosh> (define true #t)
true
gosh> (define false #f)
false
gosh> (compile-and-go '(define (f n) (g n)))

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

;;; EC-Eval input:
(compile-and-run '(define (factorial n) (if (= n 1) 1 (* (factorial (- n 1)) n))))

(total-pushes = 0 maximum-depth = 0)
;;; EC-Eval value:
(define (factorial n) (if (= n 1) 1 (* (factorial (- n 1)) n)))

;;; EC-Eval input:
(factorial 1)
*** ERROR: Unbound variable factorial
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"
gosh> 

compile-and-run の出力微妙杉。なんだこれは、と言いつつ続きは別途。

うーん

と言いつつ継続検討してたりなんかして。(を
それは良いのですが、何故に

;;; EC-Eval input:
(define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1)))))

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

;;; EC-Eval input:
(factorial 1)
*** ERROR: Empty stack -- POP
Stack Trace:
_______________________________________
  0  (pop stack)
        At line 330 of "./ch5-regsim.scm"
  1  (set-contents! reg (pop stack))
        At line 330 of "./ch5-regsim.scm"
  2  (instruction-execution-proc (car insts))
        At line 139 of "./ch5-regsim.scm"
gosh> 

になってしまうのだろうか (って今更 ...
# マズい、ループしてるカンジがするんだけど止まらん。

ってか、これって昨晩の(355)なソレと現象が酷似しとるんですが一体どーゆー事だ。とりあえずボケに気づいて中断したトレイスを途中から再開。
ええと ev-appl-did-operator に戻ってきて以下な時点か。

ev-appl-did-operator
  (restore unev)
  (restore env)
  (assign argl (op empty-arglist))
  (assign proc (reg val))
  (test (op no-operands?) (reg unev))
  (branch (label apply-dispatch))
  (save proc)
ev-appl-operand-loop
  (save argl)
  (assign exp (op first-operand) (reg unev))
  (test (op last-operand?) (reg unev))
  (branch (label ev-appl-last-arg))

ev-appl-last-arg に jmp する直前の stack の状態は以下か

(label print-result) - <factorial な proc> - ()

右がてっぺんです。で exp には (factorial 1) の 1 が格納。で、以下の手続きに jmp して

ev-appl-last-arg
  (assign continue (label ev-appl-accum-last-arg))
  (goto (label eval-dispatch))

immediate なソレですので val は 1 で以下に戻る

ev-appl-accum-last-arg
  (restore argl)
  (assign argl (op adjoin-arg) (reg val) (reg argl))
  (restore proc)
  (goto (label apply-dispatch))

この時点で argl と proc を restore したので stack にあるのは

(label print-result)

だけになる。ここで apply-dispatch に jmp して

apply-dispatch
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-apply))
  (test (op compound-procedure?) (reg proc))
  (branch (label compound-apply))
;;*next added to call compiled code from evaluator (section 5.5.7)
  (test (op compiled-procedure?) (reg proc))
  (branch (label compiled-apply))
  (goto (label unknown-procedure-type))

が評価されるんですが、ここでは compound 認定なので以下に jmp

compound-apply
  (assign unev (op procedure-parameters) (reg proc))
  (assign env (op procedure-environment) (reg proc))
  (assign env (op extend-environment)
              (reg unev) (reg argl) (reg env))
  (assign unev (op procedure-body) (reg proc))
  (save continue)
  (goto (label ev-sequence))

ここで continue を save しているのは問題。でもこれは昨晩のナニによるとこれをやっとかねぇと (以下略) みたいなんですが ...
両立させるためには

• 翻訳系における compound-proc-appl の修正
  • continue を save しとく必要があるが全てのケイスで必要か??
  • 少なくとも val で return な場合には必要
• 解釈系では compoundl-apply な手続きで save continue しない

なんか微妙なカンジなので 5.47 は前提としない形で盛り込んでみたんですが、不具合はナシ。ってーコトは 5.47 のソレが不適切とゆー事ですな。

つづき

上あたりで書いた以下

• 評価器では apply-dispatch で継続が stack のてっぺんにある
• 翻訳したコードの入口では継続が continue になければ駄目 (??)

確かに評価器での挙動を ev-sequence を切り口に見てみれば

ev-sequence-last-exp
  (restore continue)
  (goto (label eval-dispatch))

最後で continue を restore している。あるいは compile な手続きでは

compiled-apply
  (restore continue)
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))

continue を restore した状態で jmp しているし、jmp した先では例えば

 entry1 
 (assign env (op compiled-procedure-env) (reg proc)) 
 (assign env (op extend-environment) (const (n)) (reg argl) (reg env)) 

 (save continue) 
 (save env)

カブさる可能性があるのであれば先頭でいきなり push してたりする。てー事は翻訳系において compound な手続きの場合の処理では何かの形で continue を save してから該当手続きに jmp する必要がある、という事で翻訳系の compound-apply において continue を save したりなんかすると翻訳系で定義された手続きから翻訳系で定義された手続きを呼び出す場合に stack に不整合が生じてしまう、という事かと。
とりあえず別途、5.47 と 5.48 はまとめたいと思います。(とほほほ