aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog8
-rw-r--r--src/interp/buildom.boot4
-rw-r--r--src/interp/compiler.boot2
-rw-r--r--src/interp/lisp-backend.boot8
4 files changed, 17 insertions, 5 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index e9e15390..914ca6ee 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2011-12-01 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/buildom.boot (UnionEqual): Use %lambda, not %lam.
+ (coerceUn2E): Likewise.
+ * interp/compiler.boot (massageLoop): %leave now takes a label as
+ first argument.
+ * interp/lisp-backend.boot (expandLeave): New. Expand accordingly.
+
2011-11-30 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/define.boot (registerInlinableDomain): Lose last argument.
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 59e0e68b..67785524 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -423,7 +423,7 @@ UnionEqual(x, y, dom) ==
predlist := mkPredList branches
same := false
for b in stripUnionTags branches for p in predlist while not same repeat
- typeFun := eval ['%lam,'(_#1),p]
+ typeFun := eval ['%lambda,'(_#1),p]
FUNCALL(typeFun,x) and FUNCALL(typeFun,y) =>
string? b => same := (x = y)
if p is ['%ieq,['%head,.],:.] then (x := rest x; y := rest y)
@@ -438,7 +438,7 @@ coerceUn2E(x,source) ==
predlist := mkPredList branches
byGeorge := byJane := gensym()
for b in stripUnionTags branches for p in predlist repeat
- typeFun := eval ['%lam,'(_#1),p]
+ typeFun := eval ['%lambda,'(_#1),p]
if FUNCALL(typeFun,x) then return
if p is ['%ieq,['%head,.],:.] then x := rest x
-- string? b => return x -- to catch "failed" etc.
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index ae2fc54a..e99173ab 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -2429,7 +2429,7 @@ massageLoop x == main x where
x.args := expr.args
else
x.op := '%leave
- x.args := rest x.args
+ x.args := [nil,:rest x.args]
for x' in x repeat replaceThrowWithLeave(x',tag)
containsNonLocalControl?(x,tags) ==
atomic? x => false
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index 3b41d361..61d53837 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -196,6 +196,11 @@ expandList(x is ['%list,:args]) ==
args' = 'failed => ['LIST,:args]
quote args'
+expandLeave ['%leave,l,x] ==
+ x := expandToVMForm x
+ l = nil => ['RETURN,x]
+ ['RETURN_-FROM,l,x]
+
expandReturn(x is ['%return,.,y]) ==
$FUNNAME = nil => systemErrorHere ['expandReturn,x]
['RETURN_-FROM,$FUNNAME,expandToVMForm y]
@@ -626,8 +631,6 @@ for x in [
['%equal, :'EQUAL],
['%tref, :'shellEntry],
['%sptreq, :'EQL], -- system pointer equality
- ['%lam, :'LAMBDA],
- ['%leave, :'RETURN],
['%otherwise,:'T],
['%closure, :'CONS],
['%funcall, :'FUNCALL],
@@ -647,6 +650,7 @@ for x in [
['%collect, :function expandCollect],
['%loop, :function expandLoop],
['%return, :function expandReturn],
+ ['%leave, :function expandLeave],
['%bcompl, :function expandBcompl],