From 5243b933a609af037a5e39f76ea7d61b07bd1343 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 24 Jul 2015 18:22:36 -0700
Subject: Bugfix: place-form-p must expand place macros.

* share/txr/stdlib/place.tl (place-form-p): Take
environment parameter. Expand the place form using sys:pl-expand.

* share/txr/stdlib/ifa.tl (ifa): Pass environment
to place-form-p.
(nthcdr): Pass environment down to place-form-p.
---
 ChangeLog                 | 11 +++++++++++
 share/txr/stdlib/ifa.tl   |  2 +-
 share/txr/stdlib/place.tl | 12 ++++++------
 3 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 56f45633..8e083b18 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2015-07-24  Kaz Kylheku  <kaz@kylheku.com>
+
+	Bugfix: place-form-p must expand place macros.
+
+	* share/txr/stdlib/place.tl (place-form-p): Take
+	environment parameter. Expand the place form using sys:pl-expand.
+
+	* share/txr/stdlib/ifa.tl (ifa): Pass environment
+	to place-form-p.
+	(nthcdr): Pass environment down to place-form-p.
+
 2015-07-24  Kaz Kylheku  <kaz@kylheku.com>
 
 	* eval.c (op_quote): Improved diagnostic.
diff --git a/share/txr/stdlib/ifa.tl b/share/txr/stdlib/ifa.tl
index 1f79c208..c6a9abd2 100644
--- a/share/txr/stdlib/ifa.tl
+++ b/share/txr/stdlib/ifa.tl
@@ -47,7 +47,7 @@
              (throwf 'eval-error "ifa: ambiguous situation: \
                                  \ not clear what can be \"it\""))
            (iflet ((it-form (macroexpand [args pos-candidate] e))
-                   (is-place (place-form-p it-form)))
+                   (is-place (place-form-p it-form e)))
              (let ((before-it [args 0..pos-candidate])
                    (after-it [args (succ pos-candidate)..:]))
                (let* ((btemps (mapcar (ret (gensym) before-it)))
diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
index f086ce31..398ecbe3 100644
--- a/share/txr/stdlib/place.tl
+++ b/share/txr/stdlib/place.tl
@@ -83,10 +83,10 @@
                      (makunbound ',',place-expr))))
        ,*op-body))
 
-  (defun place-form-p (place)
-    (when (or (bindable place)
-              (and (consp place) [*place-update-expander* (car place)]))
-      t))
+  (defun place-form-p (unex-place env)
+    (let ((place (sys:pl-expand unex-place env)))
+      (or (bindable place)
+          (and (consp place) [*place-update-expander* (car place)] t))))
 
   (defun get-update-expander (place)
     (cond
@@ -355,10 +355,10 @@
                          (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
        ,body)))
 
-(defplace (nthcdr index list) body
+(defplace (nthcdr index list :env env) body
   (getter setter
     (with-gensyms (index-sym sentinel-head-sym parent-cell-sym)
-      (if (place-form-p list)
+      (if (place-form-p list env)
         (with-update-expander (lgetter lsetter) list nil
           ^(rlet ((,index-sym ,index))
              (let* ((,sentinel-head-sym (cons nil (,lgetter)))
-- 
cgit v1.2.3