SICP 問題 5.24

condを派生式ではなく構文として実装する．

;; unevがcondの本体を保存．expはevalされる．
 ev-cond
   (assing unev (op cond-clauses) (reg exp)) ;((p1 e1) (p2 e2) ...)の形にする．
   (save continue)                      ;cond後の継続をsave
   (save env)                           ;現在の環境をsave
   (save unev)                           ;ev-cond-loopで復元できるようにsave
   (goto (label ev-cond-test))

 ev-cond-test
   (restore exp)                        ;unevの内容がexpにコピーされる．
   (restore env)
   (restore continue)
   (test (op null?) (reg exp))
   (branch (label ev-cond-null))
   (assign exp (op car) (reg unev))      ;(p1 e1)の形に．
   (test (op cond-else-clause?) (reg exp)        ;(else e1)なら
   (branch (label ev-cond-else))        ;ev-cond-elseへ
   (save continue)
   (save env)
   (save unev)
   (assign continue (label ev-cond-loop)) ;eval-dispatchの後ev-cond-loopに戻れるように代入
   (assign exp (op cond-predicate) (reg exp))
   (goto (label eval-dispatch))

 ev-cond-loop
   (test (op true?) (reg val))
   (branch (label ev-cond-value))
   (restore unev)
   (restore env)                        ;環境を元に戻す
   (assign unev (op cdr) (reg unev))      ;残りのclausesへ
   (save env)
   (save unev)
   (goto (label ev-cond-test))


 ev-cond-else
   (assign exp (op cond-actions) (reg exp))
   (assign exp (op sequence->exp) (reg exp))
   (goto (label eval-dispatch))

 ev-cond-value
   ;; expはpredicateを評価した値になってる．
   (restore exp)                        ;unevが持っていたcond本体をexpがrestore
   (restore env)
   (restore continue)
   ;;((p1 e1 e1' ...) (p2 e2 e2' ...) ...)という形なのでcarを取る．
   (assign exp (op car) (reg exp))
   (assign exp (op cond-actions) (reg exp))  ;(e1 e1' ...)にする．
   (assign exp (op sequence->exp) (reg exp))
   (goto (label eval-dispatch))

 ev-cond-null
     (assign val (const cond-null-error))
     (goto (label signal-error))

test

gosh> (start eceval)


;;; EC-Eval input:
(define (append x y)
  (cond ((null? x) y)
        (else (cons (car x)
                    (append (cdr x) y)))))

;;; EC-Eval value:
ok

;;; EC-Eval input:
(append '(a b c) '(d e f))

;;; EC-Eval value:
(a b c d e f)

;;; EC-Eval input:
(define (append x y)
  (cond ))

;;; EC-Eval value:
ok

;;; EC-Eval input:
(append '(a b c) '(d e f))
cond-null-error