aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/compiler.boot7
-rw-r--r--src/interp/g-opt.boot13
-rw-r--r--src/interp/g-util.boot4
3 files changed, 22 insertions, 2 deletions
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],