Serendip

Web Studio

問題5.44

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