From 5897492b4cb4c906efe21246facf6f46fbcc8ff9 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Mon, 26 Mar 2018 06:18:09 -0700 Subject: compiler: implement block* special form. * share/txr/stdlib/compiler.tl (compiler compile): Route block* to same helper method as block. (compiler comp-block): Handle block* also by compiling the name form and using the resulting value as the name operand in the block instruction. --- share/txr/stdlib/compiler.tl | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index f2614f77..f1ccccd4 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -175,7 +175,7 @@ (cond me.(comp-cond oreg env form)) (if me.(comp-if oreg env form)) (unwind-protect me.(comp-unwind-protect oreg env form)) - (block me.(comp-block oreg env form)) + ((block block*) me.(comp-block oreg env form)) (return-from me.(comp-return-from oreg env form)) (return me.(comp-return oreg env form)) ((let let*) me.(comp-let oreg env form)) @@ -428,11 +428,14 @@ (defmeth compiler comp-block (me oreg env form) (mac-param-bind form (op name . body) form - (let* ((nreg (if name me.(get-dreg name) '(t 0))) + (let* ((star (and name (eq op 'block*))) + (nfrag (if star me.(compile oreg env name))) + (nreg (if star nfrag.oreg me.(get-dreg name))) (bfrag me.(comp-progn oreg env body)) (lskip (gensym "l"))) (new (frag oreg - ^((block ,oreg ,nreg ,lskip) + ^(,*(if nfrag nfrag.code) + (block ,oreg ,nreg ,lskip) ,*bfrag.code (end ,bfrag.oreg) ,lskip) -- cgit v1.2.3