* interp/lisplib.boot (augModemapsFromDomain1): Move to modemap.boot

	(mkEvalableCategoryForm): Move to define.boot

3 files changed, 35 insertions, 54 deletions

diff --git a/src/interp/define.boot b/src/interp/define.boot
index 27b91ce9..14ff75a1 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -206,19 +206,39 @@ macroExpandList(l,e) ==
   (l is [name]) and IDENTP name and niladicConstructorFromDB name and
         (u := get(name, 'macro, e)) => macroExpand(u,e)
   [macroExpand(x,e) for x in l]
+
+--% constructor evaluation
+--  The following functions are used by the compiler but are modified
+--  here for use with new LISPLIB scheme
+ 
+mkEvalableCategoryForm c ==
+  c is [op,:argl] =>
+    op="Join" => ["Join",:[mkEvalableCategoryForm x for x in argl]]
+    op is "DomainSubstitutionMacro" =>
+        --$extraParms :local
+        --catobj := EVAL c -- DomainSubstitutionFunction makes $extraParms
+        --mkEvalableCategoryForm sublisV($extraParms, catobj)
+        mkEvalableCategoryForm CADR argl
+    op is "mkCategory" => c
+    MEMQ(op,$CategoryNames) =>
+      ([x,m,$e]:= compOrCroak(c,$EmptyMode,$e); m=$Category => x)
+    --loadIfNecessary op
+    getConstructorKindFromDB op = 'category or
+      get(op,"isCategory",$CategoryFrame) =>
+        [op,:[quotifyCategoryArgument x for x in argl]]
+    [x,m,$e]:= compOrCroak(c,$EmptyMode,$e)
+    m=$Category => x
+  MKQ c
  
 compDefineCategory1(df is ['DEF,form,sig,sc,body],m,e,prefix,fal) ==
   categoryCapsule :=
---+
     body is ['add,cat,capsule] =>
       body := cat
       capsule
     nil
   [d,m,e]:= compDefineCategory2(form,sig,sc,body,m,e,prefix,fal)
---+ next two lines
   if categoryCapsule and not $bootStrapMode then [.,.,e] :=
     $insideCategoryPackageIfTrue: local := true  --see NRTmakeSlot1
--->
     $categoryPredicateList: local :=
         makeCategoryPredicates(form,$lisplibCategory)
     compDefine1(mkCategoryPackage(form,cat,categoryCapsule),$EmptyMode,e)
@@ -238,7 +258,6 @@ makeCategoryPredicates(form,u) ==
           for x in u repeat pl := fn(x,pl)
           pl
  
---+ the following function
 mkCategoryPackage(form is [op,:argl],cat,def) ==
   packageName:= INTERN(STRCONC(PNAME op,'"&"))
   packageAbb := INTERN(STRCONC(getConstructorAbbreviationFromDB op,'"-"))
@@ -506,7 +525,6 @@ compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body],
           for i in 6..MAXINDEX $domainShell |
             $domainShell.i is [.,.,['ELT,'_$,.]]]]
     --leave space for vector ops and package name to be stored
---+
     $functorLocalParameters:=
       argPars :=
         makeFunctorArgumentParameters(argl,rest signature',first signature')
@@ -525,7 +543,6 @@ compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body],
     lamOrSlam:= if $mutableDomain then 'LAM else 'SPADSLAM
     fun:= compile SUBLIS($pairlis, [op',[lamOrSlam,argl,body']])
     --The above statement stops substitutions gettting in one another's way
---+
     operationAlist := SUBLIS($pairlis,$lisplibOperationAlist)
     if $LISPLIB then
       augmentLisplibModemapsFromFunctor(parForm,operationAlist,parSignature)
@@ -728,7 +745,6 @@ mkOpVec(dom,siglist) ==
   ops
  
 genDomainViewName(a,category) ==
---+
   a
  
 compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) ==
@@ -880,7 +896,6 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
  
     T := CATCH('compCapsuleBody, compOrCroak(body,rettype,e))
 	 or ["",rettype,e]
---+
     NRTassignCapsuleFunctionSlot($op,signature')
     if $newCompCompare=true then
        SAY '"The old compiler generates:"
@@ -1036,7 +1051,6 @@ addArgumentConditions($body,$functionName) ==
  
 putInLocalDomainReferences (def := [opName,[lam,varl,body]]) ==
   $elt: local := "getShellEntry"
---+
   NRTputInTail CDDADR def
   def
  
@@ -1233,7 +1247,6 @@ compAdd(['add,$addForm,capsule],m,e) ==
   $addFormLhs: local:= $addForm
   if $addForm is ["SubDomain",domainForm,predicate] then
     $packagesUsed := [domainForm,:$packagesUsed]
---+
     $NRTaddForm := domainForm
     NRTgetLocalIndex domainForm
     --need to generate slot for add form since all $ go-get
@@ -1243,7 +1256,6 @@ compAdd(['add,$addForm,capsule],m,e) ==
     $packagesUsed :=
       $addForm is ["%Comma",:u] => [:u,:$packagesUsed]
       [$addForm,:$packagesUsed]
---+
     $NRTaddForm := $addForm
     [$addForm,.,e]:=
       $addForm is ["%Comma",:.] =>
@@ -1268,7 +1280,6 @@ compSubDomain(["SubDomain",domainForm,predicate],m,e) ==
   $addForm: local := nil
   $NRTaddForm := domainForm
   [$addForm,.,e]:= compSubDomain1(domainForm,predicate,m,e)
---+
   compCapsule(['CAPSULE],m,e)
  
 compSubDomain1(domainForm,predicate,m,e) ==
@@ -1356,13 +1367,10 @@ doIt(item,$predl) ==
       if lhs="Rep" then
         $Representation:= (get("Rep",'value,$e)).(0)
            --$Representation bound by compDefineFunctor, used in compNoStacking
---+
         if $NRTopt = true
           then NRTgetLocalIndex $Representation
---+
       $LocalDomainAlist:= --see genDeltaEntry
         [[lhs,:SUBLIS($LocalDomainAlist,(get(lhs,'value,$e)).0)],:$LocalDomainAlist]
---+
     code is ["%LET",:.] =>
       RPLACA(item,"setShellEntry")
       rhsCode:=
@@ -1387,7 +1395,6 @@ doIt(item,$predl) ==
         --Note that DescendCode, in CodeDefine, is looking for this
     RPLACD(CADR item,[$signatureOfForm])
       --This is how the signature is updated for buildFunctor to recognise
---+
     functionPart:= ['dispatchFunction,t.expr]
     RPLACA(CDDR item,functionPart)
     RPLACD(CDDR item,nil)
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index c7d6a44c..a4b90f8a 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -644,20 +644,6 @@ getConstructorSignature ctor ==
     sig
   nil
  
---% from MODEMAP BOOT
- 
-augModemapsFromDomain1(name,functorForm,e) ==
-  GETL(KAR functorForm,"makeFunctionList") =>
-    addConstructorModemaps(name,functorForm,e)
-  atom functorForm and (catform:= getmode(functorForm,e)) =>
-    augModemapsFromCategory(name,name,functorForm,catform,e)
-  mappingForm:= getmodeOrMapping(KAR functorForm,e) =>
-    ["Mapping",categoryForm,:functArgTypes]:= mappingForm
-    catform:= substituteCategoryArguments(rest functorForm,categoryForm)
-    augModemapsFromCategory(name,name,functorForm,catform,e)
-  stackMessage('"%1pb is an unknown mode",[functorForm])
-  e
- 
 getSlotFromCategoryForm ([op,:argl],index) ==
   u:= eval [op,:MAPCAR('MKQ,TAKE(#argl,$FormalMapVariableList))]
   null VECP u =>
@@ -665,29 +651,6 @@ getSlotFromCategoryForm ([op,:argl],index) ==
   u . index
  
  
---% constructor evaluation
---  The following functions are used by the compiler but are modified
---  here for use with new LISPLIB scheme
- 
-mkEvalableCategoryForm c ==       --from DEFINE
-  c is [op,:argl] =>
-    op="Join" => ["Join",:[mkEvalableCategoryForm x for x in argl]]
-    op is "DomainSubstitutionMacro" =>
-        --$extraParms :local
-        --catobj := EVAL c -- DomainSubstitutionFunction makes $extraParms
-        --mkEvalableCategoryForm sublisV($extraParms, catobj)
-        mkEvalableCategoryForm CADR argl
-    op is "mkCategory" => c
-    MEMQ(op,$CategoryNames) =>
-      ([x,m,$e]:= compOrCroak(c,$EmptyMode,$e); m=$Category => x)
-    --loadIfNecessary op
-    getConstructorKindFromDB op = 'category or
-      get(op,"isCategory",$CategoryFrame) =>
-        [op,:[quotifyCategoryArgument x for x in argl]]
-    [x,m,$e]:= compOrCroak(c,$EmptyMode,$e)
-    m=$Category => x
-  MKQ c
- 
 isDomainForm(D,e) ==
   --added for MPOLY 3/83 by RDJ
   MEMQ(KAR D,$SpecialDomainNames) or isFunctor D or
diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot
index 2eafb6ad..e35d7bb6 100644
--- a/src/interp/modemap.boot
+++ b/src/interp/modemap.boot
@@ -240,7 +240,18 @@ augModemapsFromDomain(name,functorForm,e) ==
   if name is ["Union",:dl] then for d in stripUnionTags dl
                          repeat e:= addDomain(d,e)
   augModemapsFromDomain1(name,functorForm,e)
-     --see LISPLIB BOOT
+
+augModemapsFromDomain1(name,functorForm,e) ==
+  GETL(KAR functorForm,"makeFunctionList") =>
+    addConstructorModemaps(name,functorForm,e)
+  atom functorForm and (catform:= getmode(functorForm,e)) =>
+    augModemapsFromCategory(name,name,functorForm,catform,e)
+  mappingForm:= getmodeOrMapping(KAR functorForm,e) =>
+    ["Mapping",categoryForm,:functArgTypes]:= mappingForm
+    catform:= substituteCategoryArguments(rest functorForm,categoryForm)
+    augModemapsFromCategory(name,name,functorForm,catform,e)
+  stackMessage('"%1pb is an unknown mode",[functorForm])
+  e
  
 substituteCategoryArguments(argl,catform) ==
   argl:= substitute("$$","$",argl)