aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog14
-rw-r--r--src/interp/g-opt.boot2
-rw-r--r--src/interp/g-util.boot41
-rw-r--r--src/interp/i-map.boot2
-rw-r--r--src/interp/i-spec1.boot6
-rw-r--r--src/interp/i-spec2.boot7
6 files changed, 50 insertions, 22 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index d8ef7f6a..e05ce10c 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,17 @@
+2010-05-25 Gabriel Dos Reis <gdr@cse.tamu.edu>
+
+ * interp/i-spec2.boot (evalREPEAT): Generate %repeat forms.
+ (interpREPEAT): Likewise.
+ * interp/i-spec1.boot (interpCOLLECT): Generate %collect forms.
+ * interp/i-map.boot (findLocalVars1): Handle %repeat forms the
+ same as REPEAT forms.
+ * interp/g-opt.boot (changeThrowToExit): Don't look into %repeat
+ forms.
+ (expandInit): New.
+ (expandLoop): New. abstract from expandCollect.
+ (expandCollect): Use it. Rework.
+ (expandRepeat): New.
+
2010-05-25 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/g-util.boot: Implement expansion of %collect forms.
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 2717312a..6e0ea498 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) => nil
+ atom s or first s in '(QUOTE SEQ REPEAT COLLECT %collect %repeat) => 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 72c05126..8958843e 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -116,6 +116,9 @@ expandUNTIL p ==
g := gensym()
[[[g,false]],nil,[["SETQ",g,middleEndExpand p]],nil,[g]]
+expandInit(var,val) ==
+ [[[var,middleEndExpand val]],nil,nil,nil,nil]
+
expandIterators iters ==
[toLisp it or leave "failed" for it in iters] where
toLisp it ==
@@ -125,37 +128,49 @@ expandIterators iters ==
it is ["WHILE",pred] => expandWHILE pred
it is [op,pred] and op in '(SUCHTHAT _|) => expandSUCHTHAT pred
it is ["UNTIL",pred] => expandUNTIL pred
+ it is ["%init",var,val] => expandInit(var,val)
nil
-++ Generate code for list comprehension.
-expandCollect ["%collect",:iters,body] ==
+expandLoop(iters,body,ret) ==
itersCode := expandIterators iters
- itersCode = "failed" => systemErrorHere ["expandCollect",iters]
- val := gensym() -- result of the list comprehension
+ itersCode = "failed" => systemErrorHere ["expandLoop",iters]
+ body := middleEndExpand body
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.
+ [loopInits,bodyInits,cont,filters,exits] := itersCode
+ -- Guard the 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]]],
+ [mkpf(exits,"OR"),["RETURN",ret]],
[true,body]]
body := ["LOOP",exits,:cont]
-- Finally, set up loop-wide initializations.
- ["LET",[:loopInits,[val,nil]],body]
+ loopInits = nil => body
+ ["LET",loopInits,body]
+
+++ Generate code for list comprehension.
+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]]
+ -- Initialize the variable holding the result; expand as
+ -- if ordinary loop. But don't forget we built the result
+ -- in reverse order.
+ expandLoop([:iters,["%init",val,nil]],body,["NREVERSE",val])
+
+++ Generate code for plain loop.
+expandRepeat ["%repeat",:iters,body] ==
+ expandLoop(iters,body,["voidValue"])
++ Table of opcode-expander pairs.
$OpcodeExpanders == [
- ["%collect",:"expandCollect"]
+ ["%collect",:"expandCollect"],
+ ["%repeat",:"expandRepeat"]
]
++ Return the expander of a middle-end opcode, or nil if there is none.
diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot
index 9bb6bf4e..bfc99b6d 100644
--- a/src/interp/i-map.boot
+++ b/src/interp/i-map.boot
@@ -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 %collect) =>
+ form is [oper,:itrl,body] and oper in '(REPEAT COLLECT %collect %repeat) =>
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 769af133..2b3b5ba3 100644
--- a/src/interp/i-spec1.boot
+++ b/src/interp/i-spec1.boot
@@ -572,11 +572,11 @@ 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 :=
- null value => '(None)
+ null value => $None
last $collectTypeList
rm := ['Tuple,t]
value := [objValUnwrap coerceInteractive(objNewWrap(v,m),t)
@@ -817,7 +817,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) => -- Introduces a new bound variable?
+ op in '(COLLECT REPEAT %collect %repeat) =>
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 d874e184..85035890 100644
--- a/src/interp/i-spec2.boot
+++ b/src/interp/i-spec2.boot
@@ -952,11 +952,10 @@ 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]
- if repeatMode = $Void then code := ['OR,code,'(voidValue)]
+ code := ["%repeat",:[evalLoopIter itr for itr in itrl], bodyCode]
code := timedOptimization code
if $breakCount > 0 then code := ['CATCH,$repeatLabel,code]
- val:=
+ val :=
$genValue =>
timedEVALFUN code
objNewWrap(voidValue(),repeatMode)
@@ -975,7 +974,7 @@ 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],
+ ["%repeat",:[interpIter itr for itr in itrl],
["CATCH",$repeatBodyLabel,interpLoop(body,$indexVars,
$indexTypes,nil)]]
SPADCATCH(eval $repeatLabel,timedEVALFUN code)