* interp/compiler.boot (compHasFormat): Take a DB parameter.

	Adjust callers.
	* interp/define.boot (ICformat): Likewise.
	* interp/lisplib.boot (predicateBitIndex): Likewise.
	(predicateBitRef): Likewise.
	(transHasCode): Likewise.

5 files changed, 36 insertions, 27 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 980a8574..0c0562e6 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+2013-06-18  Gabriel Dos Reis  <gdr@integrable-solutions.net>
+
+	* interp/compiler.boot (compHasFormat): Take a DB parameter.
+	Adjust callers.
+	* interp/define.boot (ICformat): Likewise.
+	* interp/lisplib.boot (predicateBitIndex): Likewise.
+	(predicateBitRef): Likewise.
+	(transHasCode): Likewise.
+
 2013-06-17  Gabriel Dos Reis  <gdr@integrable-solutions.net>
 
 	* algebra/catdef.spad.pamphlet (CommutativeOperatorCategory): New.
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 1d2921eb..e070e214 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1349,12 +1349,12 @@ compElt(form,m,E) ==
 compHas: (%Form,%Mode,%Env) -> %Maybe %Triple
 compHas(pred is ["has",a,b],m,e) ==
   e := chaseInferences(pred,e)
-  predCode := compHasFormat(pred,e)
+  predCode := compHasFormat(currentDB e,pred,e)
   coerce([predCode,$Boolean,e],m)
 
       --used in various other places to make the discrimination
 
-compHasFormat(pred is ["has",olda,b],e) ==
+compHasFormat(db,pred is ["has",olda,b],e) ==
   argl := $form.args
   formals := take(#argl,$FormalMapVariableList)
   a := applySubst(pairList(formals,argl),olda)
@@ -1365,7 +1365,7 @@ compHasFormat(pred is ["has",olda,b],e) ==
      ["HasSignature",a,
        mkList [MKQ op,mkList [mkTypeForm type for type in sig]]]
   b is ["Join",:l] or b is ["CATEGORY",.,:l] => 
-     ["AND",:[compHasFormat(["has",olda,c],e) for c in l]]
+     ["AND",:[compHasFormat(db,["has",olda,c],e) for c in l]]
   isCategoryForm(b,e) => ["HasCategory",a,optimize! mkTypeForm b]
   stackAndThrow('"Second argument to %1b must be a category, or a signature or an attribute",["has"])
 
diff --git a/src/interp/define.boot b/src/interp/define.boot
index dfcff5e3..187c3768 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -431,7 +431,7 @@ makeCompactDirect1(db,op,items) ==
       n is [p,:.] => p  --the rest is linenumber of function definition
       n
     predCode :=
-      s is [pred,:.] => predicateBitIndex(pred,$e)
+      s is [pred,:.] => predicateBitIndex(db,pred,$e)
       0
   --> drop items which are not present (predCode = -1)
   predCode = -1 => return nil
@@ -490,7 +490,7 @@ makeCategoryAlist(db,e) ==
   opcAlist := sortBy(function(x +-> LASSOC(first x,levelAlist)),pcAlist)
   newPairlis := [[i,:b] for [.,:b] in dbFormalSubst db for i in 6..]
   slot1 := [[a,:k] for [a,:b] in dbSubstituteAllQuantified(db,opcAlist)
-                   | (k := predicateBitIndex(b,e)) ~= -1]
+                   | (k := predicateBitIndex(db,b,e)) ~= -1]
   slot0 := [getCategoryConstructorDefault a.op for [a,:.] in slot1]
   sixEtc := [5 + i for i in 1..dbArity db]
   formals := substTarget dbFormalSubst db
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 356c66de..5aac19c4 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -500,7 +500,7 @@ ConstantCreator u ==
  
 ProcessCond(db,cond,e) ==
   ncond := dbSubstituteFormals(db,cond)
-  valuePosition(ncond,$NRTslot1PredicateList) => predicateBitRef(ncond,e)
+  valuePosition(ncond,$NRTslot1PredicateList) => predicateBitRef(db,ncond,e)
   cond
 
 TryGDC cond ==
@@ -636,14 +636,14 @@ InvestigateConditions(db,catvecListMaker,tbl,env) ==
                   mkOr(cond2,old,tbl,env)
               old
         list2
-  list:= [[sec,:ICformat(u,tbl,env)] for u in list for sec in secondaries]
+  list:= [[sec,:ICformat(db,u,tbl,env)] for u in list for sec in secondaries]
   pv:= getPossibleViews($principal,tbl)
   -- $HackSlot4 is used in SetVector4 to ensure that conditional
   -- extensions of the principal view are handles correctly
   -- here we build the code necessary to remove spurious extensions
-  ($HackSlot4:= [reshape(u,tbl,env) for u in $HackSlot4]) where
-    reshape(u,tbl,env) ==
-      ['%when,[TryGDC ICformat(rest u,tbl,env)],
+  ($HackSlot4:= [reshape(db,u,tbl,env) for u in $HackSlot4]) where
+    reshape(db,u,tbl,env) ==
+      ['%when,[TryGDC ICformat(db,rest u,tbl,env)],
              ['%otherwise,['RPLACA,'(CAR TrueDomain),
                              ['delete, quote first u,'(CAAR TrueDomain)]]]]
   $supplementaries:=
@@ -652,11 +652,11 @@ InvestigateConditions(db,catvecListMaker,tbl,env) ==
         and not (true=rest u) and not listMember?(first u,pv)]
   [true,:[LASSOC(ms,list) for ms in masterSecondaries]]
  
-ICformat(u,tbl,env) ==
+ICformat(db,u,tbl,env) ==
       u isnt [.,:.] => u
-      u is ["has",:.] => compHasFormat(u,env)
+      u is ["has",:.] => compHasFormat(db,u,env)
       u is ['AND,:l] or u is ['and,:l] =>
-        l:= removeDuplicates [ICformat(v,tbl,env) for [v,:l'] in tails l
+        l:= removeDuplicates [ICformat(db,v,tbl,env) for [v,:l'] in tails l
                                 | not listMember?(v,l')]
              -- we could have duplicates after, even if not before
         # l=1 => first l
@@ -666,8 +666,8 @@ ICformat(u,tbl,env) ==
         l1
       u is ['OR,:l] =>
         (l:= ORreduce l)
-        # l=1 => ICformat(first l,tbl,env)
-        l:= ORreduce removeDuplicates [ICformat(u,tbl,env) for u in l]
+        # l=1 => ICformat(db,first l,tbl,env)
+        l:= ORreduce removeDuplicates [ICformat(db,u,tbl,env) for u in l]
                  --causes multiple ANDs to be squashed, etc.
                  -- and duplicates that have been built up by tidying
         (l:= Hasreduce(l,tbl,env)) where
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 08b9417b..3ad3bc9b 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -60,16 +60,16 @@ simplifyAttributeAlist(db,al) ==
  
 genFinalAttributeAlist(db,e) ==
   [[a,:k] for [a,:b] in $NRTattributeAlist
-     | (k := predicateBitIndex(b,e)) ~= -1]
+     | (k := predicateBitIndex(db,b,e)) ~= -1]
  
-predicateBitIndex(x,e) == 
-  pn(x,false,e) where
-    pn(x,flag,e) ==
-      u := simpBool transHasCode(x,e)
+predicateBitIndex(db,x,e) == 
+  pn(db,x,false,e) where
+    pn(db,x,flag,e) ==
+      u := simpBool transHasCode(db,x,e)
       u is 'T  =>  0
       u is false => -1
       p := valuePosition(u,$NRTslot1PredicateList) => p + 1
-      not flag => pn(predicateBitIndexRemop x,true,e)
+      not flag => pn(db,predicateBitIndexRemop x,true,e)
       systemError nil
 
 predicateBitIndexRemop p==
@@ -79,9 +79,9 @@ predicateBitIndexRemop p==
   p is ["has",'$,['ATTRIBUTE,a]] => LASSOC(a,$NRTattributeAlist)
   p
  
-predicateBitRef(x,e) ==
+predicateBitRef(db,x,e) ==
   x is 'T => 'T
-  ['testBitVector,'pv_$,predicateBitIndex(x,e)]
+  ['testBitVector,'pv_$,predicateBitIndex(db,x,e)]
  
 makePrefixForm(u,op) ==
   u := MKPF(u,op)
@@ -96,7 +96,7 @@ makePredicateBitVector(db,pl,e) ==   --called by buildFunctor
     pl := union(pl,$categoryPredicateList)
   $predGensymAlist := nil --bound by buildFunctor, used by optHas
   for p in removeAttributePredicates pl repeat
-    pred := simpBool transHasCode(p,e)
+    pred := simpBool transHasCode(db,p,e)
     pred isnt [.,:.] => 'skip                --skip over T and nil
     if isHasDollarPred pred then 
       lasts := insert(pred,lasts)
@@ -146,12 +146,12 @@ removeAttributePredicates pl ==
       p
     fnl p == [fn x for x in p]
  
-transHasCode(x,e) ==
+transHasCode(db,x,e) ==
   x isnt [.,:.] => x
   op := x.op
   op in '(HasCategory HasAttribute) => x
-  op="has" => compHasFormat(x,e)
-  [transHasCode(y,e) for y in x]
+  op="has" => compHasFormat(db,x,e)
+  [transHasCode(db,y,e) for y in x]
  
 mungeAddGensyms(u,gal) ==
   ['%list,:[fn(x,gal,0) for x in u]] where fn(x,gal,n) ==