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

	(<<category.clisp>>): Remove.
	* category.boot.pamphlet: Push into package "BOOT".
	Replace ASSOC with assoc throughout.
	(mkCategory): Fix syntax.
	* i-coerce.boot.pamphlet (stripUnionTags): Move to g-util.boot.
	(isTaggeUnion): Likewise.
	(getUnionOrRecordTags): Likewise.
	* i-util.boot.pamphlet (wrap): Move to i-object.boot.
	(isWrapped): Likewise.
	(unwrap): Likewise.
	(wrapped2Quote): Likewise.
	(quote2Wrapped): Likewise.
	(removeQuote): Likewise.
	(TruthP): Move to g-util.boot.

8 files changed, 107 insertions, 90 deletions

diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog
index 784c6364..874ff605 100644
--- a/src/interp/ChangeLog
+++ b/src/interp/ChangeLog
@@ -1,3 +1,21 @@
+2007-10-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (category.$(FASLEXT)): New rule.
+	(<<category.clisp>>): Remove.
+	* category.boot.pamphlet: Push into package "BOOT".
+	Replace ASSOC with assoc throughout.
+	(mkCategory): Fix syntax.
+	* i-coerce.boot.pamphlet (stripUnionTags): Move to g-util.boot.
+	(isTaggeUnion): Likewise.
+	(getUnionOrRecordTags): Likewise.
+	* i-util.boot.pamphlet (wrap): Move to i-object.boot.
+	(isWrapped): Likewise.
+	(unwrap): Likewise.
+	(wrapped2Quote): Likewise.
+	(quote2Wrapped): Likewise.
+	(removeQuote): Likewise.
+	(TruthP): Move to g-util.boot.
+
 2007-10-22  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* g-util.boot (formatUnabbreviatedSig): Translate '$' to '%'
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 9ab363f5..33ed789e 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -451,6 +451,12 @@ format.$(FASLEXT): format.boot macros.$(FASLEXT)
 match.$(FASLEXT): match.boot sys-macros.$(FASLEXT)
 	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
 
+## OpenAxiom's compiler
+
+category.$(FASLEXT): category.boot g-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=. $<
@@ -652,10 +658,6 @@ br-util.clisp: br-util.boot
 	@ echo 487 making $@ from $<
 	@ echo '(old-boot::boot "br-util.boot")' | ${DEPSYS}
 
-category.clisp: category.boot
-	@ echo 212 making $@ from $<
-	@ echo '(old-boot::boot "category.boot")' | ${DEPSYS} 
-
 cattable.clisp: cattable.boot
 	@ echo 215 making $@ from $<
 	@ echo '(old-boot::boot "cattable.boot")' | ${DEPSYS}
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index b3bdb548..f6d14df4 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -1083,14 +1083,6 @@ $(axiom_build_texdir)/diagrams.tex: $(axiom_src_docdir)/diagrams.tex
 	$(INSTALL_DATA) $< $@
 @
 
-\subsection{category.boot \cite{58}}
-
-<<category.clisp>>=
-category.clisp: category.boot
-	@ echo 212 making $@ from $<
-	@ echo '(old-boot::boot "category.boot")' | ${DEPSYS} 
-@
-
 \subsection{cattable.boot \cite{59}}
 
 <<cattable.clisp>>=
@@ -1609,6 +1601,12 @@ format.$(FASLEXT): format.boot macros.$(FASLEXT)
 match.$(FASLEXT): match.boot sys-macros.$(FASLEXT)
 	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
 
+## OpenAxiom's compiler
+
+category.$(FASLEXT): category.boot g-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=. $<
@@ -1796,8 +1794,6 @@ boot-pkg.$(FASLEXT): boot-pkg.lisp
 
 <<br-util.clisp>>
 
-<<category.clisp>>
-
 <<cattable.clisp>>
 
 <<c-doc.clisp>>
diff --git a/src/interp/category.boot.pamphlet b/src/interp/category.boot.pamphlet
index 0dfa2b45..5da2cc25 100644
--- a/src/interp/category.boot.pamphlet
+++ b/src/interp/category.boot.pamphlet
@@ -32,21 +32,21 @@ mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) ==
      else s for s in sigList]
   NewLocals:= nil
   for s in sigList repeat
-    ((NewLocals:= union(NewLocals,Prepare CADAR s)) where
-      Prepare u == "union"/[Prepare2 v for v in u]) where
-        Prepare2 v ==
-          v is "$" => nil
-          STRINGP v => nil
-          atom v => [v]
-          MEMQ(first v,$PrimitiveDomainNames) => nil
-            --This variable is set in INIT LISP
-            --It is a list of all the domains that we need not cache
-          v is ["Union",:w] =>
-            "union"/[Prepare2 x for x in stripUnionTags w]
-          v is ["Mapping",:w] => "union"/[Prepare2 x for x in w]
-          v is ["List",w] => Prepare2 w
-          v is ["Record",.,:w] => "union"/[Prepare2 CADDR x for x in w]
-          [v]
+    NewLocals:= union(NewLocals,Prepare CADAR s) where
+      Prepare u == "union"/[Prepare2 v for v in u]
+      Prepare2 v ==
+	v is "$" => nil
+	STRINGP v => nil
+	atom v => [v]
+	MEMQ(first v,$PrimitiveDomainNames) => nil
+	  --This variable is set in INIT LISP
+	  --It is a list of all the domains that we need not cache
+	v is ["Union",:w] =>
+	  "union"/[Prepare2 x for x in stripUnionTags w]
+	v is ["Mapping",:w] => "union"/[Prepare2 x for x in w]
+	v is ["List",w] => Prepare2 w
+	v is ["Record",.,:w] => "union"/[Prepare2 CADDR x for x in w]
+	[v]
   OldLocals:= nil
   if PrincipalAncestor then for u in (OldLocals:= CADDR PrincipalAncestor.4)
      repeat NewLocals:= delete(first u,NewLocals)
@@ -163,6 +163,9 @@ copy.
 @
 <<*>>=
 <<license>>
+
+import '"g-util"
+)package "BOOT"
  
 -- Functions for building categories
  
@@ -225,7 +228,7 @@ SigListUnion(extra,original) ==
       not MachineLevelSubsume(QCAR e,QCAR x) =>
         --systemError '"Source level subsumption not implemented"
         original:= [e,:original]
-        return() -- this exits from the innermost for loop
+        return nil -- this exits from the innermost for loop
       original:= delete(x,original)
       [xsig,xpred,:ximplem]:= x
 --      if xsig ^= esig then   -- not quite strong enough
@@ -359,8 +362,8 @@ SourceLevelSubset(a,b) ==
   $noSubsumption=true => false
   b is ["Union",:blist] and member(a,blist) => true
   BOUNDP '$noSubsets and $noSubsets => false
-  atom b and ASSOC(a,GETL(b,"Subsets")) => true
-  a is [a1] and b is [b1] and ASSOC(a1,GETL(b1,"Subsets")) => true
+  atom b and assoc(a,GETL(b,"Subsets")) => true
+  a is [a1] and b is [b1] and assoc(a1,GETL(b1,"Subsets")) => true
   nil
  
 MachineLevelSubsume([name1,[out1,:in1],:flag1],[name2,[out2,:in2],:flag2]) ==
@@ -377,8 +380,8 @@ MachineLevelSubset(a,b) ==
   b is ["Union",:blist] and member(a,blist) and
     (and/[STRINGP x for x in blist | x^=a]) => true
            --all other branches must be distinct objects
-  atom b and ASSOC(a,GETL(b,"Subsets")) => true
-  a is [a1] and b is [b1] and ASSOC(a1,GETL(b1,"Subsets")) => true
+  atom b and assoc(a,GETL(b,"Subsets")) => true
+  a is [a1] and b is [b1] and assoc(a1,GETL(b1,"Subsets")) => true
              --we assume all subsets are true at the machine level
   nil
  
@@ -444,7 +447,7 @@ DescendantP(a,b) ==
   a is ["SIGNATURE",:.] => nil
   a:= CatEval a
   b is ["ATTRIBUTE",b'] =>
-    (l:=ASSOC(b',a.2)) => TruthP CADR l
+    (l:=assoc(b',a.2)) => TruthP CADR l
   member(b,first a.4) => true
   AncestorP(b,[first u for u in CADR a.4]) => true
   nil
@@ -501,7 +504,7 @@ JoinInner(l,$e) ==
       bname:= b.(0)
       CondAncestorP(bname,FundamentalAncestors,condition) => nil
       (f:=AncestorP(bname,[first u for u in FundamentalAncestors])) =>
-        [.,.,index]:=ASSOC(f,FundamentalAncestors)
+        [.,.,index]:=assoc(f,FundamentalAncestors)
         FundamentalAncestors:=[[bname,condition,index],:FundamentalAncestors]
       PrinAncb:= first (CatEval bname).(4)
                --Principal Ancestors of b
@@ -577,7 +580,7 @@ JoinInner(l,$e) ==
   for b in CondList repeat
     newpred:= first rest b
     for u in (first b).2 repeat
-      v:= ASSOC(first u,attl)
+      v:= assoc(first u,attl)
       null v =>
         attl:=
           CADR u=true => [[first u,newpred],:attl]
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 5908287c..128e683b 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -51,6 +51,28 @@ PPtoFile(x, fname) ==
 -- Convert an arbitrary lisp object to canonical boolean.
 bool x ==
     NULL NULL x
+ 
+TruthP x ==
+    --True if x is a predicate that's always true
+  x is nil => nil
+  x=true => true
+  x is ['QUOTE,:.] => true
+  nil
+
+--% Record and Union utils.
+
+stripUnionTags doms ==
+  [if dom is [":",.,dom'] then dom' else dom for dom in doms]
+
+isTaggedUnion u ==
+  u is ['Union,:tl] and tl and first tl is [":",.,.] and true
+
+getUnionOrRecordTags u ==
+  tags := nil
+  if u is ['Union, :tl] or u is ['Record, :tl] then
+      for t in tl repeat
+         if t is [":",tag,.] then tags := cons(tag, tags)
+  tags
 
 --% Various lispy things
 
diff --git a/src/interp/i-coerce.boot.pamphlet b/src/interp/i-coerce.boot.pamphlet
index a3bc0760..ff43961f 100644
--- a/src/interp/i-coerce.boot.pamphlet
+++ b/src/interp/i-coerce.boot.pamphlet
@@ -1034,19 +1034,6 @@ coerceIntAlgebraicConstant(object,t2) ==
       objNewWrap(getConstantFromDomain('(Zero),t2),t2)
   NIL
 
-stripUnionTags doms ==
-  [if dom is [":",.,dom'] then dom' else dom for dom in doms]
-
-isTaggedUnion u ==
-  u is ['Union,:tl] and tl and first tl is [":",.,.] and true
-
-getUnionOrRecordTags u ==
-  tags := nil
-  if u is ['Union, :tl] or u is ['Record, :tl] then
-      for t in tl repeat
-         if t is [":",tag,.] then tags := cons(tag, tags)
-  tags
-
 coerceUnion2Branch(object) ==
   [.,:unionDoms] := objMode object
   doms := orderUnionEntries unionDoms
diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot
index 2c6515c1..0543e466 100644
--- a/src/interp/i-object.boot
+++ b/src/interp/i-object.boot
@@ -65,7 +65,35 @@ objEnv obj == $NE
 objCodeVal obj == CADDR obj
 objCodeMode obj == CADR obj
 
-
+--% Utility Functions Used Only by the Intepreter
+ 
+wrap x ==
+  isWrapped x => x
+  ['WRAPPED,:x]
+ 
+isWrapped x == x is ['WRAPPED,:.] or NUMBERP x or FLOATP x or CVECP x
+ 
+unwrap x ==
+  NUMBERP x or FLOATP x or CVECP x => x
+  x is ["WRAPPED",:y] => y
+  x
+ 
+wrapped2Quote x ==
+  x is ["WRAPPED",:y] => MKQ y
+  x
+ 
+quote2Wrapped x ==
+  x is ['QUOTE,y] => wrap y
+  x
+ 
+removeQuote x ==
+  x is ["QUOTE",y] => y
+  x
+ 
+-- addQuote x ==
+--   NUMBERP x => x
+--   ['QUOTE,x]
+ 
 --% Library compiler structures needed by the interpreter
 
 -- Tuples and Crosses
diff --git a/src/interp/i-util.boot.pamphlet b/src/interp/i-util.boot.pamphlet
index 54cf2874..c0d785da 100644
--- a/src/interp/i-util.boot.pamphlet
+++ b/src/interp/i-util.boot.pamphlet
@@ -58,35 +58,6 @@ lisp code is unwrapped.
 <<*>>=
 <<license>>
 
---% Utility Functions Used Only by the Intepreter
- 
-wrap x ==
-  isWrapped x => x
-  ['WRAPPED,:x]
- 
-isWrapped x == x is ['WRAPPED,:.] or NUMBERP x or FLOATP x or CVECP x
- 
-unwrap x ==
-  NUMBERP x or FLOATP x or CVECP x => x
-  x is ["WRAPPED",:y] => y
-  x
- 
-wrapped2Quote x ==
-  x is ["WRAPPED",:y] => MKQ y
-  x
- 
-quote2Wrapped x ==
-  x is ['QUOTE,y] => wrap y
-  x
- 
-removeQuote x ==
-  x is ["QUOTE",y] => y
-  x
- 
--- addQuote x ==
---   NUMBERP x => x
---   ['QUOTE,x]
- 
 --% The function for making prompts
  
 spadPrompt() ==
@@ -287,16 +258,6 @@ mkPredList listOfEntries ==
         [u,:tagPredList]:= tagPredList
         u
   predList
- 
-TruthP x ==
-    --True if x is a predicate that's always true
-  x is nil => nil
-  x=true => true
-  x is ['QUOTE,:.] => true
-  nil
-
-
-