SICP 読み (329) 5.5 翻訳系

SICP scheme

問題 5.36

動くかどうか、試験をしてみる事に。allcode なソレから必要と思われるファイルをコピーして準備完了。コピーしたのは以下。

  • ch5-compiler.scm
  • ch5-eceval-compiler.scm
  • ch5-eceval-support.scm
  • ch5-regsim.scm
  • ch5-syntax.scm
  • load-eceval-compiler.scm

動作するかどうかを確認

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 '(define (f x) x) 'val 'return)
(略

で、昨晩のナニを盛り込んでみて
って括弧が多いって叱られた。あ、let を一つ削除したから括弧が一つ多かったんだ。やれやれ。一応 load もデキたんですがどうしたものか。factorial を吸わせてみて比較してみれば良いのか。
で、出てきたのが以下 (整形済み

((env continue) (val) 
 ((assign val (op make-compiled-procedure) (label entry1) (reg env)) 
  (goto (label after-lambda2)) 
  entry1 
  (assign env (op compiled-procedure-env) (reg proc)) 
  (assign env (op extend-environment) (const (n)) (reg argl) (reg env)) 
  (save continue) 
  (save env) 
  (assign proc (op lookup-variable-value) (const =) (reg env))
  (assign val (op lookup-variable-value) (const n) (reg env)) 
  (assign argl (op list) (reg val)) 
  (assign val (const 1)) 
  (assign argl (op adjoin-arg) (reg val) (reg argl)) 
  (test (op primitive-procedure?) (reg proc)) 
  (branch (label primitive-branch6)) 
  compiled-branch7 
  (assign continue (label after-call8)) 
  (assign val (op compiled-procedure-entry) (reg proc)) 
  (goto (reg val)) 
  primitive-branch6 
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  after-call8 
  (restore env) 
  (restore continue) 
  (test (op false?) (reg val)) 
  (branch (label false-branch4)) 
  true-branch3 
  (assign val (const 1)) 
  (goto (reg continue)) 
  false-branch4 
  (assign proc (op lookup-variable-value) (const *) (reg env)) 
  (save continue) 
  (save proc) 
  (save env) 
  (assign proc (op lookup-variable-value) (const factorial) (reg env)) 
  (save proc) 
  (assign proc (op lookup-variable-value) (const -) (reg env)) 
  (assign val (op lookup-variable-value) (const n) (reg env)) 
  (assign argl (op list) (reg val)) 
  (assign val (const 1)) 
  (assign argl (op adjoin-arg) (reg val) (reg argl)) 
  (test (op primitive-procedure?) (reg proc)) 
  (branch (label primitive-branch9)) 
  compiled-branch10 
  (assign continue (label after-call11)) 
  (assign val (op compiled-procedure-entry) (reg proc)) 
  (goto (reg val)) 
  primitive-branch9 
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) 
  after-call11 
  (assign argl (op list) (reg val)) 
  (restore proc) 
  (test (op primitive-procedure?) (reg proc)) 
  (branch (label primitive-branch12)) 
  compiled-branch13 
  (assign continue (label after-call14)) 
  (assign val (op compiled-procedure-entry) (reg proc)) 
  (goto (reg val)) 
  primitive-branch12 
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) 
  after-call14 
  (assign argl (op list) (reg val)) 
  (restore env) 
  (assign val (op lookup-variable-value) (const n) (reg env)) 
  (assign argl (op adjoin-arg) (reg val) (reg argl)) 
  (restore proc) 
  (restore continue) 
  (test (op primitive-procedure?) (reg proc)) 
  (branch (label primitive-branch15)) 
  compiled-branch16 
  (assign val (op compiled-procedure-entry) (reg proc)) 
  (goto (reg val)) 
  primitive-branch15 
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) 
  (goto (reg continue)) 
  after-call17 
  after-if5 
  after-lambda2 
  (perform (op define-variable!) (const factorial) (reg val) (reg env)) 
  (assign val (const ok)) 
  (goto (reg continue))))

動作確認はしてません (を
でもなんとかなってそうに見える。で、この問題の問いとしてコードの効率云々とあります。テキストに例示されているパターンは引数の連結を cons を使っているために一旦逆にして、という微妙なコトをしてます。ただ、分かりづらい部分はあるけど使っている op は cons という primitive な手続きなのに対して上記のソレは adjoin-arg を使っています。これは

(define (adjoin-arg val argl)
  (append argl (list val)))

という若干微妙なソレな為に非効率なのはこっちかな、と最初思っていたんですが reverse の考慮が抜けている事に今気づきました。うーん。
append も reverse も基本的に cons で作っているのを前提にしてみる。例えば以下

(define (reverse l)
  (let f ((l l) (result '()))
    (if (null? l)
	(cons result '())
	(f (cdr l) (cons (car l) result)))))
(define (append l1 l2)
  (if (null? l1)
      l2
      (cons (car l1) (append (cdr l1) l2))))

ちなみに append はテキスト 58p のナニを流用。繰り返しなソレを作ろうとしたんですがハマりかけたので止めた。(こら
基本的に (list val) が (cons val '()) だとすれば、テキストの例と問題 5.36 のナニの効率の差は reverse と append の差という事になるんですが、reverse は最初の一発のみの呼び出しなのに対して append は argl の追加の度に呼び出される。引数リストの要素数が少なければそんなに影響ないのでしょうが、という世界なのかなぁ。
なんかもの凄い大きなボケをカマしてる気がしてきた。微妙スギだったら追記を予定。