* interp/define.boot ($lisplibAbbreviation): Remove. Adjust users.

	($lisplibForm): Likewise.
	* interp/c-doc.boot (finalizeDocumentation): Take constructor's
	name as parameter.  Adjust callers.
	* interp/lisplib.boot (compileDocumentation): Likewise.
	(WriteKind): New.
	(writeConstructorForm): Likewise.
	(writeOperations): Likewise.
	(WriteConstructorModemap): Likewise.
	(finalizeLisplib): Use them.

6 files changed, 50 insertions, 42 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 39266740..f342d215 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,18 @@
 2011-08-21  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/define.boot ($lisplibAbbreviation): Remove.  Adjust users.
+	($lisplibForm): Likewise.
+	* interp/c-doc.boot (finalizeDocumentation): Take constructor's
+	name as parameter.  Adjust callers.
+	* interp/lisplib.boot (compileDocumentation): Likewise.
+	(WriteKind): New.
+	(writeConstructorForm): Likewise.
+	(writeOperations): Likewise.
+	(WriteConstructorModemap): Likewise.
+	(finalizeLisplib): Use them.
+
+2011-08-21  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/lisplib.boot (leaveIfErrors): Take kind as argument.
 	(writeInfo): New.
 	(writeSuperDomain): Likewise.
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index bac63c43..056fa8d5 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -317,7 +317,7 @@ newfort.$(FASLEXT): macros.$(FASLEXT)
 lisplib.$(FASLEXT): nlib.$(FASLEXT) c-util.$(FASLEXT) debug.$(FASLEXT) \
 	daase.$(FASLEXT)
 interop.$(FASLEXT): interop.boot c-util.$(FASLEXT) hashcode.$(FASLEXT)
-c-doc.$(FASLEXT): c-util.$(FASLEXT)
+c-doc.$(FASLEXT): c-util.$(FASLEXT) daase.$(FASLEXT)
 server.$(FASLEXT): macros.$(FASLEXT)
 
 ##
diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot
index e3842172..a77aab7c 100644
--- a/src/interp/c-doc.boot
+++ b/src/interp/c-doc.boot
@@ -33,6 +33,7 @@
 
 
 import c_-util
+import daase
 namespace BOOT
 
 batchExecute() ==
@@ -132,7 +133,7 @@ collectAndDeleteAssoc x ==
       y.rest := s
   res
 
-finalizeDocumentation() ==
+finalizeDocumentation ctor ==
   unusedCommentLineNumbers := [x for (x := [n,:r]) in $COMBLOCKLIST | r]
   docList := substitute("$","%",transDocList($op,$docList))
   if u := [sig for [sig,:doc] in docList | null doc] then
@@ -141,17 +142,16 @@ finalizeDocumentation() ==
       y is [x,b] and b is ['attribute,:r] =>
         attributes := [[x,:r],:attributes]
       signatures := [y,:signatures]
-    name := first $lisplibForm
     if noHeading or signatures or attributes or unusedCommentLineNumbers then
       sayKeyedMsg("S2CD0001",nil)
       bigcnt := 1
       if noHeading or signatures or attributes then
-        sayKeyedMsg("S2CD0002",[strconc(STRINGIMAGE bigcnt,'"."),name])
+        sayKeyedMsg("S2CD0002",[strconc(STRINGIMAGE bigcnt,'"."),ctor])
         bigcnt := bigcnt + 1
         litcnt := 1
         if noHeading then
           sayKeyedMsg("S2CD0003",
-            [strconc('"(",STRINGIMAGE litcnt,'")"),name])
+            [strconc('"(",STRINGIMAGE litcnt,'")"),ctor])
           litcnt := litcnt + 1
         if signatures then
           sayKeyedMsg("S2CD0004",
@@ -172,15 +172,15 @@ finalizeDocumentation() ==
               a isnt [.,:.] => ['%x9,a]
               ['%x9,:a]
       if unusedCommentLineNumbers then
-        sayKeyedMsg("S2CD0006",[strconc(STRINGIMAGE bigcnt,'"."),name])
+        sayKeyedMsg("S2CD0006",[strconc(STRINGIMAGE bigcnt,'"."),ctor])
         for [n,r] in unusedCommentLineNumbers repeat
           sayMSG ['"   ",:bright n,'"   ",r]
-  hn [[:fn(sig,$e),:doc] for [sig,:doc] in docList] where
-    fn(x,e) ==
+  form := dbConstructorForm constructorDB ctor
+  hn [[:fn(sig,$e,form.args),:doc] for [sig,:doc] in docList] where
+    fn(x,e,args) ==
       x isnt [.,:.] => [x,nil]
       if #x > 2 then x := TAKE(2,x)
-      applySubst(pairList($lisplibForm.args,$FormalMapVariableList),
-        macroExpand(x,e))
+      applySubst(pairList(args,$FormalMapVariableList),macroExpand(x,e))
     hn u ==
      -- ((op,sig,doc), ...)  --> ((op ((sig doc) ...)) ...)
       opList := removeDuplicates ASSOCLEFT u
diff --git a/src/interp/define.boot b/src/interp/define.boot
index aeeff45e..b7b1941a 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -75,7 +75,6 @@ $functorStats := nil
 
 $lisplibCategory := nil
 $lisplibAncestors := nil
-$lisplibAbbreviation := nil
 $CheckVectorList := []
 $pairlis := []
 $functorTarget := nil
@@ -1051,13 +1050,11 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
     $domainShell := eval [op',:[MKQ f for f in sargl]]
     $lisplibCategory:= formalBody
     if $LISPLIB then
-      $lisplibForm:= form
       modemap:= [[parForm,:parSignature],[true,op']]
       $lisplibModemap:= modemap
       $lisplibParents  :=         
         getParentsFor($op,$FormalMapVariableList,$lisplibCategory)
       $lisplibAncestors := computeAncestorsOf($form,nil)
-      $lisplibAbbreviation := getConstructorAbbreviationFromDB $op
       form':=[op',:sargl]
       augLisplibModemapsFromCategory(form',formalBody,signature')
     [fun,$Category,e]
@@ -1077,6 +1074,7 @@ compDefineCategory(df,m,e,prefix,fal) ==
   ctor := opOf lhs
   kind := getConstructorKindFromDB ctor
   kind ~= "category" => throwKeyedMsg("S2IC0016",[ctor,"category",kind])
+  dbConstructorForm(constructorDB ctor) := lhs
   $insideFunctorIfTrue or $LISPLIB = nil or $compileDefaultsOnly =>
     compDefineCategory1(df,m,e,prefix,fal)
   dbNiladic?(constructorDB ctor) := lhs isnt [.,:.] or lhs.args = nil
@@ -1362,6 +1360,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
     $genSDVar: local:= 0
     originale:= $e
     [$op,:argl]:= form
+    dbConstructorForm(constructorDB $op) := form
     $formalArgList:= [:argl,:$formalArgList]
     $pairlis: local := pairList(argl,$FormalMapVariableList)
     $mutableDomain: local :=
@@ -1445,10 +1444,8 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
       $lisplibParents  :=         
         getParentsFor($op,$FormalMapVariableList,$lisplibCategory)
       $lisplibAncestors := computeAncestorsOf($form,nil)
-      $lisplibAbbreviation := getConstructorAbbreviationFromDB $op
     $insideFunctorIfTrue:= false
     if $LISPLIB then
-      $lisplibForm:= form
       if not $bootStrapMode then
         $NRTslot1Info := NRTmakeSlot1Info()
         $isOpPackageName: local := isCategoryPackageName $op
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 1616a042..4fbf05db 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -437,8 +437,6 @@ compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) ==
   $LISPLIB: local := 'T
   $lisplibAttributes: local := nil
   $lisplibPredicates: local := nil
-  $lisplibForm: local := nil
-  $lisplibAbbreviation: local := nil
   $lisplibParents: local := nil
   $lisplibAncestors: local := nil
   $lisplibModemap: local := nil
@@ -468,8 +466,6 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) ==
   $op: local := op
   $lisplibAttributes: local := nil
   $lisplibPredicates: local := nil -- set by makePredicateBitVector
-  $lisplibForm: local := nil
-  $lisplibAbbreviation: local := nil
   $lisplibParents: local := nil
   $lisplibAncestors: local := nil
   $lisplibModemap: local := nil
@@ -486,7 +482,7 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) ==
   --will eventually become the "constructorCategory" property in lisplib
   --set in compDefineCategory1 if category, otherwise in finalizeLisplib
   libName := getConstructorAbbreviation op
-  $compileDocumentation => compileDocumentation libName
+  $compileDocumentation => compileDocumentation(op,libName)
   sayMSG ['"   initializing ",$spadLibFT,:bright libName,
     '"for",:bright op]
   initializeLisplib libName
@@ -512,13 +508,11 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) ==
   $newConlist := [op, :$newConlist]  ---------->  bound in function "compiler"
   res
  
-compileDocumentation libName ==
+compileDocumentation(ctor,libName) ==
   filename := MAKE_-INPUT_-FILENAME(libName,$spadLibFT)
   $FCOPY(filename,[libName,'DOCLB])
   stream := RDEFIOSTREAM [['FILE,libName,'DOCLB],['MODE, :'O]]
-  lisplibWrite('"documentation",finalizeDocumentation(),stream)
---  if $lisplibRelatedDomains then 
---    lisplibWrite('"relatedDomains",$lisplibRelatedDomains,stream)
+  lisplibWrite('"documentation",finalizeDocumentation ctor,stream)
   RSHUT(stream)
   RPACKFILE([libName,'DOCLB])
   $REPLACE([libName,$spadLibFT],[libName,'DOCLB])
@@ -550,9 +544,21 @@ writeInfo(ctor,info,key,prop,file) ==
     LAM_,FILEACTQ(key,expandToVMForm insn)
   lisplibWrite(symbolName key,info,file)
   
+writeKind(ctor,kind,file) ==
+  writeInfo(ctor,kind,'constructorKind,'dbConstructorKind,file)
+
+writeConstructorForm(ctor,form,file) ==
+  writeInfo(ctor,form,'constructorForm,'dbConstructorForm,file)
+
 writeSuperDomain(ctor,domPred,file) ==
   writeInfo(ctor,domPred,'superDomain,'dbSuperDomain,file)
 
+writeOperations(ctor,ops,file) ==
+  writeInfo(ctor,ops,'operationAlist,'dbOperations,file)
+
+writeConstructorModemap(ctor,mm,file) ==
+  writeInfo(ctor,mm,'constructorModemap,'dbConstructorModemap,file)
+
 ++ If compilation produces an error, issue inform user and
 ++ return to toplevel reader.
 leaveIfErrors(libName,kind) ==
@@ -564,22 +570,20 @@ leaveIfErrors(libName,kind) ==
 ++ Finalize `libName' compilation; returns true if everything is OK.
 finalizeLisplib(ctor,libName) ==
   kind := dbConstructorKind constructorDB ctor
-  lisplibWrite('"constructorForm",removeZeroOne $lisplibForm,$libFile)
-  lisplibWrite('"constructorKind",kind,$libFile)
-  lisplibWrite('"constructorModemap",removeZeroOne $lisplibModemap,$libFile)
-  $lisplibCategory:= $lisplibCategory or $lisplibModemap.mmTarget
+  form := dbConstructorForm constructorDB ctor
+  writeConstructorForm(ctor,form,$libFile)
+  writeKind(ctor,kind,$libFile)
+  writeConstructorModemap(ctor,removeZeroOne $lisplibModemap,$libFile)
+  $lisplibCategory := $lisplibCategory or $lisplibModemap.mmTarget
   -- set to target of modemap for package/domain constructors;
   -- to the right-hand sides (the definition) for category constructors
   lisplibWrite('"constructorCategory",$lisplibCategory,$libFile)
   lisplibWrite('"sourceFile",namestring _/EDITFILE,$libFile)
   lisplibWrite('"modemaps",removeZeroOne $lisplibModemapAlist,$libFile)
-  opsAndAtts:= getConstructorOpsAndAtts(
-    $lisplibForm,kind,$lisplibModemap)
-  lisplibWrite('"operationAlist",removeZeroOne first opsAndAtts,$libFile)
-  --lisplibWrite('"attributes",rest opsAndAtts,$libFile)
-  --if kind='category then NRTgenInitialAttributeAlist rest opsAndAtts
+  opsAndAtts := getConstructorOpsAndAtts(form,kind,$lisplibModemap)
+  writeOperations(ctor,removeZeroOne first opsAndAtts,$libFile)
   if kind='category then
-     $pairlis : local := pairList($lisplibForm,$FormalMapVariableList)
+     $pairlis : local := pairList(form,$FormalMapVariableList)
      $NRTslot1PredicateList : local := []
      NRTgenInitialAttributeAlist rest opsAndAtts
   writeSuperDomain(ctor,dbSuperDomain constructorDB ctor,$libFile)
@@ -588,10 +592,10 @@ finalizeLisplib(ctor,libName) ==
                                     $lisplibVariableAlist),$libFile)
   lisplibWrite('"attributes",removeZeroOne $lisplibAttributes,$libFile)
   lisplibWrite('"predicates",removeZeroOne  $lisplibPredicates,$libFile)
-  lisplibWrite('"abbreviation",$lisplibAbbreviation,$libFile)
+  lisplibWrite('"abbreviation",dbAbbreviation constructorDB ctor,$libFile)
   lisplibWrite('"parents",removeZeroOne $lisplibParents,$libFile)
   lisplibWrite('"ancestors",removeZeroOne $lisplibAncestors,$libFile)
-  lisplibWrite('"documentation",finalizeDocumentation(),$libFile)
+  lisplibWrite('"documentation",finalizeDocumentation ctor,$libFile)
   lisplibWrite('"slot1Info",removeZeroOne $lisplibSlot1,$libFile)
   if $profileCompiler then profileWrite()
   leaveIfErrors(libName,kind)
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 3f1c2ce1..e0ea10f5 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -167,12 +167,6 @@ $letAssoc := false
 $libFile := nil
 
 ++
-$lisplibForm := nil
-
-++
-$lisplibKind := nil
-
-++
 $lisplibModemapAlist := []
 
 ++