(rplacd prettyprint ((expr lambda (l) (map l (func (j) (prog (t1
) (terpri) (prin1 lpar) (prin1 j) (terpri) (printdef (cond ((set
q t1 (assoc (quote expr) (cdr j) nil)) t1) ((setq t1 (assoc (quo
te fexpr) (cdr j) nil)) t1) (t (quote undefined)))) (prin1 rpar)
 (terpri))))))) 
(rplacd printdef ((expr lambda (e) (prog (i iunit iunitl) (setq 
i 1) (setq iunit (pack (quote (0 0 0)))) (setq iunitl 3) (prin1 
iunit) (superprint e) (return nil))))) 
(rplacd superprint ((expr lambda (e) (cond ((atom e) (prinat e))
 (t (prog (ep m) (setq ep e) (prin1 lpar) a (cond ((member (car 
ep) (quote (and or list plus times cond prog2))) (go pl)) ((eq (
caar ep) (quote lambda)) (go pl)) ((eq (car ep) (quote prog)) (g
o pp))) (superprint (car ep)) (setq ep (cdr ep)) (cond ((null ep
) (return (prin1 rpar))) ((atom ep) (go pd))) (prin1 blank) (go 
a) pk (setq i (sub1 i)) pd (prin1 dot) (prinat ep) (return (prin
1 rpar)) pl (setq i (add1 i)) (superprint (car ep)) pm (setq ep 
(cdr ep)) (cond ((null ep) (go pj)) ((atom ep) (go pk))) (endlin
e) (superprint (car ep)) (go pm) pj (setq i (sub1 i)) (return (p
rin1 rpar)) pp (prinat (car ep)) (setq ep (cdr ep)) (setq i (add
1 i)) (cond ((null ep) (go pj)) ((atom ep) (go pk))) (prin1 blan
k) (superprint (car ep)) py (setq ep (cdr ep)) (cond ((null ep) 
(go pj)) ((atom ep) (go pk))) (endline) (cond ((atom (car ep)) (
go pz))) (prin1 iunit) (prin1 iunit) px (setq i (plus i 2)) (sup
erprint (car ep)) (setq i (plus i -2)) (go py) pz (prinat (car e
p)) (setq m (plus iunitl iunitl (minus (length (unpack (car ep))
)))) aa (setq m (sub1 m)) (prin1 blank) (cond ((greaterp m 0) (g
o aa))) (setq ep (cdr ep)) (cond ((null ep) (go pj)) ((atom ep) 
(go pk)) ((atom (car ep)) (go pz))) (go px))))))) 
(rplacd endline ((expr lambda nil (prog (j) (setq j i) (terpri) 
a (cond ((eq j 0) (return nil)) ((greaterp 0 j) (error i))) (pri
n1 iunit) (setq j (sub1 j)) (go a))))) 
(rplacd lpar ((apval..())) 
(rplacd rpar ((apval..)))) 
(rplacd blank ((apval.. ))) 
(rplacd dot ((apval...))) 
(rplacd prinat ((expr lambda (x) (prog nil (cond ((charp x) (pri
n1 overbar))) (prin1 x))))) 
(rplacd overbar ((apval...))) 
(rplacd dumpp ((expr lambda (n) (dump n (quote (prettyprint prin
tdef superprint endline lpar rpar blank dot prinat overbar dumpp
)))))) 
(stop 15)