diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2020-05-31 18:04:59 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2020-05-31 18:04:59 -0700 |
| commit | b5c6ac6f6a5dec8b0422d678b137b53092f82b79 (patch) | |
| tree | 18dc1273195dde366b0064168cca0955374ec791 | |
| parent | a488d2e3d4ffd9148083c30c318a4f127bca65f0 (diff) | |
| download | txr-b5c6ac6f6a5dec8b0422d678b137b53092f82b79.tar.gz txr-b5c6ac6f6a5dec8b0422d678b137b53092f82b79.tar.bz2 txr-b5c6ac6f6a5dec8b0422d678b137b53092f82b79.zip | |
compiler: bugfix: missing block in dohash and each.
The compiler's expander for dohash, and for the each family of
operators neglects to add the (block nil ...) around the forms
that are expected to be in a block.
* share/txr/stdlib/compiler.tl (expand-dohash, expand-each):
Generate the (block nil ...) around the sys:for construct
which doesn't produce one.
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 34 |
1 files changed, 18 insertions, 16 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 75ecdef0..3b5caffe 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -1369,12 +1369,13 @@ (mac-param-bind form (op (key-var val-var hash-form : res-form) . body) form (with-gensyms (iter-var cell-var) ^(let (,key-var ,val-var (,iter-var (hash-begin ,hash-form)) ,cell-var) - (sys:for-op ((sys:setq ,cell-var (hash-next ,iter-var))) - (,cell-var ,res-form) - ((sys:setq ,cell-var (hash-next ,iter-var))) - (sys:setq ,key-var (car ,cell-var)) - (sys:setq ,val-var (cdr ,cell-var)) - ,*body))))) + (block nil + (sys:for-op ((sys:setq ,cell-var (hash-next ,iter-var))) + (,cell-var ,res-form) + ((sys:setq ,cell-var (hash-next ,iter-var))) + (sys:setq ,key-var (car ,cell-var)) + (sys:setq ,val-var (cdr ,cell-var)) + ,*body)))))) (defun expand-each (form env) (mac-param-bind form (op each-type vars . body) form @@ -1385,16 +1386,17 @@ (gensym))) (accum (if out (gensym)))) ^(let* (,*(zip gens vars) ,*(if accum ^((,out (cons nil nil)) (,accum ,out)))) - (sys:for-op () - ((and ,*gens) ,*(if accum ^((cdr ,out)))) - (,*(mapcar (ret ^(sys:setq ,@1 (cdr ,@1))) gens)) - ,*(mapcar (ret ^(sys:setq ,@1 (car ,@2))) vars gens) - ,*(caseq each-type - (collect-each ^((rplacd ,accum (cons (progn ,*body) nil)) - (sys:setq ,accum (cdr ,accum)))) - (append-each ^((rplacd ,accum (append (cdr ,accum) (progn ,*body))) - (sys:setq ,accum (last ,accum)))) - (t body))))))) + (block nil + (sys:for-op () + ((and ,*gens) ,*(if accum ^((cdr ,out)))) + (,*(mapcar (ret ^(sys:setq ,@1 (cdr ,@1))) gens)) + ,*(mapcar (ret ^(sys:setq ,@1 (car ,@2))) vars gens) + ,*(caseq each-type + (collect-each ^((rplacd ,accum (cons (progn ,*body) nil)) + (sys:setq ,accum (cdr ,accum)))) + (append-each ^((rplacd ,accum (append (cdr ,accum) (progn ,*body))) + (sys:setq ,accum (last ,accum)))) + (t body)))))))) (defun expand-bind-mac-params (ctx-form err-form params menv-var obj-var strict err-block body) |