diff options
| author | dos-reis <gdr@axiomatics.org> | 2011-12-01 07:26:56 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2011-12-01 07:26:56 +0000 |
| commit | e3e244b08ed4c138a2f64092e088612bb9a7e0fa (patch) | |
| tree | e729ba283e403b6ef270668b38e374c9380000cc | |
| parent | 1c6cef480393a8531153737bf2c72da748ca2589 (diff) | |
| download | open-axiom-e3e244b08ed4c138a2f64092e088612bb9a7e0fa.tar.gz | |
* 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.
| -rw-r--r-- | src/ChangeLog | 8 | ||||
| -rw-r--r-- | src/interp/buildom.boot | 4 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 2 | ||||
| -rw-r--r-- | src/interp/lisp-backend.boot | 8 |
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], |