From 11e9c8bdc2031050e78f10a8a43ab817870f4ddc Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sun, 31 May 2020 18:04:59 -0700 Subject: 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. --- share/txr/stdlib/compiler.tl | 34 ++++++++++++++++++---------------- 1 file 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) -- cgit v1.2.3