From 35102fea22aa54cdc3dff3e9faea8b1c58b93aa2 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Thu, 10 Jun 2010 15:15:28 +0000 Subject: * interp/compiler.boot (freeVarUsage): Handle %when too. (compLogicalNot): Generate %not form. (satisfies): Use %bind. (compMatch): Likewise. (compReduce1): Generate %loop directly instead of %reduce. * interp/g-opt.boot (changeThrowToExit): Don't check for %reduce. * interp/g-util.boot (expandRepeat): Remove. (expandReduce): Likewise. --- src/ChangeLog | 11 +++++++++++ src/interp/compiler.boot | 20 ++++++++++---------- src/interp/g-opt.boot | 2 +- src/interp/g-util.boot | 9 --------- src/interp/i-map.boot | 8 ++++---- src/interp/i-spec1.boot | 2 +- src/interp/i-spec2.boot | 6 +++--- src/interp/slam.boot | 4 ++-- 8 files changed, 32 insertions(+), 30 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 3376c341..464bf14d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,14 @@ +2010-06-10 Gabriel Dos Reis + + * interp/compiler.boot (freeVarUsage): Handle %when too. + (compLogicalNot): Generate %not form. + (satisfies): Use %bind. + (compMatch): Likewise. + (compReduce1): Generate %loop directly instead of %reduce. + * interp/g-opt.boot (changeThrowToExit): Don't check for %reduce. + * interp/g-util.boot (expandRepeat): Remove. + (expandReduce): Likewise. + 2010-06-10 Gabriel Dos Reis * interp/g-opt.boot (optCollectVector): Generate %loop for the diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index a9e29dea..4489cf96 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -300,7 +300,7 @@ freeVarUsage([.,vars,body],env) == for v in rest u | cons? v repeat free := freeList(v,bound,free,e) free - op = "COND" => + op in '(COND %when) => for v in rest u repeat for vv in v repeat free := freeList(vv,bound,free,e) @@ -1450,7 +1450,7 @@ compLogicalNot(x,m,e) == $EmptyMode yT := comp(y,yTarget,e) or return nil yT.mode = $Boolean and yTarget = $Boolean => - [["NOT",yT.expr],yT.mode,yT.env] + [["%not",yT.expr],yT.mode,yT.env] compResolveCall("not",[yT],m,yT.env) @@ -1627,7 +1627,7 @@ satisfies(val,pred) == pred=false or pred=true => pred vars := findVMFreeVars pred vars ~= nil and vars isnt ["#1"] => false - eval ["LET",[["#1",val]],pred] + eval ['%bind,[["#1",val]],pred] ++ If the domain designated by the domain forms `m' and `m'' have @@ -2170,9 +2170,9 @@ compMatch(["%Match",subject,altBlock],m,env) == $catchAllCount = 0 => stackAndThrow('"missing %b otherwise %d alternative in case pattern",nil) code := - atom sn => ["LET",[[sn,se]],["COND",:nreverse altsCode]] + atom sn => ['%bind,[[sn,se]],['%when,:nreverse altsCode]] ["%bind",[[n,e] for n in sn for e in rest se], - ["COND",:nreverse altsCode]] + ['%when,:nreverse altsCode]] [code,m,savedEnv] ++ Compile the form scheme `x'. @@ -2227,12 +2227,12 @@ compReduce1(form is ["REDUCE",op,.,collectForm],m,e,$formalArgList) == [untilCode,.,e]:= comp($until,$Boolean,e) or return nil itl := substitute(["UNTIL",untilCode],'$until,itl) firstTime := gensym() - finalCode := ['%reduce, + finalCode := ['%loop, ['%init,accu,'%nil],['%init,firstTime,'%true],:itl, - ['%when,[firstTime,nval],['%otherwise,accu]], - ['%bind,[[b,third bval]], - ['%when,[firstTime,move],['%otherwise,update]], - ['%store,firstTime,'%false]]] + ['%bind,[[b,third bval]], + ['%when,[firstTime,move],['%otherwise,update]], + ['%store,firstTime,'%false]], + ['%when,[firstTime,nval],['%otherwise,accu]]] T := coerce([finalCode,mode,e],m) or return nil [T.expr,T.mode,oldEnv] diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 7c9ad4bd..be39629b 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 s.op in '(QUOTE SEQ REPEAT COLLECT %collect %repeat %reduce) => nil + atom s or s.op in '(QUOTE SEQ REPEAT COLLECT %collect %loop) => 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 7c8945c5..689f2d5d 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -217,13 +217,6 @@ expandCollect ['%collect,:iters,body] == -- in reverse order. expandLoop ['%loop,:iters,["%init",val,nil],body,["NREVERSE",val]] -++ Generate code for plain loop. -expandRepeat ["%repeat",:iters,body] == - expandLoop ['%loop,:iters,body,["voidValue"]] - -expandReduce ['%reduce,:iters,val,body] == - expandLoop ['%loop,:iters,body,val] - expandReturn(x is ['%return,.,y]) == $FUNNAME = nil => systemErrorHere ['expandReturn,x] ['RETURN_-FROM,$FUNNAME,expandToVMForm y] @@ -346,8 +339,6 @@ for x in [ ++ Table of opcode-expander pairs. for x in [ ['%collect,:function expandCollect], - ["%repeat",:function expandRepeat], - ['%reduce, :function expandReduce], ['%loop, :function expandLoop], ['%return, :function expandReturn], diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index ae03d823..a6a26ac9 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -226,11 +226,11 @@ getUserIdentifiersIn body == body = $ClearBodyToken => nil [body] body is ["WRAPPED",:.] => nil - body is [op,:itl,body1] and op in '(COLLECT REPEAT %repeat %collect) => + body is [op,:itl,body1] and op in '(COLLECT REPEAT %collect) => userIds := S_+(getUserIdentifiersInIterators itl,getUserIdentifiersIn body1) S_-(userIds,getIteratorIds itl) - body is [op,:itl,val,body1] and op in '(%reduce %loop) => + body is ['%loop,:itl,val,body1] => userIds := S_+(getUserIdentifiersInIterators itl,getUserIdentifiersIn body1) userIds := S_+(getUserIdentifiersIn val,userIds) @@ -1034,9 +1034,9 @@ 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) => + form is [oper,:itrl,body] and oper in '(REPEAT COLLECT %collect) => findLocalsInLoop(op,itrl,body) - form is [oper,:itrl,val,body] and oper in '(%reduce %loop) => + form is ['%loop,:itrl,val,body] => findLocalsInLoop(op,itrl,[body,val]) form is [y,:argl] => y is "Record" or (y is "Union" and argl is [[":",.,.],:.]) => diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot index 4e814477..18bbaf8e 100644 --- a/src/interp/i-spec1.boot +++ b/src/interp/i-spec1.boot @@ -815,7 +815,7 @@ checkForFreeVariables(v,locals) == op in '(LAMBDA QUOTE getValueFromEnvironment) => v op = "LETT" => -- Expands to a SETQ. ["SETF",:[checkForFreeVariables(a,locals) for a in args]] - op in '(COLLECT REPEAT %collect %repeat %reduce) => + op in '(COLLECT REPEAT %collect %loop) => first(args) is ["STEP",var,:.] => $boundVariables := [var,:$boundVariables] r := [op,:[checkForFreeVariables(a,locals) for a in args]] diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot index a77b92e1..c67ccb7e 100644 --- a/src/interp/i-spec2.boot +++ b/src/interp/i-spec2.boot @@ -953,7 +953,7 @@ evalREPEAT(op,[:itrl,body],repeatMode) == bodyCode := getArgValue(body,bodyMode) if $iterateCount > 0 then bodyCode := ["CATCH",$repeatBodyLabel,bodyCode] - code := ["%repeat",:[evalLoopIter itr for itr in itrl], bodyCode] + code := ['%loop,:[evalLoopIter itr for itr in itrl],bodyCode,voidValue()] code := timedOptimization code if $breakCount > 0 then code := ['CATCH,$repeatLabel,code] val := @@ -975,9 +975,9 @@ interpREPEAT(op,itrl,body,repeatMode) == $indexTypes: local := NIL code := -- we must insert a CATCH for the iterate clause - ["%repeat",:[interpIter itr for itr in itrl], + ['%loop,:[interpIter itr for itr in itrl], ["CATCH",$repeatBodyLabel,interpLoop(body,$indexVars, - $indexTypes,nil)]] + $indexTypes,nil)],voidValue()] SPADCATCH(eval $repeatLabel,timedEVALFUN code) val:= objNewWrap(voidValue(),repeatMode) putValue(op,val) diff --git a/src/interp/slam.boot b/src/interp/slam.boot index c0256b97..0affa71f 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -294,8 +294,8 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == newValueCode:= ["%LET",g,substitute(gIndex,sharpArg, EQSUBSTLIST(gsList,rest $TriangleVariableList,body))] ["%bind",decomposeBindings, - ["%repeat",["WHILE",true],["PROGN",endTest,advanceCode, - newValueCode,:rotateCode]]] + ['%loop,["WHILE",true],["PROGN",endTest,advanceCode, + newValueCode,:rotateCode],voidValue()]] fromScratchInit:= [["%LET",gIndex,n],:[["%LET",g,x] for g in gsList for x in initCode]] continueInit:= -- cgit v1.2.3