diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2025-06-20 07:17:47 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2025-06-20 07:17:47 -0700 |
| commit | 3227d5a67d9554a7814422dd558647a5017e9558 (patch) | |
| tree | f06ec39eebe5268f1aa6732567ea2439d23eab31 /stdlib/compiler.tl | |
| parent | 0e55be1f72abc62e0520a6ed05ce974517ba3df3 (diff) | |
| download | txr-3227d5a67d9554a7814422dd558647a5017e9558.tar.gz txr-3227d5a67d9554a7814422dd558647a5017e9558.tar.bz2 txr-3227d5a67d9554a7814422dd558647a5017e9558.zip | |
compiler: only last case of tree-case is tail position.
* stdlib/compiler.tl (compiler comp-tree-case): Disable the
tail position for all but the last cases. The reason is that
the case result values are checked for : fallthrough.
It's a bad hack we should think about restricting to static
cases.
Diffstat (limited to 'stdlib/compiler.tl')
| -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 |