SICP 読み (362) 5.5 翻訳系

SICP scheme

問題 5.49

ワケワカらんなりに色々ヤッてみる。まず直前エントリの以下の手続き

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))

  (assign val (op compile->assemble) (reg exp))
  (goto (reg val))

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))

によると eceval に渡す必要がある手続きが格段に少ないはず。数えてみると

  • initialize-stack
  • read
  • get-global-environment
  • compile->assemble
  • print-stack-statistics
  • announce-output
  • user-print

と思ったら (goto (reg val)) しとるな。
compiler で翻訳され得る命令も必要か。op で ch5-compiler.scm を grep してみたら以下

  • lookup-variable-value
  • set-variable-value!
  • define-variable!
  • false?
  • make-compiled-procedure
  • compiled-procedure-env
  • extend-environment
  • list
  • cons
  • primitive-procedure?
  • compound-procedure?
  • apply-primitive-procedure
  • compiled-procedure-entry

これでも格段に少ないな。紆余曲折はありましたが、以下の定義で動いている模様。

(define eceval
  (make-machine
   '(exp env val proc argl continue unev
	 compapp			;*for compiled to call interpreted
	 )
   (list (list 'prompt-for-input prompt-for-input)
	 (list 'read read)
	 (list 'get-global-environment get-global-environment)
	 (list 'compile->assemble compile->assemble)
	 (list 'announce-output announce-output)
	 (list 'user-print user-print)
	 (list 'lookup-variable-value lookup-variable-value)
	 (list 'set-variable-value! set-variable-value!)
	 (list 'define-variable! define-variable!)
	 (list 'false? false?)
	 (list 'make-compiled-procedure make-compiled-procedure)
	 (list 'compiled-procedure-env compiled-procedure-env)
	 (list 'extend-environment extend-environment)
	 (list 'list list)
	 (list 'cons cons)
	 (list 'primitive-procedure? primitive-procedure?)
	 (list 'compound-procedure? compound-procedure?)
	 (list 'apply-primitive-procedure apply-primitive-procedure)
	 (list 'compiled-procedure-entry compiled-procedure-entry))
   '(
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))

  (assign val (op compile->assemble) (reg exp))
  (goto (reg val))

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))
)))

既存の eceval をリネイムしてその他の allcode なソレはそのまんまです。一応起動スクリプトとして以下のソレも作っております。

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

operation 的に上記の箇条書きと微妙に整合していないかも。もう少し性能面で色々見てみたい気もするんですがどう計測すれば良いか分からん世界だなぁ。(とほほほ