aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-08-19 09:28:19 +0000
committerdos-reis <gdr@axiomatics.org>2011-08-19 09:28:19 +0000
commit2b21dbe204cbf48aefdf0f2ac591d4f05722c4df (patch)
treed0d404da7bfe9ca5a6d096c708dd180a4c937d63 /src/interp
parent9b0a1395071e204c7f85473809c751e39e5adbb8 (diff)
downloadopen-axiom-2b21dbe204cbf48aefdf0f2ac591d4f05722c4df.tar.gz
* interp/category.boot (mkOr): Taken environment as parameter.
Adjust callers. (mkOr2): Likewise. (mkAnd): Likewise. (mkAnd2): Likewise. (FindFundAncs): Likewise. (CatEval): Likewise. (AncestorP): Likewise. (CondAncestorP): Likewise. (DescendantP): Likewise. * interp/compiler.boot (compMapCond): Likewise. (compMapCond'): Likewise. * interp/define.boot (formatPred): Likewise. (formatInfo): Likewise. (addInfo): Likewise. (knownPred): Likewise. * interp/functor.boot (InvestigateConditions): Likewise. (ICformat): Likewise.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/category.boot118
-rw-r--r--src/interp/compiler.boot20
-rw-r--r--src/interp/define.boot91
-rw-r--r--src/interp/functor.boot52
-rw-r--r--src/interp/nruncomp.boot2
5 files changed, 142 insertions, 141 deletions
diff --git a/src/interp/category.boot b/src/interp/category.boot
index e73cccd9..dd5a9839 100644
--- a/src/interp/category.boot
+++ b/src/interp/category.boot
@@ -175,13 +175,13 @@ SigListUnion(extra,original) ==
original := [x,:original]
else
original:= [[xsig,xpred,["Subsumed",:esig]],:original]
- else epred:=mkOr(epred,xpred)
+ else epred := mkOr(epred,xpred,$e)
-- this used always to be done, as noted below, but that's not safe
if not(ximplem is [["Subsumed",:.],:.]) then eimplem:= ximplem
if eimplem then esig:=[first esig,second esig]
-- in case there's a constant marker
e:= [esig,epred,:eimplem]
--- e:= [esig,mkOr(xpred,epred),:ximplem]
+-- e:= [esig,mkOr(xpred,epred,$e),:ximplem]
-- Original version -gets it wrong if the new operator is only
-- present under certain conditions
-- We must pick up the previous implementation, if any
@@ -191,18 +191,18 @@ SigListUnion(extra,original) ==
original:= [e,:original]
original
-mkOr: (%Form,%Form) -> %Form
-mkOr(a,b) ==
+mkOr: (%Form,%Form,%Env) -> %Form
+mkOr(a,b,e) ==
a=true => true
b=true => true
b=a => a
l:=
a is ["OR",:a'] =>
- (b is ["OR",:b'] => union(a',b'); mkOr2(b,a') )
- b is ["OR",:b'] => mkOr2(a,b')
+ (b is ["OR",:b'] => union(a',b'); mkOr2(b,a',e) )
+ b is ["OR",:b'] => mkOr2(a,b',e)
(a is ["has",avar,acat]) and (b is ["has",=avar,bcat]) =>
- DescendantP(acat,bcat) => [b]
- DescendantP(bcat,acat) => [a]
+ DescendantP(acat,bcat,e) => [b]
+ DescendantP(bcat,acat,e) => [a]
[a,b]
a is ['AND,:a'] and listMember?(b,a') => [b]
b is ['AND,:b'] and listMember?(a,b') => [a]
@@ -212,47 +212,47 @@ mkOr(a,b) ==
#l = 1 => first l
["OR",:l]
-mkOr2: (%Form,%Form) -> %Form
-mkOr2(a,b) ==
+mkOr2: (%Form,%Form,%Env) -> %Form
+mkOr2(a,b,e) ==
--a is a condition, "b" a list of them
listMember?(a,b) => b
a is ["has",avar,acat] =>
aRedundant:=false
for c in b | c is ["has",=avar,ccat] repeat
- DescendantP(acat,ccat) =>
+ DescendantP(acat,ccat,e) =>
return (aRedundant:=true)
- if DescendantP(ccat,acat) then b := remove(b,c)
+ if DescendantP(ccat,acat,e) then b := remove(b,c)
aRedundant => b
[a,:b]
[a,:b]
-mkAnd: (%Form,%Form) -> %Form
-mkAnd(a,b) ==
+mkAnd: (%Form,%Form,%Env) -> %Form
+mkAnd(a,b,e) ==
a=true => b
b=true => a
b=a => a
l:=
a is ["AND",:a'] =>
- (b is ["AND",:b'] => union(a',b'); mkAnd2(b,a') )
- b is ["AND",:b'] => mkAnd2(a,b')
+ (b is ["AND",:b'] => union(a',b'); mkAnd2(b,a',e) )
+ b is ["AND",:b'] => mkAnd2(a,b',e)
(a is ["has",avar,acat]) and (b is ["has",=avar,bcat]) =>
- DescendantP(acat,bcat) => [a]
- DescendantP(bcat,acat) => [b]
+ DescendantP(acat,bcat,e) => [a]
+ DescendantP(bcat,acat,e) => [b]
[a,b]
[a,b]
#l = 1 => first l
["AND",:l]
-mkAnd2: (%Form,%Form) -> %Form
-mkAnd2(a,b) ==
+mkAnd2: (%Form,%Form,%Env) -> %Form
+mkAnd2(a,b,e) ==
--a is a condition, "b" a list of them
listMember?(a,b) => b
a is ["has",avar,acat] =>
aRedundant:=false
for c in b | c is ["has",=avar,ccat] repeat
- DescendantP(ccat,acat) =>
+ DescendantP(ccat,acat,e) =>
return (aRedundant:=true)
- if DescendantP(acat,ccat) then b := remove(b,c)
+ if DescendantP(acat,ccat,e) then b := remove(b,c)
aRedundant => b
[a,:b]
[a,:b]
@@ -303,71 +303,70 @@ MachineLevelSubset(a,b) ==
--% Ancestor chasing code
-FindFundAncs l ==
+FindFundAncs(l,e) ==
--l is a list of categories and associated conditions (a list of 2-lists
--returns a list of them and all their fundamental ancestors
--also as two-lists with the appropriate conditions
l=nil => nil
- f1:= CatEval CAAR 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 categoryAncestors f1] repeat
+ f1 := CatEval(CAAR l,e)
+ canonicalForm f1 = nil => FindFundAncs(rest l,e)
+ ans := FindFundAncs(rest l,e)
+ for u in FindFundAncs([[CatEval(first x,e),mkAnd(CADAR l,second x,e)]
+ for x in categoryAncestors f1],e) repeat
x:= ASSQ(first u,ans) =>
- ans:= [[first u,mkOr(second x,second u)],:remove(ans,x)]
+ ans:= [[first u,mkOr(second x,second u,e)],: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)]
+ x:= ASSQ(CAAR l,ans) => [[CAAR l,mkOr(CADAR l,second x,e)],:remove(ans,x)]
CADAR l=true =>
for x in categoryPrincipals f1 repeat
- if y:= ASSQ(CatEval x,ans) then ans := remove(ans,y)
+ if y:= ASSQ(CatEval(x,e),ans) then ans := remove(ans,y)
[first l,:ans]
for x in categoryPrincipals f1 repeat
- if y:= ASSQ(CatEval x,ans) then ans:=
- [[first y,mkOr(CADAR l,second y)],:remove(ans,y)]
+ if y:= ASSQ(CatEval(x,e),ans) then ans:=
+ [[first y,mkOr(CADAR l,second y,e)],:remove(ans,y)]
[first l,:ans]
-- Our new thing may have, as an alternate view, a principal
-- descendant of something previously added which is therefore
-- subsumed
-CatEval: %Thing -> %Shell
-CatEval x ==
+CatEval: (%Thing,%Env) -> %Shell
+CatEval(x,e) ==
vector? x => x
- e :=
- $InteractiveMode => $CategoryFrame
- $e
+ if $InteractiveMode then
+ e := $CategoryFrame
compMakeCategoryObject(x,e).expr
-AncestorP: (%Form, %List %Instantiation) -> %Form
-AncestorP(xname,leaves) ==
+AncestorP: (%Form,%List %Instantiation,%Env) -> %Form
+AncestorP(xname,leaves,env) ==
-- checks for being a principal ancestor of one of the leaves
listMember?(xname,leaves) => xname
for y in leaves repeat
- listMember?(xname,categoryPrincipals CatEval y) => return y
+ listMember?(xname,categoryPrincipals CatEval(y,env)) => return y
-CondAncestorP(xname,leaves,condition) ==
+CondAncestorP(xname,leaves,condition,env) ==
-- checks for being a principal ancestor of one of the leaves
for u in leaves repeat
u':=first u
ucond:=
null rest u => true
second u
- xname = u' or listMember?(xname,categoryPrincipals CatEval u') =>
+ xname = u' or listMember?(xname,categoryPrincipals CatEval(u',env)) =>
PredImplies(ucond,condition) => return u'
++ Returns true if the form `a' designates a category that is any
++ kind of descendant of the category designated by the form `b'.
-DescendantP: (%Form,%Form) -> %Boolean
-DescendantP(a,b) ==
+DescendantP: (%Form,%Form,%Env) -> %Boolean
+DescendantP(a,b,e) ==
a=b => true
a is ["ATTRIBUTE",:.] => false
a is ["SIGNATURE",:.] => false
- a:= CatEval a
+ a:= CatEval(a,e)
b is ["ATTRIBUTE",b'] =>
(l := assoc(b',categoryAttributes a)) => TruthP second l
listMember?(b,categoryPrincipals a) => true
- AncestorP(b,[first u for u in categoryAncestors a]) => true
+ AncestorP(b,[first u for u in categoryAncestors a],e) => true
false
--% The implementation of Join
@@ -388,16 +387,17 @@ JoinInner(l,$e) ==
pred:= second at
-- The predicate under which this category is conditional
listMember?(pred,get("$Information","special",$e)) =>
- l:= [:l,CatEval at2]
+ l:= [:l,CatEval(at2,$e)]
--It's true, so we add this as unconditional
- not (pred is ["and",:.]) => CondList:= [[CatEval at2,pred],:CondList]
+ pred isnt ["and",:.] =>
+ CondList := [[CatEval(at2,$e),pred],:CondList]
pred':=
[u
for u in rest pred | not listMember?(u,get("$Information","special",$e))
and not (u=true)]
- null pred' => l:= [:l,CatEval at2]
- # pred'=1 => CondList:= [[CatEval at2,pred'],:CondList]
- CondList:= [[CatEval at2,["and",:pred']],:CondList]
+ null pred' => l:= [:l,CatEval(at2,$e)]
+ # pred'=1 => CondList:= [[CatEval(at2,$e),pred'],:CondList]
+ CondList:= [[CatEval(at2,$e),["and",:pred']],:CondList]
[$NewCatVec,:l]:= l
l':= [:CondList,:[[u,true] for u in l]]
-- This is a list of all the categories that this extends
@@ -414,17 +414,17 @@ JoinInner(l,$e) ==
-- this flag helps us detect this case
originalVector := false
-- this skips buggy code which discards needed categories
- for [b,condition] in FindFundAncs l' repeat
+ for [b,condition] in FindFundAncs(l',$e) repeat
--This loop implements Category Subsumption
--as described in JHD's report
if not (b.0=nil) then
--It's a named category
bname:= b.0
- CondAncestorP(bname,FundamentalAncestors,condition) => nil
- (f:=AncestorP(bname,[first u for u in FundamentalAncestors])) =>
+ CondAncestorP(bname,FundamentalAncestors,condition,$e) => nil
+ (f:=AncestorP(bname,[first u for u in FundamentalAncestors],$e)) =>
[.,.,index]:=assoc(f,FundamentalAncestors)
FundamentalAncestors:=[[bname,condition,index],:FundamentalAncestors]
- PrinAncb := categoryPrincipals CatEval bname
+ PrinAncb := categoryPrincipals CatEval(bname,$e)
--Principal Ancestors of b
reallynew:= true
for anc in FundamentalAncestors repeat
@@ -455,7 +455,7 @@ JoinInner(l,$e) ==
then ($NewCatVec.ancindex:= bname; reallynew:= nil)
else
if originalVector and (condition=true) then
- $NewCatVec:= CatEval bname
+ $NewCatVec:= CatEval(bname,$e)
copied:= nil
FundamentalAncestors:= [[bname],:categoryAncestors $NewCatVec]
--bname is Principal, so comes first
@@ -516,8 +516,8 @@ JoinInner(l,$e) ==
second v=true => nil
attl:= remove(attl,v)
attl:=
- second u=true => [[first u,mkOr(second v,newpred)],:attl]
- [[first u,mkOr(second v,mkAnd(newpred,second u))],:attl]
+ second u=true => [[first u,mkOr(second v,newpred,$e)],:attl]
+ [[first u,mkOr(second v,mkAnd(newpred,second u,$e),$e)],:attl]
sigl:=
SigListUnion(
[AddPredicate(DropImplementations u,newpred) for u in categoryExports(first b)],sigl) where
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index abf2f685..3e828bba 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1918,7 +1918,7 @@ compViableModemap(op,argTl,mm,e) ==
argTl = "failed" => nil
-- 2. obtain domain-specific function, if possible
- f := compMapCond(dc,fnsel) or return nil
+ f := compMapCond(dc,fnsel,e) or return nil
-- 3. Mark `f' as used.
-- We can no longer trust what the modemap says for a reference into
@@ -1948,13 +1948,13 @@ compApplyModemap(form,modemap,$e) ==
-- 2. Select viable modemap implementation.
compViableModemap(op,lt,modemap,$e)
-compMapCond': (%Form,%Mode) -> %Boolean
-compMapCond'(cexpr,dc) ==
+compMapCond': (%Form,%Mode,%Env) -> %Boolean
+compMapCond'(cexpr,dc,env) ==
cexpr=true => true
- cexpr is ["AND",:l] => and/[compMapCond'(u,dc) for u in l]
- cexpr is ["OR",:l] => or/[compMapCond'(u,dc) for u in l]
- cexpr is ["not",u] => not compMapCond'(u,dc)
- cexpr is ["has",name,cat] => (knownInfo cexpr => true; false)
+ cexpr is ["AND",:l] => and/[compMapCond'(u,dc,env) for u in l]
+ cexpr is ["OR",:l] => or/[compMapCond'(u,dc,env) for u in l]
+ cexpr is ["not",u] => not compMapCond'(u,dc,env)
+ cexpr is ["has",name,cat] => (knownInfo(cexpr,env) => true; false)
--for the time being we'll stop here - shouldn't happen so far
--$disregardConditionIfTrue => true
--stackSemanticError(("not known that",'"%b",name,
@@ -1965,9 +1965,9 @@ compMapCond'(cexpr,dc) ==
stackMessage('"not known that %1pb has %2pb",[dc,cexpr])
false
-compMapCond: (%Mode,%List %Code) -> %Code
-compMapCond(dc,[cexpr,fnexpr]) ==
- compMapCond'(cexpr,dc) => fnexpr
+compMapCond: (%Mode,%List %Code,%Env) -> %Code
+compMapCond(dc,[cexpr,fnexpr],env) ==
+ compMapCond'(cexpr,dc,env) => fnexpr
stackMessage('"not known that %1pb has %2pb",[dc,cexpr])
diff --git a/src/interp/define.boot b/src/interp/define.boot
index b1feafef..67802fc4 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -147,54 +147,53 @@ liftCond (clause is [ante,conseq]) ==
["and",pred,conj]
[clause]
-formatPred u ==
- --Assumes that $e is set up to point to an environment
+formatPred(u,e) ==
u is ["has",a,b] =>
- b isnt [.,:.] and isCategoryForm([b],$e) => ["has",a,[b]]
+ b isnt [.,:.] and isCategoryForm([b],e) => ["has",a,[b]]
b isnt [.,:.] => ["has",a,["ATTRIBUTE",b]]
- isCategoryForm(b,$e) => u
+ isCategoryForm(b,e) => u
b is ["ATTRIBUTE",.] => u
b is ["SIGNATURE",:.] => u
["has",a,["ATTRIBUTE",b]]
u isnt [.,:.] => u
- u is ["and",:v] => ["and",:[formatPred w for w in v]]
+ u is ["and",:v] => ["and",:[formatPred(w,e) for w in v]]
systemError ['"formatPred",u]
-formatInfo u ==
+formatInfo(u,e) ==
u isnt [.,:.] => u
u is ["SIGNATURE",:v] => ["SIGNATURE","$",:v]
- u is ["PROGN",:l] => ["PROGN",:[formatInfo v for v in l]]
+ u is ["PROGN",:l] => ["PROGN",:[formatInfo(v,e) for v in l]]
u is ["ATTRIBUTE",v] =>
-- The parser can't tell between those attributes that really
-- are attributes, and those that are category names
- v isnt [.,:.] and isCategoryForm([v],$e) => ["has","$",[v]]
+ v isnt [.,:.] and isCategoryForm([v],e) => ["has","$",[v]]
v isnt [.,:.] => ["ATTRIBUTE","$",v]
- isCategoryForm(v,$e) => ["has","$",v]
+ isCategoryForm(v,e) => ["has","$",v]
["ATTRIBUTE","$",v]
u is ["IF",a,b,c] =>
- c="%noBranch" => ['%when,:liftCond [formatPred a,formatInfo b]]
- b="%noBranch" => ['%when,:liftCond [["not",formatPred a],formatInfo c]]
- ['%when,:liftCond [formatPred a,formatInfo b],:
- liftCond [["not",formatPred a],formatInfo c]]
+ c is "%noBranch" =>
+ ['%when,:liftCond [formatPred(a,e),formatInfo(b,e)]]
+ b is "%noBranch" =>
+ ['%when,:liftCond [["not",formatPred(a,e)],formatInfo(c,e)]]
+ ['%when,:liftCond [formatPred(a,e),formatInfo(b,e)],:
+ liftCond [["not",formatPred(a,e)],formatInfo(c,e)]]
systemError ['"formatInfo",u]
-addInfo u ==
- $Information:= [formatInfo u,:$Information]
+addInfo(u,e) ==
+ $Information:= [formatInfo(u,e),:$Information]
-addInformation(m,$e) ==
+addInformation(m,e) ==
$Information: local := nil
- info m where
- info m ==
+ info(m,e) where
+ info(m,e) ==
--Processes information from a mode declaration in compCapsule
m isnt [.,:.] => nil
- m is ["CATEGORY",.,:stuff] => for u in stuff repeat addInfo u
- m is ["Join",:stuff] => for u in stuff repeat info u
+ m is ["CATEGORY",.,:stuff] => for u in stuff repeat addInfo(u,e)
+ m is ["Join",:stuff] => for u in stuff repeat info(u,e)
nil
- $e:=
- put("$Information","special",[:$Information,:
- get("$Information","special",$e)],$e)
- $e
+ put("$Information","special",
+ [:$Information,:get("$Information","special",e)],e)
hasToInfo (pred is ["has",a,b]) ==
b is ["SIGNATURE",:data] => ["SIGNATURE",a,:data]
@@ -203,48 +202,48 @@ hasToInfo (pred is ["has",a,b]) ==
++ Return true if we are certain that the information
++ denotated by `pred' is derivable from the current environment.
-knownInfo pred ==
+knownInfo(pred,env) ==
pred=true => true
- listMember?(pred,get("$Information","special",$e)) => true
- pred is ["OR",:l] => or/[knownInfo u for u in l]
- pred is ["AND",:l] => and/[knownInfo u for u in l]
- pred is ["or",:l] => or/[knownInfo u for u in l]
- pred is ["and",:l] => and/[knownInfo u for u in l]
+ listMember?(pred,get("$Information","special",env)) => true
+ pred is ["OR",:l] => or/[knownInfo(u,env) for u in l]
+ pred is ["AND",:l] => and/[knownInfo(u,env) for u in l]
+ pred is ["or",:l] => or/[knownInfo(u,env) for u in l]
+ pred is ["and",:l] => and/[knownInfo(u,env) for u in l]
pred is ["ATTRIBUTE",name,attr] =>
- v := compForMode(name,$EmptyMode,$e) or return
+ v := compForMode(name,$EmptyMode,env) or return
stackAndThrow('"can't find category of %1pb",[name])
- [vv,.,.] := compMakeCategoryObject(v.mode,$e) or return
+ [vv,.,.] := compMakeCategoryObject(v.mode,env) or return
stackAndThrow('"can't make category of %1pb",[name])
listMember?(attr,categoryAttributes vv) => true
- x := assoc(attr,categoryAttributes vv) => knownInfo second x
+ x := assoc(attr,categoryAttributes vv) => knownInfo(second x,env)
--format is a list of two elements: information, predicate
false
pred is ["has",name,cat] =>
- cat is ["ATTRIBUTE",:a] => knownInfo ["ATTRIBUTE",name,:a]
- cat is ["SIGNATURE",:a] => knownInfo ["SIGNATURE",name,:a]
+ cat is ["ATTRIBUTE",:a] => knownInfo(["ATTRIBUTE",name,:a],env)
+ cat is ["SIGNATURE",:a] => knownInfo(["SIGNATURE",name,:a],env)
-- unnamed category expressions imply structural checks.
- cat is ["Join",:.] => and/[knownInfo ["has",name,c] for c in cat.args]
+ cat is ["Join",:.] => and/[knownInfo(["has",name,c],env) for c in cat.args]
cat is ["CATEGORY",.,:atts] =>
- and/[knownInfo hasToInfo ["has",name,att] for att in atts]
+ and/[knownInfo(hasToInfo ["has",name,att],env) for att in atts]
name is ['Union,:.] => false
-- we have a named category expression
- v:= compForMode(name,$EmptyMode,$e) or return
+ v:= compForMode(name,$EmptyMode,env) or return
stackAndThrow('"can't find category of %1pb",[name])
vmode := v.mode
cat = vmode => true
vmode is ["Join",:l] and listMember?(cat,l) => true
- [vv,.,.]:= compMakeCategoryObject(vmode,$e) or return
+ [vv,.,.]:= compMakeCategoryObject(vmode,env) or return
stackAndThrow('"cannot find category %1pb",[vmode])
listMember?(cat,categoryPrincipals vv) => true --checks princ. ancestors
- (u:=assoc(cat,categoryAncestors vv)) and knownInfo second u => true
+ (u:=assoc(cat,categoryAncestors vv)) and knownInfo(second u,env) => 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 categoryAncestors vv | knownInfo second u] => true
+ or/[AncestorP(cat,[first u],env)
+ for u in categoryAncestors vv | knownInfo(second u,env)] => true
false
pred is ["SIGNATURE",name,op,sig,:.] =>
- v:= get(op,"modemap",$e)
+ v:= get(op,"modemap",env)
for w in v repeat
ww := w.mmSignature --the actual signature part
ww = sig =>
@@ -340,7 +339,7 @@ infoToHas a ==
chaseInferences(pred,$e) ==
foo hasToInfo pred where
foo pred ==
- knownInfo pred => nil
+ knownInfo(pred,$e) => nil
$e:= actOnInfo(pred,$e)
pred:= infoToHas pred
for u in get("$Information","special",$e) repeat
@@ -1114,7 +1113,7 @@ getModemap(x is [op,:.],e) ==
addModemap(op,mc,sig,pred,fn,$e) ==
$InteractiveMode => $e
- if knownInfo pred then pred:=true
+ if knownInfo(pred,$e) then pred:=true
$insideCapsuleFunctionIfTrue =>
$CapsuleModemapFrame :=
addModemap0(op,mc,sig,pred,fn,$CapsuleModemapFrame)
@@ -1919,7 +1918,7 @@ getSignature(op,argModeList,$e) ==
removeDuplicates
[sig
for [[dc,:sig],[pred,:.]] in (mmList:= get(op,'modemap,$e)) | dc='_$
- and sig.source = argModeList and knownInfo pred]) => first sigl
+ and sig.source = argModeList and knownInfo(pred,$e)]) => first sigl
null sigl =>
(u:= getmode(op,$e)) is ['Mapping,:sig] => sig
SAY '"************* USER ERROR **********"
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index d3c5823c..f8a2ff11 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -585,7 +585,7 @@ makeMissingFunctionEntry(alist,i) ==
--% Under what conditions may views exist?
-InvestigateConditions catvecListMaker ==
+InvestigateConditions(catvecListMaker,env) ==
-- given a principal view and a list of secondary views,
-- discover under what conditions the secondary view are
-- always present.
@@ -626,8 +626,10 @@ InvestigateConditions catvecListMaker ==
[true,:[true for u in secondaries]]
$HackSlot4:=
MinimalPrimary=MaximalPrimary => nil
- MaximalPrimaries:=[MaximalPrimary,:categoryPrincipals CatEval MaximalPrimary]
- MinimalPrimaries:=[MinimalPrimary,:categoryPrincipals CatEval MinimalPrimary]
+ MaximalPrimaries :=
+ [MaximalPrimary,:categoryPrincipals CatEval(MaximalPrimary,env)]
+ MinimalPrimaries :=
+ [MinimalPrimary,:categoryPrincipals CatEval(MinimalPrimary,env)]
MaximalPrimaries:=S_-(MaximalPrimaries,MinimalPrimaries)
[[x] for x in MaximalPrimaries]
($Conditions:= Conds($principal,nil)) where
@@ -657,31 +659,31 @@ InvestigateConditions catvecListMaker ==
# u=1 => first u
['AND,:u]
for [v,:.] in newS repeat
- for v' in [v,:categoryPrincipals CatEval v] repeat
+ for v' in [v,:categoryPrincipals CatEval(v,env)] 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
- update(list,cond,secondaries,newS) ==
+ w.rest := if rest w then mkOr(u,rest w,env) else u
+ (list:= update(list,u,secondaries,newS,env)) where
+ update(list,cond,secondaries,newS,env) ==
(list2:=
- [flist(sec,newS,old,cond) for sec in secondaries for old in list]) where
- flist(sec,newS,old,cond) ==
+ [flist(sec,newS,old,cond,env) for sec in secondaries for old in list]) where
+ flist(sec,newS,old,cond,env) ==
old=true => old
for [newS2,:morecond] in newS repeat
old:=
- not AncestorP(sec,[newS2]) => old
- cond2:= mkAnd(cond,morecond)
+ not AncestorP(sec,[newS2],env) => old
+ cond2 := mkAnd(cond,morecond,env)
null old => cond2
- mkOr(cond2,old)
+ mkOr(cond2,old,env)
old
list2
- list:= [[sec,:ICformat u] for u in list for sec in secondaries]
+ list:= [[sec,:ICformat(u,env)] for u in list for sec in secondaries]
pv:= getPossibleViews $principal
-- $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 for u in $HackSlot4]) where
- reshape u ==
- ['%when,[TryGDC ICformat rest u],
+ ($HackSlot4:= [reshape(u,env) for u in $HackSlot4]) where
+ reshape(u,env) ==
+ ['%when,[TryGDC ICformat(rest u,env)],
['%otherwise,['RPLACA,'(CAR TrueDomain),
['delete,['QUOTE,first u],'(CAAR TrueDomain)]]]]
$supplementaries:=
@@ -690,32 +692,32 @@ InvestigateConditions catvecListMaker ==
and not (true=rest u) and not listMember?(first u,pv)]
[true,:[LASSOC(ms,list) for ms in masterSecondaries]]
-ICformat u ==
+ICformat(u,env) ==
u isnt [.,:.] => u
u is ["has",:.] => compHasFormat u
u is ['AND,:l] or u is ['and,:l] =>
- l:= removeDuplicates [ICformat v for [v,:l'] in tails l
+ l:= removeDuplicates [ICformat(v,env) for [v,:l'] in tails l
| not listMember?(v,l')]
-- we could have duplicates after, even if not before
# l=1 => first l
l1:= first l
for u in rest l repeat
- l1:=mkAnd(u,l1)
+ l1 := mkAnd(u,l1,env)
l1
u is ['OR,:l] =>
(l:= ORreduce l)
- # l=1 => ICformat first l
- l:= ORreduce removeDuplicates [ICformat u for u in l]
+ # l=1 => ICformat(first l,env)
+ l:= ORreduce removeDuplicates [ICformat(u,env) for u in l]
--causes multiple ANDs to be squashed, etc.
-- and duplicates that have been built up by tidying
- (l:= Hasreduce l) where
- Hasreduce l ==
+ (l:= Hasreduce(l,env)) where
+ Hasreduce(l,env) ==
for u in l | u is ['HasCategory,name,cond] and cond is ['QUOTE,
cond] repeat
--check that v causes descendants to go
for v in l | not (v=u) and v is ['HasCategory, =name,['QUOTE,
cond2]] repeat
- if DescendantP(cond,cond2) then l:= remove(l,u)
+ if DescendantP(cond,cond2,env) then l:= remove(l,u)
--v subsumes u
for u in l | u is ['AND,:l'] or u is ['and,:l'] repeat
for u' in l' | u' is ['HasCategory,name,cond] and cond is ['QUOTE,
@@ -723,7 +725,7 @@ ICformat u ==
--check that v causes descendants to go
for v in l | v is ['HasCategory, =name,['QUOTE,
cond2]] repeat
- if DescendantP(cond,cond2) then l:= remove(l,u)
+ if DescendantP(cond,cond2,env) then l:= remove(l,u)
--v subsumes u
l
# l=1 => first l
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index d8703729..8f0fff7d 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -491,7 +491,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
catvecListMaker := removeDuplicates
[comp($catsig,$EmptyMode,$e).expr,
:[compCategories u for [u,:.] in categoryAncestors $domainShell]]
- condCats := InvestigateConditions [$catsig,:rest catvecListMaker]
+ condCats := InvestigateConditions([$catsig,:rest catvecListMaker],$e)
-- a list, one %for each element of catvecListMaker
-- indicating under what conditions this
-- category should be present. true => always