Serendip

Web Studio

問題5.43

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 で詳細を見る