TAPC

TAPC をサポート。LispMe 論文の丸パクリだけど。例によって末尾再帰が有効な例を探すのが難しい。
SELR はまだ。

INTERP> secd-4
"           INITIAL STATE                                             TRANSFORMED STATE
S                   E           C                  D                S                E           C    D             
--------------------------------------------------------------------------------------------------------------------
s                   e           (nil . c)          d             -> (nil . s)        e           c    d             
s                   e           (ldc x . c)        d             -> (x . s)          e           c    d             
s                   e           (ld (m . n) . c)   d             -> (x . s)          e           c    d             
                                                                    where x = (locate m n e)
s                   e           (ldf c' . c)       d             -> ((c' . e) . s)   e           c    d             
(x . s)             e           (sel ct cf . c)    d             -> s                e           cx   (c . d)       
                                                                    where cx = (if x ct cf)
s                   e           (join . c)         (cr . d)      -> s                e           cr   d             
((c' . e') v . s)   e           (tapc)             d             -> nil              (v . e')    c'   d             
((c' . e') v . s)   e           (ap . c)           d             -> nil              (v . e')    c'   (s e c . d)   
(a b . s)           e           (cons . c)         d             -> ((a . b) . s)    e           c    d             
((a . b) . s)       e           (car . c)          d             -> (a . s)          e           c    d             
((a . b) . s)       e           (cdr . c)          d             -> (b . s)          e           c    d             
(x . z)             e'          (rtn . c')         (s e c . d)   -> (x . s)          e           c    d             
s                   e           (dum . c)          d             -> s                (nil . e)   c    d             
((c' . e') v . s)   (nil . e)   (rap . c)          d             -> nil              e''         c'   (s e c . d)   
                                                                    where e'' = (rplaca e' v)
(a b . s)           e           (+ . c)            d             -> (x . s)          e           c    d             
                                                                    where x = (+ a b)
(a b . s)           e           (- . c)            d             -> (x . s)          e           c    d             
                                                                    where x = (- a b)
(a b . s)           e           (* . c)            d             -> (x . s)          e           c    d             
                                                                    where x = (* a b)
(a b . s)           e           (= . c)            d             -> (x . s)          e           c    d             
                                                                    where x = (= a b)
(a b . s)           e           (> . c)            d             -> (x . s)          e           c    d             
                                                                    where x = (> a b)
(a b . s)           e           (< . c)            d             -> (x . s)          e           c    d             
                                                                    where x = (< a b)
(v . s)             e           (vlen . c)         d             -> (x . s)          e           c    d             
                                                                    where x = (length v)
(l . s)             e           (l2v . c)          d             -> (v . s)          e           c    d             
                                                                    where v = (make-vector l)
(v n . s)           e           (vref . c)         d             -> (x . s)          e           c    d             
                                                                    where x = (aref v n)
(v n x . s)         e           (vset . c)         d             -> (v . s)          e           c    d             
                                                                    where v = (progn (setf (aref v n) x) v)
--------------------------------------------------------------------------------------------------------------------
"
INTERP> 

最適化。パターンマッチで特定の命令列の並びを変換しているだけ。コンパイラに組み込んでもいいけど最適化なしのプログラムも取っておきたいのでとりあえず分けておこう。

(defun optimizer (program)
  (cond
    ((null program) nil)
    (t
     (match program
       ((:AP :RTN)
        `(:TAPC))
       (t
        (cond
          ((consp program)
           (cons (optimizer (car program)) (optimizer (cdr program))))
          (t
           program)))))))