(rplacd strip ((expr lambda (x p) (cond ((null p) x) (t (strip (
cdr x) (cdr p))))))) 
(rplacd defd ((expr lambda (x y) (sassoc x y (func nil nil))))) 

(rplacd extd ((expr lambda (y x) (prog2 (rplacd (sassoc (car x) 
y (func nil (car (setq y (cons x y))))) (cdr x)) y)))) 
(rplacd caddr ((expr lambda (x) (cadr (cdr x))))) 
(rplacd caddar ((expr lambda (x) (cadr (cdar x))))) 
(rplacd cadddr ((expr lambda (x) (cadr (cddr x))))) 
(rplacd cdddar ((expr lambda (x) (cddr (cdar x))))) 
(rplacd caddddr ((expr lambda (x) (cadr (cddr (cdr x)))))) 
(rplacd cdddddr ((expr lambda (x) (cddr (cddr (cdr x)))))) 
(rplacd cadar ((expr lambda (x) (cadr (car x))))) 
(rplacd union ((expr lambda (x y) (append x (ldel1 x y))))) 
(rplacd ldel1 ((expr lambda (x y) (cond ((null y) nil) ((member 
y x) nil) ((atom y) (list y)) (t (union (ldel1 x (car y)) (ldel1
 x (cdr y)))))))) 
(rplacd defdel ((expr lambda (x l) (cond ((null l) nil) ((eq x (
caar l)) (defdel x (cdr l))) (t (cons (car l) (defdel x (cdr l))
)))))) 
(rplacd inseq ((expr lambda (x l) (cond ((null l) (list x)) ((gr
eaterp (caddr x) (caddar l)) (cons x l)) (t (cons (car l) (inseq
 x (cdr l)))))))) 
(rplacd words ((apval))) 
(rplacd ops ((apval))) 
(rplacd supers ((apval (basic.defi1) (special.defi2) (delete.del
op) (super.supdef) (define.fundef)))) 
(rplacd defi1 ((expr lambda (x) (defi x nil)))) 
(rplacd defi2 ((expr lambda (x) (defi x t)))) 
(rplacd supdef ((expr lambda (x) (prog2 (csetq supers (extd supe
rs (cons (cadr x) (caddr x)))) (cadr x))))) 
(rplacd mess ((expr lambda (x) (maplist x (func (y) ((assoc (car
 y) supers (quote trans)) y)))))) 
(rplacd defi ((expr lambda (x j) (prog nil (csetq words (union w
ords (ldel1 (cadddr x) (caddddr x)))) (csetq ops (inseq (cons (c
adr x) (cons j (cddr x))) ops)) (return (cadr x)))))) 
(rplacd mess1 ((apval (basic also 250 (x y) (x also y) lista (y.
x)) (basic lista 240 (x y z) (lista (lista (x.y).z)) (lista y x.
z)) (basic lista 230 (x y) (lista (x.y)) (lista y x)) (basic lis
t 140 (x) (list x) (list x)) (basic list 150 (x) (list (lista.x)
) (list.x)) (basic begin 1050 (x) (begin x end) x) (basic if 70 
(x y z) (if x then y else (cond.z)) (cond (x y).z)) (basic if 60
 (x y z) (if x then y else z) (cond (x y) (t z)))))) 
(rplacd fitpat ((expr lambda (x p v) (null (eq (setq gv (gpat x 
p v nil)) t))))) 
(rplacd subpat ((expr lambda (x l) (cond ((null x) nil) ((fitpat
 x (cadr l) (car l)) (append (cond (ef (eval (caddr l) gv)) (t (
sublis gv (cddr l)))) (strip x (cadr l)))) (t (cons (car x) (sub
pat (cdr x) l))))))) 
(rplacd sublis ((expr lambda (l x) (cond ((defd x l) (assoc x l 
nil)) ((atom x) x) (t (cons (sublis l (car x)) (sublis l (cdr x)
))))))) 
(rplacd gpat ((expr lambda (x p v l) (cond ((null p) l) ((member
 p v) (cond ((member x words) t) ((defd p l) (cond ((equal (asso
c p l nil) x) l) (t t))) (t (extd l (cons p x))))) ((atom p) (co
nd ((eq x p) l) (t t))) ((atom x) t) ((eq (setq l (gpat (car x) 
(car p) v l)) t) t) (t (gpat (cdr x) (cdr p) v l)))))) 
(rplacd fundef ((expr lambda (x) (rplacd (cadr x) (list (list (q
uote expr) (quote lambda) (caddr x) (trans (cadddr x)))))))) 
(rplacd trans ((expr lambda (x) (prog (l m e ef gv) (setq e x) a
 (setq l ops) b (cond ((null l) (return (cond (m (cond ((null (c
dr e)) (car e)) (t (error (list x (quote untranslatable)))))) (t
 e))))) (setq ef (cadar l)) (cond ((equal e (setq e (subpat e (c
dddar l)))) (go d))) (setq m t) (go a) d (setq l (cdr l)) (go b)
)))) 
(rplacd dumpc ((expr lambda (n) (dump n (quote (strip defd extd 
caddr caddar cadddr cdddar caddddr cdddddr cadar union ldel1 def
del inseq words ops supers defi1 defi2 supdef mess defi mess1 fi
tpat subpat sublis gpat fundef trans dumpc)))))) 
(stop 15)