aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog13
-rw-r--r--src/interp/c-util.boot2
-rw-r--r--src/interp/g-opt.boot2
-rw-r--r--src/interp/g-util.boot111
-rw-r--r--src/interp/i-map.boot4
-rw-r--r--src/interp/i-spec1.boot15
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!