From 8629f3e1eb6860d72861800ed5004cf0ae5dd2b3 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 13 Oct 2022 07:21:53 -0700
Subject: New function: macroexpand-place.

* stdlib/place.tl (sys:pl-expand): Function renamed to
macroexpand-place; env parameter becomes optional.
(macroexpand-1-place): New function.
(place-form-p, call-update-expander, call-clobber-expander,
call-delete-expander): Follow rename.

* autoload.c (place_set_entries): Register symbols
macroexpand-place and macroexpand-1-place for autoload.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.
---
 stdlib/doc-syms.tl |  2 ++
 stdlib/place.tl    | 19 +++++++++++++------
 2 files changed, 15 insertions(+), 6 deletions(-)

(limited to 'stdlib')

diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index d6c001c1..e75ad2c7 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -1185,8 +1185,10 @@
       ("macroexpand" "N-02ED5471")
       ("macroexpand-1" "N-02ED5471")
       ("macroexpand-1-lisp1" "N-01E62179")
+      ("macroexpand-1-place" "N-00684FF9")
       ("macroexpand-lisp1" "N-01E62179")
       ("macroexpand-params" "N-037EB49A")
+      ("macroexpand-place" "N-00684FF9")
       ("macrolet" "N-00AC12C0")
       ("madv-dontneed" "N-027D1E84")
       ("madv-normal" "N-027D1E84")
diff --git a/stdlib/place.tl b/stdlib/place.tl
index 07ee7be4..fcc86735 100644
--- a/stdlib/place.tl
+++ b/stdlib/place.tl
@@ -63,7 +63,7 @@
   (or [*place-macro* sym]
       (progn (sys:autoload-try-fun sym) [*place-macro* sym])))
 
-(defun sys:pl-expand (unex-place env)
+(defun macroexpand-place (unex-place : env)
   (while t
     (let ((place unex-place)
           pm-expander)
@@ -76,11 +76,18 @@
       (when (or (eq place unex-place)
                 (null place)
                 (and (atom place) (not (symbolp place))))
-        (return-from sys:pl-expand place))
+        (return-from macroexpand-place place))
       (sys:setq unex-place place))))
 
+(defun macroexpand-1-place (unex-place : env-unused)
+  (let ((pm-expander (if (consp unex-place)
+                       (sys:get-place-macro (car unex-place)))))
+    (if pm-expander
+      [pm-expander unex-place]
+      unex-place)))
+
 (defun place-form-p (unex-place env)
-  (let ((place (sys:pl-expand unex-place env)))
+  (let ((place (macroexpand-place unex-place env)))
     (or (bindable place)
         (and (consp place) [*place-update-expander* (car place)] t))))
 
@@ -147,7 +154,7 @@
 
 (defun call-update-expander (getter setter unex-place env body)
   (sys:propagate-ancestor body unex-place getter setter)
-  (let* ((place (sys:pl-expand unex-place env))
+  (let* ((place (macroexpand-place unex-place env))
          (expander (get-update-expander place))
          (sys:*pl-env* env)
          (sys:*pl-form* unex-place)
@@ -157,7 +164,7 @@
 
 (defun call-clobber-expander (ssetter unex-place env body)
   (sys:propagate-ancestor body unex-place ssetter)
-  (let* ((place (sys:pl-expand unex-place env))
+  (let* ((place (macroexpand-place unex-place env))
          (expander (get-clobber-expander place))
          (sys:*pl-env* env)
          (sys:*pl-form* unex-place)
@@ -167,7 +174,7 @@
 
 (defun call-delete-expander (deleter unex-place env body)
   (sys:propagate-ancestor body unex-place deleter)
-  (let* ((place (sys:pl-expand unex-place env))
+  (let* ((place (macroexpand-place unex-place env))
          (expander (get-delete-expander place))
          (sys:*pl-env* env)
          (sys:*pl-form* unex-place)
-- 
cgit v1.2.3