diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-28 06:51:26 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-28 06:51:26 -0800 |
| commit | 83d294fe8651643b7064dfea1402e24629853452 (patch) | |
| tree | e930033012fef8d6531d36782844c016fd5843eb /share | |
| parent | 600ec3af3f742f361164aac53cda6b02b90e5173 (diff) | |
| download | txr-83d294fe8651643b7064dfea1402e24629853452.tar.gz txr-83d294fe8651643b7064dfea1402e24629853452.tar.bz2 txr-83d294fe8651643b7064dfea1402e24629853452.zip | |
compiler: bug: append-each mutates lists.
* share/txr/stdlib/compiler.tl (expand-each): The algorithm
for appending is completely wrong. Not only does it
destructively mutate, it doesn't look like it will behave like
the interpreted append-each operator, since it assumes
it can rplacd the tail cons of the output list, which won't
work for non-list sequence types.
* share/txr/stdlib/compiler.tl (expand-each): New translation
strategy: append-each each will now accumulate the values of
the body expression into a list, exactly like collect-each
does. Then it will apply the sys:append function to that list.
This ensures the "as if" semantics (append-each behaves like
the append function), and non-destructive behavior: everything
is copied that needs to be, except that a list tail can share
substructure.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 12 |
1 files changed, 7 insertions, 5 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 65ce119c..bf06548e 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -1416,14 +1416,16 @@ ,*(if accum ^((,out (cons nil nil)) (,accum ,out)))) (block nil (sys:for-op () - ((and ,*(mapcar (op list 'iter-more) gens)) ,*(if accum ^((cdr ,out)))) + ((and ,*(mapcar (op list 'iter-more) gens)) + ,*(if accum (if (eq each-type 'collect-each) + ^((cdr ,out)) + ^((sys:apply (fun append) ,out))))) (,*(mapcar (ret ^(sys:setq ,@1 (iter-step ,@1))) gens)) ,*(mapcar (ret ^(sys:setq ,@1 (iter-item ,@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)))) + ((collect-each append-each) + ^((rplacd ,accum (cons (progn ,*body) nil)) + (sys:setq ,accum (cdr ,accum)))) (t body)))))))) (defun expand-bind-mac-params (ctx-form err-form params menv-var |