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