diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet
index 88be9e0..6fbe322 100644
--- a/books/bookvol9.pamphlet
+++ b/books/bookvol9.pamphlet
@@ -8898,373 +8898,12 @@ of the symbol being parsed. The original list read:
 
 \chapter{DEF forms}
 
-\defun{def}{def}
-\calls{def}{deftran}
-\calls{def}{def-insert-let}
-\calls{def}{def-stringtoquote}
-\calls{def}{bootTransform}
-\calls{def}{comp}
-\calls{def}{sublis}
-\usesdollar{def}{body}
-\usesdollar{def}{opassoc}
-\usesdollar{def}{op}
-<<defun def>>=
-(defun def (form signature $body)
- (declare (ignore signature))
- (let* ($opassoc
-        ($op (first form))
-        (argl (rest form))
-        ($body (deftran $body))
-        (argl (def-insert-let argl))
-        (arglp (def-stringtoquote argl))
-        ($body (|bootTransform| $body)))
-  (declare (special $body $opassoc $op))
-  (comp (sublis $opassoc (list (list $op (list 'lam arglp $body)))))))
-
-@
-
-\defun{def-process}{def-process}
-\calls{def-process}{def}
-\calls{def-process}{b-mdef}
-\calls{def-process}{eqcar}
-\calls{def-process}{def-process}
-\calls{def-process}{is-console}
-\calls{def-process}{say}
-\calls{def-process}{deftran}
-\calls{def-process}{print-full}
-\calls{def-process}{deftran}
-\usesdollar{def-process}{macroassoc}
-<<defun def-process>>=
-(defun def-process (x &aux $macroassoc)
- (cond
-  ((eqcar x 'def)
-   (def (second x) (third x) (first (cddddr x))))
-  ((eqcar x 'mdef)
-   (b-mdef (second x) (third x) (first (cddddr x))))
-  ((and (eqcar x 'where) (eqcar (second x) 'def))
-   (let* ((u (second x)) (y (cdr u)))
-    (def-process
-     (list 'def
-      (car y)
-      (car (setq y (cdr y)))
-      (car (setq y (cdr y)))
-      (cons 'where (cons (car (setq y (cdr y))) (cddr x)))))))
-  ((is-console *standard-output*)
-   (say "  VALUE = " (eval (deftran x))))
-  ((print-full (deftran x)))))
-
-@
-
-\defun{def-rename}{def-rename}
-\calls{def-rename}{def-rename1}
-<<defun def-rename>>=
-(defun def-rename (x)
- (def-rename1 x))
-
-@
-
-\defun{def-rename1}{def-rename1}
-\calls{def-rename1}{def-rename1}
-<<defun def-rename1>>=
-(defun def-rename1 (x)
- (cond
-  ((symbolp x)
-   (let ((y (get x 'rename))) (if y (first y) x)))
-  ((and (listp x) x)
-   (if (eqcar x 'quote)
-       x
-       (cons (def-rename1 (first x)) (def-rename1 (cdr x)))))
-  (x)))
-
-@
-
-\defun{def-insert-let}{def-insert-let}
-\calls{def-insert-let}{def-insert-let}
-\calls{def-insert-let}{deftran}
-\calls{def-insert-let}{def-let}
-\calls{def-insert-let}{errhuh}
-<<defun def-insert-let>>=
-(defun def-insert-let (x)
- (labels (
-  (insert-let1 (y)
-   (declare (special $body))
-    (if (and (consp y) (eq (qcar y) 'spadlet))
-     (cond 
-      ((identp (second y))
-       (setq $body (cons 'progn (list (def-let (third y) (second y)) $body)))
-       (setq y (second y)))
-      ((identp (third y))
-       (setq $body (cons 'progn (list (deftran y) $body))) (setq y (third y)))
-      ((errhuh)))
-     y)))
- (if (atom x) 
-  x
-  (cons (insert-let1 (first x)) (def-insert-let (cdr x))))))
-
-@
-
-\defun{defLET}{defLET}
-\calls{defLET}{defLET1}
-\usesdollar{defLET}{letGenVarCounter}
-\usesdollar{defLET}{inDefLET}
-<<defun defLET>>=
-(defun |defLET| (lhs rhs)
- (let (|$letGenVarCounter| |$inDefLET|)
- (declare (special |$letGenVarCounter| |$inDefLET|))
-  (setq |$letGenVarCounter| 1)
-  (setq |$inDefLET| t)
-  (|defLET1| lhs rhs)))
-
-@
-
-\defun{defLET1}{defLET1}
-\calls{defLET1}{identp}
-\calls{defLET1}{defLetForm}
-\calls{defLET1}{contained}
-\calls{defLET1}{defLET2}
-\calls{defLET1}{mkprogn}
-\calls{defLET1}{defLET1}
-\calls{defLET1}{strconc}
-\calls{defLET1}{stringimage}
-\usesdollar{defLET1}{let}
-\usesdollar{defLET1}{letGenVarCounter}
-<<defun defLET1>>=
-(defun |defLET1| (lhs rhs)
- (let (name l1 l2 g rhsprime letprime)
- (declare (special $let |$letGenVarCounter|))
-  (cond
-   ((identp lhs) (|defLetForm| lhs rhs))
-   ((and (pairp lhs) (eq (qcar lhs) 'fluid)
-         (pairp (qcdr lhs)) (eq (qcdr (qcdr lhs)) nil))
-     (|defLetForm| lhs rhs))
-   ((and (identp rhs) (null (contained rhs lhs)))
-    (setq rhsprime (|defLET2| lhs rhs))
-    (cond
-     ((and (consp rhsprime) (eql (qcar rhsprime) $let))
-       (mkprogn (list rhsprime rhs)))
-     ((and (consp rhsprime) (eq (qcar rhsprime) 'progn))
-      (append rhsprime (list rhs)))
-     (t
-      (when (identp (car rhsprime)) (setq rhsprime (list rhsprime)))
-      (mkprogn (append rhsprime (list rhs))))))
-   ((and (pairp rhs) (eqcar rhs $let) (identp (setq name (cadr rhs))))
-     (setq l1 (|defLET1| name (third rhs)))
-     (setq l2 (|defLET1| lhs name))
-     (if (and (consp l2) (eq (qcar l2) 'progn))
-      (mkprogn (cons l1 (cdr l2)))
-      (progn
-        (when (identp (car l2)) (setq l2 (list l2)))
-        (mkprogn (cons l1 (append l2 (list name)))))))
-   (t
-    (setq g (intern (strconc "LETTMP#" (stringimage |$letGenVarCounter|))))
-    (setq |$letGenVarCounter| (1+ |$letGenVarCounter|))
-    (setq rhsprime (list $let g rhs))
-    (setq letprime (|defLET1| lhs g))
-    (if (and (consp letprime) (eq (qcar letprime) 'progn))
-     (mkprogn (cons rhsprime (cdr letprime)))
-     (progn
-      (when (identp (car letprime)) (setq letprime (list letprime)))
-      (mkprogn (cons rhsprime (append letprime (list g))))))))))
-
-
-@
-
-\defun{defLET2}{defLET2}
-\calls{defLET2}{identp}
-\calls{defLET2}{defLetForm}
-\calls{defLET2}{qcar}
-\calls{defLET2}{qcdr}
-\calls{defLET2}{defLET2}
-\calls{defLET2}{addCARorCDR}
-\calls{defLET2}{defISReverse}
-\calls{defLET2}{strconc}
-\calls{defLET2}{stringimage}
-\calls{defLET2}{defIS1}
-\calls{defLET2}{defIS}
-\usesdollar{defLET2}{inDefIS}
-\usesdollar{defLET2}{let}
-\usesdollar{defLET2}{letGenVarCounter}
-<<defun defLET2>>=
-(defun |defLET2| (lhs rhs)
- (let (a b l1 var2 patrev rev g l2 val1 var1 isPred)
- (declare (special |$inDefIS| $let |$letGenVarCounter|))
-  (cond
-   ((identp lhs) (|defLetForm| lhs rhs))
-   ((null lhs) nil)
-   ((and (pairp lhs) (eq (qcar lhs) 'fluid)
-         (pairp (qcdr lhs)) (eq (qcdr (qcdr lhs)) nil))
-     (|defLetForm| lhs rhs))
-   ((and (pairp lhs) (equal (qcar lhs) $let)
-         (pairp (qcdr lhs)) (pairp (qcdr (qcdr lhs))) 
-         (eq (qcdr (qcdr (qcdr lhs))) nil))
-     (setq a (|defLET2| (qcar (qcdr lhs)) rhs))
-     (setq b (qcar (qcdr (qcdr lhs))))
-     (cond
-      ((null (setq b (|defLET2| b rhs))) a)
-      ((atom b) (list a b))
-      ((pairp (qcar b)) (cons a b))
-      (t (list a b))))
-   ((and (pairp lhs) (eq (qcar lhs) 'cons)
-         (pairp (qcdr lhs)) (pairp (qcdr (qcdr lhs)))
-         (eq (qcdr (qcdr (qcdr lhs))) nil))
-     (setq var1 (qcar (qcdr lhs)))
-     (setq var2 (qcar (qcdr (qcdr lhs))))
-     (if (or (eq var1 (intern "." "BOOT"))
-         (and (pairp var1) (eqcar var1 'quote)))
-      (|defLET2| var2 (|addCARorCDR| 'cdr rhs))
-      (progn
-       (setq l1 (|defLET2| var1 (|addCARorCDR| 'car rhs)))
-       (if (member var2 '(nil |.|)) 
-        l1
-        (progn
-         (when (and (pairp l1) (atom (car l1))) (setq l1 (cons l1 nil)))
-         (if (identp var2)
-          (append l1 (cons (|defLetForm| var2 (|addCARorCDR| 'cdr rhs)) nil))
-          (progn
-           (setq l2 (|defLET2| var2 (|addCARorCDR| 'cdr rhs)))
-           (when (and (pairp l2) (atom (car l2))) (setq l2 (cons l2 nil)))
-           (append l1 l2))))))))
-   ((and (pairp lhs) (eq (qcar lhs) 'append)
-         (pairp (qcdr lhs)) (pairp (qcdr (qcdr lhs)))
-         (eq (qcdr (qcdr (qcdr lhs))) nil))
-     (setq var1 (qcar (qcdr lhs)))
-     (setq var2 (qcar (qcdr (qcdr lhs))))
-     (setq patrev (|defISReverse| var2 var1))
-     (setq rev (list 'reverse rhs))
-     (setq g (intern (strconc "LETTMP#" (stringimage |$letGenVarCounter|))))
-     (setq |$letGenVarCounter| (1+ |$letGenVarCounter|))
-     (setq l2 (|defLET2| patrev g))
-     (when (and (pairp l2) (atom (car l2))) (setq l2 (cons l2 nil)))
-     (cond
-      ((eq var1 (intern "." "BOOT"))
-       (cons (list $LET g rev) l2))
-      ((and (pairp (|last| l2)) (equal (qcar (|last| l2)) $let)
-            (pairp (qcdr (|last| l2)))
-            (equal (qcar (qcdr (|last| l2))) var1)
-            (pairp (qcdr (qcdr (|last| l2))))
-            (eq (qcdr (qcdr (qcdr (|last| l2)))) nil))
-        (setq val1 (qcar (qcdr (qcdr (|last| l2)))))
-        (cons
-         (list $let g rev)
-         (append 
-          (reverse (cdr (reverse l2)))
-          (list (|defLetForm| var1 (list 'nreverse val1))))))
-      (t
-       (cons
-        (list $let g rev)
-        (append l2 (list (|defLetForm| var1 (list 'nreverse var1))))))))
-   ((and (pairp lhs) (eq (qcar lhs) 'equal)
-         (pairp (qcdr lhs)) (eq (qcdr (qcdr lhs)) nil))
-     (setq var1 (qcar (qcdr lhs)))
-     (list 'cond (list (list 'equal var1 rhs) var1)))
-   (t
-    (setq isPred
-     (if |$inDefIS| 
-      (|defIS1| rhs lhs)
-      (|defIS| rhs lhs)))
-    (list 'cond (list isPred rhs))))))
-
-@
-
-\defun{defLetForm}{defLetForm}
-\usesdollar{defLetForm}{let}
-<<defun defLetForm>>=
-(defun |defLetForm| (lhs rhs)
- (declare (special $let))
- (list $let lhs rhs))
-
-@
-
 \defdollar{defstack}
 <<initvars>>=
 (defparameter $defstack nil)
 
 @
 
-\defun{def-whereclauselist}{def-whereclauselist}
-\calls{def-whereclauselist}{def-whereclause}
-\calls{def-whereclauselist}{deftran}
-<<defun def-whereclauselist>>=
-(defun def-whereclauselist (l)
- (if (not (cdr l))
-  (def-whereclause (deftran (first l)))
-  (reduce #'append (mapcar #'(lambda (u) (def-whereclause (deftran u))) l))))
-
-@
-
-\defun{def-whereclause}{def-whereclause}
-\calls{def-whereclause}{eqcar}
-\calls{def-whereclause}{def-whereclause}
-\calls{def-whereclause}{whdef}
-<<defun def-whereclause>>=
-(defun def-whereclause (x)
- (cond 
-  ((or (eqcar x 'seq) (eqcar x 'progn))
-   (reduce #'append (mapcar #'def-whereclause (cdr x))))
-  ((eqcar x 'def)
-   (whdef (second x) (first (cddddr x))) nil)
-  ((and (eqcar x '|exit|) (eqcar (second x) 'def))
-   (whdef (cadadr x) (first (cddddr (second x)) )) nil)
-  ((list x))))
-
-@
-
-\defun{def-message}{def-message}
-\calls{def-message}{def-message1}
-<<defun def-message>>=
-(defun def-message (u)
- (cons (first u) (mapcar #'def-message1 (cdr u))))
-
-@
-
-\defun{def-message1}{def-message1}
-\calls{def-message1}{eqcar}
-\calls{def-message1}{def-message1}
-\calls{def-message1}{deftran}
-<<defun def-message1>>=
-(defun def-message1 (v)
- (cond
-  ((and (stringp v) (> (size v) 0) (not (eq (elt v 0) '\%)))
-   (list 'makestring v))
-  ((eqcar v 'cons)
-   (list 'cons (def-message1 (second v)) (def-message1 (third v))))
-  ((deftran v))))
-
-@
-
-\defun{def-in2on}{def-in2on}
-\calls{def-in2on}{eqcar}
-<<defun def-in2on>>=
-(defun def-in2on (it)
- (mapcar 
-  #'(lambda (x) (let (u)
-     (cond
-      ((and (eqcar x 'in) (eqcar (third x) '|tails|))
-       (list 'on (second x) (second (third x))))
-      ((and (eqcar x 'in) (eqcar (setq u (third x)) 'segment))
-       (cond
-        ((third u) (list 'step (second x) (second u) 1 (third u)))
-        ((list 'step (second x) (second u) 1))))
-      ((and (eqcar x 'inby) (eqcar (setq u (third x)) 'segment))
-       (cond
-        ((third u) (list 'step (second x) (second u) (|last| x) (third u)))
-        ((list 'step (second x) (second u) (|last| x)))))
-      (x))))
-    it))
-
-@
-
-\defun{def-cond}{def-cond}
-\calls{def-cond}{deftran}
-\calls{def-cond}{def-cond}
-<<defun def-cond>>=
-(defun def-cond (l)
- (cond
-  ((not l) nil)
-  ((cons (mapcar #'deftran (first l)) (def-cond (cdr l))))))
-
-@
-
 \defdollar{is-spill}
 <<initvars>>=
 (defvar $is-spill nil)
@@ -9277,146 +8916,12 @@ of the symbol being parsed. The original list read:
 
 @
 
-\defun{def-is-eqlist}{def-is-eqlist}
-\calls{def-is-eqlist}{}
-\usesdollar{def-is-eqlist}{is-eqlist}
-\usesdollar{def-is-eqlist}{is-spill-list}
-<<defun def-is-eqlist>>=
-(defun def-is-eqlist (str)
- (let (g e)
-  (declare (special $is-eqlist $is-spill-list))
-  (cond
-   ((not str) (push `(eq ,(setq g (is-gensym)) nil) $is-eqlist) g)
-   ((eq str '\.) (is-gensym))
-   ((identp str) str)
-   ((stringp str)
-     (setq e (def-string str))
-     (push (list (if (atom (second e)) 'eq 'equal)
-                 (setq g (is-gensym)) e)
-        $is-eqlist)
-     g)
-   ((or (numberp str) (member str '((|Zero|) (|One|))))
-    (push (list 'eq (setq g (is-gensym)) str) $is-eqlist)
-    g)
-   ((atom str) (errhuh))
-   ((eqcar str 'spadlet)
-    (cond
-     ((identp (second str))
-      (push (def-is2 (second str) (third str)) $is-spill-list)
-      (second str))
-     ((identp (third str))
-       (push (deftran str) $is-spill-list) (third str))
-     ((errhuh))))
-   ((eqcar str 'quote)
-    (push (list (cond ((atom (second str)) 'eq) ('equal))
-                (setq g (is-gensym)) str) 
-          $is-eqlist) 
-     g)
-   ((eqcar str 'list) (def-is-eqlist (list2cons str)))
-   ((or (eqcar str 'cons) (eqcar str 'vcons))
-     (cons (def-is-eqlist (second str)) (def-is-eqlist (third str))))
-   ((eqcar str 'append)
-     (unless (identp (second str)) (error "CANT!"))
-     (push (def-is2 (list 'reverse (setq g (is-gensym)))
-                    (def-is-rev (third str) (second str)))
-       $is-eqlist)
-     (cond ((eq (second str) '\.) ''t)
-      ((push (subst (second str) 'l '(or (setq l (nreverse l)) t))
-         $is-spill-list)))
-     g)
-   ((errhuh)))))
-
-@
-
 \defdollar{vl}
 <<initvars>>=
 (defparameter $vl nil)
 
 @
 
-\defun{def-is-remdup}{def-is-remdup}
-\calls{def-is-remdup}{def-is-remdup1}
-\usesdollar{def-is-remdup}{vl}
-<<defun def-is-remdup>>=
-(defun def-is-remdup (x)
- (let ($vl)
-  (def-is-remdup1 x)))
-
-@
-
-\defun{def-is-remdup1}{def-is-remdup1}
-\calls{def-is-remdup1}{is-gensym}
-\calls{def-is-remdup1}{eqcar}
-\calls{def-is-remdup1}{def-is-remdup1}
-\calls{def-is-remdup1}{errhuh}
-\usesdollar{def-is-remdup1}{vl}
-\usesdollar{def-is-remdup1}{is-eqlist}
-<<defun def-is-remdup1>>=
-(defun def-is-remdup1 (x)
- (let (rhs lhs g)
- (declare (special $vl $is-eqlist))
-  (cond
-   ((not x) nil)
-   ((eq x '\.) x)
-   ((identp x)
-    (cond
-     ((member x $vl)
-      (push (list 'equal (setq g (is-gensym)) x) $is-eqlist)
-      g)
-     ((push x $vl)
-      x)))
-   ((member x '((|Zero|) (|One|))) x)
-   ((atom x) x)
-   ((eqcar x 'spadlet)
-     (setq rhs (def-is-remdup1 (third x)))
-     (setq lhs (def-is-remdup1 (second x)))
-     (list 'spadlet lhs rhs))
-   ((eqcar x 'let)
-     (setq rhs (def-is-remdup1 (third x)))
-     (setq lhs (def-is-remdup1 (second x)))
-     (list 'let lhs rhs))
-   ((eqcar x 'quote) x)
-   ((and (eqcar x 'equal) (not (cddr x)))
-     (push (list 'equal (setq g (is-gensym)) (second x)) $is-eqlist)
-     g)
-   ((member (first x) '(list append cons vcons))
-    (cons
-     (cond ((eq (first x) 'vcons) 'cons) ( (first x)))
-     (mapcar #'def-is-remdup1 (cdr x))))
-   ((errhuh)))))
-
-@
-
-\defun{addCARorCDR}{addCARorCDR}
-\calls{addCARorCDR}{eqcar}
-\calls{addCARorCDR}{qcdr}
-\calls{addCARorCDR}{qcar}
-<<defun addCARorCDR>>=
-(defun |addCARorCDR| (acc expr)
- (let (funs p funsA funsR)
-  (cond
-   ((null (pairp expr)) (list acc expr))
-   ((and (eq acc 'car) (eqcar expr 'reverse)) (cons '|last| (qcdr expr)))
-   (t
-    (setq funs
-     '(car cdr caar cdar cadr cddr caaar cadar caadr caddr
-       cdaar cddar cdadr cdddr))
-    (setq p (position (qcar expr) funs))
-    (if (null p)
-     (list acc expr)
-     (progn
-      (setq funsA
-       '(caar cadr caaar cadar caadr caddr caaaar caadar caaadr caaddr
-         cadaar caddar cadadr cadddr))
-      (setq funsR
-       '(cdar cddr cdaar cddar cdadr cdddr cdaaar cdadar cdaadr cdaddr
-         cddaar cdddar cddadr cddddr))
-      (if (eq acc 'car)
-       (cons (elt funsA p) (qcdr expr))
-       (cons (elt funsR p) (qcdr expr)))))))))
-
-@
-
 <<initvars>>=
 (defparameter $IS-GENSYMLIST nil)
 
@@ -9433,253 +8938,6 @@ of the symbol being parsed. The original list read:
 
 @
 
-\defun{defIS}{defIS}
-\calls{defIS}{deftran}
-\calls{defIS}{defIS1}
-\usesdollar{defIS}{isGenVarCounter}
-\usesdollar{defIS}{inDefIS}
-<<defun defIS>>=
-(defun |defIS| (lhs rhs)
- (let (|$isGenVarCounter| |$inDefIS|)
- (declare (special |$isGenVarCounter| |$inDefIS|))
-  (setq |$isGenVarCounter| 1)
-  (setq |$inDefIS| t)
-  (|defIS1| (deftran lhs) rhs)))
-
-@
-
-\defun{defIS1}{defIS1}
-\calls{defIS1}{defLetForm}
-\calls{defIS1}{defLET1}
-\calls{defIS1}{defLET}
-\calls{defIS1}{defIS1}
-\calls{defIS1}{mkprogn}
-\calls{defIS1}{strconc}
-\calls{defIS1}{stringimage}
-\calls{defIS1}{qcar}
-\calls{defIS1}{qcdr}
-\calls{defIS1}{defISReverse}
-\calls{defIS1}{say}
-\calls{defIS1}{def-is}
-\usesdollar{defIS1}{let}
-\usesdollar{defIS1}{isGenVarCounter}
-\usesdollar{defIS1}{inDefLET}
-<<defun defIS1>>=
-(defun |defIS1| (lhs rhs)
- (let (d l a1 b1 c cls a b patrev g rev l2)
- (declare (special $let |$isGenVarCounter| |$inDefLET|))
- (cond
-  ((null rhs) (list 'null lhs))
-  ((stringp rhs) (list 'eq lhs (list 'quote (intern rhs))))
-  ((numberp rhs) (list 'equal lhs rhs))
-  ((atom rhs) (list 'progn (|defLetForm| rhs lhs) 't))
-  ((and (pairp rhs) (eq (qcar rhs) 'quote)
-        (pairp (qcdr rhs)) (eq (qcdr (qcdr rhs)) nil))
-    (if (identp (qcar (qcdr rhs)))
-     (list 'eq lhs rhs)
-     (list 'equal lhs rhs)))
-  ((and (pairp rhs) (equal (qcar rhs) $let)
-         (pairp (qcdr rhs)) (pairp (qcdr (qcdr rhs)))
-         (eq (qcdr (qcdr (qcdr rhs))) nil))
-    (setq c (qcar (qcdr rhs)))
-    (setq d (qcar (qcdr (qcdr rhs))))
-    (setq l
-     (if |$inDefLET|
-      (|defLET1| c lhs)
-      (|defLET| c lhs)))
-    (list 'and (|defIS1| lhs d) (mkprogn (list l t))))
-  ((and (pairp rhs) (eq (qcar rhs) 'equal)
-        (pairp (qcdr rhs)) (eq (qcdr (qcdr rhs)) nil))
-   (setq a (qcar (qcdr rhs)))
-   (list 'equal lhs a ))
-  ((pairp lhs)
-   (setq g (intern (strconc "ISTMP#" (stringimage |$isGenVarCounter|))))
-   (setq |$isGenVarCounter| (1+ |$isGenVarCounter|))
-   (mkprogn (list (list $let g lhs) (|defIS1| g rhs))))
-  ((and (pairp rhs) (eq (qcar rhs) 'cons) (pairp (qcdr rhs))
-        (pairp (qcdr (qcdr rhs))) (eq (qcdr (qcdr (qcdr rhs))) nil))
-    (setq a (qcar (qcdr rhs)))
-    (setq b (qcar (qcdr (qcdr rhs))))
-    (cond
-     ((eq a (intern "." "BOOT"))
-      (if (null b)
-       (list 'and (list 'pairp lhs) (list 'eq (list 'qcdr lhs) nil))
-       (list 'and (list 'pairp lhs) (|defIS1| (list 'qcdr lhs) b))))
-     ((null b)
-      (list 'and (list 'pairp lhs) 
-                 (list 'eq (list 'qcdr lhs) nil)
-                 (|defIS1| (list 'qcar lhs) a)))
-     ((eq b (intern "." "BOOT"))
-       (list 'and (list 'pairp lhs) (|defIS1| (list 'qcar lhs) a)))
-     (t
-      (setq a1 (|defIS1| (list 'qcar lhs) a))
-      (setq b1 (|defIS1| (list 'qcdr lhs) b))
-      (cond
-       ((and (pairp a1) (eq (qcar a1) 'progn)
-             (pairp (qcdr a1)) (pairp (qcdr (qcdr a1)))
-             (eq (qcdr (qcdr (qcdr a1))) nil)
-             (equal (qcar (qcdr (qcdr a1))) t)
-             (pairp b1) (eq (qcar b1) 'progn))
-         (setq c (qcar (qcdr a1)))
-         (setq cls (qcdr b1))
-         (list 'and (list 'pairp lhs) (mkprogn (cons c cls))))
-       (t
-        (list 'and (list 'pairp lhs) a1 b1))))))
-  ((and (pairp rhs) (eq (qcar rhs) 'append) (pairp (qcdr rhs))
-        (pairp (qcdr (qcdr rhs))) (eq (qcdr (qcdr (qcdr rhs))) nil))
-    (setq a (qcar (qcdr rhs)))
-    (setq b (qcar (qcdr (qcdr rhs))))
-    (setq patrev (|defISReverse| b a))
-    (setq g (intern (strconc "ISTMP#" (stringimage |$isGenVarCounter|))))
-    (setq |$isGenVarCounter| (1+ |$isGenVarCounter|))
-    (setq rev
-     (list 'and
-       (list 'pairp lhs)
-       (list 'progn (list $let g  (list 'reverse lhs)) t)))
-    (setq l2 (|defIS1| g patrev))
-    (when  (and (pairp l2) (atom (car l2))) (setq l2 (list l2)))
-    (cond
-     ((eq a (intern "." "BOOT"))
-      (cons 'and (cons rev l2)))
-     (t
-      (cons 'and
-       (cons rev
-        (append l2
-         (list
-          (list 'progn (list (|defLetForm| a (list 'nreverse a )) t)))))))))
-  (t
-   (say "WARNING (defIS1): possibly bad IS code being generated")
-   (def-is (list lhs rhs))))))
-
-@
-
-\defun{def-is-rev}{def-is-rev}
-\calls{def-is-rev}{def-is-rev}
-\calls{def-is-rev}{errhuh}
-<<defun def-is-rev>>=
-(defun def-is-rev (x a)
- (let (y)
-  (if (eq (first x) 'cons)
-   (cond
-    ((not (third x)) (list 'cons (second x) a))
-    ((setq y (def-is-rev (third x) nil))
-      (setf (third y) (list 'cons (second x) a))
-      y))
-   (errhuh))))
-
-@
-
-\defun{defISReverse}{defISReverse}
-This reverses forms coming from APPENDs in patterns. 
-It is pretty much just a translation of DEF-IS-REV
-\calls{defISReverse}{defISReverse}
-\calls{defISReverse}{errhuh}
-<<defun defISReverse>>=
-(defun |defISReverse| (x a)
- (let (y)
-  (if (and (pairp x) (eq (qcar x) 'cons))
-   (if (null (caddr x))
-     (list 'cons (cadr x) a)
-     (progn 
-      (setq y (|defISReverse| (caddr x) nil))
-      (rplac (caddr y) (list 'cons (cadr x) a))
-      y))
-   (errhuh))))
-
-@
-
-\defun{def-it}{def-it}
-\calls{def-it}{def-in2on}
-\calls{def-it}{deftran}
-\calls{def-it}{reset}
-\calls{def-it}{def-let}
-\calls{def-it}{errhuh}
-<<defun def-it>>=
-(defun def-it (fn l)
- (setq l (reverse l))
- (let ((b (first l)))
-  (let ((it (def-in2on (nreverse (rest l)))))
-   (let ((itp
-          (apply #'append
-           (mapcar
-             #'(lambda (x &aux op y g)
-                (if (and (member (setq op (first x)) '(in on))
-                         (not (atom (second x))))
-                  (if (eqcar (setq y (second x)) 'spadlet)
-                   (if (atom (setq g (second y)))
-                    (list 
-                     `(,op ,g ,(deftran (third x)))
-                     `(reset ,(def-let (deftran (third y)) g)))
-                    (errhuh))
-                   (list
-                    `(,op ,(setq g (gensym)) ,(deftran (third x)))
-                    `(reset ,(def-let (deftran (second x)) g))))
-                  `(,x)))
-            it))))
-    (cons fn (nconc itp (list b)))))))
-
-@
-
-\defun{def-string}{def-string}
-\calls{def-string}{deftran}
-\uses{def-string}{*package*}
-<<defun def-string>>=
-(defun def-string (x)
- ;; following patches needed to fix reader bug in Lucid Common Lisp
-  (if (and (> (size x) 0) (or (char= (elt x 0) #\.) (char= (elt x 0) #\Page)))
-   `(intern ,X ,(package-name *package*))
-   `(quote ,(deftran (intern x)))))
-
-@
-
-\defun{def-stringtoquote}{def-stringtoquote}
-\calls{def-stringtoquote}{def-addlet}
-\calls{def-stringtoquote}{def-stringtoquote}
-<<defun def-stringtoquote>>=
-(defun def-stringtoquote (x)
- (cond
-  ((stringp x) (list 'quote (intern x)))
-  ((atom x) x)
-  ((cons (def-addlet (first x)) (def-stringtoquote (cdr x))))))
-
-@
-
-\defun{def-addlet}{def-addlet}
-\calls{def-addlet}{mkprogn}
-\calls{def-addlet}{def-let}
-\calls{def-addlet}{compfluidize}
-\usesdollar{def-addlet}{body}
-<<defun def-addlet>>=
-(defun def-addlet (x)
- (declare (special $body))
- (if (atom x)
-  (if (stringp x) `(quote ,(intern x))  x)
-  (let ((g (gensym)))
-   (setq $body (mkprogn (list (def-let (compfluidize x) g) $body)))
-   g)))
-
-@
-
-\defun{def-inner}{def-inner}
-\calls{def-inner}{def-insert-let}
-\calls{def-inner}{def-stringtoquote}
-\calls{def-inner}{sublis}
-\calls{def-inner}{comp}
-\usesdollar{def-inner}{body}
-\usesdollar{def-inner}{OpAssoc}
-\usesdollar{def-inner}{op}
-<<defun def-inner>>=
-(defun def-inner (form signature $body)
-  "Same as DEF but assumes body has already been DEFTRANned"
- (declare (special $body) (ignore signature))
- (let ($OpAssoc ($op (first form)) (argl (rest form)))
- (declare (special $OpAssoc $op))
-   (let* ((argl (def-insert-let argl))
-          (arglp (def-stringtoquote argl)))
-    (comp (sublis $opassoc `((,$op (lam ,arglp ,$body))))))))
-
-@
-
 \defun{hackforis}{hackforis}
 \calls{hackforis}{hackforis1}
 <<defun hackforis>>=
@@ -9715,391 +8973,6 @@ It is pretty much just a translation of DEF-IS-REV
 
 @
 
-\section{The def-tran table}
-\begin{verbatim}
-  |:|       |DEF-:|
-  |::|      |DEF-::|
-  CATEGORY  DEF-CATEGORY
-  COLLECT   DEF-COLLECT
-  ELT       DEF-ELT
-  EQUAL     DEF-EQUAL
-  |is|      DEF-IS
-  |isnt|    DEF-ISNT
-  LESSP     DEF-LESSP
-  |<|       DEF-LESSP
-  SPADLET   DEF-LET
-  LET       DEF-LET
-  REPEAT    DEF-REPEAT
-  SEQ       DEF-SEQ
-  SETELT    DEF-SETELT
-  |where|   DEF-WHERE
-\end{verbatim}
-
-\defun{deftran}{deftran}
-This two-level call allows DEF-RENAME to be locally bound to do
-nothing (see boot2Lisp) yet still allow function call (lisp2BootAndComp).
-\calls{deftran}{}
-\usesdollar{deftran}{macroassoc}
-<<defun deftran>>=
-(defun deftran (x)
- (let (op y)
-  (cond
-   ((stringp x) (def-string x))
-   ((identp x) (cond ((lassoc x $macroassoc)) (x)))
-   ((atom x) x)
-   ((eq (setq op (first x)) 'where) (def-where (cdr x)))
-   ((eq op 'repeat) (def-repeat (cdr x)))
-   ((eq op 'collect) (def-collect (cdr x)))
-   ((eq op 'makestring)
-          (cond ((stringp (second x)) x)
-                ((eqcar (second x) 'quote)
-                 (list 'makestring (stringimage (cadadr x))))
-                ((list 'makestring (deftran (second x))))))
-   ((eq op 'quote)
-          (if (stringp (setq y (second x))) (list 'makestring y)
-             (if (and (identp y) (char= (elt (pname y) 0) #\.))
-                 `(intern ,(pname y) ,(package-name *package*)) x)))
-   ((eq op 'is) (|defIS| (second x) (third x)))
-   ((eq op 'spadlet) (def-let (second x) (third x)))
-   ((eq op 'dcq) (list 'dcq (second x) (deftran (third x))))
-   ((eq op 'cond) (cons 'cond (def-cond (cdr x))))
-   ((member (first x) '(|sayBrightly| say moan croak) :test #'eq)
-          (def-message x))
-   ((setq y (getl (first x) 'def-tran))
-          (funcall y (mapcar #'deftran (cdr x))))
-   ((mapcar #'deftran x)))))
-
-@
-
-\defplist{def-:}{def-:}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get '|:| 'def-tran) '|DEF-:|))
-
-@
-
-\defun{def-:}{def-:}
-\calls{def-:}{dcq}
-<<defun def-:>>=
-(defun |DEF-:| (x &aux y)
- (dcq (x y) x)
-  `(spadlet
-     ,(if (or (eq y '|fluid|)
-              (and (identp x) (char= #\$ (elt (pname x) 0))))
-       `(fluid ,x) x)
-        nil))
-
-@
-
-\defplist{def-::}{def-::}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get '|::| 'def-tran) '|DEF-::|))
-
-@
-
-\defmacro{def-::}
-<<defmacro def-::>>=
-(defmacro |def-::| (x)
-  (let ((expr (first x)) (type (second x)))
-    (if (equal type '(|Triple|)) expr (errhuh))))
-
-@
-
-\defplist{category}{def-category}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get 'category 'def-tran) 'def-category))
-
-@
-
-\defun{def-category}{def-category}
-\calls{def-category}{eqcar}
-\calls{def-category}{kadr}
-<<defun def-category>>=
-(defun def-category (l)
- (let (siglist atlist)
-  (mapcar #'(lambda (x)
-             (if (eqcar (kadr X) 'signature)
-              (push x siglist)
-              (push x atlist)))
-          l)
-  (list 'category (mkq (nreverse siglist)) (mkq (nreverse atlist)))))
-
-@
-
-\defplist{collect}{def-collect}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get 'collect 'def-tran) 'def-collect))
-
-@
-
-\defun{def-collect}{def-collect}
-\calls{def-collect}{def-it}
-\calls{def-collect}{deftran}
-\calls{def-collect}{hackforis}
-<<defun def-collect>>=
-(defun def-collect (l)
- (def-it 'collect (mapcar #'deftran (hackforis l))))
-
-@
-
-\defplist{elt}{def-elt}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get 'elt 'def-tran) 'def-elt))
-
-@
-
-\defun{def-elt}{def-elt}
-<<defun def-elt>>=
-(defun def-elt (args)
- (let ((expr (car args)) (sel (cadr args)) y)
-  (if (and (symbolp sel) (setq y (get sel 'sel\,function)))
-   (if (integerp y) 
-     (list 'elt expr y)
-     (list y expr))
-   (list 'elt expr sel))))
-
-@
-
-\defplist{equal}{def-equal}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get 'equal 'def-tran) 'def-equal))
-
-@
-
-\defun{def-equal}{def-equal}
-\usesdollar{def-equal}{boot}
-<<defun def-equal>>=
-(defun def-equal (x)
- (declare (special $boot))
- (cond
-  ((not (cdr x)) (cons 'equal x))
-  ((or (member '(|One|) X) (member '(|Zero|) X)
-    (integerp (first x)) (integerp (second x))) (cons 'eql x))
-  ((not (first x)) (list 'null (second x)))
-  ((not (second x)) (list 'null (first x)))
-  ($boot (cons 'boot-equal x))
-  ((cons 'equal x))))
- 
-@
-
-\defplist{lessp}{def-lessp}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get 'lessp 'def-tran) 'def-lessp))
-
-@
-
-\defplist{$<$}{def-lessp}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get '|<| 'def-tran) 'def-lessp))
-
-@
-
-\defun{def-lessp}{def-lessp}
-<<defun def-lessp>>=
-(defun def-lessp (x)
- (labels (
-  (smint-able (x)
-   (or (typep x 'fixnum)
-       (and (pairp x)
-            (member (car x) '(|One| |Zero| length \# qcsize qvsize qlength)))))
- )
- (cond
-  ((null (cdr x)) (cons '< x))
-  ((eq (cadr x) 0) (list 'minusp (car x)))
-  ((and (smint-able (car x)) (smint-able (cadr x))) (cons 'qslessp x))
-  ('t (list '> (cadr x) (car x))))))
-
-@
-
-\defplist{spadlet}{def-let}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get 'spadlet 'def-tran) 'def-let))
-
-@
-
-\defplist{let}{def-let}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get 'let 'def-tran) 'def-let))
-
-@
-
-\defun{def-let}{def-let}
-\calls{def-let}{deftran}
-\calls{def-let}{defLET}
-<<defun def-let>>=
-(defun def-let (form rhs)
- (let (f1 f2)
-  (unless (and (consp form) (eq (qcar form) '\:))
-   (setq form (macroexpand form)))
-  (cond
-   ((and (consp form) (eq (qcar form) '\:))
-    (setq f1 (deftran form))
-    (setq f2 (deftran (list 'spadlet (second form) rhs)))
-    (if (and (eq (car f2) 'spadlet) (equal (second f2) (second form)))
-      (list 'spadlet (second f1) (third f2))
-      (list 'progn f1 f2)))
-   ((and (consp form) (eq (qcar form) 'elt))
-     (deftran (list 'setelt (second form) (third form) rhs)))
-   (t 
-     (|defLET| form (deftran rhs))))))
-
-@
-
-\defplist{is}{def-is}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get '|is| 'def-tran) 'def-is))
-
-@
-
-\defun{def-is}{def-is}
-\calls{def-is}{def-is2}
-\usesdollar{def-is}{is-gensymlist}
-\uses{def-is}{Initial-Gensym}
-<<defun def-is>>=
-(defun def-is (x)
- (let (($is-gensymlist Initial-Gensym))
-  (declare (special is-gensymlist Initial-Gensym))
-  (def-is2 (first X) (second x))))
-
-@
-
-\defun{def-is2}{def-is2}
-\calls{def-is2}{eqcar}
-\calls{def-is2}{moan}
-\calls{def-is2}{def-is-eqlist}
-\calls{def-is2}{def-is-remdup}
-\calls{def-is2}{mkpf}
-\calls{def-is2}{subst}
-\calls{def-is2}{dcq}
-\calls{def-is2}{listofatoms}
-\calls{def-is2}{/tracelet-print}
-\usesdollar{def-is2}{is-eqlist}
-\usesdollar{def-is2}{is-spill-list}
-<<defun def-is2>>=
-(defun def-is2 (form struct)
- (let ($is-eqlist $is-spill-list (form (deftran form)))
-  (when (eqcar struct '|@Tuple|)
-   (moan "you must use square brackets around right arg. to" '%b "is" '%d))
-  (let* ((x (def-is-eqlist (def-is-remdup struct)))
-         (code (if (identp x)
-                     (mkpf (subst form x $is-eqlist) 'and)
-                     (mkpf `((dcq ,x ,form) . ,$is-eqlist) 'and))))
-   (let ((code (mkpf `(,code . ,$is-spill-list) 'and)))
-    (if $traceletflag
-     (let ((l (remove-if #'gensymp (listofatoms x))))
-      `(prog1 ,code ,@(mapcar #'(lambda (y) `(/tracelet-print ,y ,y)) L)))
-     code)))))
-
-@
-
-\defplist{isnt}{def-isnt}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get '|isnt| 'def-tran) 'def-isnt))
-
-@
-
-\defun{def-isnt}{def-isnt}
-\calls{def-isnt}{deftran}
-<<defun def-isnt>>=
-(defun def-isnt (x)
- (deftran (list 'null (cons 'is x))))
-
-@
-
-\defplist{repeat}{def-repeat}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get 'repeat 'def-tran) 'def-repeat))
-
-@
-
-\defun{def-repeat}{def-repeat}
-\calls{def-repeat}{def-it}
-\calls{def-repeat}{deftran}
-\calls{def-repeat}{hackforis}
-<<defun def-repeat>>=
-(defun def-repeat (l)
- (def-it 'repeat (mapcar #'deftran (hackforis l))))
-
-@
-
-\defplist{setelt}{def-setelt}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get 'setelt 'def-tran) 'def-setelt))
-
-@
-
-\defun{def-setelt}{def-setelt}
-<<defun def-setelt>>=
-(defun def-setelt (args)
- (let ((var (first args)) (sel (second args)) (expr (third args)))
-  (let ((y (and (symbolp sel) (get sel 'sel\,function))))
-   (if y
-    (if (integerp y)
-     (list 'setelt var y expr)
-     (list 'rplac (list y var) expr))
-    (list 'setelt var sel expr)))))
-
-@
-
-\defplist{seq}{def-seq}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get 'seq 'def-tran) 'def-seq))
-
-@
-
-\defun{def-seq}{def-seq}
-\calls{def-seq}{eqcar}
-<<defun def-seq>>=
-(defun def-seq (u)
- (labels (
-  (seqoptimize (u)
-   (if (and (eqcar (cadr u) 'exit) (eqcar (cadadr u) 'seq))
-       (cadadr u)
-       u)))
-  (seqoptimize (cons 'seq u))))
-
-@
-
-\defplist{where}{def-where}
-<<postvars>>=
-(eval-when (eval load)
- (setf (get '|where| 'def-tran) 'def-where))
-
-@
-
-\defun{def-where}{def-where}
-\calls{def-where}{def-whereclauselist}
-\calls{def-where}{def-inner}
-\calls{def-where}{sublis}
-\calls{def-where}{mkprogn}
-\calls{def-where}{deftran}
-\usesdollar{def-where}{defstack}
-\usesdollar{def-where}{opassoc}
-<<defun def-where>>=
-(defun def-where (args)
- (let ((x (car args)) (y (cdr args)) $defstack)
- (declare (special $defstack $opassoc))
-  (let ((u (def-whereclauselist y)))
-   (mapc #'(lambda (X) (def-inner (first x) nil (sublis $opassoc (second x))))
-         $defstack)
-   (mkprogn (nconc u (list (deftran x)))))))
-
-@
-
 \chapter{PARSE forms}
 \section{The original meta specification}
 This package provides routines to support the Metalanguage
@@ -13554,7 +12427,7 @@ And the {\bf s-process} function which returns a parsed version of the input.
    (setq $traceflag t)
    (if (not x) (return nil))
    (if $boot
-     (setq x (def-rename (|new2OldLisp| x)))
+     (setq x (def-rename (|new2OldLisp| x))) 
      (setq x (|parseTransform| (|postTransform| x))))
    (when |$TranslateOnly| (return (setq |$Translation| x)))
    (when |$postStack| (|displayPreCompilationErrors|) (return nil))
@@ -13572,6 +12445,29 @@ And the {\bf s-process} function which returns a parsed version of the input.
 
 @
 
+\defun{def-rename}{def-rename}
+\calls{def-rename}{def-rename1}
+<<defun def-rename>>=
+(defun def-rename (x)
+ (def-rename1 x))
+
+@
+
+\defun{def-rename1}{def-rename1}
+\calls{def-rename1}{def-rename1}
+<<defun def-rename1>>=
+(defun def-rename1 (x)
+ (cond
+  ((symbolp x)
+   (let ((y (get x 'rename))) (if y (first y) x)))
+  ((and (listp x) x)
+   (if (eqcar x 'quote)
+       x
+       (cons (def-rename1 (first x)) (def-rename1 (cdr x)))))
+  (x)))
+
+@
+
 \defun{compTopLevel}{compTopLevel}
 \calls{compTopLevel}{newComp}
 \calls{compTopLevel}{compOrCroak}
@@ -15115,12 +14011,10 @@ if \verb|$InteractiveMode| then use a null outputstream
 <<GENERICTable>>
 
 <<defmacro bang>>
-<<defmacro def-::>>
 <<defmacro must>>
 <<defmacro star>>
 
 <<defun action>>
-<<defun addCARorCDR>>
 <<defun addclose>>
 <<defun add-parens-and-semis-to-line>>
 <<defun advance-token>>
@@ -15217,48 +14111,8 @@ if \verb|$InteractiveMode| then use a null outputstream
 
 <<defun decodeScripts>>
 <<defun deepestExpression>>
-<<defun def>>
-<<defun def-:>>
-<<defun def-addlet>>
-<<defun def-category>>
-<<defun def-collect>>
-<<defun def-cond>>
-<<defun def-elt>>
-<<defun def-equal>>
-<<defun def-lessp>>
-<<defun def-inner>>
-<<defun def-insert-let>>
-<<defun def-in2on>>
-<<defun def-is>>
-<<defun def-is2>>
-<<defun def-is-eqlist>>
-<<defun defIS>>
-<<defun defIS1>>
-<<defun def-isnt>>
-<<defun defISReverse>>
-<<defun def-is-remdup>>
-<<defun def-is-remdup1>>
-<<defun def-is-rev>>
-<<defun def-it>>
-<<defun def-let>>
-<<defun defLET>>
-<<defun defLET1>>
-<<defun defLET2>>
-<<defun defLetForm>>
-<<defun def-message>>
-<<defun def-message1>>
-<<defun def-process>>
 <<defun def-rename>>
 <<defun def-rename1>>
-<<defun def-repeat>>
-<<defun def-setelt>>
-<<defun def-seq>>
-<<defun def-string>>
-<<defun def-stringtoquote>>
-<<defun deftran>>
-<<defun def-where>>
-<<defun def-whereclause>>
-<<defun def-whereclauselist>>
 <<defun dollarTran>>
 <<defun drop>>
 
diff --git a/changelog b/changelog
index 4c19af4..d9d5401 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,7 @@
+20110108 tpd src/axiom-website/patches.html 20110108.01.tpd.patch
+20110108 tpd src/interp/vmlisp.lisp treeshake compiler
+20110108 tpd src/interp/parsing.lisp treeshake compiler
+20110108 tpd books/bookvol9 treeshake compiler
 20101220 tpd src/axiom-website/patches.html 20101220.02.tpd.patch
 20101220 tpd src/interp/vmlisp.lisp treeshake compiler
 20101220 tpd src/interp/parsing.lisp treeshake compiler
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 0c2d26c..1657987 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -3331,5 +3331,7 @@ src/interp/vmlisp.lisp cleaning vmlisp<br/>
 books/bookvol9 treeshake compiler<br/>
 <a href="patches/20101220.02.tpd.patch">20101220.02.tpd.patch</a>
 books/bookvol9 treeshake compiler<br/>
+<a href="patches/20110108.01.tpd.patch">20110108.01.tpd.patch</a>
+books/bookvol9 treeshake compiler<br/>
  </body>
 </html>
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet
index 572bc56..b75f201 100644
--- a/src/interp/parsing.lisp.pamphlet
+++ b/src/interp/parsing.lisp.pamphlet
@@ -1071,23 +1071,6 @@ foo defined inside of fum gets renamed as fum,foo.")
     (SETQ $DEFSTACK (CONS (LIST (CONS OP (CDR XP)) Y) $DEFSTACK))
     NIL))
 
-(mapcar #'(lambda (x) (MAKEPROP (first X) 'SEL\,FUNCTION (second X)))
-        '((|aTree| 0)           (|aMode| 1)
-          (|aValue| 2)          (|aModeSet| 3)
-          (|aGeneral| 4)        (|expr| CAR)
-          (|mode| CADR)         (|env| CADDR)
-          (|mmDC| CAAR)         (|cacheName| CADR)
-          (|cacheType| CADDR)   (|cacheReset| CADDDR)
-          (|cacheCount| CADDDDR)(|mmSignature| CDAR)
-          (|mmTarget| CADAR)    (|mmCondition| CAADR)
-          (|mmImplementation| CADADR)
-          (|streamName| CADR)   (|streamDef| CADDR)
-          (|streamCode| CADDDR) (|opSig| CADR)
-          (|attributes| CADDR)  (|op| CAR)
-          (|opcode| CADR)       (|sig| CDDR)
-          (|source| CDR)        (|target| CAR)
-          (|first| CAR)         (|rest| CDR)))
-
 (defvar |$new2OldRenameAssoc|
         '((\QUAD . \.) (\' . QUOTE) (|nil| . NIL) (|append| . APPEND)
           (|union| . UNION) (|cons| . CONS)))
diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet
index 7635cb7..81fbd65 100644
--- a/src/interp/vmlisp.lisp.pamphlet
+++ b/src/interp/vmlisp.lisp.pamphlet
@@ -6263,16 +6263,6 @@ o  there is some code at the end of SPECEVAL BOOT that puts "up"
   )) (MAKEPROP X '|dataCoerce|
       (INTERNL (STRCONC "coerce" (STRINGIMAGE X))))))
 
-(REPEAT (IN X '(
-  (|Integer| . (INTEGERP |#1|))
-  ;; (|Float| . (FLOATP |#1|))
-  (|DoubleFloat| . (FLOATP |#1|))
-  ;; (|Symbol| . (IDENTP |#1|))
-  ;;(|Boolean| . (BOOLEANP |#1|))  worthless predicate is always true
-  (|String| . (STRINGP |#1|))
-  (|PrimitiveSymbol| . (IDENTP |#1|))
-  )) (MAKEPROP (CAR X) '|BasicPredicate| (CDR X)))
-
 ;; this property is checked for Integers to decide which subdomain to
 ;; choose at compile time.