From e9584df65c00f385474f9e4dd56b95b51e1efb65 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sat, 3 Dec 2011 04:24:04 +0000
Subject: * 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.
---
src/ChangeLog | 9 +++++++++
src/algebra/aggcat.spad.pamphlet | 2 ++
src/interp/g-opt.boot | 35 ++++++++++++-----------------------
src/interp/g-util.boot | 23 +++++++++++++++++++++++
4 files changed, 46 insertions(+), 23 deletions(-)
(limited to 'src')
diff --git a/src/ChangeLog b/src/ChangeLog
index 05dbc0cb..6f3f808a 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+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.
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
@@ -46,6 +46,29 @@ module g_-util where
isDefaultPackageName: %Symbol -> %Boolean
makeDefaultPackageName: %String -> %Symbol
+--%
+
+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
--
cgit v1.2.3