2014年1月6日月曜日

開発環境

計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の5(レジスタ計算機での計算)、5.5(翻訳系)、翻訳系の概観、5.5.6(文面アドレス)、問題 5.43.を解いてみる。

その他参考書籍

問題 5.43.

追加、修正箇所。

コード(BBEdit)

compiler5.43.scm

;;
(define (compile-lambda-body exp proc-entry compile-time-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 compile-time-env)))))
;;

修正する前と、ブロック構造の内部定義は「真の」defineと考えず、手続き本体は、定義している内部変数は、set!を使って正しい値に初期化する通常のlambda変数として組み込まれているように解釈するように修正した場合とで比較してみる。

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

$ scheme
MIT/GNU Scheme running under MacOSX
Type `^C' (control-C) followed by `H' to obtain information about interrupts.

Copyright (C) 2011 Massachusetts Institute of Technology
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

Image saved on Saturday October 26, 2013 at 11:02:50 PM
  Release 9.1.1 || Microcode 15.3 || Runtime 15.7 || SF 4.41 || LIAR/C 4.118
  Edwin 3.116

1 ]=> (load "./eval.scm")

;Loading "./eval.scm"... done
;Value: the-global-environment

1 ]=> (load "./compiler5.42.scm")

;Loading "./compiler5.42.scm"... done
;Value: print-compiled

1 ]=> (print-compiled
(compile
  '(lambda ()
     (define u 10)
     (define v 20)
     (+ u v))
  'val
  'next
  '())
)

(env)
(val)
  (assign val (op make-compiled-procedure) (label entry2) (reg env))
  (goto (label after-lambda1))
entry2
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env (op extend-environment) (const ()) (reg argl) (reg env))
  (assign val (const 10))
  (perform (op define-variable!) (const u) (reg val) (reg env))
  (assign val (const ok))
  (assign val (const 20))
  (perform (op define-variable!) (const v) (reg val) (reg env))
  (assign val (const ok))
  (assign arg1 (op lookup-variable-value) (const u) (reg env))
  (save arg1)
  (assign arg2 (op lookup-variable-value) (const v) (reg env))
  (restore arg1)
  (assign val (op +) (reg arg1) (reg arg2))
  (goto (reg continue))
after-lambda1
;Value: done

1 ]=> (load "./compiler5.43.scm")

;Loading "./compiler5.43.scm"... done
;Value: print-compiled

1 ]=> (print-compiled
(compile
  '(lambda ()
     (define u 10)
     (define v 20)
     (+ u v))
  'val
  'next
  '())
)

(env)
(val)
  (assign val (op make-compiled-procedure) (label entry2) (reg env))
  (goto (label after-lambda1))
entry2
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env (op extend-environment) (const ()) (reg argl) (reg env))
  (assign val (op lookup-variable-value) (const let) (reg env))
  (save continue)
  (save env)
  (save env)
  (assign proc (op lookup-variable-value) (const v) (reg env))
  (assign val (const *unassigned*))
  (assign argl (op list) (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch14))
compiled-branch13
  (assign continue (label proc-return15))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
proc-return15
  (assign proc (reg val))
  (goto (label after-call12))
primitive-branch14
  (assign proc (op apply-primitive-procedure) (reg proc) (reg argl))
after-call12
  (restore env)
  (save proc)
  (assign proc (op lookup-variable-value) (const u) (reg env))
  (assign val (const *unassigned*))
  (assign argl (op list) (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch11))
compiled-branch10
  (assign continue (label after-call9))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch11
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call9
  (assign argl (op list) (reg val))
  (restore proc)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch18))
compiled-branch17
  (assign continue (label after-call16))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch18
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call16
  (restore env)
  (restore continue)
  (save continue)
  (save env)
  (assign proc (const 20))
  (assign argl (const ()))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch8))
compiled-branch7
  (assign continue (label after-call6))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch8
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call6
  (restore env)
  (perform (op set-variable-value!) (const v) (reg val) (reg env))
  (assign val (const ok))
  (restore continue)
  (save continue)
  (save env)
  (assign proc (const 10))
  (assign argl (const ()))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch5))
compiled-branch4
  (assign continue (label after-call3))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch5
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call3
  (restore env)
  (perform (op set-variable-value!) (const u) (reg val) (reg env))
  (assign val (const ok))
  (restore continue)
  (assign arg1 (op lookup-variable-value) (const u) (reg env))
  (save arg1)
  (assign arg2 (op lookup-variable-value) (const v) (reg env))
  (restore arg1)
  (assign val (op +) (reg arg1) (reg arg2))
  (goto (reg continue))
after-lambda1
;Value: done

1 ]=> ^D
End of input stream reached.
Moriturus te saluto.
$

0 コメント:

コメントを投稿