* interp/sys-globals.boot ($lisplibModemapAlist): Remove.

	* interp/lisplib.boot (compileConstructorLib): Do not bind
	$lisplibModemapAlist.
	(compDefineLisplib): Likewise.
	* interp/database.boot (modemapsFromCategory): Rename from
	augLisplibModmapsFromCategory.  Tidy.  Avoid use of special
	variable $lisplibModemapAlist.
	(modemapsFromFunctor): Rename from augmentLisplibFromFunctor.
	Tidy.  Avoid use of special variable $lisplibModemapAlist.
	* interp/define.boot (compDefineCategory2): Adjust.
	(compDefineFunctor1): Likewise.

5 files changed, 66 insertions, 45 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 9710f49f..e588c073 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,17 @@
+2011-10-27  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/sys-globals.boot ($lisplibModemapAlist): Remove.
+	* interp/lisplib.boot (compileConstructorLib): Do not bind
+	$lisplibModemapAlist.
+	(compDefineLisplib): Likewise.
+	* interp/database.boot (modemapsFromCategory): Rename from
+	augLisplibModmapsFromCategory.  Tidy.  Avoid use of special
+	variable $lisplibModemapAlist.
+	(modemapsFromFunctor): Rename from augmentLisplibFromFunctor.
+	Tidy.  Avoid use of special variable $lisplibModemapAlist.
+	* interp/define.boot (compDefineCategory2): Adjust.
+	(compDefineFunctor1): Likewise.
+
 2011-10-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* algebra/stream.spad.pamphlet (Stream): Tidy accessors.
diff --git a/src/interp/database.boot b/src/interp/database.boot
index bee544b0..ffd10de7 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -172,58 +172,70 @@ getConstructorKind ctor ==
 
 --% Functions for manipulating MODEMAP DATABASE
 
-augLisplibModemapsFromCategory(form is [op,:argl],body,signature) ==
-  sl := [["$",:"*1"],:pairList(argl,rest $PatternVariableList)]
-  form:= applySubst(sl,form)
-  body:= applySubst(sl,body)
-  signature:= applySubst(sl,signature)
-  opAlist:= applySubst(sl,categoryExports $domainShell) or return nil
-  nonCategorySigAlist:=
+++ We are about to finish the elaboration of the category `form' with
+++ given `body' and `signature'.  Return the list of all modemaps
+++ of operators exported by generic instantiation of the category constructor.
+++ Note: The structure of the modemaps is that understood by the
+++ interpreter, but that of the of the compiler.
+modemapsFromCategory(form,body,signature) ==
+  sl := [["$",:"*1"],:pairList(form.args,rest $PatternVariableList)]
+  form := applySubst(sl,form)
+  body := applySubst(sl,body)
+  signature := applySubst(sl,signature)
+  opAlist := applySubst(sl,categoryExports $domainShell) or return nil
+  nonCategorySigAlist :=
     mkAlistOfExplicitCategoryOps substitute("*1","$",body)
-  domainList:=
-    [[a,m] for a in rest form for m in rest signature |
+  domainList :=
+    [[a,m] for a in form.args for m in signature.source |
       isCategoryForm(m,$EmptyEnvironment)]
-  catPredList:= [['ofCategory,:u] for u in [["*1",form],:domainList]]
+  catPredList := [['ofCategory,:u] for u in [["*1",form],:domainList]]
+  op := form.op
+  mms := nil
   for (entry:= [[op,sig,:.],pred,sel]) in opAlist |
     listMember?(sig,LASSOC(op,nonCategorySigAlist)) repeat
-      pred':= MKPF([pred,:catPredList],'AND)
-      modemap:= [["*1",:sig],[pred',sel]]
-      $lisplibModemapAlist:=
-        [[op,:interactiveModemapForm modemap],:$lisplibModemapAlist]
-
-augmentLisplibModemapsFromFunctor(form,opAlist,signature) ==
-  form:= [formOp,:argl]:= formal2Pattern form
-  opAlist:= formal2Pattern opAlist
-  signature:= formal2Pattern signature
+      pred' := MKPF([pred,:catPredList],'AND)
+      modemap := [["*1",:sig],[pred',sel]]
+      mms := [[op,:interactiveModemapForm modemap],:mms]
+  mms
+
+++ We are about to finish the elaboration of the generic instantiation
+++ of the function `form.op' with `signature'. Return a list of modemaps
+++ for operations from `opAlist' explicitly exported by the functor.
+++ Note: the structure of modemaps same as for modemapsFromCategory.
+modemapsFromFunctor(form,opAlist,signature) ==
+  form := [.,:argl] := formal2Pattern form
+  opAlist := formal2Pattern opAlist
+  signature := formal2Pattern signature
   for u in form for v in signature repeat
     if symbolMember?(u,$PatternVariableList) then
       -- we are going to be EVALing categories containing these
       -- pattern variables
-      $e:=put(u,'mode,v,$e)
-  nonCategorySigAlist:=
-    mkAlistOfExplicitCategoryOps first signature or return nil
-  for (entry:= [[op,sig,:.],pred,sel]) in opAlist |
+      $e := put(u,'mode,v,$e)
+  nonCategorySigAlist :=
+    mkAlistOfExplicitCategoryOps signature.target or return nil
+  mms := nil
+  for (entry := [[op,sig,:.],pred,sel]) in opAlist |
     or/[listMember?(sig,catSig) for catSig in
       allLASSOCs(op,nonCategorySigAlist)] repeat
-        skip:=
-          argl and CONTAINED("$",rest sig) => 'SKIP
+        skip :=
+          argl ~= nil and CONTAINED("$",sig.source) => 'SKIP
           nil
-        sel:= substitute(form,"$",sel)
-        patternList:= listOfPatternIds sig
+        sel := substitute(form,"$",sel)
+        patternList := listOfPatternIds sig
         --get relevant predicates
-        predList:=
-          [[a,m] for a in argl for m in rest signature
+        predList :=
+          [[a,m] for a in argl for m in signature.source
             | symbolMember?(a,$PatternVariableList)]
-        sig:= substitute(form,"$",sig)
-        pred':= MKPF([pred,:[mkDatabasePred y for y in predList]],'AND)
-        l:=listOfPatternIds predList
-        if "OR"/[null symbolMember?(u,l) for u in argl] then
+        sig := substitute(form,"$",sig)
+        pred' := MKPF([pred,:[mkDatabasePred y for y in predList]],'AND)
+        l := listOfPatternIds predList
+        if "OR"/[not symbolMember?(u,l) for u in argl] then
           sayMSG ['"cannot handle modemap for",:bright op,
                           '"by pattern match" ]
-          skip:= 'SKIP
-        modemap:= [[form,:sig],[pred',sel,:skip]]
-        $lisplibModemapAlist:= [[op,:interactiveModemapForm modemap],
-          :$lisplibModemapAlist]
+          skip := 'SKIP
+        modemap := [[form,:sig],[pred',sel,:skip]]
+        mms := [[op,:interactiveModemapForm modemap],:mms]
+  mms
 
 rebuildCDT(filemode) ==
   clearConstructorAndLisplibCaches()
diff --git a/src/interp/define.boot b/src/interp/define.boot
index da7c2ed0..d135d4ef 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1076,7 +1076,7 @@ compDefineCategory2(form,signature,body,m,e,$prefix,$formalArgList) ==
     $lisplibCategory:= formalBody
     dbPrincipals(db) := getParentsFor(db,$FormalMapVariableList,$lisplibCategory)
     dbAncestors(db) := computeAncestorsOf($form,nil)
-    augLisplibModemapsFromCategory([op',:sargl],formalBody,signature')
+    dbModemaps(db) := modemapsFromCategory([op',:sargl],formalBody,signature')
     dbBeingDefined?(db) := false
     [fun,$Category,e]
 
@@ -1439,7 +1439,7 @@ compDefineFunctor1(df is ['DEF,form,signature,body],
     fun:= compile applySubst($pairlis, [op',[lamOrSlam,argl,body']])
     --The above statement stops substitutions gettting in one another's way
     operationAlist := applySubst($pairlis,$lisplibOperationAlist)
-    augmentLisplibModemapsFromFunctor(parForm,operationAlist,parSignature)
+    dbModemaps(db) := modemapsFromFunctor(parForm,operationAlist,parSignature)
     reportOnFunctorCompilation()
  
     --  5.
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index c7d3bfdb..f8cf0867 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -387,7 +387,6 @@ compileConstructorLib(l,op,editFlag,traceFlag) ==
 compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) ==
   $PrettyPrint: local := 'T
   $lisplibPredicates: local := nil
-  $lisplibModemapAlist: local := nil
   $lisplibOperationAlist: local := nil
   $libFile: local := nil
   $lisplibVariableAlist: local := nil
@@ -409,7 +408,6 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) ==
   sayMSG fillerSpaces(72,char "-")
   $op: local := op
   $lisplibPredicates: local := nil -- set by makePredicateBitVector
-  $lisplibModemapAlist: local := nil
   $lisplibOperationAlist: local := nil
   $lisplibSignatureAlist: local := nil
   $libFile: local := nil
@@ -534,7 +532,7 @@ finalizeLisplib(ctor,libName) ==
   if dbConstructorKind db = 'category then
     writeCategory(ctor,$lisplibCategory,$libFile)
   lisplibWrite('"sourceFile",namestring _/EDITFILE,$libFile)
-  lisplibWrite('"modemaps",$lisplibModemapAlist,$libFile)
+  lisplibWrite('"modemaps",dbModemaps db,$libFile)
   opsAndAtts := getConstructorOpsAndAtts(form,kind,mm)
   writeOperations(ctor,first opsAndAtts,$libFile)
   if kind='category then
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 31d062af..0d97305f 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -163,9 +163,6 @@ $letAssoc := false
 $libFile := nil
 
 ++
-$lisplibModemapAlist := []
-
-++
 $lisplibOperationAlist := []
 
 ++