diff options
Diffstat (limited to 'src/interp/category.boot.pamphlet')
| -rw-r--r-- | src/interp/category.boot.pamphlet | 49 |
1 files changed, 26 insertions, 23 deletions
diff --git a/src/interp/category.boot.pamphlet b/src/interp/category.boot.pamphlet index 0dfa2b45..5da2cc25 100644 --- a/src/interp/category.boot.pamphlet +++ b/src/interp/category.boot.pamphlet @@ -32,21 +32,21 @@ mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) == else s for s in sigList] NewLocals:= nil for s in sigList repeat - ((NewLocals:= union(NewLocals,Prepare CADAR s)) where - Prepare u == "union"/[Prepare2 v for v in u]) where - Prepare2 v == - v is "$" => nil - STRINGP v => nil - atom v => [v] - MEMQ(first v,$PrimitiveDomainNames) => nil - --This variable is set in INIT LISP - --It is a list of all the domains that we need not cache - v is ["Union",:w] => - "union"/[Prepare2 x for x in stripUnionTags w] - v is ["Mapping",:w] => "union"/[Prepare2 x for x in w] - v is ["List",w] => Prepare2 w - v is ["Record",.,:w] => "union"/[Prepare2 CADDR x for x in w] - [v] + NewLocals:= union(NewLocals,Prepare CADAR s) where + Prepare u == "union"/[Prepare2 v for v in u] + Prepare2 v == + v is "$" => nil + STRINGP v => nil + atom v => [v] + MEMQ(first v,$PrimitiveDomainNames) => nil + --This variable is set in INIT LISP + --It is a list of all the domains that we need not cache + v is ["Union",:w] => + "union"/[Prepare2 x for x in stripUnionTags w] + v is ["Mapping",:w] => "union"/[Prepare2 x for x in w] + v is ["List",w] => Prepare2 w + v is ["Record",.,:w] => "union"/[Prepare2 CADDR x for x in w] + [v] OldLocals:= nil if PrincipalAncestor then for u in (OldLocals:= CADDR PrincipalAncestor.4) repeat NewLocals:= delete(first u,NewLocals) @@ -163,6 +163,9 @@ copy. @ <<*>>= <<license>> + +import '"g-util" +)package "BOOT" -- Functions for building categories @@ -225,7 +228,7 @@ SigListUnion(extra,original) == not MachineLevelSubsume(QCAR e,QCAR x) => --systemError '"Source level subsumption not implemented" original:= [e,:original] - return() -- this exits from the innermost for loop + return nil -- this exits from the innermost for loop original:= delete(x,original) [xsig,xpred,:ximplem]:= x -- if xsig ^= esig then -- not quite strong enough @@ -359,8 +362,8 @@ SourceLevelSubset(a,b) == $noSubsumption=true => false b is ["Union",:blist] and member(a,blist) => true BOUNDP '$noSubsets and $noSubsets => false - atom b and ASSOC(a,GETL(b,"Subsets")) => true - a is [a1] and b is [b1] and ASSOC(a1,GETL(b1,"Subsets")) => true + atom b and assoc(a,GETL(b,"Subsets")) => true + a is [a1] and b is [b1] and assoc(a1,GETL(b1,"Subsets")) => true nil MachineLevelSubsume([name1,[out1,:in1],:flag1],[name2,[out2,:in2],:flag2]) == @@ -377,8 +380,8 @@ MachineLevelSubset(a,b) == b is ["Union",:blist] and member(a,blist) and (and/[STRINGP x for x in blist | x^=a]) => true --all other branches must be distinct objects - atom b and ASSOC(a,GETL(b,"Subsets")) => true - a is [a1] and b is [b1] and ASSOC(a1,GETL(b1,"Subsets")) => true + atom b and assoc(a,GETL(b,"Subsets")) => true + a is [a1] and b is [b1] and assoc(a1,GETL(b1,"Subsets")) => true --we assume all subsets are true at the machine level nil @@ -444,7 +447,7 @@ DescendantP(a,b) == a is ["SIGNATURE",:.] => nil a:= CatEval a b is ["ATTRIBUTE",b'] => - (l:=ASSOC(b',a.2)) => TruthP CADR l + (l:=assoc(b',a.2)) => TruthP CADR l member(b,first a.4) => true AncestorP(b,[first u for u in CADR a.4]) => true nil @@ -501,7 +504,7 @@ JoinInner(l,$e) == bname:= b.(0) CondAncestorP(bname,FundamentalAncestors,condition) => nil (f:=AncestorP(bname,[first u for u in FundamentalAncestors])) => - [.,.,index]:=ASSOC(f,FundamentalAncestors) + [.,.,index]:=assoc(f,FundamentalAncestors) FundamentalAncestors:=[[bname,condition,index],:FundamentalAncestors] PrinAncb:= first (CatEval bname).(4) --Principal Ancestors of b @@ -577,7 +580,7 @@ JoinInner(l,$e) == for b in CondList repeat newpred:= first rest b for u in (first b).2 repeat - v:= ASSOC(first u,attl) + v:= assoc(first u,attl) null v => attl:= CADR u=true => [[first u,newpred],:attl] |