SICP 問題 5.38ab
+ - * = はopen-codeとして (reg val (op +) (reg arg1) (reg arg2)) の形で処理できるようにする.
(define (open-code? exp) (memq (car exp) '(= * - +))) (define (compile exp target linkage) (cond ((self-evaluating? exp) (compile-self-evaluating exp target linkage)) ((quoted? exp) (compile-quoted exp target linkage)) ((variable? exp) (compile-variable exp target linkage)) ((assignment? exp) (compile-assignment exp target linkage)) ((definition? exp) (compile-definition exp target linkage)) ((if? exp) (compile-if exp target linkage)) ((lambda? exp) (compile-lambda exp target linkage)) ((begin? exp) (compile-sequence (begin-actions exp) target linkage)) ((cond? exp) (compile (cond->if exp) target linkage)) ((open-code? exp) ;open-code?でdispatch (compile-open-code exp target linkage)) ((application? exp) (compile-application exp target linkage)) (else (error "Unknown expression type -- COMPILE" exp)))) (define (spread-arguments operand) ;それぞれコンパイルしてリストにして返す (let ((co-arg1 (compile (car operand) 'arg1 'next)) (co-arg2 (compile (cadr operand) 'arg2 'next))) (list co-arg1 co-arg2))) (define (compile-open-code exp target linkage) (if (= (length exp) 3) (let ((proc (operator exp)) (args (spread-arguments (operands exp)))) (end-with-linkage linkage (append-instruction-sequences (car args) ;; co-arg2がopen-code式だった場合にarg1が上書きされるので退避させる. (preserving '(arg1) (cadr args) (make-instruction-sequence '(arg1 arg2) (list target) `((assign ,target (op ,proc) (reg arg1) (reg arg2)))))))) (error "require 2 operand" exp)))
test
gosh> (compile '(+ 1 2) 'val 'next) (() (arg1 arg2 val) ((assign arg1 (const 1)) (assign arg2 (const 2)) (assign val (op +) (reg arg1) (reg arg2)) )) (() (arg1 arg2 val) ((assign arg1 (const 1)) (save arg1) (assign arg1 (const 2)) (assign arg2 (const 3)) (assign arg2 (op +) (reg arg1) (reg arg2)) (restore arg1) (assign val (op +) (reg arg1) (reg arg2)) ))