Scheme - 翻訳系の概観(オープンコード基本手続き基本手続き+、*が任意個の被演算子を扱えるようにコード生成器を拡張)

計算機プログラムの構造と解釈
Gerald Jay Sussman, Julie Sussman
Harold Abelson (原著) 和田 英一 (翻訳)

開発環境

• 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.5(翻訳したコードの例)、問題 5.38-d.を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs

問題 5.38-d.

compiler5.38-b.scmのcompile-open-code手続きを修正。

コード(BBEdit)

compiler5.38-d.scm

;;
(define (compile-open-code exp target linkage)
  (define (inner exp target linkage)
    (end-with-linkage linkage
     (preserving '(env continue)
      (spread-arguments (operands exp))
      (make-instruction-sequence '(arg1 arg2) (list target)
       '((assign ,target (op ,(operator exp)) (reg arg1) (reg arg2)))))))
  (define (fold op operand-codes)
    (if (null? (cdr operand-codes))
        (car operand-codes)
        (list op (car operand-codes) (fold op (cdr operand-codes)))))
  (let ((op (operator exp)))
    (if (or (eq? op '+) (eq? op '*))
        (inner (fold op (operands exp)) target linkage)
        (inner exp target linkage))))
;;

入出力結果(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.38-d.scm")

;Loading "./compiler5.38-d.scm"... done
;Value: parallel-instruction-sequences

1 ]=> (compile '(+ 1 2 3 4 5) 'val 'next)

;Value 2: (() (arg2 arg1 val) ((assign arg1 (const 1)) (save arg1) (assign arg1 (const 2)) (save arg1) (assign arg1 (const 3)) (save arg1) (assign arg1 (const 4)) (save arg1) (assign arg2 (const 5)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2))))

1 ]=> (compile '(* 1 2 3 4 5) 'val 'next)

;Value 3: (() (arg2 arg1 val) ((assign arg1 (const 1)) (save arg1) (assign arg1 (const 2)) (save arg1) (assign arg1 (const 3)) (save arg1) (assign arg1 (const 4)) (save arg1) (assign arg2 (const 5)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2))))

1 ]=> (compile '(+ (* 1 2 3 4) 5 6 (+ 7 8 9 10)) 'val 'next)

;Value 4: (() (arg2 arg1 val) ((assign arg1 (const 1)) (save arg1) (assign arg1 (const 2)) (save arg1) (assign arg1 (const 3)) (save arg1) (assign arg2 (const 4)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (save arg1) (assign arg1 (const 5)) (save arg1) (assign arg1 (const 6)) (save arg1) (assign arg1 (const 7)) (save arg1) (assign arg1 (const 8)) (save arg1) (assign arg1 (const 9)) (save arg1) (assign arg2 (const 10)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2))))

1 ]=> (compile '(= 5 10) 'val 'next)

;Value 5: (() (arg2 arg1 val) ((assign arg1 (const 5)) (save arg1) (assign arg2 (const 10)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2))))

1 ]=> (compile '(* 5 10) 'val 'next)

;Value 6: (() (arg2 arg1 val) ((assign arg1 (const 5)) (save arg1) (assign arg2 (const 10)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2))))

1 ]=> (compile '(- 5 10) 'val 'next)

;Value 7: (() (arg2 arg1 val) ((assign arg1 (const 5)) (save arg1) (assign arg2 (const 10)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2))))

1 ]=> (compile '(+ 5 10) 'val 'next)

;Value 8: (() (arg2 arg1 val) ((assign arg1 (const 5)) (save arg1) (assign arg2 (const 10)) (restore arg1) (assign (unquote target) (op (unquote (operator exp))) (reg arg1) (reg arg2))))

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