diff options
| -rw-r--r-- | src/ChangeLog | 9 | ||||
| -rw-r--r-- | src/algebra/aggcat.spad.pamphlet | 2 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 35 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 23 |
4 files changed, 46 insertions, 23 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 05dbc0cb..6f3f808a 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,14 @@ 2011-12-02 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/g-util.boot (hasNoLeave?): Move from g-opt.boot. + (mkLabelled): New. + (mkBind): Likewise. + * interp/g-opt.boot (groupVariableDefinitions): Use them. + * algebra/aggcat.spad.pamphlet (ListAggregate) [merge!]: Declare + local variables `r' and `s' before assigning to them. + +2011-12-02 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/g-opt.boot (iteratorName): New. (changeLoopVarDefsToStore): Likewise. (changeVariableDefinitionToStore): Use it. Tidy. diff --git a/src/algebra/aggcat.spad.pamphlet b/src/algebra/aggcat.spad.pamphlet index 3d0e1e14..ab9eb619 100644 --- a/src/algebra/aggcat.spad.pamphlet +++ b/src/algebra/aggcat.spad.pamphlet @@ -2353,6 +2353,8 @@ ListAggregate(S:Type): Category == Join(StreamAggregate S, empty? p => q empty? q => p eq?(p, q) => error "cannot merge a list into itself" + r: % + t: % if f(first p, first q) then (r := t := p; p := rest p) else (r := t := q; q := rest q) diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 64cde531..a53f6fb9 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -171,29 +171,23 @@ groupVariableDefinitions form == second(clause) := groupVariableDefinitions second clause form form is ['%labelled,tag,expr] => - expr := groupVariableDefinitions expr - expr is ['%bind,inits,expr'] and - (and/[hasNoLeave init for [.,init] in inits]) => - ['%bind,inits,['%labelled,tag,expr']] - [form.op,tag,expr] + mkLabelled(tag,groupVariableDefinitions expr) form is ['%bind,inits,expr] => - expr := groupVariableDefinitions expr - expr is ['%bind,inits',expr'] => ['%bind,[:inits,:inits'],expr'] - [form.op,inits,expr] + mkBind(inits,groupVariableDefinitions expr) form is ['%lambda,:.] => [form.absKind,form.absParms,groupVariableDefinitions form.absBody] form is ['%loop,:iters,body,val] => [form.op,:iters,groupVariableDefinitions body,val] form isnt ['%seq,:stmts,['%exit,val]] => form - defs := nil - for x in stmts while nonExitingSingleAssignment? x repeat - defs := [x.args,:defs] - defs = nil or jumpToToplevel? defs => form + form.args = nil => nil + form.args is [s] => groupVariableDefinitions s + defs := [s.args for s in stmts while nonExitingSingleAssignment? s] + defs = nil => form stmts := drop(#defs,stmts) expr := stmts = nil => val ['%seq,:stmts,['%exit,val]] - ['%bind,reverse! defs,expr] + mkBind(defs,expr) optimizeFunctionDef(def) == if $reportOptimization then @@ -227,8 +221,8 @@ optimizeFunctionDef(def) == [name,[slamOrLam,args,body']] resetTo(x,y) == - y isnt [.,:.] => x := y - sameObject?(x,y) => x + y isnt [.,:.] => y + sameObject?(x,y) => y x.first := y.first x.rest := y.rest x @@ -266,11 +260,6 @@ changeLeaveToExit(s,g) == changeLeaveToExit(first s,g) changeLeaveToExit(rest s,g) -hasNoLeave(a,g) == - a is ['%leave, =g,:.] => false - a isnt [.,:.] => true - hasNoLeave(first a,g) and hasNoLeave(rest a,g) - changeLeaveToGo(s,g) == s isnt [.,:.] or s.op is 'QUOTE => nil s is ['%leave, =g,u] => @@ -303,9 +292,9 @@ optLabelled (x is ['%labelled,g,a]) == changeLeaveToExit(s,g) a.rest := [:s,['%exit,u]] a := simplifyVMForm a - if hasNoLeave(a,g) then - resetTo(x,a) - else + a isnt [.,:.] => a + do + hasNoLeave?(a,g) => resetTo(x,a) changeLeaveToGo(a,g) x.first := '%seq x.rest := [['%exit,a],second g,['%exit,second g]] diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 18ada7f8..b9a6e99c 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -48,6 +48,29 @@ module g_-util where --% +hasNoLeave?(expr,g) == + expr is ['%leave, =g,:.] => false + expr isnt [.,:.] => true + hasNoLeave?(first expr,g) and hasNoLeave?(rest expr,g) + +mkLabelled(tag,expr) == + expr is ['%leave,=tag,expr'] and hasNoLeave?(expr',tag) => expr' + expr is ['%bind,inits,expr'] and hasNoLeave?(inits,tag) => + mkBind(inits,mkLabelled(tag,expr')) + hasNoLeave?(expr,tag) => expr + ['%labelled,tag,expr] + +mkBind(inits,expr) == + expr is ['%leave,tag,expr'] => + ['%leave,tag,mkBind(inits,expr')] + expr is ['%bind,inits',expr'] => + mkBind([:inits,:inits'],expr') + ['%bind,inits,expr] + + + +--% + ++ List of category constructors that do not have entries in the ++ constructor database. So, they are mostly recognized by their names. $CategoryNames == |