diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet
index 9c1f4a3..257677b 100644
--- a/books/bookvol9.pamphlet
+++ b/books/bookvol9.pamphlet
@@ -1615,6 +1615,97 @@ Symbolics read-line returns embedded newlines in a c-m-Y.")
 
 @
 
+\defun{aplTran}{aplTran}
+\calls{aplTran}{}
+\usesdollar{aplTran}{}
+<<defun aplTran>>=
+(defun |aplTran| (x)
+ (let ($genno u)
+ (declare (special $genno $boot))
+  (cond
+   ($boot x)
+   (t
+    (setq $genno 0)
+    (setq u (|aplTran1| x))
+    (cond
+     ((|containsBang| u) (|throwKeyedMsg| 's2ip0002 nil))
+     (t u))))))
+
+@
+
+\defun{aplTran1}{aplTran1}
+\calls{aplTran1}{aplTranList}
+\calls{aplTran1}{aplTran1}
+\calls{aplTran1}{hasAplExtension}
+\calls{aplTran1}{nreverse0}
+\calls{aplTran1}{}
+\usesdollar{aplTran1}{boot}
+<<defun aplTran1>>=
+(defun |aplTran1| (x)
+ (let (op argl1 argl f y opprime yprime tmp1 arglAssoc futureArgl g a tmp2)
+ (declare (special $boot))
+  (if (atom x)
+   x
+   (progn
+    (setq op (car x))
+    (setq argl1 (cdr x))
+    (setq argl (|aplTranList| argl1))
+    (cond
+     ((eq op '!)
+      (cond
+       ((and (pairp argl)
+             (progn
+              (setq f (qcar argl))
+              (setq tmp1 (qcdr argl))
+              (and (pairp tmp1)
+                   (eq (qcdr tmp1) nil)
+                   (progn
+                    (setq y (qcar tmp1))
+                    t))))
+         (cond
+          ((and (pairp y)
+                (progn
+                 (setq opprime (qcar y))
+                 (setq yprime (qcdr y))
+                 t)
+                (eq opprime '!))
+            (|aplTran1| (cons op (cons op (cons f yprime)))))
+          ($boot 
+           (cons 'collect
+            (cons
+             (list 'in (setq g (genvar)) (|aplTran1| y))
+              (list (list f g ) ))))
+          (t
+           (list '|map| f (|aplTran1| y) ))))
+       (t x)))
+     ((progn
+       (setq tmp1 (|hasAplExtension| argl))
+       (and (pairp tmp1)
+            (progn
+             (setq arglAssoc (qcar tmp1))
+             (setq futureArgl (qcdr tmp1))
+             t)))
+       (cons '|reshape|
+        (cons
+         (cons 'collect
+          (append
+           (do ((tmp3 arglAssoc (cdr tmp3)) (tmp4 nil))
+               ((or (atom tmp3)
+                    (progn (setq tmp4 (car tmp3)) nil)
+                    (progn
+                      (setq g (car tmp4))
+                      (setq a (cdr tmp4))
+                      nil))
+                   (nreverse0 tmp2))
+              (push (list 'in g (list '|ravel| a))) tmp2))
+          (list (|aplTran1| (cons op futureArgl)))))
+         (list (cdar arglAssoc))))
+     (t (cons op argl)))))))
+
+@
+
+
+
 \chapter{The Compiler}
 
 \section{Compiling EQ.spad}
@@ -4675,6 +4766,8 @@ if \verb|$InteractiveMode| then use a null outputstream
 <<initvars>>
 
 <<defun add-parens-and-semis-to-line>>
+<<defun aplTran>>
+<<defun aplTran1>>
 <<defun argsToSig>>
 
 <<defun comp>>
diff --git a/changelog b/changelog
index 46505f3..2446fef 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,6 @@
+20101006 tpd src/axiom-website/patches.html 20101006.01.tpd.patch
+20101006 tpd src/interp/parsing.lisp treeshake compiler
+20101006 tpd books/bookvol9 treeshake compiler	
 20101005 tpd src/axiom-website/patches.html 20101005.01.tpd.patch
 20101005 tpd books/bookvol6 add a research ideas section
 20101005 tpd books/bookvolbib add Kaufmann [KMJ00] and Linger [LMW79]
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 10b725f..be8a276 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -3192,5 +3192,7 @@ books/bookvol9 treeshake compiler<br/>
 books/bookvol9 treeshake compiler<br/>
 <a href="patches/20101005.01.tpd.patch">20101005.01.tpd.patch</a>
 books/bookvol6 add a research ideas section<br/>
+<a href="patches/20101006.01.tpd.patch">20101006.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 7e6c651..10f04ae 100644
--- a/src/interp/parsing.lisp.pamphlet
+++ b/src/interp/parsing.lisp.pamphlet
@@ -4583,16 +4583,6 @@ parse
 
 (DEFUN |unTuple| (|x|) (PROG (|y|) (RETURN (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |@Tuple|)) (PROGN (SPADLET |y| (QCDR |x|)) (QUOTE T))) |y|) ((QUOTE T) (LIST |x|)))))) 
 ;--% APL TRANSFORMATION OF INPUT
-;aplTran x ==
-;  $BOOT => x
-;  $GENNO: local := 0
-;  u:= aplTran1 x
-;  containsBang u => throwKeyedMsg("S2IP0002",NIL)
-;  u
-
-;;;     ***       |aplTran| REDEFINED
-
-(DEFUN |aplTran| (|x|) (PROG ($GENNO |u|) (DECLARE (SPECIAL $GENNO)) (RETURN (COND ($BOOT |x|) ((QUOTE T) (SPADLET $GENNO 0) (SPADLET |u| (|aplTran1| |x|)) (COND ((|containsBang| |u|) (|throwKeyedMsg| (QUOTE S2IP0002) NIL)) ((QUOTE T) |u|))))))) 
 ;containsBang u ==
 ;  atom u => EQ(u,"!")
 ;  u is [='QUOTE,.] => false
@@ -4601,27 +4591,6 @@ parse
 ;;;     ***       |containsBang| REDEFINED
 
 (DEFUN |containsBang| (|u|) (PROG (|ISTMP#1|) (RETURN (SEQ (COND ((ATOM |u|) (EQ |u| (QUOTE !))) ((AND (PAIRP |u|) (EQUAL (QCAR |u|) (QUOTE QUOTE)) (PROGN (SPADLET |ISTMP#1| (QCDR |u|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL)))) NIL) ((QUOTE T) (PROG (#0=#:G167897) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G167903 NIL #0#) (#2=#:G167904 |u| (CDR #2#)) (|x| NIL)) ((OR #1# (ATOM #2#) (PROGN (SETQ |x| (CAR #2#)) NIL)) #0#) (SEQ (EXIT (SETQ #0# (OR #0# (|containsBang| |x|)))))))))))))) 
-;aplTran1 x ==
-;  atom x => x
-;  [op,:argl1] := x
-;  argl := aplTranList argl1
-;  -- unary case f ! y
-;  op = "_!" =>
-;    argl is [f,y] =>
-;      y is [op',:y'] and op' = "_!" => aplTran1 [op,op,f,:y']
-;      $BOOT => ['COLLECT,['IN,g:=GENVAR(),aplTran1 y],[f,g]]
-;      ['map,f,aplTran1 y]
-;    x    --do not handle yet
-;  -- multiple argument case
-;  hasAplExtension argl is [arglAssoc,:futureArgl] =>
-;    -- choose the last aggregate type to be result of reshape
-;    ['reshape,['COLLECT,:[['IN,g,['ravel,a]] for [g,:a] in arglAssoc],
-;      aplTran1 [op,:futureArgl]],CDAR arglAssoc]
-;  [op,:argl]
-
-;;;     ***       |aplTran1| REDEFINED
-
-(DEFUN |aplTran1| (|x|) (PROG (|op| |argl1| |argl| |f| |y| |op'| |y'| |ISTMP#1| |arglAssoc| |futureArgl| |g| |a|) (RETURN (SEQ (COND ((ATOM |x|) |x|) ((QUOTE T) (SPADLET |op| (CAR |x|)) (SPADLET |argl1| (CDR |x|)) (SPADLET |argl| (|aplTranList| |argl1|)) (COND ((BOOT-EQUAL |op| (QUOTE !)) (COND ((AND (PAIRP |argl|) (PROGN (SPADLET |f| (QCAR |argl|)) (SPADLET |ISTMP#1| (QCDR |argl|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |y| (QCAR |ISTMP#1|)) (QUOTE T))))) (COND ((AND (PAIRP |y|) (PROGN (SPADLET |op'| (QCAR |y|)) (SPADLET |y'| (QCDR |y|)) (QUOTE T)) (BOOT-EQUAL |op'| (QUOTE !))) (|aplTran1| (CONS |op| (CONS |op| (CONS |f| |y'|))))) ($BOOT (CONS (QUOTE COLLECT) (CONS (CONS (QUOTE IN) (CONS (SPADLET |g| (GENVAR)) (CONS (|aplTran1| |y|) NIL))) (CONS (CONS |f| (CONS |g| NIL)) NIL)))) ((QUOTE T) (CONS (QUOTE |map|) (CONS |f| (CONS (|aplTran1| |y|) NIL)))))) ((QUOTE T) |x|))) ((PROGN (SPADLET |ISTMP#1| (|hasAplExtension| |argl|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |arglAssoc| (QCAR |ISTMP#1|)) (SPADLET |futureArgl| (QCDR |ISTMP#1|)) (QUOTE T)))) (CONS (QUOTE |reshape|) (CONS (CONS (QUOTE COLLECT) (APPEND (PROG (#0=#:G167951) (SPADLET #0# NIL) (RETURN (DO ((#1=#:G167957 |arglAssoc| (CDR #1#)) (#2=#:G167941 NIL)) ((OR (ATOM #1#) (PROGN (SETQ #2# (CAR #1#)) NIL) (PROGN (PROGN (SPADLET |g| (CAR #2#)) (SPADLET |a| (CDR #2#)) #2#) NIL)) (NREVERSE0 #0#)) (SEQ (EXIT (SETQ #0# (CONS (CONS (QUOTE IN) (CONS |g| (CONS (CONS (QUOTE |ravel|) (CONS |a| NIL)) NIL))) #0#))))))) (CONS (|aplTran1| (CONS |op| |futureArgl|)) NIL))) (CONS (CDAR |arglAssoc|) NIL)))) ((QUOTE T) (CONS |op| |argl|))))))))) 
 ;aplTranList x ==
 ;  atom x => x
 ;  [aplTran1 first x,:aplTranList rest x]