diff options
| -rw-r--r-- | stdlib/compiler.tl | 8 |
1 files changed, 6 insertions, 2 deletions
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index 7ad727e0..37e2b684 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -1703,7 +1703,9 @@ (defmeth compiler comp-tree-case (me oreg env form) (mac-param-bind form (op obj . cases) form - (let* ((nenv (new env up env co me)) + (let* ((tpos *tail-pos*) + (*tail-pos* nil) + (nenv (new env up env co me)) (obj-immut-var nenv.(extend-var (gensym))) (obj-var nenv.(extend-var (gensym))) (err-blk (gensym)) @@ -1711,8 +1713,9 @@ (ctx-form (rlcp-tree ^'(,op) form)) (treg me.(maybe-alloc-treg oreg)) (objfrag me.(compile treg env obj)) + (ncases (len cases)) (cfrags (collect-each ((c cases) - (i (range 1))) + (i 1)) (mac-param-bind form (params . body) c (let* ((src (expand ^(block ,err-blk (set ,obj-var.sym @@ -1722,6 +1725,7 @@ params nil obj-var.sym : err-blk body)))) + (*tail-pos* (if (eq c ncases) tpos)) (cfrag me.(compile treg nenv src))) (new (frag treg ^(,*cfrag.code |