From 9cde874de258533a18944602afa62c9e56ac991a Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 20 Jun 2010 15:00:29 +0000
Subject: 	* interp/compiler.boot (massageLoop): New. 
 (compRepeatOrCollect): Use it to generate appropriate %loop forms. 	Bind
 new special variable $mayHaveFreeIteratorVariables. 	(complainIfShadowing):
 Set it as appropriate.

---
 src/interp/compiler.boot | 31 ++++++++++++++++++++++++++++++-
 src/interp/g-util.boot   |  1 +
 2 files changed, 31 insertions(+), 1 deletion(-)

(limited to 'src/interp')

diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index ceae230f..d5febb66 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -2263,6 +2263,33 @@ localReferenceIfThere m ==
   idx := NRTassocIndex m => ["getShellEntry","$",idx]
   quoteForm m
 
+massageLoop x == main x where
+  main x ==
+    x isnt ['CATCH,tag,['REPEAT,:iters,body]] => x
+    $mayHaveFreeIteratorVariables or CONTAINED('TAGGEDexit,x) => x
+    replaceThrowWithLeave(body,tag)
+    containsNonLocalControl?(body,nil) => systemErrorHere ['massageLoop,x]
+    ['CATCH,tag,['%loop,:iters,body,'%nil]]
+  replaceThrowWithLeave(x,tag) ==
+    isAtomicForm x => nil
+    x is ['THROW,=tag,expr] =>
+      replaceThrowWithLeave(expr,tag)
+      -- Avoid redudant THROW for return-expressions.
+      if expr is ['TAGGEDreturn,:.] then
+        x.op := expr.op
+        x.args := expr.args
+      else
+        x.op := '%leave
+        x.args := rest x.args
+    for x' in x repeat replaceThrowWithLeave(x',tag)
+  containsNonLocalControl?(x,tags) ==
+    isAtomicForm x => false
+    x is ['THROW,tag,x'] =>
+      not(tag in tags) or containsNonLocalControl?(x',tags)
+    x is ['CATCH,tag,x'] =>
+      containsNonLocalControl?(x',[tag,:tags])
+    or/[containsNonLocalControl?(x',tags) for x' in x]
+
 compRepeatOrCollect(form,m,e) ==
   fn(form,[m,:$exitModeStack],[#$exitModeStack,:$leaveLevelStack],$formalArgList
     ,e) where
@@ -2272,6 +2299,7 @@ compRepeatOrCollect(form,m,e) ==
         $iterateCount: local := 0
         $loopBodyTag: local := nil
         $breakCount: local := 0
+        $mayHaveFreeIteratorVariables: local := false
         oldEnv := e
         aggr := nil
         [repeatOrCollect,:itl,body]:= form
@@ -2315,7 +2343,7 @@ compRepeatOrCollect(form,m,e) ==
         T := coerceExit([form',m'',e'],targetMode) or return nil
         -- iterator variables and other variables declared in
         -- in a loop are local to the loop.
-        [T.expr,T.mode,oldEnv]
+        [massageLoop T.expr,T.mode,oldEnv]
  
 --constructByModemap([x,source,e],target) ==
 --  u:=
@@ -2367,6 +2395,7 @@ compIntegerValue(x,e) ==
 ++ declaration  or definition in the enclosing scope.  
 complainIfShadowing(x,e) ==
   if getmode(x,e) ~= nil then
+    $mayHaveFreeIteratorVariables := true  -- bound in compRepeatOrCollect
     stackWarning('"loop variable %1b shadows variable from enclosing scope",[x])
 
 ++ Attempt to compile a `for' iterator of the form
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 689f2d5d..ed134390 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -332,6 +332,7 @@ for x in [
     -- general utility
     ['%hash,     :'SXHASH],
     ['%lam,      :'LAMBDA],
+    ['%leave,    :'RETURN],
     ['%otherwise,:'T],
     ['%when,     :'COND]
   ] repeat property(first x,'%Rename) := rest x
-- 
cgit v1.2.3