diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2016-11-06 19:22:11 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2016-11-06 19:22:11 -0800 |
commit | 8077a89133b50fb6863ce0b202803d1cf41d8f39 (patch) | |
tree | 5366d44f6d2007ef6072c512eb1bf20297d5b6a7 | |
parent | 64941defcd16ba61afee20ab5fb0eac6e6ea58b1 (diff) | |
download | txr-8077a89133b50fb6863ce0b202803d1cf41d8f39.tar.gz txr-8077a89133b50fb6863ce0b202803d1cf41d8f39.tar.bz2 txr-8077a89133b50fb6863ce0b202803d1cf41d8f39.zip |
Fix regression: infinite loop in place expansion.
This shows up when the anaphoric ifa is used.
Test case:
| (ifa (f a)
| (set it (g it)))
* share/txr/stdlib/place.tl (sys:pl-expand): In the
origin chasing loop, use a stack to more thoroughly
detect a cycle.
-rw-r--r-- | share/txr/stdlib/place.tl | 10 |
1 files changed, 6 insertions, 4 deletions
diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl index 48e0182e..12ad1b71 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -165,12 +165,14 @@ (defun sys:cp-origin (to-tree from-form : circ-check) (unless (memq to-tree circ-check) (tree-case to-tree - ((a . d) (whenlet (next-orig - (orig (macro-ancestor to-tree))) - (while (and (neq orig from-form) + ((a . d) (whenlet ((next-orig nil) + (visited-stack (list from-form)) + (orig (macro-ancestor to-tree))) + (while (and (not (memq orig visited-stack)) (sys:setq next-orig (macro-ancestor orig))) + (sys:setq visited-stack (cons next-orig visited-stack)) (sys:setq orig next-orig)) - (unless (eq orig from-form) + (unless (memq orig visited-stack) (sys:set-macro-ancestor orig from-form))) (sys:cp-origin a from-form (cons to-tree circ-check)) (sys:cp-origin d from-form (cons to-tree circ-check))))) |