diff options
-rw-r--r-- | src/ChangeLog | 7 | ||||
-rw-r--r-- | src/interp/compiler.boot | 17 | ||||
-rw-r--r-- | src/interp/g-opt.boot | 2 | ||||
-rw-r--r-- | src/interp/g-util.boot | 16 |
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 --% |