transition rule
ようやく LDCT を実装。
(deftransition secd (s e c d) (:transitions ( 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 -> ((:clos |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) ) ( (x . s) e (:SELR cT cF) d -> s e cX d where cX = (if x cT cF) ) ( s e (:JOIN . c) (cr . d) -> s e cr d ) ( ((:clos |c'| . |e'|) v . s) e (:TAP) d -> s (v . |e'|) |c'| d ) ( ((:cont s e c . d) (v) . |s'|) |e'| (:TAP) |d'| -> (v . s) e c d ) ( ((:clos |c'| . |e'|) v . s) e (:AP . c) d -> nil (v . |e'|) |c'| (s e c . d) ) ( ((:cont s e c . d) (v) . |s'|) |e'| (:AP . |c'|) |d'| -> (v . s) e c d) ( s e (:LDCT |c'| . c) d -> ( ((:cont s e |c'| . d)) . s) e c d ) ( (b a . s) e (:CONS . c) d -> ((b . a) . 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 . s) e (:CONSP . c) d -> (p . s) e c d where p = (consp x) ) ( (x . z) |e'| (:RTN . |c'|) (s e c . d) -> (x . s) e c d ) ( s e (:DUM . c) d -> s (nil . e) c d) ( ((:clos |c'| . |e'|) v . s) (nil . e) (:RAP . c) d -> nil |e''| |c'| (s e c . d) where |e''| = (rplaca |e'| v)) ( ((:clos |c'| . |e'|) v . s) (nil . e) (:RTAP . c) d -> nil |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) ) ( (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 (:mod . c) d -> (x . s) e c d where x = (mod 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)) ( s e (:ECHO x . c) d -> s e c d where z = (format t ";;ECHO: ~a~%" x)) ( (x . s) e (:WRITE . c) d -> s e c d where dum = (format t ";; ~s~%" x) )) (:last-value (lambda (s e c d) (car s))) )