diff options
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/interp/br-op1.boot | 2 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 2 | ||||
| -rw-r--r-- | src/interp/interop.boot | 4 | ||||
| -rw-r--r-- | src/interp/nrunfast.boot | 85 | ||||
| -rw-r--r-- | src/interp/showimp.boot | 2 |
6 files changed, 46 insertions, 56 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 594729cc..47b69ce4 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2011-08-12 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/nrunfast.boot (newLookupInTable): Compare domain and + dollar as objects, not as value. + (newLookupInCategories): Remove deadcode. + (newExpandGoGetTypes): Remove as unused. + 2011-08-11 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/define.boot (NRTgetLookupFunction): Handle the case where diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index 39340f6a..a7c1efa4 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -401,7 +401,7 @@ dbGatherDataImplementation(htPage,opAlist) == for (x := [.,.,:key]) in u for i in 0.. repeat key = domainForm => domexports := [x,:domexports] integer? key => unexports := [x,:unexports] - isDefaultPackageForm? key => defexports := [x,:defexports] + defaultPackageForm? key => defexports := [x,:defexports] key is 'nowhere => nowheres := [x,:nowheres] key is 'constant =>constants := [x,:constants] others := [x,:others] --add chain domains go here diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index dc663fa7..53926f37 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -877,7 +877,7 @@ isDefaultPackageName x == s := symbolName x stringChar(s,maxIndex s) = char "&" -isDefaultPackageForm? x == +defaultPackageForm? x == x is [op,:.] and ident? op and isDefaultPackageName op makeDefaultPackageName x == diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 5067a3f2..4d4f066e 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -473,7 +473,7 @@ hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) == success := nil $isDefaultingPackage: local := -- use special defaulting handler when dollar non-trivial - dollar ~= domain and isDefaultPackageForm? devaluate domain + dollar ~= domain and defaultPackageForm? devaluate domain while finish > start repeat PROGN i := start @@ -631,7 +631,7 @@ newHasCategory(domain,catform) == slot4 := domain.4 auxvec := first slot4 catvec := second slot4 - $isDefaultingPackage: local := isDefaultPackageForm? devaluate domain + $isDefaultingPackage: local := defaultPackageForm? devaluate domain #catvec > 0 and integer? KDR catvec.0 => --old style predIndex := lazyMatchAssocV1(catform,catvec,domain) null predIndex => false diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index 3424ecf1..23614946 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -191,16 +191,24 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) == success := nil $isDefaultingPackage: local := -- use special defaulting handler when dollar non-trivial - dollar ~= domain and isDefaultPackageForm? devaluate domain + not sameObject?(dollar,domain) and defaultPackageForm? canonicalForm domain while finish > start repeat do + -- a. Skip if non-matching arity. i := start - numArgs ~= (numTableArgs := arrayRef(numvec,i)) => nil - predIndex := arrayRef(numvec,i := i + 1) + numTableArgs := arrayRef(numvec,i) + numArgs ~= numTableArgs => nil + -- b. Skip if predicate untrue. + i := i + 1 + predIndex := arrayRef(numvec,i) predIndex ~= 0 and not testBitVector(predvec,predIndex) => nil - loc := newCompareSig(sig,numvec,(i := i + 1),dollar,domain) + -- c. Skip if differing signature. + i := i + 1 + loc := newCompareSig(sig,numvec,i,dollar,domain) null loc => nil --signifies no match - loc = 1 => (someMatch := true) + -- d. Should we consider for inherited operator? + loc = 1 => someMatch := true + -- e. Operator may be subsumed? loc = 0 => start := start + numTableArgs + 4 i := start + 2 @@ -211,18 +219,11 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) == if $monitorNewWorld then sayBrightly [formatOpSignature(op,sig),'"--?-->", formatOpSignature(op,subsumptionSig)] - nil slot := domainRef(domain,loc) cons? slot => - slot.op is 'newGoGet => someMatch:=true + slot.op is 'newGoGet => someMatch := true --treat as if operation were not there - --if sameObject?(QCAR slot,'newGoGet) then - -- UNWIND_-PROTECT --break infinite recursion - -- ((SETELT(domain,loc,'skip); slot := replaceGoGetSlot rest slot), - -- if domain.loc is 'skip then domain.loc := slot) return (success := slot) - slot is 'skip => --recursive call from above 'replaceGoGetSlot - return (success := newLookupInAddChain(op,sig,domain,dollar)) systemError '"unexpected format" start := start + numTableArgs + 4 success isnt 'failed and success => @@ -290,35 +291,22 @@ newLookupInCategories(op,sig,dom,dollar) == ident? entry => cat := vectorRef(catVec,i) packageForm := nil - if not property(entry,'LOADED) then loadLib entry + if property(entry,'LOADED) = nil then loadLib entry infovec := property(entry,'infovec) success := - --vector? infovec => ----new world - true => ----new world - opvec := infovec.1 - max := maxIndex opvec - code := getOpCode(op,opvec,max) - null code => nil - byteVector := CDDDR infovec.3 - endPos := - code + 2 > max => # byteVector - vectorRef(opvec,code+2) - not nrunNumArgCheck(#sig.source,byteVector,opvec.code,endPos) => nil - --numOfArgs := byteVector.(opvec.code) - --numOfArgs ~= #sig.source => nil - packageForm := [entry,'$,:rest cat] - package := evalSlotDomain(packageForm,dom) - vectorRef(packageVec,i) := package - package - ----old world - table := tableValue($Slot1DataBase,entry) or systemError nil - (u := LASSQ(op,table)) - and (v := or/[rest x for x in u | #sig = #x.0]) => - packageForm := [entry,'$,:rest cat] - package := evalSlotDomain(packageForm,dom) - vectorRef(packageVec,i) := package - package - nil + [.,opvec,:.] := infovec + max := maxIndex opvec + code := getOpCode(op,opvec,max) + null code => nil + [.,.,.,[.,.,.,:byteVector],:.] := infovec + endPos := + code + 2 > max => # byteVector + vectorRef(opvec,code+2) + not nrunNumArgCheck(#sig.source,byteVector,opvec.code,endPos) => nil + packageForm := [entry,'$,:rest cat] + package := evalSlotDomain(packageForm,dom) + vectorRef(packageVec,i) := package + package success = nil => if $monitorNewWorld then sayBrightlyNT '" not in: " @@ -432,17 +420,16 @@ lazyMatchArg(s,a,dollar,domain) == lazyMatchArg2(s,a,dollar,domain,true) lazyMatchArg2(s,a,dollar,domain,typeFlag) == if s is '$ then - -- a = 0 => return true --needed only if extra call in newGoGet to basicLookup s := devaluate dollar -- calls from HasCategory can have $s integer? a => not typeFlag => s = domainRef(domain,a) a = 6 and $isDefaultingPackage => s = devaluate dollar - vector? (d := domainVal(dollar,domain,a)) => - s = d.0 => true + d := domainVal(dollar,domain,a) + vector? d => + s = canonicalForm d => true domainArg := ($isDefaultingPackage => domain.6.0; domain.0) - KAR s = first d.0 and + KAR s = canonicalForm(d).op and lazyMatchArgDollarCheck(replaceSharpCalls s,d.0,dollar.0,domainArg) - --vector? first d => lazyMatch(s,CDDR d,dollar,domain) --old style (erase) lazyMatch(replaceSharpCalls s,d,dollar,domain) --new style a is '$ => s = devaluate dollar a is "$$" => s = devaluate domain @@ -451,7 +438,7 @@ lazyMatchArg2(s,a,dollar,domain,typeFlag) == s is ['QUOTE,y] and PNAME y = a ident? s and symbolName s = a a isnt [.,:.] => a = s - op := opOf a + op := a.op op is 'NRTEVAL => s = nrtEval(second a,domain) op is 'QUOTE => s = second a lazyMatch(s,a,dollar,domain) @@ -512,7 +499,7 @@ lookupInDomainByName(op,domain,arg) == max := maxIndex opvec k := getOpCode(op,opvec,max) or return nil idxmax := maxIndex numvec - start := vctorRef(opvec,k) + start := vectorRef(opvec,k) finish := max > k => vectorRef(opvec,k + 2) idxmax @@ -533,14 +520,10 @@ lookupInDomainByName(op,domain,arg) == --======================================================= -- Expand Signature from Encoded Slot Form --======================================================= -newExpandGoGetTypeSlot(slot,dollar,domain) == - newExpandTypeSlot(slot,domain,domain) - newExpandTypeSlot(slot, dollar, domain) == -- returns domain form for dollar.slot newExpandLocalType(sigDomainVal(dollar, domain, slot), dollar,domain) - newExpandLocalType(lazyt,dollar,domain) == vector? lazyt => canonicalForm lazyt lazyt isnt [.,:.] => lazyt diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot index 347a09a1..4829d5e0 100644 --- a/src/interp/showimp.boot +++ b/src/interp/showimp.boot @@ -58,7 +58,7 @@ showImp(dom,:options) == for (x := [.,.,:key]) in u repeat key = domainForm => domexports := [x,:domexports] integer? key => unexports := [x,:unexports] - isDefaultPackageForm? key => defexports := [x,:defexports] + defaultPackageForm? key => defexports := [x,:defexports] key is 'nowhere => nowheres := [x,:nowheres] key is 'constant => constants := [x,:constants] others := [x,:others] --add chain domains go here |