From 75abded71ecaf0f5d1d3257f436b2df9690bdc25 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 23 Jan 2021 18:19:52 -0800
Subject: places: fix runaway recursion bug.

The following form fails to expand:

  (let (a) (set a '#1=(#1#)))

This is due to macro ancestor propagation which wants to
traverse the entire (set ...) form in order to indicate its
macro ancestor.

* share/txr/stdlib/place.tl (sys:propagate-ancestor): We check
whether to-tree already has a macro ancestor, and only recurse
if it doesn't.
---
 share/txr/stdlib/place.tl | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

(limited to 'share')

diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
index ac403ccb..3ee0ea8c 100644
--- a/share/txr/stdlib/place.tl
+++ b/share/txr/stdlib/place.tl
@@ -135,12 +135,13 @@
   ^(let ,(zip syms (repeat '((gensym)))) ,*body))
 
 (defun sys:propagate-ancestor (to-tree from-form . syms)
-  (tree-case to-tree
-    ((a . d)
-     (when (memq a syms)
-       (sys:set-macro-ancestor to-tree from-form))
-     (sys:propagate-ancestor a from-form . syms)
-     (sys:propagate-ancestor d from-form . syms)))
+  (unless (macro-ancestor to-tree)
+    (tree-case to-tree
+      ((a . d)
+       (when (memq a syms)
+         (sys:set-macro-ancestor to-tree from-form))
+       (sys:propagate-ancestor a from-form . syms)
+       (sys:propagate-ancestor d from-form . syms))))
   to-tree)
 
 (defun call-update-expander (getter setter unex-place env body)
-- 
cgit v1.2.3