diff options
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/interp/functor.boot | 46 |
2 files changed, 27 insertions, 24 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 9fc67991..32150509 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2010-07-09 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/functor.boot (SetFunctionSlots): Simplify. The outer + loop was executed only once. + 2010-07-05 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/compiler.boot (compTopLevel): Bind $whereDecls. diff --git a/src/interp/functor.boot b/src/interp/functor.boot index f79a8fb2..6292f5fe 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -657,30 +657,28 @@ TryGDC cond == cond SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding" - catNames := ['$] - for u in $catvecList for v in catNames repeat - null body => return nil - for catImplem in LookUpSigSlots(sig,u.1) repeat - 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 + null body => return nil + u := first $catvecList + for catImplem in LookUpSigSlots(sig,u.1) repeat + 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,'$,index,body] + not REFVECP $SetFunctions => nil --packages don't set it + if TruthP flag then -- unconditionally defined function + u.index := true + TruthP $SetFunctions.index => -- the function was already assigned + 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 nil LookUpSigSlots(sig,siglist) == |