diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet
index f02a36f..fe5d500 100644
--- a/books/bookvol9.pamphlet
+++ b/books/bookvol9.pamphlet
@@ -6156,7 +6156,6 @@ $\rightarrow$
 \calls{mkEvalableCategoryForm}{compOrCroak}
 \calls{mkEvalableCategoryForm}{getdatabase}
 \calls{mkEvalableCategoryForm}{get}
-\calls{mkEvalableCategoryForm}{quotifyCategoryArgument}
 \calls{mkEvalableCategoryForm}{mkq}
 \refsdollar{mkEvalableCategoryForm}{Category}
 \refsdollar{mkEvalableCategoryForm}{e}
@@ -9900,8 +9899,8 @@ Since we can't be sure we take the least disruptive course of action.
 \begin{chunk}{defun doIt}
 (defun |doIt| (item |$predl|)
  (declare (special |$predl|))
- (prog ($genno x rhs tmp3 lhsp lhs rhsp rhsCode a doms b z tmp1
-        tmp2 tmp6 op body tt functionPart u code)
+ (prog ($genno x rhs lhsp lhs rhsp rhsCode z tmp1 tmp2 tmp6 op body tt
+        functionPart u code)
  (declare (special $genno |$e| |$EmptyMode| |$signatureOfForm| 
                    |$QuickCode| |$LocalDomainAlist| |$Representation|
                    |$NRTopt| |$packagesUsed| |$functorsUsed|
@@ -10049,6 +10048,96 @@ Since we can't be sure we take the least disruptive course of action.
 
 \end{chunk}
 
+\defun{doItIf}{doItIf}
+\begin{chunk}{defun doItIf}
+(defun |doItIf| (item |$predl| |$e|)
+ (declare (special |$predl| |$e|))
+ (labels (
+  (localExtras (oldFLP)
+   (let (oldFLPp flp1 gv ans nils n)
+   (declare (special |$functorLocalParameters| |$getDomainCode|))
+    (unless (eq oldFLP |$functorLocalParameters|) 
+     (setq flp1 |$functorLocalParameters|)
+     (setq oldFLPp oldFLP)
+     (setq n 0)
+     (loop while oldFLPp 
+      do
+       (setq oldFLPp (cdr oldFLPp))
+       (setq n (1+ n)))
+     (setq nils (setq ans nil))
+     (loop for u in flp1
+      do
+       (if (or (atom u)
+               (let (result)
+                (loop for v in |$getDomainCode|
+                 do
+                 (setq result (or result
+                  (and (pairp v) (pairp (qcdr v))
+                       (equal (qcar (qcdr v)) u)))))
+                result))
+  ; Now we have to add code to compile all the elements of 
+  ; functorLocalParameters that were added during the conditional compilation
+        (setq nils (cons u nils))
+        (progn
+         (setq gv (gensym))
+         (setq ans (cons (list 'let gv u) ans))
+         (setq nils (CONS gv nils))))
+       (setq n (1+ n)))
+     (setq |$functorLocalParameters| (append oldFLP (nreverse nils)))
+     (nreverse ans)))))
+ (let (p x y olde tmp1 pp xp oldFLP yp)
+ (declare (special |$functorLocalParameters|))
+   (setq p (second item))
+   (setq x (third item))
+   (setq y (fourth item))
+   (setq olde |$e|)
+   (setq tmp1
+    (or (|comp| p |$Boolean| |$e|)
+        (|userError| (list "not a Boolean:" p))))
+   (setq pp (first tmp1))
+   (setq |$e| (third tmp1))
+   (setq oldFLP |$functorLocalParameters|)
+   (unless (eq x '|noBranch|)
+     (|compSingleCapsuleItem| x |$predl| (|getSuccessEnvironment| p |$e|))
+     (setq xp (localExtras oldFLP)))
+   (setq oldFLP |$functorLocalParameters|)
+   (unless (eq y '|noBranch|)
+     (|compSingleCapsuleItem| y |$predl| (|getInverseEnvironment| p olde))
+     (setq yp (localExtras oldFLP)))
+   (rplaca item 'cond)
+   (rplacd item (list (cons pp (cons x xp)) (cons ''t (cons y yp)))))))
+
+\end{chunk}
+
+\defun{isMacro}{isMacro}
+\calls{isMacro}{pairp}
+\calls{isMacro}{qcar}
+\calls{isMacro}{qcdr}
+\calls{isMacro}{get}
+\begin{chunk}{defun isMacro}
+(defun |isMacro| (x env)
+ (let (op args signature body)
+  (when
+   (and (pairp x) (eq (qcar x) 'def) (pairp (qcdr x)) 
+        (pairp (qcar (qcdr x))) (pairp (qcdr (qcdr x)))
+        (pairp (qcdr (qcdr (qcdr x))))
+        (pairp (qcdr (qcdr (qcdr (qcdr x)))))
+        (eq (qcdr (qcdr (qcdr (qcdr (qcdr x))))) nil))
+     (setq op (qcar (qcar (qcdr x))))
+     (setq args (qcdr (qcar (qcdr x))))
+     (setq signature (qcar (qcdr (qcdr x))))
+     (setq body (qcar (qcdr (qcdr (qcdr (qcdr x))))))
+     (when 
+      (and (null (|get| op '|modemap| env))
+           (null args)
+           (null (|get| op '|mode| env))
+           (pairp signature)
+           (eq (qcdr signature) nil)
+           (null (qcar signature)))
+       body))))
+
+\end{chunk}
+
 \defplist{case}{compCase plist}
 \begin{chunk}{postvars}
 (eval-when (eval load)
@@ -10170,6 +10259,11 @@ An angry JHD - August 15th., 1984
 \calls{compCategory}{compCategoryItem}
 \calls{compCategory}{mkExplicitCategoryFunction}
 \calls{compCategory}{systemErrorHere}
+\defsdollar{compCategory}{sigList}
+\defsdollar{compCategory}{atList}
+\defsdollar{compCategory}{top-level}
+\refsdollar{compCategory}{sigList}
+\refsdollar{compCategory}{atList}
 \begin{chunk}{defun compCategory}
 (defun |compCategory| (form mode env)
  (let ($top_level |$sigList| |$atList| domainOrPackage z rep)
@@ -10186,8 +10280,6 @@ An angry JHD - August 15th., 1984
     (setq z (qcdr (qcdr form)))
     (setq |$sigList| nil)
     (setq |$atList| nil)
-    (setq |$sigList| nil) 
-    (setq |$atList| nil)
     (dolist (x z) (|compCategoryItem| x nil))
     (setq rep
       (|mkExplicitCategoryFunction| domainOrPackage |$sigList| |$atList|))
@@ -10197,6 +10289,56 @@ An angry JHD - August 15th., 1984
 
 \end{chunk}
 
+\defun{mkExplicitCategoryFunction}{mkExplicitCategoryFunction}
+\calls{mkExplicitCategoryFunction}{mkq}
+\calls{mkExplicitCategoryFunction}{union}
+\calls{mkExplicitCategoryFunction}{mustInstantiate}
+\calls{mkExplicitCategoryFunction}{remdup}
+\calls{mkExplicitCategoryFunction}{identp}
+\calls{mkExplicitCategoryFunction}{nequal}
+\calls{mkExplicitCategoryFunction}{wrapDomainSub}
+\begin{chunk}{defun mkExplicitCategoryFunction}
+(defun |mkExplicitCategoryFunction| (domainOrPackage sigList atList)
+ (let (body sig parameters)
+  (setq body
+   (list '|mkCategory| (mkq domainOrPackage)
+      (cons 'list (reverse sigList))
+      (cons 'list (reverse atList))
+      (mkq
+        (let (result)
+         (loop for item in sigList
+          do
+           (setq sig (car (cdaadr item)))
+           (setq result 
+             (|union| result 
+               (loop for d in sig
+                when (|mustInstantiate| d)
+                collect d))))
+         result))
+      nil))
+   (setq parameters
+    (remdup
+     (let (result)
+      (loop for item in sigList
+       do
+        (setq sig (car (cdaadr item)))
+        (setq result
+         (append result
+          (loop for x in sig
+           when (and (identp x) (nequal x '$))
+           collect x))))
+      result)))
+   (|wrapDomainSub| parameters body)))
+
+\end{chunk}
+
+\defun{wrapDomainSub}{wrapDomainSub}
+\begin{chunk}{defun wrapDomainSub}
+(defun |wrapDomainSub| (parameters x)
+ (list '|DomainSubstitutionMacro| parameters x))
+
+\end{chunk}
+
 \defplist{:}{compColon plist}
 \begin{chunk}{postvars}
 (eval-when (eval load)
@@ -10380,6 +10522,20 @@ An angry JHD - August 15th., 1984
 
 \end{chunk}
 
+\defun{makeCategoryForm}{makeCategoryForm}
+\calls{makeCategoryForm}{isCategoryForm}
+\calls{makeCategoryForm}{compOrCroak}
+\refsdollar{makeCategoryForm}{EmptyMode}
+\begin{chunk}{defun makeCategoryForm}
+(defun |makeCategoryForm| (c env)
+ (let (tmp1)
+ (declare (special |$EmptyMode|))
+  (when (|isCategoryForm| c env)
+    (setq tmp1 (|compOrCroak| c |$EmptyMode| env))
+    (list (first tmp1) (third tmp1)))))
+
+\end{chunk}
+
 \defplist{cons}{compCons plist}
 \begin{chunk}{postvars}
 (eval-when (eval load)
@@ -21302,6 +21458,7 @@ The current input line.
 \getchunk{defun displayMissingFunctions}
 \getchunk{defun displayPreCompilationErrors}
 \getchunk{defun doIt}
+\getchunk{defun doItIf}
 \getchunk{defun dollarTran}
 \getchunk{defun domainMember}
 \getchunk{defun drop}
@@ -21376,6 +21533,7 @@ The current input line.
 \getchunk{defun isDomainSubst}
 \getchunk{defun isFunctor}
 \getchunk{defun isListConstructor}
+\getchunk{defun isMacro}
 \getchunk{defun isSuperDomain}
 \getchunk{defun isTokenDelimiter}
 \getchunk{defun isUnionMode}
@@ -21398,6 +21556,7 @@ The current input line.
 \getchunk{defun macroExpand}
 \getchunk{defun macroExpandInPlace}
 \getchunk{defun macroExpandList}
+\getchunk{defun makeCategoryForm}
 \getchunk{defun makeCategoryPredicates}
 \getchunk{defun makeFunctorArgumentParameters}
 \getchunk{defun makeSimplePredicateOrNil}
@@ -21416,6 +21575,7 @@ The current input line.
 \getchunk{defun mkConstructor}
 \getchunk{defun mkDatabasePred}
 \getchunk{defun mkEvalableCategoryForm}
+\getchunk{defun mkExplicitCategoryFunction}
 \getchunk{defun mkNewModemapList}
 \getchunk{defun mkOpVec}
 \getchunk{defun mkUnion}
@@ -21691,6 +21851,7 @@ The current input line.
 \getchunk{defun updateCategoryFrameForCategory}
 \getchunk{defun updateCategoryFrameForConstructor}
 
+\getchunk{defun wrapDomainSub}
 \getchunk{defun writeLib1}
 
 \getchunk{postvars}
diff --git a/changelog b/changelog
index 3305292..03b75cc 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,6 @@
+20110825 tpd src/axiom-website/patches.html 20110825.01.tpd.patch
+20110825 tpd src/interp/define.lisp treeshake compiler
+20110825 tpd books/bookvol9 treeshake compiler
 20110824 tpd src/axiom-website/patches.html 20110824.01.tpd.patch
 20110824 tpd src/interp/i-util.lisp treeshake compiler
 20110824 tpd src/interp/define.lisp treeshake compiler
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 414c4ff..a7da462 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -3594,5 +3594,7 @@ books/bookvol9 treeshake compiler, remove compiler.lisp<br/>
 src/interp/Makefile remove foam_l<br/>
 <a href="patches/20110824.01.tpd.patch">20110824.01.tpd.patch</a>
 books/bookvol9 treeshake compiler<br/>
+<a href="patches/20110825.01.tpd.patch">20110825.01.tpd.patch</a>
+books/bookvol9 treeshake compiler<br/>
  </body>
 </html>
diff --git a/src/interp/define.lisp.pamphlet b/src/interp/define.lisp.pamphlet
index 94580b8..4e41b9f 100644
--- a/src/interp/define.lisp.pamphlet
+++ b/src/interp/define.lisp.pamphlet
@@ -109,176 +109,6 @@
      (|error| '|CategoryDefaults is a reserved name|))
     ('T (|buildFunctor| |form| |signature| |data| |localParList| |e|))))
 
-;isMacro(x,e) ==
-;  x is ['DEF,[op,:args],signature,specialCases,body] and
-;    null get(op,'modemap,e) and null args and null get(op,'mode,e)
-;      and signature is [nil] => body
-
-(DEFUN |isMacro| (|x| |e|)
-  (PROG (|ISTMP#1| |ISTMP#2| |op| |args| |ISTMP#3| |signature|
-            |ISTMP#4| |specialCases| |ISTMP#5| |body|)
-    (RETURN
-      (SEQ (COND
-             ((AND (PAIRP |x|) (EQ (QCAR |x|) 'DEF)
-                   (PROGN
-                     (SPADLET |ISTMP#1| (QCDR |x|))
-                     (AND (PAIRP |ISTMP#1|)
-                          (PROGN
-                            (SPADLET |ISTMP#2| (QCAR |ISTMP#1|))
-                            (AND (PAIRP |ISTMP#2|)
-                                 (PROGN
-                                   (SPADLET |op| (QCAR |ISTMP#2|))
-                                   (SPADLET |args| (QCDR |ISTMP#2|))
-                                   'T)))
-                          (PROGN
-                            (SPADLET |ISTMP#3| (QCDR |ISTMP#1|))
-                            (AND (PAIRP |ISTMP#3|)
-                                 (PROGN
-                                   (SPADLET |signature|
-                                    (QCAR |ISTMP#3|))
-                                   (SPADLET |ISTMP#4| (QCDR |ISTMP#3|))
-                                   (AND (PAIRP |ISTMP#4|)
-                                    (PROGN
-                                      (SPADLET |specialCases|
-                                       (QCAR |ISTMP#4|))
-                                      (SPADLET |ISTMP#5|
-                                       (QCDR |ISTMP#4|))
-                                      (AND (PAIRP |ISTMP#5|)
-                                       (EQ (QCDR |ISTMP#5|) NIL)
-                                       (PROGN
-                                         (SPADLET |body|
-                                          (QCAR |ISTMP#5|))
-                                         'T)))))))))
-                   (NULL (|get| |op| '|modemap| |e|)) (NULL |args|)
-                   (NULL (|get| |op| '|mode| |e|)) (PAIRP |signature|)
-                   (EQ (QCDR |signature|) NIL)
-                   (NULL (QCAR |signature|)))
-              (EXIT |body|)))))))
-
-;doItIf(item is [.,p,x,y],$predl,$e) ==
-;  olde:= $e
-;  [p',.,$e]:= comp(p,$Boolean,$e) or userError ['"not a Boolean:",p]
-;  oldFLP:=$functorLocalParameters
-;  if x^="noBranch" then
-;    compSingleCapsuleItem(x,$predl,getSuccessEnvironment(p,$e))
-;    x':=localExtras(oldFLP)
-;          where localExtras(oldFLP) ==
-;            EQ(oldFLP,$functorLocalParameters) => NIL
-;            flp1:=$functorLocalParameters
-;            oldFLP':=oldFLP
-;            n:=0
-;            while oldFLP' repeat
-;              oldFLP':=CDR oldFLP'
-;              flp1:=CDR flp1
-;              n:=n+1
-;            -- Now we have to add code to compile all the elements
-;            -- of functorLocalParameters that were added during the
-;            -- conditional compilation
-;            nils:=ans:=[]
-;            for u in flp1 repeat -- is =u form always an ATOM?
-;              if ATOM u or (or/[v is [.,=u,:.] for v in $getDomainCode])
-;                then
-;                  nils:=[u,:nils]
-;                else
-;                  gv := GENSYM()
-;                  ans:=[['LET,gv,u],:ans]
-;                  nils:=[gv,:nils]
-;              n:=n+1
-;            $functorLocalParameters:=[:oldFLP,:NREVERSE nils]
-;            NREVERSE ans
-;  oldFLP:=$functorLocalParameters
-;  if y^="noBranch" then
-;    compSingleCapsuleItem(y,$predl,getInverseEnvironment(p,olde))
-;    y':=localExtras(oldFLP)
-;  RPLACA(item,"COND")
-;  RPLACD(item,[[p',x,:x'],['(QUOTE T),y,:y']])
-
-(DEFUN |doItIf,localExtras| (|oldFLP|)
-  (PROG (|oldFLP'| |flp1| |ISTMP#1| |gv| |ans| |nils| |n|)
-  (declare (special |$functorLocalParameters| |$getDomainCode|))
-    (RETURN
-      (SEQ (IF (EQ |oldFLP| |$functorLocalParameters|) (EXIT NIL))
-           (SPADLET |flp1| |$functorLocalParameters|)
-           (SPADLET |oldFLP'| |oldFLP|) (SPADLET |n| 0)
-           (DO () ((NULL |oldFLP'|) NIL)
-             (SEQ (SPADLET |oldFLP'| (CDR |oldFLP'|))
-                  (SPADLET |flp1| (CDR |flp1|))
-                  (EXIT (SPADLET |n| (PLUS |n| 1)))))
-           (SPADLET |nils| (SPADLET |ans| NIL))
-           (DO ((G170185 |flp1| (CDR G170185)) (|u| NIL))
-               ((OR (ATOM G170185)
-                    (PROGN (SETQ |u| (CAR G170185)) NIL))
-                NIL)
-             (SEQ (IF (OR (ATOM |u|)
-                          (PROG (G170191)
-                            (SPADLET G170191 NIL)
-                            (RETURN
-                              (DO ((G170199 NIL G170191)
-                                   (G170200 |$getDomainCode|
-                                    (CDR G170200))
-                                   (|v| NIL))
-                                  ((OR G170199 (ATOM G170200)
-                                    (PROGN
-                                      (SETQ |v| (CAR G170200))
-                                      NIL))
-                                   G170191)
-                                (SEQ (EXIT
-                                      (SETQ G170191
-                                       (OR G170191
-                                        (AND (PAIRP |v|)
-                                         (PROGN
-                                           (SPADLET |ISTMP#1|
-                                            (QCDR |v|))
-                                           (AND (PAIRP |ISTMP#1|)
-                                            (EQUAL (QCAR |ISTMP#1|)
-                                             |u|))))))))))))
-                      (SPADLET |nils| (CONS |u| |nils|))
-                      (SEQ (SPADLET |gv| (GENSYM))
-                           (SPADLET |ans|
-                                    (CONS
-                                     (CONS 'LET
-                                      (CONS |gv| (CONS |u| NIL)))
-                                     |ans|))
-                           (EXIT (SPADLET |nils| (CONS |gv| |nils|)))))
-                  (EXIT (SPADLET |n| (PLUS |n| 1)))))
-           (SPADLET |$functorLocalParameters|
-                    (APPEND |oldFLP| (NREVERSE |nils|)))
-           (EXIT (NREVERSE |ans|))))))
-
-(DEFUN |doItIf| (|item| |$predl| |$e|)
-  (DECLARE (SPECIAL |$predl| |$e|))
-  (PROG (|p| |x| |y| |olde| |LETTMP#1| |p'| |x'| |oldFLP| |y'|)
-  (declare (special |$functorLocalParameters|))
-    (RETURN
-      (PROGN
-        (SPADLET |p| (CADR |item|))
-        (SPADLET |x| (CADDR |item|))
-        (SPADLET |y| (CADDDR |item|))
-        (SPADLET |olde| |$e|)
-        (SPADLET |LETTMP#1|
-                 (OR (|comp| |p| |$Boolean| |$e|)
-                     (|userError|
-                         (CONS "not a Boolean:"
-                               (CONS |p| NIL)))))
-        (SPADLET |p'| (CAR |LETTMP#1|))
-        (SPADLET |$e| (CADDR |LETTMP#1|))
-        (SPADLET |oldFLP| |$functorLocalParameters|)
-        (COND
-          ((NEQUAL |x| '|noBranch|)
-           (|compSingleCapsuleItem| |x| |$predl|
-               (|getSuccessEnvironment| |p| |$e|))
-           (SPADLET |x'| (|doItIf,localExtras| |oldFLP|))))
-        (SPADLET |oldFLP| |$functorLocalParameters|)
-        (COND
-          ((NEQUAL |y| '|noBranch|)
-           (|compSingleCapsuleItem| |y| |$predl|
-               (|getInverseEnvironment| |p| |olde|))
-           (SPADLET |y'| (|doItIf,localExtras| |oldFLP|))))
-        (RPLACA |item| 'COND)
-        (RPLACD |item|
-                (CONS (CONS |p'| (CONS |x| |x'|))
-                      (CONS (CONS ''T (CONS |y| |y'|)) NIL)))))))
-
 ;--compSingleCapsuleIf(x,predl,e,$functorLocalParameters) ==
 ;--  compSingleCapsuleItem(x,predl,e)
 ;
@@ -317,190 +147,6 @@
            (|convert| T$ |m|))
           ('T NIL))))))
 
-;quotifyCategoryArgument x == MKQ x
-
-;(DEFUN |quotifyCategoryArgument| (|x|) (MKQ |x|))
-
-;makeCategoryForm(c,e) ==
-;  not isCategoryForm(c,e) => nil
-;  [x,m,e]:= compOrCroak(c,$EmptyMode,e)
-;  [x,e]
-
-(DEFUN |makeCategoryForm| (|c| |e|)
-  (PROG (|LETTMP#1| |x| |m|)
-  (declare (special |$EmptyMode|))
-    (RETURN
-      (COND
-        ((NULL (|isCategoryForm| |c| |e|)) NIL)
-        ('T (SPADLET |LETTMP#1| (|compOrCroak| |c| |$EmptyMode| |e|))
-         (SPADLET |x| (CAR |LETTMP#1|)) (SPADLET |m| (CADR |LETTMP#1|))
-         (SPADLET |e| (CADDR |LETTMP#1|)) (CONS |x| (CONS |e| NIL)))))))
-
-;compCategory(x,m,e) ==
-;  $TOP__LEVEL: local:= true
-;  (m:= resolve(m,["Category"]))=["Category"] and x is ['CATEGORY,
-;    domainOrPackage,:l] =>
-;      $sigList: local := nil
-;      $atList: local := nil
-;      $sigList:= $atList:= nil
-;      for x in l repeat compCategoryItem(x,nil)
-;      rep:= mkExplicitCategoryFunction(domainOrPackage,$sigList,$atList)
-;    --if inside compDefineCategory, provide for category argument substitution
-;      [rep,m,e]
-;  systemErrorHere '"compCategory"
-
-(DEFUN |compCategory| (|x| |m| |e|)
-  (PROG ($TOP_LEVEL |$sigList| |$atList| |ISTMP#1| |domainOrPackage|
-            |l| |rep|)
-    (DECLARE (SPECIAL $TOP_LEVEL |$sigList| |$atList|))
-    (RETURN
-      (SEQ (PROGN
-             (SPADLET $TOP_LEVEL 'T)
-             (COND
-               ((AND (BOOT-EQUAL
-                         (SPADLET |m|
-                                  (|resolve| |m|
-                                      (CONS '|Category| NIL)))
-                         (CONS '|Category| NIL))
-                     (PAIRP |x|) (EQ (QCAR |x|) 'CATEGORY)
-                     (PROGN
-                       (SPADLET |ISTMP#1| (QCDR |x|))
-                       (AND (PAIRP |ISTMP#1|)
-                            (PROGN
-                              (SPADLET |domainOrPackage|
-                                       (QCAR |ISTMP#1|))
-                              (SPADLET |l| (QCDR |ISTMP#1|))
-                              'T))))
-                (SPADLET |$sigList| NIL) (SPADLET |$atList| NIL)
-                (SPADLET |$sigList| (SPADLET |$atList| NIL))
-                (DO ((G170487 |l| (CDR G170487)) (|x| NIL))
-                    ((OR (ATOM G170487)
-                         (PROGN (SETQ |x| (CAR G170487)) NIL))
-                     NIL)
-                  (SEQ (EXIT (|compCategoryItem| |x| NIL))))
-                (SPADLET |rep|
-                         (|mkExplicitCategoryFunction|
-                             |domainOrPackage| |$sigList| |$atList|))
-                (CONS |rep| (CONS |m| (CONS |e| NIL))))
-               ('T (|systemErrorHere| "compCategory"))))))))
-
-;mkExplicitCategoryFunction(domainOrPackage,sigList,atList) ==
-;  body:=
-;    ["mkCategory",MKQ domainOrPackage,['LIST,:REVERSE sigList],['LIST,:
-;      REVERSE atList],MKQ domList,nil] where
-;        domList() ==
-;          ("UNION"/[fn sig for ["QUOTE",[[.,sig,:.],:.]] in sigList]) where
-;            fn sig == [D for D in sig | mustInstantiate D]
-;  parameters:=
-;    REMDUP
-;      ("append"/
-;        [[x for x in sig | IDENTP x and x^='_$]
-;          for ["QUOTE",[[.,sig,:.],:.]] in sigList])
-;  wrapDomainSub(parameters,body)
-
-(DEFUN |mkExplicitCategoryFunction,fn| (|sig|)
-  (PROG ()
-    (RETURN
-      (SEQ (PROG (G170517)
-             (SPADLET G170517 NIL)
-             (RETURN
-               (DO ((G170523 |sig| (CDR G170523)) (D NIL))
-                   ((OR (ATOM G170523)
-                        (PROGN (SETQ D (CAR G170523)) NIL))
-                    (NREVERSE0 G170517))
-                 (SEQ (EXIT (COND
-                              ((|mustInstantiate| D)
-                               (SETQ G170517 (CONS D G170517)))))))))))))
-
-(DEFUN |mkExplicitCategoryFunction|
-       (|domainOrPackage| |sigList| |atList|)
-  (PROG (|body| |sig| |parameters|)
-    (RETURN
-      (SEQ (PROGN
-             (SPADLET |body|
-                      (CONS '|mkCategory|
-                            (CONS (MKQ |domainOrPackage|)
-                                  (CONS (CONS 'LIST
-                                         (REVERSE |sigList|))
-                                        (CONS
-                                         (CONS 'LIST
-                                          (REVERSE |atList|))
-                                         (CONS
-                                          (MKQ
-                                           (PROG (G170546)
-                                             (SPADLET G170546 NIL)
-                                             (RETURN
-                                               (DO
-                                                ((G170552 |sigList|
-                                                  (CDR G170552))
-                                                 (G170533 NIL))
-                                                ((OR (ATOM G170552)
-                                                  (PROGN
-                                                    (SETQ G170533
-                                                     (CAR G170552))
-                                                    NIL)
-                                                  (PROGN
-                                                    (PROGN
-                                                      (SPADLET |sig|
-                                                       (CAR
-                                                        (CDAADR
-                                                         G170533)))
-                                                      G170533)
-                                                    NIL))
-                                                 G170546)
-                                                 (SEQ
-                                                  (EXIT
-                                                   (SETQ G170546
-                                                    (|union| G170546
-                                                     (|mkExplicitCategoryFunction,fn|
-                                                      |sig|)))))))))
-                                          (CONS NIL NIL)))))))
-             (SPADLET |parameters|
-                      (REMDUP (PROG (G170559)
-                                (SPADLET G170559 NIL)
-                                (RETURN
-                                  (DO ((G170565 |sigList|
-                                        (CDR G170565))
-                                       (G170542 NIL))
-                                      ((OR (ATOM G170565)
-                                        (PROGN
-                                          (SETQ G170542
-                                           (CAR G170565))
-                                          NIL)
-                                        (PROGN
-                                          (PROGN
-                                            (SPADLET |sig|
-                                             (CAR (CDAADR G170542)))
-                                            G170542)
-                                          NIL))
-                                       G170559)
-                                    (SEQ
-                                     (EXIT
-                                      (SETQ G170559
-                                       (APPEND G170559
-                                        (PROG (G170577)
-                                          (SPADLET G170577 NIL)
-                                          (RETURN
-                                            (DO
-                                             ((G170583 |sig|
-                                               (CDR G170583))
-                                              (|x| NIL))
-                                             ((OR (ATOM G170583)
-                                               (PROGN
-                                                 (SETQ |x|
-                                                  (CAR G170583))
-                                                 NIL))
-                                              (NREVERSE0 G170577))
-                                              (SEQ
-                                               (EXIT
-                                                (COND
-                                                  ((AND (IDENTP |x|)
-                                                    (NEQUAL |x| '$))
-                                                   (SETQ G170577
-                                                    (CONS |x|
-                                                    G170577))))))))))))))))))
-             (|wrapDomainSub| |parameters| |body|))))))
-
 ;wrapDomainSub(parameters,x) ==
 ;   ["DomainSubstitutionMacro",parameters,x]