* interp/compiler.boot (compHasFormat): Take environment

	argument.  Adjust callers.
	* interp/define.boot (NRTmakeCategoryAlist): Likewise.
	* interp/functor.boot (ProcessCond): Likewise.
	* interp/lisplib.boot (NRTgenFinalAttributeAlist): Likewise.
	(predicateBitIndex): Likewise.
	(predicateBitRef): Likewise.
	(makePredicateBitVector): Likewise.
	(transHasCode): Likewise.

6 files changed, 49 insertions, 36 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index de3b2d3b..795f4246 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,17 @@
 2011-08-25  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/compiler.boot (compHasFormat): Take environment
+	argument.  Adjust callers.
+	* interp/define.boot (NRTmakeCategoryAlist): Likewise.
+	* interp/functor.boot (ProcessCond): Likewise.
+	* interp/lisplib.boot (NRTgenFinalAttributeAlist): Likewise.
+	(predicateBitIndex): Likewise.
+	(predicateBitRef): Likewise.
+	(makePredicateBitVector): Likewise.
+	(transHasCode): Likewise.
+
+2011-08-25  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/hashcode.boot: Remove.
 	*interp/interop.boot: Move OpenAxiom relevant code to define.boot
 	and nrunfast.boot.  Remove.
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 3e828bba..49aa460a 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1231,26 +1231,26 @@ compElt(form,m,E) ==
 --% HAS
 
 compHas: (%Form,%Mode,%Env) -> %Maybe %Triple
-compHas(pred is ["has",a,b],m,$e) ==
-  $e:= chaseInferences(pred,$e)
-  predCode:= compHasFormat pred
-  coerce([predCode,$Boolean,$e],m)
+compHas(pred is ["has",a,b],m,e) ==
+  e := chaseInferences(pred,e)
+  predCode := compHasFormat(pred,e)
+  coerce([predCode,$Boolean,e],m)
 
       --used in various other places to make the discrimination
 
-compHasFormat (pred is ["has",olda,b]) ==
+compHasFormat(pred is ["has",olda,b],e) ==
   argl := rest $form
   formals := TAKE(#argl,$FormalMapVariableList)
   a := applySubst(pairList(formals,argl),olda)
-  [a,:.] := comp(a,$EmptyMode,$e) or return nil
+  [a,.,e] := comp(a,$EmptyMode,e) or return nil
   a := applySubst(pairList(argl,formals),a)
   b is ["ATTRIBUTE",c] => ["HasAttribute",a,["QUOTE",c]]
   b is ["SIGNATURE",op,sig,:.] =>
      ["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] for c in l]]
-  isCategoryForm(b,$e) => ["HasCategory",a,mkTypeForm b]
+     ["AND",:[compHasFormat(["has",olda,c],e) for c in l]]
+  isCategoryForm(b,e) => ["HasCategory",a,mkTypeForm b]
   stackAndThrow('"Second argument to %1b must be a category, or a signature or an attribute",["has"])
 
 --% IF
diff --git a/src/interp/define.boot b/src/interp/define.boot
index f4675b08..ef251ab9 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -360,8 +360,8 @@ getInfovecCode() ==
   ['LIST,
     MKQ makeDomainTemplate $template,
       MKQ makeCompactDirect $NRTslot1Info,
-        MKQ NRTgenFinalAttributeAlist(),
-          NRTmakeCategoryAlist(),
+        MKQ NRTgenFinalAttributeAlist $e,
+          NRTmakeCategoryAlist $e,
             MKQ $lookupFunction]
 
 --=======================================================================
@@ -425,7 +425,7 @@ makeCompactDirect1(op,items) ==
       n is [p,:.] => p  --the rest is linenumber of function definition
       n
     predCode :=
-      s is [pred,:.] => predicateBitIndex pred
+      s is [pred,:.] => predicateBitIndex(pred,$e)
       0
   --> drop items which are not present (predCode = -1)
   predCode = -1 => return nil
@@ -480,7 +480,7 @@ depthAssoc x ==
  
 getCatAncestors x ==  [CAAR y for y in parentsOf opOf x]
  
-NRTmakeCategoryAlist() ==
+NRTmakeCategoryAlist e ==
   $depthAssocCache: local := hashTable 'EQ
   $catAncestorAlist: local := nil
   pcAlist := [:[[x,:"T"] for x in $uncondAlist],:$condAlist]
@@ -488,7 +488,7 @@ NRTmakeCategoryAlist() ==
   opcAlist := reverse! SORTBY(function NRTcatCompare,pcAlist)
   newPairlis := [[5 + i,:b] for [.,:b] in $pairlis for i in 1..]
   slot1 := [[a,:k] for [a,:b] in applySubst($pairlis,opcAlist)
-                   | (k := predicateBitIndex b) ~= -1]
+                   | (k := predicateBitIndex(b,e)) ~= -1]
   slot0 := [hasDefaultPackage opOf a for [a,:b] in slot1]
   sixEtc := [5 + i for i in 1..#$pairlis]
   formals := ASSOCRIGHT $pairlis
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 20ed8c36..33e7c592 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -445,7 +445,7 @@ DescendCode(code,flag,viewAssoc) ==
       reverse! [v for u in reverse codelist |
                     (v:= DescendCode(u,flag,viewAssoc))~=nil]]
   code is ['%when,:condlist] =>
-    c:= [[u2:= ProcessCond first u,:q] for u in condlist] where q() ==
+    c:= [[u2:= ProcessCond(first u,$e),:q] for u in condlist] where q() ==
           null u2 => nil
           f:=
             TruthP u2 => flag;
@@ -473,7 +473,7 @@ DescendCode(code,flag,viewAssoc) ==
           code:=['%store,['%tref,['%tref,'$,5],#$locals-#u],code]
           $epilogue:=
             TruthP flag => [code,:$epilogue]
-            [['%when,[ProcessCond  flag,code]],:$epilogue]
+            [['%when,[ProcessCond(flag,$e),code]],:$epilogue]
           nil
         code
     code -- doItIf deletes entries from $locals so can't optimize this
@@ -488,7 +488,7 @@ DescendCode(code,flag,viewAssoc) ==
     if not $insideCategoryPackageIfTrue then
       updateCapsuleDirectory([second(u).args,third u],flag)
     ConstantCreator u =>
-      if flag ~= true then u:= ['%when,[ProcessCond flag,u]]
+      if flag ~= true then u:= ['%when,[ProcessCond(flag,$e),u]]
       $ConstantAssignments:= [u,:$ConstantAssignments]
       nil
     u
@@ -508,9 +508,9 @@ ConstantCreator u ==
   u is ['CONS,:.] => false
   true
  
-ProcessCond cond ==
+ProcessCond(cond,e) ==
   ncond := applySubst($pairlis,cond)
-  integer? POSN1(ncond,$NRTslot1PredicateList) => predicateBitRef ncond
+  integer? POSN1(ncond,$NRTslot1PredicateList) => predicateBitRef(ncond,e)
   cond
 
 TryGDC cond ==
@@ -688,7 +688,7 @@ InvestigateConditions(catvecListMaker,env) ==
  
 ICformat(u,env) ==
       u isnt [.,:.] => u
-      u is ["has",:.] => compHasFormat u
+      u is ["has",:.] => compHasFormat(u,env)
       u is ['AND,:l] or u is ['and,:l] =>
         l:= removeDuplicates [ICformat(v,env) for [v,:l'] in tails l
                                 | not listMember?(v,l')]
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 25b00464..5d952942 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -64,17 +64,18 @@ simplifyAttributeAlist al ==
     [[a,:pred],:simplifyAttributeAlist s]
   nil
  
-NRTgenFinalAttributeAlist() ==
-  [[a,:k] for [a,:b] in $NRTattributeAlist | (k := predicateBitIndex(b)) ~= -1]
- 
-predicateBitIndex x == 
-  pn(x,false) where
-    pn(x,flag) ==
-      u := simpBool transHasCode x
+NRTgenFinalAttributeAlist e ==
+  [[a,:k] for [a,:b] in $NRTattributeAlist
+     | (k := predicateBitIndex(b,e)) ~= -1]
+ 
+predicateBitIndex(x,e) == 
+  pn(x,false,e) where
+    pn(x,flag,e) ==
+      u := simpBool transHasCode(x,e)
       u is 'T  =>  0
       u = nil => -1
       p := POSN1(u,$NRTslot1PredicateList) => p + 1
-      not flag => pn(predicateBitIndexRemop x,true)
+      not flag => pn(predicateBitIndexRemop x,true,e)
       systemError nil
 
 predicateBitIndexRemop p==
@@ -84,9 +85,9 @@ predicateBitIndexRemop p==
   p is ["has",'$,['ATTRIBUTE,a]] => LASSOC(a,$NRTattributeAlist)
   p
  
-predicateBitRef x ==
+predicateBitRef(x,e) ==
   x is 'T => 'T
-  ['testBitVector,'pv_$,predicateBitIndex x]
+  ['testBitVector,'pv_$,predicateBitIndex(x,e)]
  
 makePrefixForm(u,op) ==
   u := MKPF(u,op)
@@ -96,12 +97,12 @@ makePrefixForm(u,op) ==
 --=======================================================================
 --               Generate Slot 3 Predicate Vector
 --=======================================================================
-makePredicateBitVector pl ==   --called by buildFunctor
+makePredicateBitVector(pl,e) ==   --called by buildFunctor
   if $insideCategoryPackageIfTrue then
     pl := union(pl,$categoryPredicateList)
   $predGensymAlist := nil --bound by buildFunctor, used by optHas
   for p in removeAttributePredicates pl repeat
-    pred := simpBool transHasCode p
+    pred := simpBool transHasCode(p,e)
     pred isnt [.,:.] => 'skip                --skip over T and nil
     if isHasDollarPred pred then 
       lasts := insert(pred,lasts)
@@ -151,12 +152,12 @@ removeAttributePredicates pl ==
       p
     fnl p == [fn x for x in p]
  
-transHasCode x ==
+transHasCode(x,e) ==
   x isnt [.,:.] => x
   op := x.op
   op in '(HasCategory HasAttribute) => x
-  op="has" => compHasFormat x
-  [transHasCode y for y in x]
+  op="has" => compHasFormat(x,e)
+  [transHasCode(y,e) for y in x]
  
 mungeAddGensyms(u,gal) ==
   ['%list,:[fn(x,gal,0) for x in u]] where fn(x,gal,n) ==
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 6171d4eb..3070bd71 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -473,7 +473,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
   $GENNO: local:= 0     --bound in compDefineFunctor1, then as parameter here
   $catvecList: local := nil   --list of vectors v1..vn for each view
   $hasCategoryAlist: local := nil  --list of GENSYMs bound to (HasCategory ..) items
-  $catsig: local := nil        --target category (used in ProcessCond)
+  $catsig: local := nil        --target category
   $SetFunctions: local := nil  --copy of p view with preds telling when fnct defined
   $ConstantAssignments: local := nil --code for creation of constants
   $epilogue: local := nil     --code to set slot 5, things to be done last
@@ -514,7 +514,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
   [$uncondAlist,:$condAlist] :=    --bound in compDefineFunctor1
       NRTsetVector4Part1(viewNames,catvecListMaker,condCats)
   [$NRTslot1PredicateList,predBitVectorCode1,:predBitVectorCode2] :=
-      makePredicateBitVector [:ASSOCRIGHT $condAlist,:$NRTslot1PredicateList]
+    makePredicateBitVector([:ASSOCRIGHT $condAlist,:$NRTslot1PredicateList],$e)
 
   storeOperationCode := DescendCode(code,true,nil)
   NRTaddDeltaCode()