aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-11-14 09:10:24 +0000
committerdos-reis <gdr@axiomatics.org>2011-11-14 09:10:24 +0000
commit8d5fe26df40ed62aa60ec078858ed184bb0a82fb (patch)
treec428a5b67d00f64ced5b3e0497279dfbca364aa2
parent12a65643579cab809e4a7c95f6ebc9124da4bf3f (diff)
downloadopen-axiom-8d5fe26df40ed62aa60ec078858ed184bb0a82fb.tar.gz
* interp/category.boot ($NewCatVec): Remove.
(SigListUnion): Take the principal ancestor as third argument. Use it instead of $NewCatVec. Adjust caller. (JoinInner): Do not bind $NewCatVec. Introduce local variable principal. Tidy.
-rw-r--r--src/ChangeLog8
-rw-r--r--src/interp/category.boot187
2 files changed, 101 insertions, 94 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index b02f7608..6de75bde 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2011-11-14 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/category.boot ($NewCatVec): Remove.
+ (SigListUnion): Take the principal ancestor
+ as third argument. Use it instead of $NewCatVec. Adjust caller.
+ (JoinInner): Do not bind $NewCatVec. Introduce local variable
+ principal. Tidy.
+
2011-11-13 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/category.boot (filterConditionalCategories): Split out of
diff --git a/src/interp/category.boot b/src/interp/category.boot
index 78661e10..9639ee2a 100644
--- a/src/interp/category.boot
+++ b/src/interp/category.boot
@@ -41,8 +41,6 @@ namespace BOOT
++ List of global attributes.
$Attributes := []
-$NewCatVec := nil
-
--%
++ Returns true if `a' is a category (runtime) object.
@@ -139,7 +137,7 @@ DropImplementations a ==
[[:sig,'constant],pred]
a
-SigListUnion(extra,original) ==
+SigListUnion(extra,original,principal) ==
--augments original %with everything in extra that is not in original
for (o:=[[ofn,osig,:.],opred,:.]) in original repeat
-- The purpose of this loop is to detect cases when the
@@ -187,7 +185,7 @@ SigListUnion(extra,original) ==
-- We must pick up the previous implementation, if any
--+
if ximplem is [[q,.,index]] and integer? index and (q="ELT" or q="CONST")
- then $NewCatVec. index:= e
+ then principal . index:= e
original:= [e,:original]
original
@@ -392,20 +390,18 @@ filterConditionalCategories(l,e) ==
[conditionals,reverse! unconditionals]
JoinInner(l,$e) ==
- $NewCatVec: local := nil
[CondList,uncondList] := filterConditionalCategories(l,$e)
- [$NewCatVec,:l] := [:l,:uncondList]
+ [principal,:l] := [:l,:uncondList]
l' := [:CondList,:[[u,true] for u in l]]
-- This is a list of all the categories that this extends
-- conditionally or unconditionally
- sigl := categoryExports $NewCatVec
- attl := categoryAttributes $NewCatVec
- globalDomains := categoryParameters $NewCatVec
- FundamentalAncestors := categoryAncestors $NewCatVec
- if $NewCatVec.0 then FundamentalAncestors:=
- [[$NewCatVec.0],:FundamentalAncestors]
- --principal ancestor . all those already included
- copied:= nil
+ sigl := categoryExports principal
+ attl := categoryAttributes principal
+ globalDomains := categoryParameters principal
+ FundamentalAncestors := categoryAncestors principal
+ if principal.0 then
+ FundamentalAncestors := [[principal.0],:FundamentalAncestors]
+ copied := false
-- we can not decide to extend the vector in multiple ways
-- this flag helps us detect this case
originalVector := false
@@ -413,118 +409,121 @@ JoinInner(l,$e) ==
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
+ if bname := b.0 then
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]
+ f := AncestorP(bname,[first u for u in FundamentalAncestors],$e) =>
+ [.,.,index] := assoc(f,FundamentalAncestors)
+ FundamentalAncestors := [[bname,condition,index],:FundamentalAncestors]
PrinAncb := categoryPrincipals CatEval(bname,$e)
--Principal Ancestors of b
- reallynew:= true
+ reallynew := true
for anc in FundamentalAncestors repeat
if listMember?(first anc,PrinAncb) then
--This is the check for "Category Subsumption"
- if rest anc
- then (anccond:= second anc; ancindex:= third anc)
- else (anccond:= true; ancindex:= nil)
- if predicateImplies(anccond,condition)
- then FundamentalAncestors:=
+ if rest anc then
+ anccond := second anc
+ ancindex := third anc
+ else
+ anccond := true
+ ancindex := nil
+ if predicateImplies(anccond,condition) then
+ FundamentalAncestors :=
-- the new 'b' is more often true than the old one 'anc'
[[bname,condition,ancindex],:remove(FundamentalAncestors,anc)]
- else
- if ancindex then
+ else if ancindex then
--the new 'b' is less often true
- newentry:=[bname,condition,ancindex]
- if not listMember?(newentry,FundamentalAncestors) then
- FundamentalAncestors:= [newentry,:FundamentalAncestors]
- else ancindex:= nil
+ newentry := [bname,condition,ancindex]
+ if not listMember?(newentry,FundamentalAncestors) then
+ FundamentalAncestors := [newentry,:FundamentalAncestors]
+ else ancindex := nil
if not copied then
- $NewCatVec:= copyVector $NewCatVec
- copied:= true
- if ancindex
- then ($NewCatVec.ancindex:= bname; reallynew:= nil)
- else
- if originalVector and (condition=true) then
- $NewCatVec:= CatEval(bname,$e)
- copied:= nil
- FundamentalAncestors:= [[bname],:categoryAncestors $NewCatVec]
- --bname is Principal, so comes first
- reallynew:= nil
- objectMember?(b,l) =>
- --objectMember? since category vectors are guaranteed unique
- (sigl:= categoryExports $NewCatVec; attl:= categoryAttributes $NewCatVec; l:= remove(l,b))
- -- SAY("domain ",bname," subsumes")
- -- SAY("adding a conditional domain ",
- -- bname,
- -- " replacing",
- -- first anc)
- bCond := objectAssoc(b,CondList)
- CondList := remove(CondList,bCond)
- -- value of bCond not used and could be nil
- -- bCond:= second bCond
- globalDomains := categoryParameters $NewCatVec
- for u in categoryExports $NewCatVec repeat
- if not listMember?(u,sigl) then
- [s,c,i]:= u
- sigl :=
- c is true => [[s,condition,i],:sigl]
- [[s,["and",condition,c],i],:sigl]
- for u in categoryAttributes $NewCatVec repeat
- if not listMember?(u,attl) then
- [a,c]:= u
- attl :=
- c is true => [[a,condition],:attl]
- [[a,["and",condition,c]],:attl]
+ principal := copyVector principal
+ copied := true
+ if ancindex then
+ principal.ancindex := bname
+ reallynew := nil
+ else if originalVector and condition is true then
+ principal := CatEval(bname,$e)
+ copied := nil
+ FundamentalAncestors := [[bname],:categoryAncestors principal]
+ --bname is Principal, so comes first
+ reallynew := nil
+ objectMember?(b,l) =>
+ --objectMember? since category vectors are guaranteed unique
+ sigl := categoryExports principal
+ attl := categoryAttributes principal
+ l := remove(l,b)
+ -- SAY("domain ",bname," subsumes")
+ -- SAY("adding a conditional domain ",
+ -- bname,
+ -- " replacing",
+ -- first anc)
+ bCond := objectAssoc(b,CondList)
+ CondList := remove(CondList,bCond)
+ -- value of bCond not used and could be nil
+ -- bCond:= second bCond
+ globalDomains := categoryParameters principal
+ for u in categoryExports principal repeat
+ if not listMember?(u,sigl) then
+ [s,c,i] := u
+ sigl :=
+ c is true => [[s,condition,i],:sigl]
+ [[s,["and",condition,c],i],:sigl]
+ for u in categoryAttributes principal repeat
+ if not listMember?(u,attl) then
+ [a,c] := u
+ attl :=
+ c is true => [[a,condition],:attl]
+ [[a,["and",condition,c]],:attl]
if reallynew then
- n:= # $NewCatVec
- FundamentalAncestors:= [[b.0,condition,n],:FundamentalAncestors]
- $NewCatVec:= LENGTHENVEC($NewCatVec,n+1)
+ n := # principal
+ FundamentalAncestors := [[b.0,condition,n],:FundamentalAncestors]
+ principal := LENGTHENVEC(principal,n+1)
-- We need to copy the vector otherwise the FundamentalAncestors
-- list will get stepped on while compiling "If R has ... " code
-- Camm Maguire July 26, 2003
--- copied:= true
- copied:= false
- originalvector:= false
- $NewCatVec.n:= b.0
+-- copied := true
+ copied := false
+ originalvector := false
+ principal.n := b.0
if not copied then
- $NewCatVec:= copyVector $NewCatVec
+ principal := copyVector principal
-- It is important to copy the vector now,
-- in case SigListUnion alters it while
-- performing Operator Subsumption
for b in l repeat
- sigl:= SigListUnion([DropImplementations u for u in categoryExports b],sigl)
+ sigl := SigListUnion([DropImplementations u for u in categoryExports b],
+ sigl,principal)
attl := S_+(categoryAttributes b,attl)
- globalDomains:= [:globalDomains,:S_-(categoryParameters b,globalDomains)]
+ globalDomains := [:globalDomains,:S_-(categoryParameters b,globalDomains)]
for b in CondList repeat
- newpred:= second b
+ newpred := second b
for u in categoryAttributes first b repeat
- v:= assoc(first u,attl)
+ v := assoc(first u,attl)
null v =>
- attl:=
+ attl :=
second u is true => [[first u,newpred],:attl]
[[first u,["and",newpred,second u]],:attl]
- second v=true => nil
- attl:= remove(attl,v)
- attl:=
+ second v is true => nil
+ attl := remove(attl,v)
+ attl :=
second u is 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
+ sigl := SigListUnion(
+ [AddPredicate(DropImplementations u,newpred)
+ for u in categoryExports(first b)],sigl,principal) where
AddPredicate(op is [sig,oldpred,:implem],newpred) ==
newpred is true => op
oldpred is true => [sig,newpred,:implem]
[sig,mkpf([oldpred,newpred],"and"),:implem]
- FundamentalAncestors:= [x for x in FundamentalAncestors | rest x]
+ FundamentalAncestors := [x for x in FundamentalAncestors | rest x]
--strip out the pointer to Principal Ancestor
- c := categoryPrincipals $NewCatVec
- pName:= $NewCatVec.0
- if pName and not listMember?(pName,c) then c:= [pName,:c]
- categoryAssociatedTypes($NewCatVec) :=
- [c,FundamentalAncestors,categoryLocals $NewCatVec]
- mkCategory("domain",sigl,attl,globalDomains,$NewCatVec)
+ c := categoryPrincipals principal
+ pName := principal.0
+ if pName and not listMember?(pName,c) then c := [pName,:c]
+ categoryAssociatedTypes(principal) :=
+ [c,FundamentalAncestors,categoryLocals principal]
+ mkCategory("domain",sigl,attl,globalDomains,principal)
Join(:l) ==
e :=