From c9a91f89404386552c174fee057b68b3d20c42a8 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sun, 6 Nov 2016 19:22:11 -0800 Subject: 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. --- share/txr/stdlib/place.tl | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'share') 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))))) -- cgit v1.2.3