From 065a1bd3b0facc445cccd066b47a1801abd6f0aa Mon Sep 17 00:00:00 2001 From: dos-reis Date: Thu, 10 Jun 2010 02:53:03 +0000 Subject: Clean up --- src/interp/compiler.boot | 2 +- src/interp/g-opt.boot | 2 +- src/interp/g-util.boot | 4 ++-- src/interp/i-map.boot | 28 ++++++++++++++++++---------- src/interp/i-spec1.boot | 4 ++-- 5 files changed, 24 insertions(+), 16 deletions(-) (limited to 'src/interp') diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 7ac0ce3e..a9e29dea 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -2304,7 +2304,7 @@ compRepeatOrCollect(form,m,e) == repeatOrCollect = "%CollectV" => ["%CollectV",localReferenceIfThere m',:itl',body'] -- We are phasing out use of LISP macros COLLECT and REPEAT. - repeatOrCollect = "COLLECT" => ["%collect",:itl',body'] + repeatOrCollect = "COLLECT" => ['%collect,:itl',body'] [repeatOrCollect,:itl',body'] m'' := aggr is [c,.] and c in '(List PrimitiveArray Vector) => [c,m'] diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index af9fb966..84fd563e 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -124,7 +124,7 @@ subrname u == nil changeThrowToExit(s,g) == - atom s or first s in '(QUOTE SEQ REPEAT COLLECT %collect %repeat %reduce) => nil + atom s or s.op in '(QUOTE SEQ REPEAT COLLECT %collect %repeat %reduce) => nil s is ["THROW", =g,:u] => (s.first := "EXIT"; s.rest := u) changeThrowToExit(first s,g) changeThrowToExit(rest s,g) diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index e6926643..9bfb08f0 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -208,7 +208,7 @@ expandLoop(iters,body,ret) == ["LET",loopInits,body] ++ Generate code for list comprehension. -expandCollect ["%collect",:iters,body] == +expandCollect ['%collect,:iters,body] == val := gensym() -- result of the list comprehension -- Transform the body to build the list as we go. body := ["SETQ",val,["CONS",middleEndExpand body,val]] @@ -345,7 +345,7 @@ for x in [ ++ Table of opcode-expander pairs. for x in [ - ["%collect",:function expandCollect], + ['%collect,:function expandCollect], ["%repeat",:function expandRepeat], ['%reduce, :function expandReduce], ['%return, :function expandReturn], diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index a0ed9d15..ae03d823 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -226,10 +226,15 @@ getUserIdentifiersIn body == body = $ClearBodyToken => nil [body] body is ["WRAPPED",:.] => nil - body is [op,:itl,body1] and op in '(COLLECT REPEAT %repeat %collect %reduce) => + body is [op,:itl,body1] and op in '(COLLECT REPEAT %repeat %collect) => userIds := S_+(getUserIdentifiersInIterators itl,getUserIdentifiersIn body1) S_-(userIds,getIteratorIds itl) + body is [op,:itl,val,body1] and op in '(%reduce %loop) => + userIds := + S_+(getUserIdentifiersInIterators itl,getUserIdentifiersIn body1) + userIds := S_+(getUserIdentifiersIn val,userIds) + S_-(userIds,getIteratorIds itl) body is [op,:l] => argIdList := -- field tags do not contribute to dependencies. @@ -248,6 +253,7 @@ getUserIdentifiersInIterators itl == varList:= [:"append"/[getUserIdentifiersIn y for y in l],:varList] x is ["IN",.,y] => varList:= [:getUserIdentifiersIn y,:varList] x is ["ON",.,y] => varList:= [:getUserIdentifiersIn y,:varList] + x is ['%init,.,y] => varList:= [:getUserIdentifiersIn y,:varList] x is [op,a] and op in '(_| WHILE UNTIL) => varList:= [:getUserIdentifiersIn a,:varList] keyedSystemError("S2GE0016",['"getUserIdentifiersInIterators", @@ -255,10 +261,12 @@ getUserIdentifiersInIterators itl == removeDuplicates varList getIteratorIds itl == + varList := nil for x in itl repeat - x is ["STEP",i,:.] => varList:= [i,:varList] - x is ["IN",y,:.] => varList:= [y,:varList] - x is ["ON",y,:.] => varList:= [y,:varList] + x is ["STEP",i,:.] => varList := [i,:varList] + x is ["IN",y,:.] => varList := [y,:varList] + x is ["ON",y,:.] => varList := [y,:varList] + x is ['%init,y,:.] => varList := [y,:varList] nil varList @@ -1026,8 +1034,10 @@ findLocalVars1(op,form) == form is ['is,l,pattern] => findLocalVars1(op,l) for var in listOfVariables rest pattern repeat mkLocalVar(op,var) - form is [oper,:itrl,body] and oper in '(REPEAT COLLECT %collect %repeat %reduce) => + form is [oper,:itrl,body] and oper in '(REPEAT COLLECT %collect %repeat) => findLocalsInLoop(op,itrl,body) + form is [oper,:itrl,val,body] and oper in '(%reduce %loop) => + findLocalsInLoop(op,itrl,[body,val]) form is [y,:argl] => y is "Record" or (y is "Union" and argl is [[":",.,.],:.]) => -- don't pick field tags, their are not variables. @@ -1045,14 +1055,12 @@ findLocalsInLoop(op,itrl,body) == mkLocalVar(op,index) findLocalVars1(op,lower) for up in upperList repeat findLocalVars1(op,up) - it is ['IN,index,s] => + it is [op,index,s] and op in '(IN %init) => iterVars := [index,:iterVars] mkLocalVar(op,index) findLocalVars1(op,s) - it is ['WHILE,b] => - findLocalVars1(op,b) - it is ['_|,pred] => - findLocalVars1(op,pred) + it is ['WHILE,b] => findLocalVars1(op,b) + it is ['_|,pred] => findLocalVars1(op,pred) findLocalVars1(op,body) for it in itrl repeat it is [op,b] and (op in '(UNTIL)) => diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot index c297582e..4e814477 100644 --- a/src/interp/i-spec1.boot +++ b/src/interp/i-spec1.boot @@ -541,7 +541,7 @@ evalCOLLECT(op,[:itrl,body],m) == iters := [evalLoopIter itr for itr in itrl] bod := getArgValue(body,computedMode body) if bod isnt ['SPADCALL,:.] then bod := ['unwrap,bod] - code := timedOptimization asTupleNewCode0(second m, ["%collect",:iters,bod]) + code := timedOptimization asTupleNewCode0(second m, ['%collect,:iters,bod]) putValue(op,object(code,m)) falseFun(x) == nil @@ -569,7 +569,7 @@ interpCOLLECT(op,itrl,body) == emptyAtree op emptyAtree itrl emptyAtree body - code := ["%collect",:[interpIter itr for itr in itrl], + code := ['%collect,:[interpIter itr for itr in itrl], interpCOLLECTbody(body,$indexVars,$indexTypes)] value := timedEVALFUN code t := -- cgit v1.2.3