* Makefile.pamphlet (compiler.$(FASLEXT)): New rule.

	(c-doc.$(FASLEXT)): Likewise.
	(<<c-doc.clisp>>): Likewise.
	(<<compiler.clisp>>): Likewise.
	* c-doc.boot.pamphlet: Push into package "BOOT".  Fix syntax.
	Document functions.  Remove dead codes.
	* compiler.boot.pamphlet: Push into package "BOOT".  Fix syntax.

5 files changed, 86 insertions, 66 deletions

diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog
index 0b069080..f40fbd5f 100644
--- a/src/interp/ChangeLog
+++ b/src/interp/ChangeLog
@@ -1,3 +1,13 @@
+2007-11-05  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (compiler.$(FASLEXT)): New rule.
+	(c-doc.$(FASLEXT)): Likewise.
+	(<<c-doc.clisp>>): Likewise.
+	(<<compiler.clisp>>): Likewise.
+	* c-doc.boot.pamphlet: Push into package "BOOT".  Fix syntax.
+	Document functions.  Remove dead codes.
+	* compiler.boot.pamphlet: Push into package "BOOT".  Fix syntax.
+
 2007-11-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* Makefile.pamphlet (iterator.$(FASLEXT)): New rule.
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 5c6e25e7..1bc269bf 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -438,6 +438,10 @@ record.$(FASLEXT): record.boot nlib.$(FASLEXT) pathname.$(FASLEXT)
 
 ## OpenAxiom's compiler
 
+compiler.$(FASLEXT): compiler.boot category.$(FASLEXT) c-util.$(FASLEXT) \
+			modemap.$(FASLEXT) pathname.$(FASLEXT)
+	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
+
 iterator.$(FASLEXT): iterator.boot g-util.$(FASLEXT)
 	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
 
@@ -467,6 +471,9 @@ simpbool.$(FASLEXT): simpbool.boot macros.$(FASLEXT)
 newfort.$(FASLEXT): newfort.boot macros.$(FASLEXT)
 	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
 
+c-doc.$(FASLEXT): c-doc.boot c-util.$(FASLEXT)
+	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
+
 ## Interface with the Aldor compiler.
 ax.$(FASLEXT): ax.boot as.$(FASLEXT)
 	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
@@ -680,18 +687,10 @@ br-util.clisp: br-util.boot
 	@ echo 487 making $@ from $<
 	@ echo '(old-boot::boot "br-util.boot")' | ${DEPSYS}
 
-c-doc.clisp: c-doc.boot
-	@ echo 219 making $@ from $<
-	@ echo '(old-boot::boot "c-doc.boot")' | ${DEPSYS} 
-
 clammed.clisp: clammed.boot
 	@ echo 226 making $@ from $<
 	@ echo '(old-boot::boot "clammed.boot")' | ${DEPSYS} 
 
-compiler.clisp: compiler.boot
-	@ echo 233 making $@ from $<
-	@ echo '(old-boot::boot "compiler.boot")' | ${DEPSYS}
-
 i-analy.clisp: i-analy.boot
 	@ echo 280 making $@ from $<
 	@ echo '(old-boot::boot "i-analy.boot")' | ${DEPSYS}
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index 9cbe7046..94c1b16d 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -824,15 +824,6 @@ $(axiom_build_texdir)/diagrams.tex: $(axiom_src_docdir)/diagrams.tex
 	$(INSTALL_DATA) $< $@
 @
 
-\subsection{c-doc.boot \cite{60}}
-
-<<c-doc.clisp>>=
-c-doc.clisp: c-doc.boot
-	@ echo 219 making $@ from $<
-	@ echo '(old-boot::boot "c-doc.boot")' | ${DEPSYS} 
-@
-
-
 \subsection{clammed.boot \cite{62}}
 
 <<clammed.clisp>>=
@@ -841,14 +832,6 @@ clammed.clisp: clammed.boot
 	@ echo '(old-boot::boot "clammed.boot")' | ${DEPSYS} 
 @
 
-\subsection{compiler.boot \cite{64}}
-
-<<compiler.clisp>>=
-compiler.clisp: compiler.boot
-	@ echo 233 making $@ from $<
-	@ echo '(old-boot::boot "compiler.boot")' | ${DEPSYS}
-@
-
 \subsection{i-analy.boot}
 
 <<i-analy.clisp>>=
@@ -1240,6 +1223,10 @@ record.$(FASLEXT): record.boot nlib.$(FASLEXT) pathname.$(FASLEXT)
 
 ## OpenAxiom's compiler
 
+compiler.$(FASLEXT): compiler.boot category.$(FASLEXT) c-util.$(FASLEXT) \
+			modemap.$(FASLEXT) pathname.$(FASLEXT)
+	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
+
 iterator.$(FASLEXT): iterator.boot g-util.$(FASLEXT)
 	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
 
@@ -1269,6 +1256,9 @@ simpbool.$(FASLEXT): simpbool.boot macros.$(FASLEXT)
 newfort.$(FASLEXT): newfort.boot macros.$(FASLEXT)
 	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
 
+c-doc.$(FASLEXT): c-doc.boot c-util.$(FASLEXT)
+	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
+
 ## Interface with the Aldor compiler.
 ax.$(FASLEXT): ax.boot as.$(FASLEXT)
 	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
@@ -1468,12 +1458,8 @@ boot-pkg.$(FASLEXT): boot-pkg.lisp
 
 <<br-util.clisp>>
 
-<<c-doc.clisp>>
-
 <<clammed.clisp>>
 
-<<compiler.clisp>>
-
 <<i-analy.clisp>>
 
 <<i-code.clisp>>
diff --git a/src/interp/c-doc.boot.pamphlet b/src/interp/c-doc.boot.pamphlet
index e697614b..415d53cc 100644
--- a/src/interp/c-doc.boot.pamphlet
+++ b/src/interp/c-doc.boot.pamphlet
@@ -50,9 +50,15 @@
 <<*>>=
 <<license>>
 
+import '"c-util"
+)package "BOOT"
+
 batchExecute() ==
   _/RF_-1 '(GENCON INPUT)
 
+++ returns the documentation for operator `op' with given
+++ `modemap', supposedly defined in domain or category
+++ constructed from `conName'.
 getDoc(conName,op,modemap) ==
   [dc,target,sl,pred,D] := simplifyModemap modemap
   sig := [target,:sl]
@@ -65,6 +71,9 @@ getDoc(conName,op,modemap) ==
   sig := SUBST('$,dc,sig)
   getDocForCategory(conName,op,sig)
 
+++ Given a preidcate `pred' for a modemap, returns the first
+++ argument to the ofCategory predicate it contains.  Return
+++ nil otherwise.
 getOfCategoryArgument pred ==
   pred is [fn,:.] and MEMQ(fn,'(AND OR NOT)) =>
     or/[getOfCategoryArgument x for x in rest pred]
@@ -79,6 +88,9 @@ getDocForDomain(name,op,sig) ==
   getOpDoc(constructor? name,op,sig) or
     or/[getOpDoc(constructor? x,op,sig) for x in whatCatExtDom name]
 
+++ returns the documentation, known to the global DB, for a operator
+++ `op' and given signature `sigPart'.  The operator `op' is assumed
+++ to have been defined in the domain or catagory `abb'.
 getOpDoc(abb,op,:sigPart) ==
   u := LASSOC(op,GETDATABASE(abb,'DOCUMENTATION))
   $argList : local := $FormalMapVariableList
@@ -86,10 +98,14 @@ getOpDoc(abb,op,:sigPart) ==
   sigPart is [sig] => or/[d for [s,:d] in u | sig = s]
   u
 
+++ Parse the content of source file `fn' only for the purpose of
+++ documentation.
 readForDoc fn ==
   $bootStrapMode: local:= true
   _/RQ_-LIB_-1 [fn,'SPAD]
 
+++ record the documentation location for an operator wih given
+++ signature.
 recordSignatureDocumentation(opSig,lineno) ==
   recordDocumentation(rest postTransform opSig,lineno)
 
@@ -204,6 +220,9 @@ transDocList($constructorName,doclist) == --returns ((key line)...)
   checkDocError1 ['"Missing Description"]
   acc
 
+++ Given a functor `conname', and a list of documenation strings,
+++ sanity-check the documentation.  In particular extract information
+++ such as `Description', etc.
 transDoc(conname,doclist) ==
 --$exposeFlag and not isExposedConstructor conname => nil
 --skip over unexposed constructors when checking system files
@@ -258,18 +277,6 @@ checkExtractItemList l ==  --items are separated by commas or end of line
     l := rest l
   "STRCONC"/[x for x in NREVERSE acc]
 
---NREVERSE("append"/[fn string for string in acc]) where
---  fn(string) ==
---    m := MAXINDEX string
---    acc := nil
---    i := 0
---    while i < m and (k := charPosition(char '_,,string,i)) < m repeat
---      if (t := trimString SUBSTRING(string,i,k-i)) ^= '"" then acc := [t,:acc]
---      i := k + 1
---    if i < m then
---      if (t := trimString SUBSTRING(string,i,k-i)) ^= '"" then acc := [t,:acc]
---    acc
-
 ++ Translate '%' in signature to '%%' for proper printing.
 escapePercent x ==
   x is [y, :z] =>
@@ -297,7 +304,7 @@ transformAndRecheckComments(name,lines) ==
   u
 
 checkRewrite(name,lines) == main where   --similar to checkComments from c-doc
-  main ==
+  main() ==
     $checkErrorFlag: local := true
     margin := 0
     lines := checkRemoveComments lines
@@ -407,13 +414,14 @@ checkRecordHash u ==
           checkDocError ['"Wrong number of arguments: ",form2HtString key]
       else if member(x,'("\spadop" "\keyword")) and (u := checkLookForLeftBrace IFCDR u) and (u := IFCDR u) then
           x := intern checkGetStringBeforeRightBrace u
-          not (GET(x,'Led) or GET(x,'Nud)) =>
+          not (GETL(x,'Led) or GETL(x,'Nud)) =>
             checkDocError ['"Unknown \spadop: ",x]
     u := rest u
   'done
 
 checkGetParse s == ncParseFromString removeBackslashes s
 
+++ remove non-leading backslash characters from string `s'.
 removeBackslashes s ==
     s = '"" => '""
     (k := charPosition($charBack,s,0)) < #s =>
@@ -421,15 +429,19 @@ removeBackslashes s ==
       STRCONC(SUBSTRING(s,0,k),removeBackslashes SUBSTRING(s,k + 1,nil))
     s
 
+++ returns the arity (as known to the global DB) of the functor
+++ instantiated by `conform'.  Returns nil when `conform' does
+++ not imply  aknown functor.
 checkNumOfArgs conform ==
   conname := opOf conform
   constructor? conname or (conname := abbreviation? conname) =>
     #GETDATABASE(conname,'CONSTRUCTORARGS)
   nil  --signals error
 
+++ returns ok if correct, form if wrong number of arguments, nil if unknown
+++ The check is down recursively on the argument to the instantiated functor.
 checkIsValidType form == main where
---returns ok if correct, form is wrong number of arguments, nil if unknown
-  main ==
+  main() ==
     atom form => 'ok
     [op,:args] := form
     conname := (constructor? op => op; abbreviation? op)
@@ -524,6 +536,9 @@ checkRemoveComments lines ==
     lines := rest lines
   NREVERSE acc
 
+++ return the part of `line' that is not a comment.  A comment
+++ is introduced by a leading percent character (%), or a double
+++ percent character (%%).
 checkTrimCommented line ==
   n := #line
   k := htcharPosition(char '_%,line,0)
@@ -562,7 +577,7 @@ checkAddMacros u ==
   NREVERSE acc
 
 checkComments(nameSig,lines) == main where
-  main ==
+  main() ==
     $checkErrorFlag: local := false
     margin := checkGetMargin lines
     if (null BOUNDP '$attribute? or null $attribute?)
@@ -625,7 +640,7 @@ newString2Words l ==
   [w while newWordFrom(l,i,m) is [w,i]]
 
 newWordFrom(l,i,m) ==
-  while i <= m and l.i = " " repeat i := i + 1
+  while i <= m and l.i = char " " repeat i := i + 1
   i > m => NIL
   buf := '""
   ch := l.i
@@ -634,7 +649,7 @@ newWordFrom(l,i,m) ==
   while i <= m and not done repeat
     ch := l.i
     ch = $charBlank or ch = $charFauxNewline => done := true
-    buf := STRCONC(buf,ch)
+    buf := STRCONC(buf, STRING ch)
     i := i + 1
   [buf,i]
 
@@ -697,7 +712,7 @@ checkAddSpaceSegments(u,k) ==
   checkAddSpaceSegments(u,j)
 
 checkTrim($x,lines) == main where
-  main ==
+  main() ==
     s := [wherePP first lines]
     for x in rest lines repeat
       j := wherePP x
@@ -760,11 +775,11 @@ checkFixCommonProblem u ==
   NREVERSE acc
 
 checkDecorate u ==
-  count := 0
+  count := 0           -- number of enclosing opening braces
   spadflag := false    --means OK to wrap single letter words with \s{}
   mathSymbolsOk := false
   acc := nil
-  verbatim := false
+  verbatim := false    -- true if inside `verbatim' environment
   while u repeat
     x := first u
 
@@ -810,18 +825,18 @@ checkDecorate u ==
       x = char '_, or x = '","  => ['",{}",:acc]
       x = '"\spad" => ['"\spad",:acc]
       STRINGP x and DIGITP x.0 => [x,:acc]
-      null spadflag and
+      not spadflag and
         (CHARP x and ALPHA_-CHAR_-P x and not MEMQ(x,$charExclusions) or
           member(x,$argl)) => [$charRbrace,x,$charLbrace,'"\spad",:acc]
-      null spadflag and ((STRINGP x and not x.0 = $charBack and DIGITP(x.(MAXINDEX x))) or member(x,'("true" "false"))) =>
+      not spadflag and ((STRINGP x and not x.0 = $charBack and DIGITP(x.(MAXINDEX x))) or member(x,'("true" "false"))) =>
         [$charRbrace,x,$charLbrace,'"\spad",:acc]  --wrap x1, alpha3, etc
-      xcount := #x
+      xcount := SIZE x
       xcount = 3 and x.1 = char 't and x.2 = char 'h =>
         ['"th",$charRbrace,x.0,$charLbrace,'"\spad",:acc]
       xcount = 4 and x.1 = char '_- and x.2 = char 't and x.3 = char 'h =>
         ['"-th",$charRbrace,x.0,$charLbrace,'"\spad",:acc]
       xcount = 2 and x.1 = char 'i or              --wrap ei, xi, hi
-        null spadflag and xcount > 0 and xcount < 4 and not member(x,'("th" "rd" "st")) and
+        not spadflag and xcount > 0 and xcount < 4 and not member(x,'("th" "rd" "st")) and
           hasNoVowels x =>                         --wrap words with no vowels
             [$charRbrace,x,$charLbrace,'"\spad",:acc]
       [checkAddBackSlashes x,:acc]
@@ -1003,7 +1018,7 @@ checkBalance u ==
   while u repeat
     do
       x := first u
-      openClose := ASSOC(x,$checkPrenAlist)  --is it an open bracket?
+      openClose := assoc(x,$checkPrenAlist)  --is it an open bracket?
         => stack := [CAR openClose,:stack]   --yes, push the open bracket
       open  := rassoc(x,$checkPrenAlist) =>  --it is a close bracket!
         stack is [top,:restStack] => --does corresponding open bracket match?
@@ -1018,6 +1033,10 @@ checkBalance u ==
       checkDocError ['"Missing right ",checkSayBracket x]
   u
 
+++ returns the class of the parenthesis x
+++    pren    ::= '(' | ')'
+++    brace   ::= '{' | '}'
+++    bracket ::= '[' | ']'
 checkSayBracket x ==
   x = char '_( or x = char '_) => '"pren"
   x = char '_{ or x = char '_} => '"brace"
@@ -1137,7 +1156,7 @@ checkTransformFirsts(opname,u,margin) ==
       STRCONC('"\spad{",SUBSTRING(u,0,k + 1),'"}",SUBSTRING(u,k + 1,nil))
     k := checkSkipToken(u,j,m) or return u
     infixOp := INTERN SUBSTRING(u,j,k - j)
-    not GET(infixOp,'Led) =>                                     --case 3
+    not GETL(infixOp,'Led) =>                                     --case 3
       namestring ^= (firstWord := SUBSTRING(u,0,i)) =>
         checkDocError ['"Improper first word in comments: ",firstWord]
         u
@@ -1159,7 +1178,7 @@ checkTransformFirsts(opname,u,margin) ==
       checkDocError ['"Improper first word in comments: ",firstWord]
       u
     prefixOp := INTERN SUBSTRING(u,0,i)
-    not GET(prefixOp,'Nud) =>
+    not GETL(prefixOp,'Nud) =>
       u ---what could this be?
     j := checkSkipBlanks(u,i,m) or return u
     u.j = char '_( =>                                            --case 4
@@ -1205,6 +1224,7 @@ checkSkipIdentifierToken(u,i,m) ==
   i = m => nil
   i
 
+++ returns true if character `c' is alphabetic.
 checkAlphabetic c ==
   ALPHA_-CHAR_-P c or DIGITP c or MEMQ(c,$charIdentifierEndings)
 
@@ -1265,6 +1285,8 @@ checkDocError u ==
   if $exposeFlag then SAYBRIGHTLY1(msg,$outStream)
   --if called by checkDocFile (see file checkdoc.boot)
 
+++ Augment `u' with information about the owner of the source file
+++ containing the current functor definition being processed.
 checkDocMessage u ==
   sourcefile := GETDATABASE($constructorName,'SOURCEFILE)
   person := whoOwns $constructorName or '"---"
@@ -1299,9 +1321,6 @@ checkDecorateForHt u ==
     u := rest u
   u
 
-
-
-
 @
 \eject
 \begin{thebibliography}{99}
diff --git a/src/interp/compiler.boot.pamphlet b/src/interp/compiler.boot.pamphlet
index 175eff35..e93b69c6 100644
--- a/src/interp/compiler.boot.pamphlet
+++ b/src/interp/compiler.boot.pamphlet
@@ -99,6 +99,12 @@ compMacro(form,m,e) ==
 <<*>>=
 <<license>>
 
+import '"c-util"
+import '"pathname"
+import '"category"
+import '"modemap"
+)package "BOOT"
+
 compTopLevel(x,m,e) ==
 --+ signals that target is derived from lhs-- see NRTmakeSlot1Info
   $NRTderivedTargetIfTrue: local := false
@@ -208,7 +214,7 @@ compTypeOf(x:=[op,:argl],m,e) ==
 hasFormalMapVariable(x, vl) ==
   $formalMapVariables: local := vl
   null vl => false
-  ScanOrPairVec('hasone?,x) where
+  ScanOrPairVec(function hasone?,x) where
      hasone? x == MEMQ(x,$formalMapVariables)
 
 compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) ==
@@ -375,9 +381,9 @@ convert(T,m) ==
 mkUnion(a,b) ==
   b="$" and $Rep is ["Union",:l] => b
   a is ["Union",:l] =>
-    b is ["Union",:l'] => ["Union",:setUnion(l,l')]
-    ["Union",:setUnion([b],l)]
-  b is ["Union",:l] => ["Union",:setUnion([a],l)]
+    b is ["Union",:l'] => ["Union",:union(l,l')]
+    ["Union",:union([b],l)]
+  b is ["Union",:l] => ["Union",:union([a],l)]
   ["Union",a,b]
 
 maxSuperType(m,e) ==
@@ -1057,7 +1063,7 @@ compColon([":",f,t],m,e) ==
     --if inside an expression, ":" means to convert to m "on faith"
   $lhsOfColon: local:= f
   t:=
-    atom t and (t':= ASSOC(t,getDomainsInScope e)) => t'
+    atom t and (t':= assoc(t,getDomainsInScope e)) => t'
     isDomainForm(t,e) and not $insideCategoryIfTrue =>
       (if not member(t,getDomainsInScope e) then e:= addDomain(t,e); t)
     isDomainForm(t,e) or isCategoryForm(t,e) => t