From 7422a29157bf7de1742eade45590dbed7d0d4a12 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Mon, 7 Jun 2010 16:00:24 +0000
Subject: 	* interp/compiler.boot (replaceExitEtc): Replace TAGGEDreturn
 with 	%return. 	* interp/g-opt.boot (removeNeedlessThrow): New. 
 (optCatch): Use to it to avoid horrendous code generation for 	return
 statement. 	* interp/g-util.boot (expandReturn): New.  Expand %return
 forms.

---
 src/interp/compiler.boot |  7 +++++--
 src/interp/g-opt.boot    | 13 +++++++++++++
 src/interp/g-util.boot   |  4 ++++
 3 files changed, 22 insertions(+), 2 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index c4bee569..16222b24 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1036,8 +1036,11 @@ replaceExitEtc(x,tag,opFlag,opMode) ==
                   --bound in compSeq1 and compDefineCapsuleFunction
             $finalEnv => intersectionEnvironment($finalEnv,t.env)
             t.env
-          x.op := "THROW"
-          first(x.args) := tag
+          if opFlag = 'TAGGEDreturn then
+            x.op := '%return
+          else 
+            x.op := "THROW"
+            first(x.args) := tag
           second(x.args) := convertOrCroak(t,opMode).expr
         first(x.args) := second x-1
       x is [key,n,t] and key in '(TAGGEDreturn TAGGEDexit) =>
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 86fc6bc4..ad2cff91 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -143,9 +143,22 @@ changeThrowToGo(s,g) ==
   changeThrowToGo(first s,g)
   changeThrowToGo(rest s,g)
 
+++ Change any `(THROW tag (%return expr))' in x to just
+++ `(%return expr) since a return-operator transfer control
+++ out of the function body anyway.
+removeNeedlessThrow x ==
+  isAtomicForm x => x
+  x is ['THROW,.,y] and y is ['%return,:.] =>
+    removeNeedlessThrow third y
+    x.op := y.op
+    x.args := y.args
+  for x' in x repeat
+    removeNeedlessThrow x'
+
 optCatch (x is ["CATCH",g,a]) ==
   $InteractiveMode => x
   atom a => a
+  removeNeedlessThrow a
   if a is ["SEQ",:s,["THROW", =g,u]] then
     changeThrowToExit(s,g)
     a.rest := [:s,["EXIT",u]]
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 957d676a..0d786928 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -212,6 +212,9 @@ expandCollect ["%collect",:iters,body] ==
 expandRepeat ["%repeat",:iters,body] ==
   expandLoop(iters,body,["voidValue"])
 
+expandReturn(x is ['%return,.,y]) ==
+  $FUNNAME = nil => systemErrorHere ['expandReturn,x]
+  ['RETURN_-FROM,$FUNNAME,expandToVMForm y]
   
 -- Logical operators
 
@@ -330,6 +333,7 @@ for x in [
 for x in [
    ["%collect",:function expandCollect],
    ["%repeat",:function expandRepeat],
+   ['%return,  :function expandReturn],
 
    ["%eq",:function expandEq],
 
-- 
cgit v1.2.3