aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog7
-rw-r--r--src/interp/compiler.boot17
-rw-r--r--src/interp/g-opt.boot2
-rw-r--r--src/interp/g-util.boot16
4 files changed, 32 insertions, 10 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index df375ae9..f278102d 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,12 @@
2011-12-03 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/compiler.boot: Use %seq in lieu of PROGN.
+ * interp/g-util.boot (spliceSeqArgs): New.
+ * interp/g-opt.boot (changeVariableDefinitionToStore): Call it
+ before recursing on %seq forms.
+
+2011-12-03 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/compiler.boot (setqMultiple): Handle lhs and rhs of type
Cross instance.
* interp/g-util.boot ($DomainNames): Include Cross.
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 140d2362..04807d73 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -271,7 +271,7 @@ freeVarUsage([.,vars,body],env) ==
for v in CDDR u repeat
free := freeList(v,bound,free,e)
free
- op = "PROG" =>
+ op = 'PROG =>
bound := setUnion(bound, second u)
for v in CDDR u | cons? v repeat
free := freeList(v,bound,free,e)
@@ -978,7 +978,7 @@ setqMultiple(nameList,val,m,e) ==
m1 is ["List",D] =>
for y in nameList repeat
e:= giveVariableSomeValue(y,D,e)
- coerce([["PROGN",x,["%LET",nameList,g],g],m',e],m)
+ coerce([['%seq,x,["%LET",nameList,g],g],m',e],m)
-- 3. For a cross, do it by hand here instead of general mm. FIXME.
m1 is ['Cross,:.] =>
n := #m1.args
@@ -988,7 +988,7 @@ setqMultiple(nameList,val,m,e) ==
for y in nameList for t in m1.args for i in 0.. repeat
e := giveVariableSomeValue(y,t,e)
stmts := [['%LET,y,['%call,eltRecordFun(n,i),g,i]],:stmts]
- coerce([['PROGN,x,:reverse! stmts,g],m1,e],m)
+ coerce([['%seq,x,:reverse! stmts,g],m1,e],m)
-- 4. verify that the #nameList = number of parts of right-hand-side
selectorModePairs:=
--list of modes
@@ -1005,7 +1005,7 @@ setqMultiple(nameList,val,m,e) ==
[([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr
for x in nameList for [y,:z] in selectorModePairs]
assignList="failed" => nil
- [mkpf([x,:assignList,g],'PROGN),m',e]
+ [['%seq,x,:assignList,g],m',e]
setqMultipleExplicit(nameList,valList,m,e) ==
#nameList~=#valList =>
@@ -1020,7 +1020,7 @@ setqMultipleExplicit(nameList,valList,m,e) ==
[[.,.,e]:= compSetq1(name,g,$EmptyMode,e) or return "failed"
for g in gensymList for name in nameList]
reAssignList="failed" => nil
- [["PROGN",:[T.expr for T in assignList],:[T.expr for T in reAssignList]],
+ [['%seq,:[T.expr for T in assignList],:[T.expr for T in reAssignList]],
$NoValueMode, last(reAssignList).env]
--% Quasiquotation
@@ -1781,8 +1781,7 @@ coerceEasy(T,m) ==
m=$NoValueMode or m=$Void => [T.expr,m,T.env]
T.mode =m => T
T.mode =$Exit =>
- [["PROGN", T.expr, ["userError", '"Did not really exit."]],
- m,T.env]
+ [['%seq,T.expr,["userError", '"Did not really exit."]],m,T.env]
T.mode=$EmptyMode or modeEqualSubst(T.mode,m,T.env) =>
[T.expr,m,T.env]
@@ -2141,7 +2140,7 @@ compRetractGuard(x,t,sn,sm,e) ==
-- the condition and the body of the alternative, so just use
-- assignment here and let the rest of the compiler deal with it.
z := gensym()
- caseCode := ["PROGN",["%LET",z,retractCode],['%ieq,['%head,z],0]]
+ caseCode := ['%seq,["%LET",z,retractCode],['%ieq,['%head,z],0]]
restrictCode := ["%tail",z]
-- 1.3. Everything else failed; nice try.
else return stackAndThrow('"%1bp is not retractable to %2bp",[sm,t])
@@ -2213,7 +2212,7 @@ compRecoverGuard(x,t,sn,sm,e) ==
[def,.,e] := compOrCroak(varDef,$EmptyMode,e)
[hasTest,.,e] := compOrCroak(["has",var',cat'],$EmptyMode,e)
[guard,inits,e,envFalse] := compRecoverDomain(x,var',sn,e)
- [["PROGN",def,hasTest],inits,e,envFalse]
+ [['%seq,def,hasTest],inits,e,envFalse]
-- 2. Hand it to whoever is in charge.
compRecoverDomain(x,t,sn,e)
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 1e2d5ff8..5299fc74 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -136,6 +136,8 @@ changeVariableDefinitionToStore(form,vars) ==
vars
form is ['%loop,:iters,body,val] =>
changeLoopVarDefsToStore(iters,body,val,vars)
+ if form is ['%seq,:.] then
+ form.args := spliceSeqArgs form.args
for x in form repeat
vars := changeVariableDefinitionToStore(x,vars)
vars
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index c305a9bf..236076c0 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -45,6 +45,7 @@ module g_-util where
usedSymbol?: (%Symbol,%Code) -> %Boolean
isDefaultPackageName: %Symbol -> %Boolean
makeDefaultPackageName: %String -> %Symbol
+ spliceSeqArgs: %List %Code -> %Code
--%
@@ -67,7 +68,20 @@ mkBind(inits,expr) ==
mkBind([:inits,:inits'],expr')
['%bind,inits,expr]
-
+++ We have a list `l' of expressions to be executed sequentially.
+++ Splice in any directly-embedded sequence of expressions.
+++ NOTES: This function should not be called on any program with
+++ an %exit-form in it. In particular, it should be called
+++ (if at all) before any call to simplifyVMForm.
+spliceSeqArgs l ==
+ atomic? l => l
+ l is [['%seq,:stmts],:.] =>
+ stmts = nil => spliceSeqArgs rest l
+ lastNode(stmts).rest := spliceSeqArgs rest l
+ stmts
+ rest l = nil => l
+ l.rest := spliceSeqArgs rest l
+ l
--%