diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 4 | ||||
| -rw-r--r-- | src/interp/category.boot | 4 | ||||
| -rw-r--r-- | src/interp/define.boot | 43 |
4 files changed, 33 insertions, 25 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 7cd76c99..c0e9bcbf 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2011-08-08 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/c-util.boot (categoryHierarchy): New. + * interp/category.boot (mkCategory): Use it. + * interp/define.boot (NRTgetLookupFunction): Tidy. + (catExtendsCat?): Lose last argument. Adjust callers. + 2011-08-07 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/define.boot (templateVal): Fold into expantTypeArgs. Remove. diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index af1888ec..1d281ea8 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -81,6 +81,10 @@ macro categoryExports d == macro categoryAttributes d == categoryRef(d,2) +++ Return a 3-list of data describing the hierarchy of category `c'. +macro categoryHierarchy c == + categoryRef(c,4) + ++ Return the predicate values associated with the domain object. ++ This is an integer interpreted as bit vector macro domainPredicates d == diff --git a/src/interp/category.boot b/src/interp/category.boot index 1a9073e2..80d1fe86 100644 --- a/src/interp/category.boot +++ b/src/interp/category.boot @@ -120,10 +120,10 @@ mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) == if PrincipalAncestor ~= nil then for x in 6..#PrincipalAncestor-1 repeat categoryRef(v,x) := PrincipalAncestor.x - categoryRef(v,4) := + categoryHierarchy(v) := [first PrincipalAncestor.4,second PrincipalAncestor.4,OldLocals] else - categoryRef(v,4) := [nil,nil,OldLocals] --associated categories and domains + categoryHierarchy(v) := [nil,nil,OldLocals] categoryRef(v,5) := domList for [nsig,:n] in NSigList repeat categoryRef(v,n) := nsig diff --git a/src/interp/define.boot b/src/interp/define.boot index 22c0711d..80145927 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -274,17 +274,16 @@ NRTgetLookupFunction(domform,exCategory,addForm) == addForm := applySubst($pairlis,addForm) $why: local := nil addForm isnt [.,:.] => 'lookupComplete - extends := NRTextendsCategory1(domform,exCategory,getExportCategory addForm) - if null extends then - [u,msg,:v] := $why - SAY '"--------------non extending category----------------------" - sayPatternMsg('"%1p of category %2p", [domform,u]) - if v ~= nil then - sayPatternMsg('"%1b %2p",[msg,first v]) - else - sayPatternMsg('"%1b",[msg]) - SAY '"----------------------------------------------------------" - extends => 'lookupIncomplete + NRTextendsCategory1(domform,exCategory,getExportCategory addForm) => + 'lookupIncomplete + [u,msg,:v] := $why + SAY '"--------------non extending category----------------------" + sayPatternMsg('"%1p of category %2p", [domform,u]) + if v ~= nil then + sayPatternMsg('"%1b %2p",[msg,first v]) + else + sayPatternMsg('"%1b",[msg]) + SAY '"----------------------------------------------------------" 'lookupComplete getExportCategory form == @@ -320,27 +319,25 @@ extendsCategory(dom,u,v) == extendsCategoryBasic(dom,u,v) == v is ['IF,p,['ATTRIBUTE,c],.] => - uVec := (compMakeCategoryObject(u,$EmptyEnvironment)).expr + uVec := compMakeCategoryObject(u,$EmptyEnvironment).expr cons? c and isCategoryForm(c,nil) => - slot4 := vectorRef(uVec,4) - LASSOC(c,second slot4) is [=p,:.] - slot2 := vectorRef(uVec,2) - LASSOC(c,slot2) is [=p,:.] + LASSOC(c,second categoryHierarchy uVec) is [=p,:.] + LASSOC(c,categoryAttributes uVec) is [=p,:.] u is ["Join",:l] => or/[extendsCategoryBasic(dom,x,v) for x in l] u = v => true - uVec := (compMakeCategoryObject(u,$EmptyEnvironment)).expr - isCategoryForm(v,nil) => catExtendsCat?(u,v,uVec) + isCategoryForm(v,nil) => catExtendsCat?(u,v) v is ['SIGNATURE,op,sig] => - or/[vectorRef(uVec,i) is [[=op,=sig],:.] for i in 6..maxIndex uVec] + uVec := compMakeCategoryObject(u,$EmptyEnvironment).expr + or/[categoryRef(uVec,i) is [[=op,=sig],:.] for i in 6..maxIndex uVec] u is ['CATEGORY,.,:l] => v is ['IF,:.] => listMember?(v,l) false false -catExtendsCat?(u,v,uvec) == +catExtendsCat?(u,v) == u = v => true - uvec := uvec or (compMakeCategoryObject(u,$EmptyEnvironment)).expr - slot4 := vectorRef(uvec,4) + uvec := compMakeCategoryObject(u,$EmptyEnvironment).expr + slot4 := categoryHierarchy uvec prinAncestorList := first slot4 listMember?(v,prinAncestorList) => true vOp := KAR v @@ -350,7 +347,7 @@ catExtendsCat?(u,v,uvec) == PRINT similarForm sayBrightlyNT '" but not " PRINT v - or/[catExtendsCat?(x,v,nil) for x in ASSOCLEFT second slot4] + or/[catExtendsCat?(x,v) for x in ASSOCLEFT second slot4] substSlotNumbers(form,template,domain) == form is [op,:.] and |