Scheme - レジスタ計算機での計算(翻訳系(翻訳したコードの例(階乗手続きの定義と効率性)))

計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著)ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著)Julie Sussman (原著)
Gerald Jay Sussman (原著)和田 英一 (翻訳)

開発環境

• OS X Yosemite - Apple (OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• Gauche (処理系)

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の5(レジスタ計算機での計算)、5.5(翻訳系)、5.5.5(翻訳したコードの例)、問題 5.33.を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)
• Scheme手習い

問題 5.33.

コード(BBEdit, Emacs)

sample33.scm

#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-

(load "./compiler.scm")

(print  (compile
         '(define (factorial-alt n)
            (if (= n 1)
                1
                (* n (factorial-alt (- n 1)))))
         'val
         'next))

入出力結果(Terminal(gosh), REPL(Read, Eval, Print, Loop))

$ ./sample33.scm
((env val) (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 (const 1)) (assign argl (op list) (reg val)) (assign val (op lookup-variable-value) (const n) (reg env)) (assign argl (op cons) (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-alt) (reg env)) (save proc) (assign proc (op lookup-variable-value) (const -) (reg env)) (assign val (const 1)) (assign argl (op list) (reg val)) (assign val (op lookup-variable-value) (const n) (reg env)) (assign argl (op cons) (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 cons) (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-alt) (reg val) (reg env)) (assign val (const ok))))
$

見やすく改行を挿入して修正。

factorial-alt手続きを翻訳した結果のレジスタ計算機。

(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 (const 1)) 
(assign argl (op list) (reg val)) 
(assign val (op lookup-variable-value) (const n) (reg env)) 
(assign argl (op cons) (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-alt) (reg env)) 
(save proc) 
(assign proc (op lookup-variable-value) (const -) (reg env)) 
(assign val (const 1)) 
(assign argl (op list) (reg val)) 
(assign val (op lookup-variable-value) (const n) (reg env)) 
(assign argl (op cons) (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 cons) (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-alt) (reg val) (reg env)) 
(assign val (const ok))

factorialとfactorial-altの結果のコードは、ラベル、false-branch4以降から異なる。

factorialの結果のコードの場合。

1. 環境(env)でnを探す。
2. nを引数arglに追加。
3. arglを保存(save)。
4. (factorial (- n 1))の評価。
5. ...

factorial-altの結果のコードの場合。

1. 環境(env)の保存(save)。
2. 環境でfactorial-altを探す。
3. (factorial-alt (- n 1))を評価。
4. ...

スタック演算について、どちらも、最大深さ、プッシュの回数は同じなので効率性は変わらない。