開発環境
- OS X Mavericks - Apple(OS)
- Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
- Scheme (プログラミング言語)
- MIT/GNU Scheme (処理系)
計算機プログラムの構造と解釈(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.44.を解いてみる。
その他参考書籍
問題 5.44.
追加、修正箇所。
コード(BBEdit)
compiler5.44.scm
(define (compile exp target linkage compile-time-env)
(cond ((self-evaluating? exp)
(compile-self-evaluating exp target linkage))
((quoted? exp) (compile-quoted exp target linkage))
((variable? exp)
(compile-variable exp target linkage compile-time-env))
((assignment? exp)
(compile-assignment exp target linkage compile-time-env))
((definition? exp)
(compile-definition exp target linkage compile-time-env))
((if? exp) (compile-if exp target linkage compile-time-env))
((lambda? exp) (compile-lambda exp target linkage compile-time-env))
((begin? exp)
(compile-sequence (begin-actions exp)
target
linkage
compile-time-env))
((cond? exp) (compile (cond->if exp) target linkage compile-time-env))
;; 変更箇所
((open-code? exp compile-time-env)
(compile-open-code exp target linkage compile-time-env))
((application? exp)
(compile-application exp target linkage compile-time-env))
(else
(error "Unknown expression type -- COMPILE" exp))))
;;
(define (open-code? exp compile-time-env)
(let ((op (car exp)))
(and (memq op '(= * - +))
(not (redefined? op compile-time-env)))))
(define (redefined? op compile-time-env)
(not (eq? (find-variable op compile-time-env)
'not-found)))
;;
修正する前と、追加、修正後で比較して確認してみる。
入出力結果(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.43.scm")
;Loading "./compiler5.43.scm"... done
;Value: print-compiled
1 ]=> (print-compiled
(compile
'(lambda (+ * a b x y)
(+ (* a x) (* b y)))
'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 (+ * a b x y)) (reg argl) (reg env))
(assign arg1 (op lexical-address-lookup) (const (0 2)) (reg env))
(save arg1)
(assign arg2 (op lexical-address-lookup) (const (0 4)) (reg env))
(restore arg1)
(assign arg1 (op *) (reg arg1) (reg arg2))
(save arg1)
(assign arg1 (op lexical-address-lookup) (const (0 3)) (reg env))
(save arg1)
(assign arg2 (op lexical-address-lookup) (const (0 5)) (reg env))
(restore arg1)
(assign arg2 (op *) (reg arg1) (reg arg2))
(restore arg1)
(assign val (op +) (reg arg1) (reg arg2))
(goto (reg continue))
after-lambda1
;Value: done
1 ]=> (load "./compiler5.44.scm")
;Loading "./compiler5.44.scm"... done
;Value: print-compiled
1 ]=> (print-compiled
(compile
'(lambda (+ * a b x y)
(+ (* a x) (* b y)))
'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 (+ * 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-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
(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-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 argl)
(assign argl (op cons) (reg val) (reg argl))
(restore proc)
(restore continue)
(test (op primitive-procedure?) (reg proc))
(branch (label primitive-branch11))
compiled-branch10
(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-call9
after-lambda1
;Value: done
1 ]=> ^D
End of input stream reached.
Moriturus te saluto.
$
追加、修正前は、予約語の+、*をそのまま使っているのが、修正後は+、*をそのまま使っていないことを確認できた。
0 コメント:
コメントを投稿