2016/02/10
SICP 問題 5.47
コンパイルした手続きから積極制御評価器で定義した手続きを使えるようにする.
(define (compile-procedure-call target linkage)
(let ((primitive-branch (make-label 'primitive-branch))
(compiled-branch (make-label 'compiled-branch))
(compound-branch (make-label 'compound-branch)) ;; compound-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))))
;; compiled-branchへの分岐を追加
(make-instruction-sequence
'(proc) '()
`((test (op compiled-procedure?) (reg proc))
(branch (label ,compiled-branch))))
;; primitiveでもcompiledでもなかったらcompoundとして処理.
(parallel-instruction-sequences
(append-instruction-sequences
compound-branch
;; compiledと同じようにcompound-proc-applで命令を作る
(compound-proc-appl target compiled-linkage))
(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))))
;; ほとんどcompile-proc-applと同じで,continueをセーブしてからcompappにジャンプする.
;; compappには(label procedure-apply)が入っている.
(define (compound-proc-appl target linkage)
(cond ((and (eq? target 'val) (not (eq? linkage 'return)))
(make-instruction-sequence
'() all-regs
`((assign continue (label ,linkage))
(save continue)
(goto (reg compapp)))))
((and (not (eq? target 'val))
(not (eq? 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 ,linkage))))))
((and (eq? target 'val) (eq? linkage 'return))
(make-instruction-sequence
'(proc continue) all-regs
`((save continue)
(goto (reg compapp)))))
((and (not (eq? target 'val)) (eq? linkage 'return))
(error "return linkage, target not val -- COMPILE" target))))
;; ec-evalの命令の先頭でcompappを初期化する.
'((assign compapp (label compound-apply)) ;追加
(branch (label external-entry))
read-eval-print-loop
(perform (op initialize-stack))
test
gosh> (compile-and-go
'(begin
(define (f x) (+ (g x) 1))
(define (g x) (+ x 10))))
(total-pushes = 0 maximum-depth = 0)
;;; EC-Eval value:
ok
;;; EC-Eval input:
(f 1)
(total-pushes = 7 maximum-depth = 3)
;;; EC-Eval value:
12
;;; EC-Eval input:
(define (g x) (+ x 20))
(total-pushes = 3 maximum-depth = 3)
;;; EC-Eval value:
ok
;;; EC-Eval input:
(f 1)
(total-pushes = 16 maximum-depth = 7)
;;; EC-Eval value:
22
gosh> (compile-and-go
'(define (f x) (* (g x) 2)))
(total-pushes = 0 maximum-depth = 0)
;;; EC-Eval value:
ok
;;; EC-Eval input:
(define (g x) (+ x 1))
(total-pushes = 3 maximum-depth = 3)
;;; EC-Eval value:
ok
;;; EC-Eval input:
(g 1)
(total-pushes = 13 maximum-depth = 5)
;;; EC-Eval value:
2
;;; EC-Eval input:
(f 1)
(total-pushes = 16 maximum-depth = 7)
;;; EC-Eval value:
4