* interp/c-util.boot (categoryAssociatedTypes): Rename from

	categoryHierarchy.  Adjust callers.
	(categoryPrincipals): New.
	(categoryAncestors): Likewise.
	(categoryLocals): Likewise.
	(categoryParameters): Likewise.
	(extendsCategoryForm): Use them.
	* interp/category.boot: Likewise.
	* interp/cattable.boot: Likewise.
	* interp/define.boot: Likewise.
	* interp/functor.boot: Likewise.
	* interp/modemap.boot: Likewise.
	* interp/nruncomp.boot: Likewise.
	* interp/database.boot (getCategoryAttributes): Remove.
	(getPrincipalAncestors): Likewise.
	(getCategoryParents): Likewise.
	* algebra/domain.spad.pamphlet (Category): Adjust.

10 files changed, 83 insertions, 70 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 164311a1..93f7a46c 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,23 @@
+2011-08-18  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/c-util.boot (categoryAssociatedTypes): Rename from
+	categoryHierarchy.  Adjust callers.
+	(categoryPrincipals): New.
+	(categoryAncestors): Likewise.
+	(categoryLocals): Likewise.
+	(categoryParameters): Likewise.
+	(extendsCategoryForm): Use them.
+	* interp/category.boot: Likewise.
+	* interp/cattable.boot: Likewise.
+	* interp/define.boot: Likewise.
+	* interp/functor.boot: Likewise.
+	* interp/modemap.boot: Likewise.
+	* interp/nruncomp.boot: Likewise.
+	* interp/database.boot (getCategoryAttributes): Remove.
+	(getPrincipalAncestors): Likewise.
+	(getCategoryParents): Likewise.
+	* algebra/domain.spad.pamphlet (Category): Adjust.
+
 2011-08-16  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/c-util.boot (categoryPrincipals): New.
diff --git a/src/algebra/domain.spad.pamphlet b/src/algebra/domain.spad.pamphlet
index 456680dc..501d7b2a 100644
--- a/src/algebra/domain.spad.pamphlet
+++ b/src/algebra/domain.spad.pamphlet
@@ -399,18 +399,18 @@ Category(): Public == Private where
       ++ extended by the category `c'.
   Private == add
     constructor x ==
-      %head(devaluate(x)$Lisp)$Foreign(Builtin)
+      %head(devaluate(x)$Foreign(Builtin))$Foreign(Builtin)
 
     exportedOperators c ==
       [%head(x)$Foreign(Builtin)@OperatorSignature 
-         for x in categoryExports(c)$Lisp@List(Syntax)]
+         for x in categoryExports(c)$Foreign(Builtin)@List(Syntax)]
     
     principalAncestors c == 
-      getCategoryPrincipalAncestors(c)$Lisp
+      categoryPrincipals(c)$Foreign(Builtin)
 
     parents c ==
       [%head(x)$Foreign(Builtin)@ConstructorCall(CategoryConstructor)
-         for x in getCategoryParents(c)$Lisp@List(Syntax)]
+         for x in categoryAncestors(c)$Foreign(Builtin)@List(Syntax)]
 
     coerce x ==
       outputDomainConstructor(x)$Lisp
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 4ad94273..54000fad 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -86,16 +86,23 @@ macro categoryAttributes d ==
   categoryRef(d,2)
 
 ++ Return a 3-list of data describing the hierarchy of category `c'.
-macro categoryHierarchy c ==
+macro categoryAssociatedTypes c ==
   categoryRef(c,4)
 
 ++ Return the list of principal ancestors of category `c'.  
 macro categoryPrincipals c ==
-  first categoryHierarchy c
+  first categoryAssociatedTypes c
 
-++ Return the list of [ancestor,predicate,index] data of catagory `c'.  
+++ Return the list of [ancestor,predicate,index] data of catagory `c',
+++ where `ancestor' is a fundamental ancestor, `index' its sequence number.
 macro categoryAncestors c ==
-  second categoryHierarchy c
+  second categoryAssociatedTypes c
+
+macro categoryLocals c ==
+  third categoryAssociatedTypes c
+
+macro categoryParameters c ==
+  categoryRef(c,5)
 
 ++ Reference a 3-list
 ++   [lookupFunction,thisDomain,optable]
@@ -1033,12 +1040,11 @@ extendsCategoryForm(domain,form,form') ==
     form' is ["IF",:.] => true --temporary hack so comp won't fail
     -- Are we dealing with an Aldor category?  If so use the "has" function ...
     # formVec = 1 => newHasTest(form,form')
-    catvlist:= formVec.4
-    listMember?(form',first catvlist) or
-     listMember?(form',substitute(domain,"$",first catvlist)) or
+    listMember?(form',categoryPrincipals formVec) or
+     listMember?(form',substitute(domain,"$",categoryPrincipals formVec)) or
       (or/
         [extendsCategoryForm(domain,substitute(domain,"$",cat),form')
-          for [cat,:.] in second catvlist])
+          for [cat,:.] in categoryAncestors formVec])
   nil
  
 getmode(x,e) ==
diff --git a/src/interp/category.boot b/src/interp/category.boot
index 80d1fe86..c942e5c2 100644
--- a/src/interp/category.boot
+++ b/src/interp/category.boot
@@ -105,7 +105,7 @@ mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) ==
   OldLocals:= nil
   -- Remove possible duplicate local domain caches.
   if PrincipalAncestor then 
-    for u in (OldLocals:= third PrincipalAncestor.4) repeat 
+    for u in (OldLocals := categoryLocals PrincipalAncestor) repeat 
       NewLocals := remove(NewLocals,first u)
   -- New local domains caches are hosted in slots at the end onward
   for u in NewLocals repeat
@@ -120,10 +120,12 @@ mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) ==
   if PrincipalAncestor ~= nil then
     for x in 6..#PrincipalAncestor-1 repeat 
       categoryRef(v,x) := PrincipalAncestor.x
-    categoryHierarchy(v) :=
-      [first PrincipalAncestor.4,second PrincipalAncestor.4,OldLocals]
+    categoryAssociatedTypes(v) :=
+      [categoryPrincipals PrincipalAncestor,
+        categoryAncestors PrincipalAncestor,
+          OldLocals]
   else
-    categoryHierarchy(v) := [nil,nil,OldLocals]
+    categoryAssociatedTypes(v) := [nil,nil,OldLocals]
   categoryRef(v,5) := domList
   for [nsig,:n] in NSigList repeat 
     categoryRef(v,n) := nsig
@@ -310,17 +312,17 @@ FindFundAncs l ==
   canonicalForm f1 = nil => FindFundAncs rest l
   ans:= FindFundAncs rest l
   for u in FindFundAncs [[CatEval first x,mkAnd(CADAR l,second x)]
-   for x in second f1.4] repeat
+   for x in categoryAncestors f1] repeat
     x:= ASSQ(first u,ans) =>
       ans:= [[first u,mkOr(second x,second u)],:remove(ans,x)]
     ans:= [u,:ans]
         --testing to see if first l is already there
   x:= ASSQ(CAAR l,ans) => [[CAAR l,mkOr(CADAR l,second x)],:remove(ans,x)]
   CADAR l=true =>
-    for x in first f1.4 repeat
+    for x in categoryPrincipals f1 repeat
       if y:= ASSQ(CatEval x,ans) then ans := remove(ans,y)
     [first l,:ans]
-  for x in first f1.4 repeat
+  for x in categoryPrincipals f1 repeat
     if y:= ASSQ(CatEval x,ans) then ans:=
       [[first y,mkOr(CADAR l,second y)],:remove(ans,y)]
   [first l,:ans]
@@ -341,7 +343,7 @@ AncestorP(xname,leaves) ==
   -- checks for being a principal ancestor of one of the leaves
   listMember?(xname,leaves) => xname
   for y in leaves repeat
-    listMember?(xname,first CatEval(y).4) => return y
+    listMember?(xname,categoryPrincipals CatEval y) => return y
  
 CondAncestorP(xname,leaves,condition) ==
   -- checks for being a principal ancestor of one of the leaves
@@ -350,7 +352,7 @@ CondAncestorP(xname,leaves,condition) ==
     ucond:=
       null rest u => true
       second u
-    xname = u' or listMember?(xname,first CatEval(u').4) =>
+    xname = u' or listMember?(xname,categoryPrincipals CatEval u') =>
       PredImplies(ucond,condition) => return u'
 
 
@@ -364,8 +366,8 @@ DescendantP(a,b) ==
   a:= CatEval a
   b is ["ATTRIBUTE",b'] =>
     (l:=assoc(b',a.2)) => TruthP second l
-  listMember?(b,first a.4) => true
-  AncestorP(b,[first u for u in second a.4]) => true
+  listMember?(b,categoryPrincipals a) => true
+  AncestorP(b,[first u for u in categoryAncestors a]) => true
   false
  
 --% The implementation of Join
@@ -403,7 +405,7 @@ JoinInner(l,$e) ==
   sigl := categoryExports $NewCatVec
   attl:= $NewCatVec.2
   globalDomains:= $NewCatVec.5
-  FundamentalAncestors:= second $NewCatVec.4
+  FundamentalAncestors := categoryAncestors $NewCatVec
   if $NewCatVec.0 then FundamentalAncestors:=
     [[$NewCatVec.0],:FundamentalAncestors]
                     --principal ancestor . all those already included
@@ -422,7 +424,7 @@ JoinInner(l,$e) ==
       (f:=AncestorP(bname,[first u for u in FundamentalAncestors])) =>
         [.,.,index]:=assoc(f,FundamentalAncestors)
         FundamentalAncestors:=[[bname,condition,index],:FundamentalAncestors]
-      PrinAncb:= first CatEval(bname).4
+      PrinAncb := categoryPrincipals CatEval bname
                --Principal Ancestors of b
       reallynew:= true
       for anc in FundamentalAncestors repeat
@@ -455,7 +457,7 @@ JoinInner(l,$e) ==
               if originalVector and (condition=true) then
                 $NewCatVec:= CatEval bname
                 copied:= nil
-                FundamentalAncestors:= [[bname],:second $NewCatVec.4]
+                FundamentalAncestors:= [[bname],:categoryAncestors $NewCatVec]
                          --bname is Principal, so comes first
                 reallynew:= nil
                 objectMember?(b,l) =>
@@ -529,10 +531,11 @@ JoinInner(l,$e) ==
             [sig,mkpf([oldpred,newpred],"and"),:implem]
   FundamentalAncestors:= [x for x in FundamentalAncestors | rest x]
                --strip out the pointer to Principal Ancestor
-  c:= first $NewCatVec.4
+  c := categoryPrincipals $NewCatVec
   pName:= $NewCatVec.0
   if pName and not listMember?(pName,c) then c:= [pName,:c]
-  $NewCatVec.4:= [c,FundamentalAncestors,third $NewCatVec.4]
+  categoryAssociatedTypes($NewCatVec) :=
+    [c,FundamentalAncestors,categoryLocals $NewCatVec]
   mkCategory("domain",sigl,attl,globalDomains,$NewCatVec)
 
 Join(:l) ==
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index a4c1cdd9..298e6c56 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -296,8 +296,8 @@ mkCategoryExtensionAlistBasic cform ==
   category :=      -- changed by RSS on 7/29/87
     macrop cop => eval cform
     apply(cop, rest cform)
-  extendsList:= [[x,:'T] for x in category.4.0]
-  for [cat,pred,:.] in category.4.1 repeat
+  extendsList := [[x,:'T] for x in categoryPrincipals category]
+  for [cat,pred,:.] in categoryAncestors category repeat
     newList := getCategoryExtensionAlist0 cat
     finalList :=
       pred is 'T => newList
diff --git a/src/interp/database.boot b/src/interp/database.boot
index be5479d8..72cb5fc7 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -775,22 +775,6 @@ displayHiddenConstructors() ==
     else for c in $localExposureData.2 repeat
       centerAndHighlight c
 
-
-
---%
-
-
-++ Return the list of category attribute info for the category object `c'.
-++ A category attribute info is pair of attribute-predicate.
-getCategoryAttributes: %Shell -> %List %Form
-getCategoryAttributes c == c.2
-
-
-getCategoryPrincipalAncestors c == c.4.0
-
-getCategoryParents c == c.4.1
-
-
 --%
 squeezeAll: %List %Code -> %List %Code
 squeezeAll x ==
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 39c2abc1..59577423 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -327,7 +327,7 @@ extendsCategoryBasic(dom,u,v,env) ==
   v is ['IF,p,['ATTRIBUTE,c],.] =>
     uVec := compMakeCategoryObject(u,env).expr or return false
     cons? c and isCategoryForm(c,env) =>
-      LASSOC(c,second categoryHierarchy uVec) is [=p,:.]
+      LASSOC(c,categoryAncestors uVec) is [=p,:.]
     LASSOC(c,categoryAttributes uVec) is [=p,:.]
   u is ["Join",:l] => or/[extendsCategoryBasic(dom,x,v,env) for x in l]
   u = v => true
@@ -348,8 +348,7 @@ extendsCategoryBasic(dom,u,v,env) ==
 catExtendsCat?(u,v,env) ==
   u = v => true
   uvec := compMakeCategoryObject(u,env).expr
-  slot4 := categoryHierarchy uvec
-  prinAncestorList := first slot4
+  prinAncestorList := categoryPrincipals uvec
   listMember?(v,prinAncestorList) => true
   vOp := KAR v
   if similarForm := assoc(vOp,prinAncestorList) then
@@ -358,7 +357,7 @@ catExtendsCat?(u,v,env) ==
     PRINT similarForm
     sayBrightlyNT '"   but not "
     PRINT v
-  or/[catExtendsCat?(x,v,env) for x in ASSOCLEFT second slot4]
+  or/[catExtendsCat?(x,v,env) for x in ASSOCLEFT categoryAncestors uvec]
  
 substSlotNumbers(form,template,domain) ==
   form is [op,:.] and
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index fc44b8c8..d3c5823c 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -600,7 +600,7 @@ InvestigateConditions catvecListMaker ==
   if $principal is [op,:.] then
     [principal',:.]:=compMakeCategoryObject($principal,$e)
               --Rather like eval, but quotes parameters first
-    for u in second principal'.4 repeat
+    for u in categoryAncestors principal' repeat
       if not TruthP(cond:=second u) then
         new:=['CATEGORY,'domain,['IF,cond,['ATTRIBUTE,first u], '%noBranch]]
         $principal is ['Join,:l] =>
@@ -620,14 +620,14 @@ InvestigateConditions catvecListMaker ==
   null $Conditions => [true,:[true for u in secondaries]]
   PrincipalSecondaries:= getViewsConditions principal'
   MinimalPrimary:= first first PrincipalSecondaries
-  MaximalPrimary:= CAAR $domainShell.4
+  MaximalPrimary := first categoryPrincipals $domainShell
   necessarySecondaries:= [first u for u in PrincipalSecondaries | rest u=true]
   and/[listMember?(u,necessarySecondaries) for u in secondaries] =>
     [true,:[true for u in secondaries]]
   $HackSlot4:=
     MinimalPrimary=MaximalPrimary => nil
-    MaximalPrimaries:=[MaximalPrimary,:first CatEval(MaximalPrimary).4]
-    MinimalPrimaries:=[MinimalPrimary,:first CatEval(MinimalPrimary).4]
+    MaximalPrimaries:=[MaximalPrimary,:categoryPrincipals CatEval MaximalPrimary]
+    MinimalPrimaries:=[MinimalPrimary,:categoryPrincipals CatEval MinimalPrimary]
     MaximalPrimaries:=S_-(MaximalPrimaries,MinimalPrimaries)
     [[x] for x in MaximalPrimaries]
   ($Conditions:= Conds($principal,nil)) where
@@ -657,7 +657,7 @@ InvestigateConditions catvecListMaker ==
       # u=1 => first u
       ['AND,:u]
     for [v,:.] in newS repeat
-      for v' in [v,:first CatEval(v).4] repeat
+      for v' in [v,:categoryPrincipals CatEval v] repeat
         if (w:=assoc(v',$HackSlot4)) then
           w.rest := if rest w then mkOr(u,rest w) else u
     (list:= update(list,u,secondaries,newS)) where
@@ -751,8 +751,8 @@ getPossibleViews u ==
   --returns a list of all the categories that can be views of this one
   [vec,:.]:= compMakeCategoryObject(u,$e) or
     systemErrorHere ["getPossibleViews",u]
-  views:= [first u for u in second vec.4]
-  null vec.0 => [CAAR vec.4,:views] --*
+  views:= [first u for u in categoryAncestors vec]
+  null vec.0 => [first categoryPrincipals vec,:views] --*
   [vec.0,:views] --*
       --the two lines marked  ensure that the principal view comes first
       --if you don't want it, rest it off
@@ -763,10 +763,10 @@ getViewsConditions u ==
   --paired with the condition under which they are such views
   [vec,:.]:= compMakeCategoryObject(u,$e) or
     systemErrorHere ["getViewsConditions",u]
-  views:= [[first u,:second u] for u in second vec.4]
+  views:= [[first u,:second u] for u in categoryAncestors vec]
   null vec.0 =>
-    null first vec.4 => views
-    [[CAAR vec.4,:true],:views] --*
+    null categoryPrincipals vec => views
+    [[first categoryPrincipals vec,:true],:views] --*
   [[vec.0,:true],:views] --*
       --the two lines marked  ensure that the principal view comes first
       --if you don't want it, rest it off
diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot
index c066b16e..cff85592 100644
--- a/src/interp/modemap.boot
+++ b/src/interp/modemap.boot
@@ -476,14 +476,13 @@ knownInfo pred ==
     vmode is ["Join",:l] and listMember?(cat,l) => true
     [vv,.,.]:= compMakeCategoryObject(vmode,$e) or return
                  stackAndThrow('"cannot find category %1pb",[vmode])
-    catlist := vv.4
-    listMember?(cat,first catlist) => true  --checks princ. ancestors
-    (u:=assoc(cat,second catlist)) and knownInfo second u => true
+    listMember?(cat,categoryPrincipals vv) => true  --checks princ. ancestors
+    (u:=assoc(cat,categoryAncestors vv)) and knownInfo second u => true
     -- previous line checks fundamental anscestors, we should check their
     --   principal anscestors but this requires instantiating categories
 
     or/[AncestorP(cat,[first u]) 
-         for u in second catlist | knownInfo second u] => true
+         for u in categoryAncestors vv | knownInfo second u] => true
     false
   pred is ["SIGNATURE",name,op,sig,:.] =>
     v:= get(op,"modemap",$e)
@@ -547,8 +546,8 @@ actOnInfo(u,$e) ==
       [ocatvec,.,$e]:= compMakeCategoryObject(vmode,$e)
  
       --we are adding a principal descendant of what was already known
-      listMember?(cat,first ocatvec.4) or
-         assoc(cat,second ocatvec.4) is [.,"T",.] => $e
+      listMember?(cat,categoryPrincipals ocatvec) or
+         assoc(cat,categoryAncestors ocatvec) is [.,"T",.] => $e
              --what was being asserted is an ancestor of what was known
       if name="$"
         then $e:= augModemapsFromCategory(name,name,name,cat,$e)
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 0752edc4..d8703729 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -503,7 +503,8 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
     --we will clobber elements; copy since $domainShell may be a cached vector
   $template := newShell($NRTbase + $NRTdeltaLength)
   $SetFunctions := newShell # domainShell
-  $catvecList := [domainShell,:[emptyVector for u in second domainShell.4]]
+  $catvecList :=
+    [domainShell,:[emptyVector for u in categoryAncestors domainShell]]
   -- list of names n1..nn for each view
   viewNames := ['$,:[genvar() for u in rest catvecListMaker]]
   domname := 'dv_$
@@ -607,13 +608,14 @@ NRTsetVector4a(sig,form,cond) ==
   sig is '$ =>
      domainList :=
        [simplifyVMForm COPY comp(d,$EmptyMode,$e).expr or d
-         for d in $domainShell.4.0]
+         for d in categoryPrincipals $domainShell]
      $uncondList := append(domainList,$uncondList)
      if isCategoryForm(form,$e) then $uncondList := [form,:$uncondList]
      $uncondList
   evalform := eval mkEvalableCategoryForm form
-  cond = true => $uncondList := [form,:append(evalform.4.0,$uncondList)]
-  $condList := [[cond,[form,:evalform.4.0]],:$condList]
+  cond = true =>
+    $uncondList := [form,:append(categoryPrincipals evalform,$uncondList)]
+  $condList := [[cond,[form,:categoryPrincipals evalform]],:$condList]
 
 NRTmakeSlot1Info() ==
 -- 4 cases: