diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet
index 5f530fd..9663d36 100644
--- a/books/bookvol9.pamphlet
+++ b/books/bookvol9.pamphlet
@@ -4536,6 +4536,25 @@ The current input line.
 
 \end{chunk}
 
+\defun{Advance-Char}{Advance-Char}
+\calls{Advance-Char}{Line-At-End-P}
+\calls{Advance-Char}{Line-Advance-Char}
+\calls{Advance-Char}{next-line}
+\calls{Advance-Char}{current-char}
+\usesstruct{Advance-Char}{line}
+\begin{chunk}{defun Advance-Char}
+(defun Advance-Char ()
+  "Advances IN-STREAM, invoking Next Line if necessary."
+ (loop
+  (cond
+   ((not (Line-At-End-P Current-Line))
+    (return (Line-Advance-Char Current-Line)))
+   ((next-line in-stream) 
+    (return (current-char)))
+   ((return nil)))))
+
+\end{chunk}
+
 \defun{storeblanks}{storeblanks}
 \begin{chunk}{defun storeblanks}
 (defun storeblanks (line n)
@@ -5071,6 +5090,66 @@ of the symbol being parsed. The original list read:
 
 \end{chunk}
 
+\defun{transIs}{transIs}
+\calls{transIs}{isListConstructor}
+\calls{transIs}{transIs1}
+\begin{chunk}{defun transIs}
+(defun |transIs| (u)
+  (if (|isListConstructor| u) 
+    (cons '|construct| (|transIs1| u))
+    u))
+
+\end{chunk}
+
+\defun{transIs1}{transIs1}
+\calls{transIs1}{qcar}
+\calls{transIs1}{qcdr}
+\calls{transIs1}{pairp}
+\calls{transIs1}{nreverse0}
+\calls{transIs1}{transIs}
+\calls{transIs1}{transIs1}
+\begin{chunk}{defun transIs1}
+(defun |transIs1| (u)
+ (let (x h v tmp3)
+  (cond
+   ((and (pairp u) (eq (qcar u) '|construct|))
+     (dolist (x (qcdr u) (nreverse0 tmp3))
+       (push (|transIs| x) tmp3)))
+   ((and (pairp u) (eq (qcar u) '|append|) (pairp (qcdr u))
+         (pairp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil))
+     (setq x (qcar (qcdr u)))
+     (setq h (list '|:| (|transIs| x)))
+     (setq v (|transIs1| (qcar (qcdr (qcdr u)))))
+     (cond
+      ((and (pairp v) (eq (qcar v) '|:|)
+            (pairp (qcdr v)) (eq (qcdr (qcdr v)) nil))
+         (list h (qcar (qcdr v))))
+      ((eq v '|nil|) (car (cdr h)))
+      ((atom v) (list h (list '|:| v)))
+      (t (cons h v))))
+   ((and (pairp u) (eq (qcar u) '|cons|) (pairp (qcdr u)) 
+         (pairp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil))
+     (setq h (|transIs| (qcar (qcdr u))))
+     (setq v (|transIs1| (qcar (qcdr (qcdr u)))))
+     (cond
+      ((and (pairp v) (eq (qcar v) '|:|) (pairp (qcdr v))
+            (eq (qcdr (qcdr v)) nil))
+         (cons h (list (qcar (qcdr v)))))
+      ((eq v '|nil|) (cons h nil))
+      ((atom v) (list h (list '|:| v)))
+      (t (cons h v))))
+   (t u))))
+
+\end{chunk}
+
+\defun{isListConstructor}{isListConstructor}
+\calls{isListConstructor}{member}
+\begin{chunk}{defun isListConstructor}
+(defun |isListConstructor| (u)
+ (and (pairp u) (|member| (qcar u) '(|construct| |append| |cons|))))
+
+\end{chunk}
+
 
 \defplist{dollargreaterthan}{parseDollarGreaterthan}
 \begin{chunk}{postvars}
@@ -11227,6 +11306,28 @@ if X matches initial segment of inputstream.
  
 \end{chunk}
 
+\begin{chunk}{initvars}
+(defvar Escape-Character #\\ "Superquoting character.")
+
+\end{chunk}
+
+\defun{token-lookahead-type}{token-lookahead-type}
+\uses{token-lookahead-type}{Escape-Character}
+\begin{chunk}{defun token-lookahead-type}
+(defun token-lookahead-type (char)
+  "Predicts the kind of token to follow, based on the given initial character."
+ (declare (special Escape-Character))
+  (cond 
+   ((not char)                                             'eof)
+   ((or (char= char Escape-Character) (alpha-char-p char)) 'id)
+   ((digitp char)                                          'num)
+   ((char= char #\')                                       'string)
+   ((char= char #\[)                                       'bstring)
+   ((member char '(#\Space #\Tab #\Return) :test #'char=)  'white)
+   (t                                                       'special-char)))
+ 
+\end{chunk}
+
 \defun{match-advance-string}{match-advance-string}
 The match-string function returns length of X 
 if X matches initial segment of inputstream.
@@ -11713,6 +11814,85 @@ Stack of results of reduced productions.
 
 \chapter{Utility Functions}
 
+\defun{translabel}{translabel}
+\calls{translabel}{translabel1}
+\begin{chunk}{defun translabel}
+(defun translabel (x al)
+ (translabel1 x al) x)
+
+\end{chunk}
+
+\defun{translabel1}{translabel1}
+\calls{translabel1}{refvecp}
+\calls{translabel1}{maxindex}
+\calls{translabel1}{translabel1}
+\calls{translabel1}{lassoc}
+\begin{chunk}{defun translabel1}
+(defun translabel1 (x al)
+ "Transforms X according to AL = ((<label> . Sexpr) ..)."
+  (cond
+   ((refvecp x)
+    (do ((i 0 (1+ i)) (k (maxindex x)))
+        ((> i k))
+      (if (let ((y (lassoc (elt x i) al))) (setelt x i y))
+       (translabel1 (elt x i) al))))
+   ((atom x) nil)
+   ((let ((y (lassoc (first x) al)))
+           (if y (setf (first x) y) (translabel1 (cdr x) al))))
+   ((translabel1 (first x) al) (translabel1 (cdr x) al))))
+
+\end{chunk}
+
+\defun{displayPreCompilationErrors}{displayPreCompilationErrors}
+\calls{displayPreCompilationErrors}{length}
+\calls{displayPreCompilationErrors}{remdup}
+\calls{displayPreCompilationErrors}{sayBrightly}
+\calls{displayPreCompilationErrors}{nequal}
+\calls{displayPreCompilationErrors}{sayMath}
+\usesdollar{displayPreCompilationErrors}{postStack}
+\usesdollar{displayPreCompilationErrors}{topOp}
+\begin{chunk}{defun displayPreCompilationErrors}
+(defun |displayPreCompilationErrors| ()
+ (let (n errors heading)
+  (declare (special |$postStack| |$topOp|))
+  (setq n (|#| (setq |$postStack| (remdup (nreverse |$postStack|)))))
+  (unless (eql n 0)
+    (setq errors (cond ((> n 1) "errors") (t "error")))
+    (cond
+     (|$InteractiveMode|
+      (|sayBrightly| (list "   Semantic " errors " detected: ")))
+     (t
+      (setq heading
+       (if (nequal |$topOp| '|$topOp|) 
+        (list "   " |$topOp| " has")
+        (list "   You have")))
+      (|sayBrightly|
+       (append heading (list n "precompilation " errors ":" )))))
+    (cond
+     ((> n 1)
+       (let ((i 1))
+        (dolist (x |$postStack|)
+          (|sayMath| (cons "   " (cons i (cons ") " x)))))))
+     (t (|sayMath| (cons "    " (car |$postStack|)))))
+    (terpri))))
+
+\end{chunk}
+
+\defun{bumperrorcount}{bumperrorcount}
+\usesdollar{bumperrorcount}{InteractiveMode}
+\usesdollar{bumperrorcount}{spad-errors}
+\begin{chunk}{defun bumperrorcount}
+(defun bumperrorcount (kind)
+ (unless |$InteractiveMode|
+  (let ((index (case kind
+                (|syntax| 0)
+                (|precompilation| 1)
+                (|semantic| 2)
+                (t (error "BUMPERRORCOUNT")))))
+    (setelt $spad_errors index (1+ (elt $spad_errors index))))))
+
+\end{chunk}
+
 \defun{parseTranCheckForRecord}{parseTranCheckForRecord}
 \begin{verbatim}
 ;parseTranCheckForRecord(x,op) ==
@@ -14882,6 +15062,7 @@ if \verb|$InteractiveMode| then use a null outputstream
 \getchunk{defun action}
 \getchunk{defun addclose}
 \getchunk{defun add-parens-and-semis-to-line}
+\getchunk{defun Advance-Char}
 \getchunk{defun advance-token}
 \getchunk{defun aplTran}
 \getchunk{defun aplTran1}
@@ -14889,6 +15070,7 @@ if \verb|$InteractiveMode| then use a null outputstream
 \getchunk{defun argsToSig}
 
 \getchunk{defun blankp}
+\getchunk{defun bumperrorcount}
 
 \getchunk{defun char-eq}
 \getchunk{defun char-ne}
@@ -14979,6 +15161,7 @@ if \verb|$InteractiveMode| then use a null outputstream
 \getchunk{defun deepestExpression}
 \getchunk{defun def-rename}
 \getchunk{defun def-rename1}
+\getchunk{defun displayPreCompilationErrors}
 \getchunk{defun dollarTran}
 \getchunk{defun drop}
 
@@ -15007,6 +15190,7 @@ if \verb|$InteractiveMode| then use a null outputstream
 \getchunk{defun initial-substring}
 \getchunk{defun initial-substring-p}
 \getchunk{defun is-console}
+\getchunk{defun isListConstructor}
 \getchunk{defun isTokenDelimiter}
 
 \getchunk{defun killColons}
@@ -15252,7 +15436,12 @@ if \verb|$InteractiveMode| then use a null outputstream
 \getchunk{defun s-process}
 
 \getchunk{defun token-install}
+\getchunk{defun token-lookahead-type}
 \getchunk{defun token-print}
+\getchunk{defun transIs}
+\getchunk{defun transIs1}
+\getchunk{defun translabel}
+\getchunk{defun translabel1}
 \getchunk{defun try-get-token}
 \getchunk{defun tuple2List}
 
diff --git a/changelog b/changelog
index cff6b3b..b773f25 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,6 @@
+20110311 tpd src/axiom-website/patches.html 20110311.02.tpd.patch
+20110311 tpd src/interp/parsing.lisp treeshake compiler
+20110311 tpd books/bookvol9 treeshake compiler
 20110311 tpd src/axiom-website/patches.html 20110311.01.tpd.patch
 20110311 tpd src/interp/parsing.lisp treeshake compiler
 20110311 tpd books/bookvol9 treeshake compiler
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index bc989b8..67a858b 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -3429,5 +3429,7 @@ books/bookvol9 treeshake compiler<br/>
 books/bookvol9 treeshake compiler<br/>
 <a href="patches/20110311.01.tpd.patch">20110311.01.tpd.patch</a>
 books/bookvol9 treeshake compiler<br/>
+<a href="patches/20110311.02.tpd.patch">20110311.02.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 a31ec0e..ac85dc1 100644
--- a/src/interp/parsing.lisp.pamphlet
+++ b/src/interp/parsing.lisp.pamphlet
@@ -70,19 +70,6 @@ can be shoved back on the input stream (to the current line) with Unget-Tokens.
    (token-install nil nil prior-token nil)))
 
 \end{chunk}
-\subsubsection{Character handling}
-\begin{chunk}{*}
-(defun Advance-Char ()
-  "Advances IN-STREAM, invoking Next Line if necessary."
- (loop
-  (cond
-   ((not (Line-At-End-P Current-Line))
-    (return (Line-Advance-Char Current-Line)))
-   ((next-line in-stream) 
-    (return (current-char)))
-   ((return nil)))))
-
-\end{chunk}
 \subsubsection{Line handling}
 \begin{chunk}{*}
 
@@ -618,21 +605,6 @@ or the chracters ?, !, ' or %"
 
 ; Parsing of operator tokens depends on tables initialized by BOTTOMUP.LISP
 
-(defun TRANSLABEL (X AL) (TRANSLABEL1 X AL) X)
-
-(defun TRANSLABEL1 (X AL)
- "Transforms X according to AL = ((<label> . Sexpr) ..)."
-  (COND ((REFVECP X)
-         (do ((i 0 (1+ i))
-              (k (maxindex x)))
-             ((> i k))
-           (if (LET ((Y (LASSOC (ELT X I) AL))) (SETELT X I Y))
-               (TRANSLABEL1 (ELT X I) AL))))
-        ((ATOM X) NIL)
-        ((LET ((Y (LASSOC (FIRST X) AL)))
-           (if Y (setf (FIRST X) Y) (TRANSLABEL1 (CDR X) AL))))
-        ((TRANSLABEL1 (FIRST X) AL) (TRANSLABEL1 (CDR X) AL))))
-
 ; **** 5. BOOT Error Handling
 
 (defun SPAD-SYNTAX-ERROR (&rest byebye)
@@ -661,15 +633,6 @@ or the chracters ?, !, ' or %"
 (defun SPAD_ERROR_LOC (STR)
   (format str "******** Boot Syntax Error detected ********"))
 
-(defun BUMPERRORCOUNT (KIND)
-  (unless |$InteractiveMode|
-          (LET ((INDEX (case KIND
-                         (|syntax| 0)
-                         (|precompilation| 1)
-                         (|semantic| 2)
-                         (T (ERROR "BUMPERRORCOUNT")))))
-            (SETELT $SPAD_ERRORS INDEX (1+ (ELT $SPAD_ERRORS INDEX))))))
-
 
 ; NAME:     Def
 ; PURPOSE:  Defines BOOT code
@@ -961,19 +924,6 @@ empty (if File-Closed (return nil))
           (special-char (return (get-special-token token)))
           (eof          (return nil)))))
  
-(defparameter Escape-Character #\\ "Superquoting character.")
- 
-(defun token-lookahead-type (char)
-  "Predicts the kind of token to follow, based on the given initial character."
-  (cond ((not char)                                             'eof)
-        ((or (char= char Escape-Character) (alpha-char-p char)) 'id)
-        ((digitp char)                                          'num)
-        ((char= char #\')                                       'string)
-        ((char= char #\[)                                       'bstring)
-;       ((char= char #\$) (advance-char)                        'dollar)
-        ((member char '(#\Space #\Tab #\Return) :test #'char=)  'white)
-        (t                                                      'special-char)))
- 
 (defun make-adjustable-string (n)
   (make-array (list n) :element-type 'string-char :adjustable t))
 
@@ -1139,39 +1089,8 @@ parse
 (DEFUN |parseLeftArrow| (|u|) (|parseTran| (CONS (QUOTE LET) |u|))) 
 ;
 ;
-;transIs u ==
-;  isListConstructor u => ['construct,:transIs1 u]
-;  u
-
-;;;     ***       |transIs| REDEFINED
-
-(DEFUN |transIs| (|u|) (COND ((|isListConstructor| |u|) (CONS (QUOTE |construct|) (|transIs1| |u|))) ((QUOTE T) |u|))) 
 ;
-;isListConstructor u == u is [op,:.] and op in '(construct append cons)
-
-;;;     ***       |isListConstructor| REDEFINED
-
-(DEFUN |isListConstructor| (|u|) (PROG (|op|) (RETURN (AND (PAIRP |u|) (PROGN (SPADLET |op| (QCAR |u|)) (QUOTE T)) (|member| |op| (QUOTE (|construct| |append| |cons|))))))) 
 ;
-;transIs1 u ==
-;  u is ['construct,:l] => [transIs x for x in l]
-;  u is ['append,x,y] =>
-;    h:= [":",transIs x]
-;    (v:= transIs1 y) is [":",z] => [h,z]
-;    v="nil" => first rest h
-;    atom v => [h,[":",v]]
-;    [h,:v]
-;  u is ['cons,x,y] =>
-;    h:= transIs x
-;    (v:= transIs1 y) is [":",z] => [h,z]
-;    v="nil" => [h]
-;    atom v => [h,[":",v]]
-;    [h,:v]
-;  u
-
-;;;     ***       |transIs1| REDEFINED
-
-(DEFUN |transIs1| (|u|) (PROG (|l| |x| |y| |h| |v| |ISTMP#1| |ISTMP#2| |z|) (RETURN (SEQ (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |construct|)) (PROGN (SPADLET |l| (QCDR |u|)) (QUOTE T))) (PROG (#0=#:G166255) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G166260 |l| (CDR #1#)) (|x| NIL)) ((OR (ATOM #1#) (PROGN (SETQ |x| (CAR #1#)) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (|transIs| |x|) #0#)))))))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |append|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (SPADLET |h| (CONS (QUOTE |:|) (CONS (|transIs| |x|) NIL))) (COND ((PROGN (SPADLET |ISTMP#1| (SPADLET |v| (|transIs1| |y|))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |z| (QCAR |ISTMP#2|)) (QUOTE T)))))) (CONS |h| (CONS |z| NIL))) ((BOOT-EQUAL |v| (QUOTE |nil|)) (CAR (CDR |h|))) ((ATOM |v|) (CONS |h| (CONS (CONS (QUOTE |:|) (CONS |v| NIL)) NIL))) ((QUOTE T) (CONS |h| |v|)))) ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |cons|)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#2|)) (QUOTE T))))))) (SPADLET |h| (|transIs| |x|)) (COND ((PROGN (SPADLET |ISTMP#1| (SPADLET |v| (|transIs1| |y|))) (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE |:|)) (PROGN (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |z| (QCAR |ISTMP#2|)) (QUOTE T)))))) (CONS |h| (CONS |z| NIL))) ((BOOT-EQUAL |v| (QUOTE |nil|)) (CONS |h| NIL)) ((ATOM |v|) (CONS |h| (CONS (CONS (QUOTE |:|) (CONS |v| NIL)) NIL))) ((QUOTE T) (CONS |h| |v|)))) ((QUOTE T) |u|)))))) 
 ;
 ;
 ;
@@ -1408,28 +1327,6 @@ parse
 ;
 ;;;Boot translation finished for parse.boot
 
-;displayPreCompilationErrors() ==
-;  n:= #($postStack:= REMDUP NREVERSE $postStack)
-;  n=0 => nil
-;  errors:=
-;    1<n => '"errors"
-;    '"error"
-;  if $InteractiveMode
-;    then sayBrightly ['"   Semantic ",errors,'" detected: "]
-;    else
-;      heading:=
-;        $topOp ^= '$topOp => ['"   ",$topOp,'" has"]
-;        ['"   You have"]
-;      sayBrightly [:heading,'%b,n,'%d,'"precompilation ",errors,'":"]
-;  if 1<n then
-;    (for x in $postStack for i in 1.. repeat sayMath ['"   ",i,'"_) ",:x])
-;    else sayMath ['"    ",:first $postStack]
-;  TERPRI()
-
-;;;     ***       |displayPreCompilationErrors| REDEFINED
-
-(DEFUN |displayPreCompilationErrors| NIL (PROG (|n| |errors| |heading|) (RETURN (SEQ (PROGN (SPADLET |n| (|#| (SPADLET |$postStack| (REMDUP (NREVERSE |$postStack|))))) (COND ((EQL |n| 0) NIL) ((QUOTE T) (SPADLET |errors| (COND ((> |n| 1) "errors") ((QUOTE T) "error"))) (COND (|$InteractiveMode| (|sayBrightly| (CONS "   Semantic " (CONS |errors| (CONS " detected: " NIL))))) ((QUOTE T) (SPADLET |heading| (COND ((NEQUAL |$topOp| (QUOTE |$topOp|)) (CONS "   " (CONS |$topOp| (CONS " has" NIL)))) ((QUOTE T) (CONS "   You have" NIL)))) (|sayBrightly| (APPEND |heading| (CONS (QUOTE |%b|) (CONS |n| (CONS (QUOTE |%d|) (CONS "precompilation " (CONS |errors| (CONS ":" NIL)))))))))) (COND ((> |n| 1) (DO ((#0=#:G166154 |$postStack| (CDR #0#)) (|x| NIL) (|i| 1 (QSADD1 |i|))) ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) (SEQ (EXIT (|sayMath| (CONS "   " (CONS |i| (CONS ") " |x|)))))))) ((QUOTE T) (|sayMath| (CONS "    " (CAR |$postStack|))))) (TERPRI)))))))) 
-
 ;postBlockItem x ==
 ;  x:= postTran x
 ;  x is ['Tuple,:l,[":",y,t]] and (and/[IDENTP x for x in l]) =>