SICP演習問題5.35

今回は，載っている翻訳済のコードを生み出すような式をもとめよ，という問題
翻訳済のコードは以下のもの．(SICPのサイトより抜粋)

(assign val (op make-compiled-procedure) (label entry16)
                                           (reg env))
  (goto (label after-lambda15))
entry16
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env
          (op extend-environment) (const (x)) (reg argl) (reg env))
  (assign proc (op lookup-variable-value) (const +) (reg env))
  (save continue)
  (save proc)
  (save env)
  (assign proc (op lookup-variable-value) (const g) (reg env))
  (save proc)
  (assign proc (op lookup-variable-value) (const +) (reg env))
  (assign val (const 2))
  (assign argl (op list) (reg val))
  (assign val (op lookup-variable-value) (const x) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch19))
compiled-branch18
  (assign continue (label after-call17))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch19
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call17
  (assign argl (op list) (reg val))
  (restore proc)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch22))
compiled-branch21
  (assign continue (label after-call20))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch22
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))

after-call20
  (assign argl (op list) (reg val))
  (restore env)
  (assign val (op lookup-variable-value) (const x) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (restore proc)
  (restore continue)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch25))
compiled-branch24
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch25
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
after-call23
after-lambda15
  (perform (op define-variable!) (const f) (reg val) (reg env))
  (assign val (const ok))

気が付くところ

• ここで使われる変数，定数などはg,x,+,2,f
• make-comiled-procedureから始まっている
  • つまりdefineで始まる式
• entry16において，(save continue), (save proc) (save env)が続く
  • g(おそらくあらかじめ定義された関数)の前にxを使い，そして，gの引数としてxを使い，さらに，gに渡すときに, xに修正を加える
  • おそらく(+ x (g (+ x 2)))となる?
  • 2は(assign val (const 2))から伺える
• 最後に，(perform (op definition-variable!) (const f) (reg val) (reg env))を行う
  • 今回定義する関数の名前はf

ということで，以下のようなコードを翻訳する

(print-after-compiler
 (compile
  '(define (f x)
     (+ x (g (+ x 2))))
  'val
  'next))

結果

(env)
(val)
  (assign val (op make-compiled-procedure) (label entry38) (reg env))
  (goto (label after-lambda39))
entry38
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env (op extend-environment) (const (x)) (reg argl) (reg env))
  (assign proc (op lookup-variable-value) (const +) (reg env))
  (save continue)
  (save proc)
  (save env)
  (assign proc (op lookup-variable-value) (const g) (reg env))
  (save proc)
  (assign proc (op lookup-variable-value) (const +) (reg env))
  (assign val (const 2))
  (assign argl (op list) (reg val))
  (assign val (op lookup-variable-value) (const x) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch40))
compiled-branch41
  (assign continue (label after-call42))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch40
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call42
  (assign argl (op list) (reg val))
  (restore proc)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch43))
compiled-branch44
  (assign continue (label after-call45))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch43
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call45
  (assign argl (op list) (reg val))
  (restore env)
  (assign val (op lookup-variable-value) (const x) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (restore proc)
  (restore continue)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch46))
compiled-branch47
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch46
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
after-call48
after-lambda39
  (perform (op define-variable!) (const f) (reg val) (reg env))
  (assign val (const ok))
#<undef>

できた！