計算機プログラムの構造と解釈

posted with amazlet at 09.12.29

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 119177

Amazon.co.jp で詳細を見る

SICP を読む過程で得たもの

1章で scheme での基本的なプログラミングに慣れて、カッコの存在を忘れることが出来た。

弟子が尋ねた。「先生、私は先生がカッコをまるで魔術師のように扱っているのを常々敬服しています。どうすれば先生のようになれるのでしょうか?」
師「えっ?カッコ?あ、そうか。そんなものもあったな。いやあ、すっかり忘れておったわ」

このあたりでは、まだ再帰に慣れていなくて、末尾再帰の意味もよく解ってなかった。
また、高階手続きを普通に使えるようになった。

2章で抽象化の有用性やその導入方法を理解できた。
1章2章は数学的な知識が必要な部分も多く、その部分で苦労した。

2章のデータ抽象や3章の環境モデルでオブジェクト指向の舞台裏を覗き、3章では遅延評価の一端に触れることができた。
3章で初めて set! による代入が登場し、参照透明性の破れによる副作用を理解した。

4章でインタプリタを実装し、遅延評価や継続・論理型プログラミングを実装を通して理解できた。

5章でレジスタのしくみを理解して、インタプリタとコンパイラとの違いを理解できた。
といっても、5章はかなりとばしていったので、ちゃんと理解したかというと・・・

まとめ

全てを読み終えてみると、章を追うごとに計算機プログラムのより低レベルの部分に降りていく感じがした。
そういう意味では、1章から順に読み進めていかないと理解できなかったと思う。
そして、1人で SICP を読むにはネットの情報なしには読めなかったと思う、ネットに記事を書いてくださった皆様、ありがとうございました。

SICP では scheme を使ったけれどもマクロなどは一切登場しなかったので、次は OnLisp で lisp のマクロについて勉強してみようかな。

On Lisp

posted with amazlet at 09.12.29

ポール グレアム 野田 開
オーム社
売り上げランキング: 41558

Amazon.co.jp で詳細を見る

参考にしたサイト集

SICP公式サイト

Welcome to the SICP Web Site

公式サイト

SICP Web Site for the Japanese Edition

日本語版公式サイト

SICP解答例

SICP関数型言語の勉強に「計算機プログラムの構造と解釈」を読もう – ひげぽん OSとか作っちゃうかMona-

解答例あり

『計算機プログラムの構造と解釈 第二版』解答集(未完) – Answer Book | SICP | OSS-Web

解答例あり

素人くさいSICP読書会 Wiki – SICP Reading’s Wiki

解答例あり

計算機プログラムの構造と解釈 – assari

解答例あり

ボクノス

解答例あり

[SICP] – さかもっちゃんちゃんこ

解答例あり

いろいろてｓｔ: SICP

解答例あり

Eli Bendersky’s website » SICP

解答例あり

SICP 関連記事

「計算機プログラムの構造と解釈(SICP)」を読み終えて – ひげぽん OSとか作っちゃうかMona-

SICP 読後感

なつたん: 「計算機プログラムの構造と解釈(SICP)」を読み終えて by なつたん

SICP 読後感

SICP終了 – さかもっちゃんちゃんこ

SICP 読後感

本当のプログラミング初心者がSICPを読んではいけない三つの理由 – ヤドカリデンキ商会（第一倉庫）

その他

『計算機プログラムの構造と解釈』について

その他

404 Blog Not Found:(いい本) – 書評 – 計算機プログラムの構造と解釈(SICP)

その他

いまSICPを読むのは時間の無駄 – きしだのはてな

その他

SICPの価値 – きしだのはてな

その他

「たしなみ」ではなく「たのしみ」としてのSICP – 思っているよりもずっとずっと人生は短い。

その他

「計算機プログラムの構造と解釈」は読む価値がないか？ – なるひこの Linux Printing お勉強日記

その他

Gauche 関連リンク集

Gauche – A Scheme Interpreter

Gauche 公式サイト

Gauche ユーザリファレンス: Top

Gauche のリファレンスマニュアル

Gaucheクックブック

Gauche の実用的な短いコードを提示。毎週月曜、木曜に更新

Gaucheプログラミング(立読み版)

karetta.jpのWebBook

その他

Shibuya.lisp

We love Lisp-based languages Common Lisp, Scheme, Arc and Clojure.

【SICP】計算機プログラムの構造と解釈 Part2

2ちゃんねる SICP スレッド

4.1節の超循環評価器を compile-and-go させる。

primitive-procedures に必要な手続きを追加していく。
また、let が定義されていなかったので基本手続きに let を追加する。
レジスタ計算機シミュレータの make-new-machine は性能監視機能を追加したものを使った。
環境へ基本手続きを登録する際に map が上手く動作しなかったので "いろいろてｓｔ: SICP問題5.50" を参考にして map を定義し primitive-procedure-objects を修正した。
また、ece4compiler.scm の compile-and-go の (eceval 'trace-on) のコメントアウトを解除すると実行をトレースできる。

とりあえず、ちゃんと動作するようになったのでファイル(sicp-ex5.50.zip)をアップロードしておく。

実行結果

$ gosh
gosh> (load "./compiled-eval.scm")

(total-pushes = 1669 max-depth = 123)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(driver-loop)

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

;;; M-Eval value:
ok

;;; M-Eval input:
(factorial 5)

;;; M-Eval value:
120

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る

式を "読み込み(read-eval-print-loop)"、それを"翻訳(compile)"し、結果のコードを"アセンブリ(assemble)"して実行し、結果を"印字(print-result)"する。

(load "./register_machine.scm")
(load "./compiler.scm")

(define (empty-arglist) '())

(define (last-operand? ops)
  (null? (cdr ops)))

(define (adjoin-arg arg arglist)
  (append arglist (list arg)))

(define the-global-environment (setup-environment))

(define (get-global-environment)
  the-global-environment)

(define (make-compiled-procedure entry env)
  (list 'compiled-procedure entry env))

(define (compiled-procedure? proc)
  (tagged-list? proc 'compiled-procedure))

(define (compiled-procedure-entry c-proc)
  (cadr c-proc))

(define (compiled-procedure-env c-proc)
  (caddr c-proc))

(define (make-register-machine) register-machine)

(define operations
  (list (list 'self-evaluating? self-evaluating?)
        (list 'variable? variable?)
        (list 'quoted? quoted?)
        (list 'assignment? assignment?)
        (list 'definition? definition?)
        (list 'if? if?)
        (list 'lambda? lambda?)
        (list 'begin? begin?)
        (list 'application? application?)
        ;;;
        (list 'lookup-variable-value lookup-variable-value)
        (list 'text-of-quotation text-of-quotation)
        (list 'lambda-parameters lambda-parameters)
        (list 'lambda-body lambda-body)
        (list 'make-procedure make-procedure)
        (list 'operands operands)
        (list 'operator operator)
        (list 'empty-arglist empty-arglist)
        (list 'no-operands? no-operands?)
        (list 'first-operand first-operand)
        (list 'last-operand? last-operand?)
        (list 'adjoin-arg adjoin-arg)
        (list 'rest-operands rest-operands)
        (list 'primitive-procedure? primitive-procedure?)
        (list 'compound-procedure? compound-procedure?)
        (list 'apply-primitive-procedure apply-primitive-procedure)
        (list 'procedure-parameters procedure-parameters)
        (list 'procedure-environment procedure-environment)
        (list 'extend-environment extend-environment)
        (list 'procedure-body procedure-body)
        (list 'begin-actions begin-actions)
        (list 'first-exp first-exp)
        (list 'last-exp? last-exp?)
        (list 'rest-exps rest-exps)
        (list 'if-predicate if-predicate)
        (list 'true? true?)
        (list 'if-alternative if-alternative)
        (list 'if-consequent if-consequent)
        (list 'assignment-variable assignment-variable)
        (list 'assignment-value assignment-value)
        (list 'set-variable-value! set-variable-value!)
        (list 'definition-variable definition-variable)
        (list 'definition-value definition-value)
        (list 'define-variable! define-variable!)
        (list 'prompt-for-input prompt-for-input)
        (list 'read read)
        (list 'get-global-environment get-global-environment)
        (list 'announce-output announce-output)
        (list 'user-print user-print)
        (list 'make-compiled-procedure make-compiled-procedure)
        (list 'compiled-procedure? compiled-procedure?)
        (list 'compiled-procedure-entry compiled-procedure-entry)
        (list 'compiled-procedure-env compiled-procedure-env)
        (list 'list list)
        (list 'cons cons)
        (list 'false? false?)
        (list 'print-stack-statistics)
        (list 'make-register-machine make-register-machine)
        (list 'compile compile)
        (list 'statements statements)
        (list 'assemble assemble)
        ))

(define register-machine
  (make-machine
    '(exp env val proc argl continue unev compapp machine)
    operations
    '(
        (assign machine (op make-register-machine))
      read-eval-print-loop
        (perform (op initialize-stack))
        (perform
          (op prompt-for-input) (const ";;; RM-Eval input:"))
        (assign exp (op read))
        (assign env (op get-global-environment))
        (assign continue (label print-result))
        (goto (label compile))
      print-result
        (perform (op print-stack-statistics))
        (perform
          (op announce-output) (const ";;; RM-Eval value:"))
        (perform (op user-print) (reg val))
        (goto (label read-eval-print-loop))
      compile
        (assign exp (op compile) (reg exp) (const val) (const return))
        (assign exp (op statements) (reg exp))
        (goto (label assemble))
      assemble
        (assign val (op assemble) (reg exp) (reg machine))
        (goto (reg val))
      )))

(define (start-register-machine)
  (set! the-global-environment (setup-environment))
  (set-register-contents! register-machine 'flag false)
  (start register-machine))

実行結果

$ gosh
gosh> (load "./sicp-ex5.49.scm")
#t
gosh> (start-register-machine)

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

(total-pushes = 0 max-depth = 0)
;;; RM-Eval value:
ok

;;; RM-Eval input:
(factorial 5)

(total-pushes = 26 max-depth = 14)
;;; RM-Eval value:
120

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る

;; 環境に compile-and-run を基本手続として追加する。
(define (setup-environment2)
  (extend-environment
    (list 'compile-and-run)
    (list (list 'primitive compile-and-run))
    (setup-environment)))

;; setup-environment2 を呼び出すように変更する。
(define (compile-and-go expression)
  (let ((instructions
          (assemble (statements
                      (compile expression 'val 'return))
                    eceval)))
       (set! the-global-environment (setup-environment2))
       (set-register-contents! eceval 'val instructions)
       (set-register-contents! eceval 'flag true)
       (start eceval)))

(define (compile-and-run? proc)
  (tagged-list? proc 'compile-and-run))

(define (compile-and-run expression)
  (let ((instructions
          (assemble (statements
                      (compile expression 'val 'return))
                    eceval)))
       (set-register-contents! eceval 'val instructions)
       (set-register-contents! eceval 'flag true)
       (start eceval)))

(define eceval-operations
  (list (list 'self-evaluating? self-evaluating?)
        ;; 省略
        (list 'compile-and-run? compile-and-run?)
        (list 'compile-and-run compile-and-run)
        ;; 省略
        ))

(define eceval
      ;; 省略
      ev-compile-and-run
        (perform (op compile-and-run) (reg exp))
        (goto (reg continue))
      ;; 省略
      )))

翻訳した Factorial 手続き(factorial)と合成手続きの Factorial (factorial2) での total-pushes と max-depth を比較すると、積極制御評価器上で compile-and-run 手続きを使って翻訳できていることがわかる。

$ gosh
gosh> (load "./ece4compiler.scm")
#t
gosh> (compile-and-go
  '(define (square x) (* x x)))

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

;;; EC-Eval input:
(square 4)

(total-pushes = 5 max-depth = 3)
;;; EC-Eval value:
16

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

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

;;; EC-Eval input:
(factorial 5) ; <= 翻訳した Factorial

(total-pushes = 31 max-depth = 14)
;;; EC-Eval value:
120

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

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

;;; EC-Eval input:
(factorial2 5) ; <= 合成手続き（解釈された手続き）の Factorial

(total-pushes = 144 max-depth = 28)
;;; EC-Eval value:
120

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る

元の翻訳系では翻訳した手続きが合成手続き（解釈される手続き）を呼び出せない。

$ gosh
gosh> (load "./ece4compiler.scm")
#t
(compile-and-go
  '(begin
     (define (g x) (+ x 10))
     (define (f x) (g x))))

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

;;; EC-Eval input:
(f 1) ; <= 翻訳した手続き g を呼び出す

(total-pushes = 5 max-depth = 3)
;;; EC-Eval value:
11

;;; EC-Eval input:
(define (g x) (+ x 20)) ; <= 合成手続きを定義する

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

;;; EC-Eval input:
(f 1) ; <= 合成手続き g の呼び出しに失敗する
*** ERROR: pair required, but got x
Stack Trace:
_______________________________________
  0  (instruction-execution-proc (car insts))
        At line 129 of "./register_machine.scm"
  1  (instruction-execution-proc (car insts))
        At line 129 of "./register_machine.scm"
gosh>

compile-proc-appl と同様の条件分岐を追加する。
compound-apply に移動するために continue を退避させる。

(define (compile-procedure-call target linkage)
  (let ((primitive-branch (make-label 'primitive-branch))
        (compiled-branch (make-label 'compiled-branch))
        (after-call (make-label 'after-call)))
       (let ((compiled-linkage
               (if (eq? linkage 'next) after-call linkage)))
            (append-instruction-sequences
              (make-instruction-sequence '(proc) '()
                                         `((test (op primitive-procedure?) (reg proc))
                                           (branch (label ,primitive-branch))))
              (make-instruction-sequence '(proc) '()
                                         `((test (op compiled-procedure?) (reg proc))
                                           (branch (label ,compiled-branch))))
              (parallel-instruction-sequences
                (cond ((and (eq? target 'val) (not (eq? compiled-linkage 'return)))
                       (make-instruction-sequence '(proc)all-regs
                                                  `((assign continue (label ,compiled-linkage))
                                                    (save continue)
                                                    (goto (reg compapp)))))
                      ((and (not (eq? target 'val))
                            (not (eq? compiled-linkage 'return)))
                       (let ((proc-return (make-label 'proc-return)))
                            (make-instruction-sequence '(proc) all-regs
                                                       `((assign continue (label ,proc-return))
                                                         (save continue)
                                                         (goto (reg compapp))
                                                         ,proc-return
                                                         (assign ,target (reg val))
                                                         (goto (label ,compiled-linkage))))))
                      ((and (eq? target 'val) (eq? compiled-linkage 'return))
                       (make-instruction-sequence '(proc continue) all-regs
                                                  '((save continue)
                                                    (goto (reg compapp)))))
                      ((and (not (eq? target 'val)) (eq? compiled-linkage 'return))
                       (error "return linkage, target not val -- COMPILE"
                              target)))
                (parallel-instruction-sequences
                  (append-instruction-sequences
                    compiled-branch
                    (compile-proc-appl target compiled-linkage))
                  (append-instruction-sequences
                    primitive-branch
                    (end-with-linkage linkage
                                      (make-instruction-sequence '(proc argl)
                                                                 (list target)
                                                                 `((assign ,target
                                                                           (op apply-primitive-procedure)
                                                                           (reg proc)
                                                                           (reg argl))))))))
                after-call))))

compapp レジスタの追加と初期化コードを加える。

(define eceval
  (make-machine
    '(exp env val proc argl continue unev compapp)
    eceval-operations
    '(
        (assign compapp (label compound-apply))
        (branch (label external-entry)) ; flag が設定してあれば分岐する
      read-eval-print-loop
      ;; 省略

実行結果

$ gosh
gosh> (load "./ece4compiler.scm")
#t
(compile-and-go
  '(begin
     (define (g x) (+ x 10))
     (define (f x) (g x))))

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

;;; EC-Eval input:
(f 1) ; <= 翻訳した手続き g を呼び出す

(total-pushes = 5 max-depth = 3)
;;; EC-Eval value:
11

;;; EC-Eval input:
(define (g x) (+ x 20)) ; <= 合成手続きを定義する

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

;;; EC-Eval input:
(f 1) ; <= 合成手続き g を呼び出す

(total-pushes = 14 max-depth = 5)
;;; EC-Eval value:
21

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る

プッシュ回数の比較

n の増加にともなって実行時間の差が大きくなってくる。

最大スタック深さの比較

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る

push回数

push回数での翻訳版に対する各比率は、解釈版が約5.33、特殊目的版が約0.33に収束している。

最大スタック深さ

最大スタック深さでの翻訳版に対する各比率は、解釈版が約1.67、特殊目的版が約0.66に収束している。

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る

実行には以下のファイル群を利用する。

• compiler.scm (5.5節の翻訳系)
• ece4compiler.scm (5.4節の積極制御評価器計算機)
• eval4ece.scm (4.1節の超循環評価器)
• register_machine.scm (5.2節のレジスタ計算機)

これらをまとめたアーカイブ(sicp5.5.7.zip)。

実行してみる。

$ gosh
gosh> (load "./ece4compiler.scm")
#t
gosh> (compile-and-go
  '(define (factorial n)
     (if (= n 1)
         1
         (* (factorial (- n 1))  n))))

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

;;; EC-Eval input:
(factorial 5)

(total-pushes = 31 max-depth = 14)
;;; EC-Eval value:
120

ちゃんと動作している。

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る

compile の振り分け時に定義が上書きされているかを調べる。

(define (compile exp target linkage ct-env)
  ;; 省略
        ((open-code-operator? exp ct-env)
         (compile-open-code exp target linkage ct-env))
  ;; 省略
        (else
          (error "Unknown expression type -- COMPILE" exp))))

(define (overwrite? operator ct-env)
  (let ((addr (find-variable operator ct-env)))
       (eq? addr 'not-found)))

(define (open-code-operator? exp ct-env)
  (and (memq (car exp) '(+ - * / =))
       (overwrite? (operator exp) ct-env)))

定義を上書きしている場合。

(parse-compiled-code
  (compile
    '(lambda (+ * a b x y)
             (+ (* a x) (* b y)))
    'val
    'next
    '()))

オープンコードは使われずに翻訳される。

(env)
(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 (+ * a b x y)) (reg argl) (reg env))
  (assign proc (op lexical-address-lookup) (const (0 0)) (reg env))
  (save continue)
  (save proc)
  (save env)
  (assign proc (op lexical-address-lookup) (const (0 1)) (reg env))
  (assign val (op lexical-address-lookup) (const (0 5)) (reg env))
  (assign argl (op list) (reg val))
  (assign val (op lexical-address-lookup) (const (0 3)) (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
  (assign argl (op list) (reg val))
  (restore env)
  (save argl)
  (assign proc (op lexical-address-lookup) (const (0 1)) (reg env))
  (assign val (op lexical-address-lookup) (const (0 4)) (reg env))
  (assign argl (op list) (reg val))
  (assign val (op lexical-address-lookup) (const (0 2)) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch3))
compiled-branch4
  (assign continue (label after-call5))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch3
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call5
  (restore argl)
  (assign argl (op cons) (reg val) (reg argl))
  (restore proc)
  (restore continue)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch9))
compiled-branch10
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch9
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
after-call11
after-lambda2

定義が上書きされていない場合。

(parse-compiled-code
  (compile
    '(+ (* a x) (* b y))
    'val
    'next
    '()))

オープンコードを使って翻訳される。

(env)
(arg1 arg2 val)
  (assign arg1 (op lookup-variable-value) (const a) (reg env))
  (assign arg2 (op lookup-variable-value) (const x) (reg env))
  (assign arg1 (op *) (reg arg1) (reg arg2))
  (save arg1)
  (assign arg1 (op lookup-variable-value) (const b) (reg env))
  (assign arg2 (op lookup-variable-value) (const y) (reg env))
  (assign arg2 (op *) (reg arg1) (reg arg2))
  (restore arg1)
  (assign val (op +) (reg arg1) (reg arg2))

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る

4.1.6節の問題4.16で作った scan-out-defines を compile-lambda-body に組み込む

(define (compile-lambda-body exp proc-entry ct-env)
  (let ((formals (lambda-parameters exp)))
       (append-instruction-sequences
         (make-instruction-sequence
           '(env proc argl)
           '(env)
           `(,proc-entry
              (assign env (op compiled-procedure-env) (reg proc))
              (assign env
                      (op extend-environment)
                      (const ,formals)
                      (reg argl)
                      (reg env))))
         (compile-sequence
           (scan-out-defines (lambda-body exp))
           'val
           'return
           (cons formals ct-env)))))

以下のサンプルコードを scan-out-defines を使って内部定義の掃き出しを行った版と元の版とで比較する。

(parse-compiled-code
  (compile
    '(lambda (x y)
             (define u (+ u x))
             (define v (- v y))
             (* u v))
    'val
    'next
    '()))

scan-out-defines を使って内部定義の掃き出しを行った版での翻訳結果。

(env)
(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 (x y)) (reg argl) (reg env))
  (assign proc (op make-compiled-procedure) (label entry3) (reg env))
  (goto (label after-lambda4))
entry3
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env (op extend-environment) (const (u v)) (reg argl) (reg env))
  (save continue)
  (save env)
  (assign proc (op lookup-variable-value) (const +) (reg env))
  (assign val (op lexical-address-lookup) (const (1 0)) (reg env))
  (assign argl (op list) (reg val))
  (assign val (op lexical-address-lookup) (const (0 0)) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch5))
compiled-branch6
  (assign continue (label after-call7))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch5
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call7
  (restore env)
  (perform (op lexical-address-set!) (const (0 0)) (reg val) (reg env))
  (assign val (const ok))
  (restore continue)
  (save continue)
  (save env)
  (assign proc (op lookup-variable-value) (const -) (reg env))
  (assign val (op lexical-address-lookup) (const (1 1)) (reg env))
  (assign argl (op list) (reg val))
  (assign val (op lexical-address-lookup) (const (0 1)) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch8))
compiled-branch9
  (assign continue (label after-call10))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch8
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call10
  (restore env)
  (perform (op lexical-address-set!) (const (0 1)) (reg val) (reg env))
  (assign val (const ok))
  (restore continue)
  (assign proc (op lookup-variable-value) (const *) (reg env))
  (assign val (op lexical-address-lookup) (const (0 1)) (reg env))
  (assign argl (op list) (reg val))
  (assign val (op lexical-address-lookup) (const (0 0)) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch11))
compiled-branch12
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch11
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
after-call13
after-lambda4
  (assign val (const *unassigned*))
  (assign argl (op list) (reg val))
  (assign val (const *unassigned*))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch14))
compiled-branch15
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch14
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
after-call16
after-lambda2

元の翻訳系での翻訳結果。

(env)
(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 (x y)) (reg argl) (reg env))
  (save continue)
  (save env)
  (assign proc (op lookup-variable-value) (const +) (reg env))
  (assign val (op lexical-address-lookup) (const (0 0)) (reg env))
  (assign argl (op list) (reg val))
  (assign val (op lookup-variable-value) (const u) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch3))
compiled-branch4
  (assign continue (label after-call5))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch3
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call5
  (restore env)
  (perform (op define-variable!) (const u) (reg val) (reg env))
  (assign val (const ok))
  (restore continue)
  (save continue)
  (save env)
  (assign proc (op lookup-variable-value) (const -) (reg env))
  (assign val (op lexical-address-lookup) (const (0 1)) (reg env))
  (assign argl (op list) (reg val))
  (assign val (op lookup-variable-value) (const v) (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)
  (perform (op define-variable!) (const v) (reg val) (reg env))
  (assign val (const ok))
  (restore continue)
  (assign proc (op lookup-variable-value) (const *) (reg env))
  (assign val (op lookup-variable-value) (const v) (reg env))
  (assign argl (op list) (reg val))
  (assign val (op lookup-variable-value) (const u) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch9))
compiled-branch10
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch9
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
after-call11
after-lambda2

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る