diff options
| -rw-r--r-- | src/interp/c-util.boot | 34 | ||||
| -rw-r--r-- | src/interp/database.boot | 2 | ||||
| -rw-r--r-- | src/interp/nrunfast.boot | 14 |
3 files changed, 27 insertions, 23 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 0558402a..eab65f7f 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1652,7 +1652,7 @@ expandFormTemplate(shell,args,slot) == integer? slot => slot = 0 => "$" slot = 2 => "$$" - expandFormTemplate(shell,args,vectorRef(shell,slot)) + expandFormTemplate(shell,args,domainRef(shell,slot)) slot isnt [.,:.] => slot slot is ["local",parm] and (n := formal? parm) => args.n -- FIXME: we should probably expand with dual signature @@ -1668,7 +1668,7 @@ equalFormTemplate(shell,args,slot,form) == integer? slot => slot = 0 => form = "$" slot = 2 => form = "$$" - equalFormTemplate(shell,args,vectorRef(shell,slot),form) + equalFormTemplate(shell,args,domainRef(shell,slot),form) slot is ["local",parm] and (n := formal? parm) => equalFormTemplate(shell,args,args.n,form) slot is ['%eval,val] => form = val @@ -1687,19 +1687,20 @@ equalFormTemplate(shell,args,slot,form) == ++ nil => function not defined by `shell'. ++ "ambiguous" => too many candidates ++ <number> => slot number of unique matching function. -getFunctionTemplate(sig,start,end,shell,args,funDesc) == +matchSignatureInTemplate(sig,start,end,shell,args,funDesc) == nargs := #rest sig loc := nil -- candidate locations while loc ~= "ambiguous" and start < end repeat n := arrayRef(funDesc,start) -- arity of current operator - PROGN + do -- Skip if arity mismatch i := start n ~= nargs => nil + -- FIXME: Check the corresponding predicate. -- We are not interested in predicates, at this point. -- Skip if this operator's signature does not match i := i + 2 - or/[not equalFormTemplate(shell,args,funDesc.k,t) + or/[not equalFormTemplate(shell,args,arrayRef(funDesc,k),t) for k in i.. for t in sig] => nil -- Grab the location of this match loc := @@ -1709,10 +1710,14 @@ getFunctionTemplate(sig,start,end,shell,args,funDesc) == loc ++ Subroutine of lookupDefiningFunction. -lookupInheritedDefiningFunction(op,sig,shell,args,slot) == +lookupRemoteDefiningFunction(op,sig,shell,args,slot) == dom := expandFormTemplate(shell,args,slot) dom isnt [.,:.] or dom is ["local",:.] => nil - lookupDefiningFunction(op,sig,dom) + fun := lookupDefiningFunction(op,sig,dom) or return nil + -- Note: In general, functions needing their domain enviornment + -- to operate properly can't be safely pulled out. + ident? fun and getFunctionReplacement fun => fun + fun ++ Return the name of the function definition that explicitly implements ++ the operation `op' with signature `sig' in the domain of @@ -1737,20 +1742,20 @@ lookupDefiningFunction(op,sig,dc) == env is ['makeSpadConstant,fun,:.] => BPINAME fun BPINAME first env -- 1.2. Don't look into defaulting package - isDefaultPackageName ctor => nil + dbDefaultPackage? db => nil infovec := property(ctor,'infovec) or return nil -- 1.3. We need information about the original domain template shell := dbTemplate db -- domain template opTable := second infovec -- operator-code table opTableLength := #opTable - forgetful := dbLookupFunction db is 'lookupIncomplete -- 2. Get the address range of op's descriptor set [.,.,.,:funDesc] := fourth infovec - index := getOpCode(op, opTable, opTableLength - 1) + index := getOpCode(op,opTable) -- 2.1. For a forgetful functor, try the add chain index = nil => - forgetful and lookupInheritedDefiningFunction(op,sig,shell,args,5) + dbLookupFunction db is 'lookupIncomplete and + lookupRemoteDefiningFunction(op,sig,shell,args,$AddChainIndex) -- 2.2. The operation is either defined here, or is available -- from category package defaults. limit := @@ -1758,11 +1763,11 @@ lookupDefiningFunction(op,sig,dc) == #funDesc -- 3. Locate the descriptor with matching signature - loc := getFunctionTemplate(sig,opTable.index,limit,shell,args,funDesc) + loc := matchSignatureInTemplate(sig,vectorRef(opTable,index),limit,shell,args,funDesc) -- 4. Look into the add-chain if necessary loc = nil => - lookupInheritedDefiningFunction(op,sig,shell,args,domainRef(shell,5)) + lookupRemoteDefiningFunction(op,sig,shell,args,$AddChainIndex) -- 5. Give up if the operation is overloaded on semantics predicates. loc is 'ambiguous => nil @@ -1776,8 +1781,7 @@ lookupDefiningFunction(op,sig,dc) == not integer? idx => nil -- a UFO? loc := arrayRef(funDesc,idx + 1) if loc = 0 then loc := 5 - domainRef(shell,loc) = nil => nil - lookupInheritedDefiningFunction(op,sig,shell,args,shell.loc) + lookupRemoteDefiningFunction(op,sig,shell,args,loc) -- 6.3. Whatever. fun diff --git a/src/interp/database.boot b/src/interp/database.boot index f7ba0516..376feaac 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -906,5 +906,5 @@ loadDBIfNecessary db == loadDB db ++ Return true if this DB is for a category default package. -macro dbDefaultPackage? db == +dbDefaultPackage? db == isDefaultPackageName dbConstructor db diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index 4d0316f6..7347afbd 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -36,7 +36,7 @@ import c_-util namespace BOOT module nrunfast where - getOpCode: (%Symbol, %Vector %Thing, %Short) -> %Maybe %Short + getOpCode: (%Symbol, %Vector %Thing) -> %Maybe %Short ++ $monitorNewWorld := false @@ -72,11 +72,11 @@ getDomainCompleteCategories dom == cats := [newExpandLocalType(vectorRef(vec,i),dom,dom), :cats] reverse! cats -getOpCode(op,vec,max) == +getOpCode(op,vec) == --search Op vector for "op" returning code if found, nil otherwise res := nil - for i in 0..max by 2 repeat - sameObject?(vectorRef(vec,i),op) => return (res := i + 1) + for i in 0..maxIndex vec by 2 repeat + symbolEq?(vectorRef(vec,i),op) => return (res := i + 1) res evalSlotDomain(u,dollar) == @@ -174,7 +174,7 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) == numvec := getDomainByteVector domain predvec := domainPredicates domain max := maxIndex opvec - k := getOpCode(op,opvec,max) or return + k := getOpCode(op,opvec) or return flag => newLookupInAddChain(op,sig,domain,dollar) nil idxmax := maxIndex numvec @@ -292,7 +292,7 @@ newLookupInCategories(op,sig,dom,dollar) == success := [.,opvec,:.] := infovec max := maxIndex opvec - code := getOpCode(op,opvec,max) + code := getOpCode(op,opvec) null code => nil [.,.,.,[.,.,.,:byteVector],:.] := infovec endPos := @@ -425,7 +425,7 @@ lookupInDomainByName(op,domain,arg) == numvec := getDomainByteVector domain predvec := domainPredicates domain max := maxIndex opvec - k := getOpCode(op,opvec,max) or return nil + k := getOpCode(op,opvec) or return nil idxmax := maxIndex numvec start := vectorRef(opvec,k) finish := |