diff options
| -rw-r--r-- | src/ChangeLog | 13 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 2 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 2 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 111 | ||||
| -rw-r--r-- | src/interp/i-map.boot | 4 | ||||
| -rw-r--r-- | src/interp/i-spec1.boot | 15 |
6 files changed, 129 insertions, 18 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index ac68364e..d8ef7f6a 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,16 @@ +2010-05-25 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/g-util.boot: Implement expansion of %collect forms. + * interp/c-util.boot (middleEndExpand): Tidy. + * interp/g-opt.boot (changeThrowToExit): Don't look into %collect + forms. + * interp/i-map.boot (getUserIdentifiersIn): Factorize. Handle + %collect forms same as COLLECT forms. + (findLocalVars1): Likewise. + * interp/i-spec1.boot (evalCOLLECT): Now generate %collect forms. + (checkForFreeVariables): Factorize. Handle %collect forms same as + COLLECT forms. + 2010-05-24 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/g-util.boot (expandToVMForm): New. Export. diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index bf47eecb..b030f3b3 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1073,9 +1073,9 @@ middleEndExpand: %Form -> %Form middleEndExpand x == isAtomicForm x => x [op,:args] := x + IDENTP op and (fun := getOpcodeExpander op) => apply(fun,x,nil) op in $middleEndMacroList => middleEndExpand MACROEXPAND_-1 x - IDENTP op and (fun := getOpcodeExpander op) => apply(fun,x,nil) a := middleEndExpand op b := middleEndExpand args EQ(a,op) and EQ(b,args) => x diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 0b5d7169..2717312a 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) => nil + atom s or first s in '(QUOTE SEQ REPEAT COLLECT %collect) => 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 3181c0c8..72c05126 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -50,12 +50,117 @@ module g_-util where --% Opcode expansion to VM codes. --% -++ List of opcode-expander pairs. -$middleEndOpcodes == nil + +--% +--% Iteration control structures +--% +--% Code generation for an iterator produces a sequence of +--% length 5, whose components have the following meanings: +--% 0. list of loop-wide variables and their initializers +--% 1. list of body-wide variables and their initializers +--% 2. update code for next iteration +--% 3. predicate guarding loop body execution +--% 4. loop termination predicate + +++ Generate code that sequentially visits each component of a list. +expandIN(x,l) == + g := gensym() -- rest of the list yet to be visited + [[[g,middleEndExpand l]], + [[x,["CAR",g]]],[["SETQ",g,["CDR",g]]], + nil,[["ATOM",g]]] + +expandON(x,l) == + [[[x,middleEndExpand l]],nil,[["SETQ",x,["CDR",x]]],nil,[["ATOM",x]]] + +++ Generate code that traverses an interval with lower bound 'lo', +++ arithmetic progression `step, and possible upper bound `final'. +expandSTEP(id,lo,step,final)== + lo := middleEndExpand lo + step := middleEndExpand step + final := middleEndExpand final + loopvar := [[id,lo]] + inc := + isAtomicForm step => step + g1 := gensym() + loopvar := [:loopvar,[g1,step]] + g1 + final := + atom final => final + final is [hi] and isAtomicForm hi => hi + g2 := gensym() + loopvar := [:loopvar,[g2,:final]] + g2 + ex := + final = nil => nil + integer? inc => + pred := + MINUSP inc => "<" + ">" + [[pred,id,final]] + [['COND,[['MINUSP,inc], + ["<",id,final]],['T,[">",id,final]]]] + suc := [["SETQ",id,["+",id,inc]]] + [loopvar,nil,suc,nil,ex] + +++ Generate code for iterators that filter out execution state +++ not satisfying predicate `p'. +expandSUCHTHAT p == + [nil,nil,nil,[middleEndExpand p],nil] + +++ Generate code for iterators that stop loop iteration when the +++ state fails predicate `p'. +expandWHILE p == + [nil,nil,nil,nil,[["NOT",middleEndExpand p]]] + +expandUNTIL p == + g := gensym() + [[[g,false]],nil,[["SETQ",g,middleEndExpand p]],nil,[g]] + +expandIterators iters == + [toLisp it or leave "failed" for it in iters] where + toLisp it == + it is ["STEP",var,lo,inc,:hi] => expandSTEP(var,lo,inc,hi) + it is ["IN",var,seq] => expandIN(var,seq) + it is ["ON",var,seq] => expandON(var,seq) + it is ["WHILE",pred] => expandWHILE pred + it is [op,pred] and op in '(SUCHTHAT _|) => expandSUCHTHAT pred + it is ["UNTIL",pred] => expandUNTIL pred + nil + +++ Generate code for list comprehension. +expandCollect ["%collect",:iters,body] == + itersCode := expandIterators iters + itersCode = "failed" => systemErrorHere ["expandCollect",iters] + val := gensym() -- result of the list comprehension + itersCode := "coagulate"/itersCode + where + coagulate(it1,it2) == [append(it1.k,it2.k) for k in 0..4] + [loopInits,bodyInits,cont,filters,exits,value] := itersCode + -- Transform the body to build the list as we go. + body := ["SETQ",val,["CONS",middleEndExpand body,val]] + -- Guard th execution of the body by the filters. + if filters ~= nil then + body := mkpf([:filters,body],"AND") + -- If there is any body-wide initialization, now is the time. + if bodyInits ~= nil then + body := ["LET",bodyInits,body] + if value ~= nil then + value := first value + exits := ["COND", + [mkpf(exits,"OR"),["RETURN",["NREVERSE",val]]], + [true,body]] + body := ["LOOP",exits,:cont] + -- Finally, set up loop-wide initializations. + ["LET",[:loopInits,[val,nil]],body] + +++ Table of opcode-expander pairs. +$OpcodeExpanders == [ + ["%collect",:"expandCollect"] + ] ++ Return the expander of a middle-end opcode, or nil if there is none. getOpcodeExpander op == - x := ASSOC(op,$middleEndOpcodes) => rest x + x := ASSOC(op,$OpcodeExpanders) => rest x nil ++ Expand all opcodes contained in the form `x' into a form diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index 331c54fa..9bb6bf4e 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -230,7 +230,7 @@ getUserIdentifiersIn body == body=" " => nil [body] body is ["WRAPPED",:.] => nil - (body is ["COLLECT",:itl,body1]) or (body is ['REPEAT,:itl,body1]) => + body is [op,:itl,body1] and op in '(COLLECT REPEAT %collect) => userIds := S_+(getUserIdentifiersInIterators itl,getUserIdentifiersIn body1) S_-(userIds,getIteratorIds itl) @@ -1031,7 +1031,7 @@ 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) => + form is [oper,:itrl,body] and oper in '(REPEAT COLLECT %collect) => findLocalsInLoop(op,itrl,body) 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 cf2c649d..769af133 100644 --- a/src/interp/i-spec1.boot +++ b/src/interp/i-spec1.boot @@ -544,7 +544,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 @@ -817,20 +817,13 @@ checkForFreeVariables(v,locals) == op in '(LAMBDA QUOTE getValueFromEnvironment) => v op = "LETT" => -- Expands to a SETQ. ["SETF",:[checkForFreeVariables(a,locals) for a in args]] - op = "COLLECT" => -- Introduces a new bound variable? + op in '(COLLECT REPEAT %collect) => -- Introduces a new bound variable? first(args) is ["STEP",var,:.] => $boundVariables := [var,:$boundVariables] - r := ["COLLECT",:[checkForFreeVariables(a,locals) for a in args]] + r := [op,:[checkForFreeVariables(a,locals) for a in args]] $boundVariables := delete(var,$boundVariables) r - ["COLLECT",:[checkForFreeVariables(a,locals) for a in args]] - op = "REPEAT" => -- Introduces a new bound variable? - first(args) is ["STEP",var,:.] => - $boundVariables := [var,:$boundVariables] - r := ["REPEAT",:[checkForFreeVariables(a,locals) for a in args]] - $boundVariables := delete(var,$boundVariables) - r - ["REPEAT",:[checkForFreeVariables(a,locals) for a in args]] + [op,:[checkForFreeVariables(a,locals) for a in args]] op = "%LET" => args is [var,form,name] => -- This is some bizarre %LET, not what one would expect in Common Lisp! |