diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/functor.boot | 84 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 3 |
2 files changed, 25 insertions, 62 deletions
diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 99b45a8c..95b9ccd1 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -661,37 +661,26 @@ SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding" for u in $catvecList for v in catNames repeat null body => return nil for catImplem in LookUpSigSlots(sig,u.1) repeat - if catImplem is [q,.,index] and (q='ELT or q='CONST) - then - if q is 'CONST and body is ['CONS,a,b] then - body := ['CONS,'IDENTITY,['FUNCALL,a,b]] - body:= ["setShellEntry",v,index,body] - if REFVECP $SetFunctions and TruthP flag then u.index:= true - --used by CheckVector to determine which ops are missing - if v='$ then -- i.e. we are looking at the principal view - not REFVECP $SetFunctions => nil - --packages don't set it - $MissingFunctionInfo.index:= flag - TruthP $SetFunctions.index => (body:= nil; return nil) - -- the function was already assigned - $SetFunctions.index:= - TruthP flag => true - not $SetFunctions.index=>flag --JHD didn't set $SF on this branch - ["or",$SetFunctions.index,flag] - else - if catImplem is ['Subsumed,:truename] - --a special marker generated by SigListUnion - then - if mode='original - then if truename is [fn,:.] and fn in '(Zero One) - then nil --hack by RDJ 8/90 - else body:= SetFunctionSlots(truename,body,nil,mode) - else nil - else - keyedSystemError("S2OR0002",[catImplem]) + catImplem is [q,.,index] and (q='ELT or q='CONST) => + if q is 'CONST and body is ['CONS,a,b] then + body := ['CONS,'IDENTITY,['FUNCALL,a,b]] + body:= ["setShellEntry",v,index,body] + if REFVECP $SetFunctions and TruthP flag then + u.index := true + v='$ => -- we are looking at the principal view + not REFVECP $SetFunctions => nil --packages don't set it + -- the function was already assigned + TruthP $SetFunctions.index => return body := nil + $SetFunctions.index := + TruthP flag => true + not $SetFunctions.index => flag + ["or",$SetFunctions.index,flag] + catImplem is ['Subsumed,:truename] => + mode='original => + truename is [fn,:.] and fn in '(Zero One) => nil --hack by RDJ 8/90 + body := SetFunctionSlots(truename,body,nil,mode) + keyedSystemError("S2OR0002",[catImplem]) body is ["setShellEntry",:.] => body - body is ['SETELT,:.] => systemErrorHere ["SetFunctionSlots",body] - body is ['QSETREFV,:.] => systemErrorHere ["SetFunctionSlots",body] nil LookUpSigSlots(sig,siglist) == @@ -704,40 +693,17 @@ LookUpSigSlots(sig,siglist) == SigSlotsMatch(sig,pattern,implem) == sig=pattern => true - not (LENGTH second sig=LENGTH second pattern) => nil + #second sig ~= # second pattern => nil --second sig is the actual signature part - not (first sig=first pattern) => nil - pat' :=SUBSTQ($definition,'$,second pattern) - sig' :=SUBSTQ($definition,'$,second sig) - sig'=pat' => true - --If we don't have this next test, then we'll recurse in SetFunctionSlots + first sig ~= first pattern => nil + pat' := substitute($definition,'$,second pattern) + sig' := substitute($definition,'$,second sig) + sig' = pat' => true implem is ['Subsumed,:.] => nil sig' = pat' -CheckVector(vec,name,catvecListMaker) == - code:= nil - condAlist := - [[a,:first b] for [.,a,:b] in $getDomainCode] - -- used as substitution alist below - for i in 6..MAXINDEX vec repeat - v:= vec.i - v=true => nil - null v => nil --a domain, which setVector4part3 will fill in - atom v => systemErrorHere ["CheckVector",v] - atom first v => - --It's a secondary view of a domain, which we - --must generate code to fill in - for x in $catNames for y in catvecListMaker repeat - if y=v then - code := [["setShellEntry",name,i,x],:code] - if name='$ then - assoc(first v,$CheckVectorList) => nil - $CheckVectorList:= - [[first v,:makeMissingFunctionEntry(condAlist,i)],:$CheckVectorList] - code - makeMissingFunctionEntry(alist,i) == - tran SUBLIS(alist,$MissingFunctionInfo.i) where + tran SUBLIS(alist,$SetFunctions.i) where tran x == x is ["HasCategory",a,["QUOTE",b]] => ["has",a,b] x is [op,:l] and op in '(AND OR NOT) => [op,:[tran y for y in l]] diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 79aa917a..6454f09f 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -409,8 +409,6 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) == $catNames: local := nil --list of names n1..nn for each view $catsig: local := nil --target category (used in ProcessCond) $SetFunctions: local := nil --copy of p view with preds telling when fnct defined - $MissingFunctionInfo: local := nil --now useless - --vector marking which functions are assigned $ConstantAssignments: local := nil --code for creation of constants $epilogue: local := nil --code to set slot 5, things to be done last $HackSlot4: local := nil --Invention of JHD 13/July/86-set in InvestigateConditions @@ -439,7 +437,6 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) == $catvecList:= [domainShell,:[emptyVector for u in second domainShell.4]] $catNames := ['$] -- for DescendCode -- to be changed below for slot 4 $SetFunctions:= newShell SIZE domainShell - $MissingFunctionInfo:= newShell SIZE domainShell $catNames:= ['$,:[GENVAR() for u in rest catvecListMaker]] domname:='dv_$ |