From 43e0e33ced93434fd32c050ab3ca68a1e7231932 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 21 Apr 2021 06:43:28 -0700
Subject: compile/eval: new operator, mac-env-param-bind.

mac-env-param-bind is like mac-param-bind but also allows
the value for the :env parameter to be specified.

* eval.c (op_mac_env_param_bind_s): New sy mbol variable.
(op_mac_env_param_bind): New static function.
(do_expand): Handle mac_env_param_bind_s.
(eval_init): Initialize symbol variable and register macro.

* share/txr/stdlib/compiler.tl (compiler compile): Add case
for mac-env-param-bind.
(compiler comp-mac-env-param-bind): New method.

* share/txr/stdlib/doc-syms.tl: Updated with new hashes for
tree-bind and mac-param-bind, and inclusion of
mac-env-param-bind.

* tests/012/binding.tl: New file.

* txr.1: Documented.
---
 share/txr/stdlib/compiler.tl | 12 ++++++++++++
 share/txr/stdlib/doc-syms.tl |  5 +++--
 2 files changed, 15 insertions(+), 2 deletions(-)

(limited to 'share')

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 88612e60..127d68af 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -506,6 +506,7 @@
               (dohash me.(compile oreg env (expand-dohash form)))
               (tree-bind me.(comp-tree-bind oreg env form))
               (mac-param-bind me.(comp-mac-param-bind oreg env form))
+              (mac-env-param-bind me.(comp-mac-env-param-bind oreg env form))
               (tree-case me.(comp-tree-case oreg env form))
               (sys:lisp1-value me.(comp-lisp1-value oreg env form))
               (dwim me.(comp-dwim oreg env form))
@@ -1498,6 +1499,17 @@
                                                       obj-var t nil body)))))
         me.(compile oreg env expn)))))
 
+(defmeth compiler comp-mac-env-param-bind (me oreg env form)
+  (mac-param-bind form (op context menv params obj . body) form
+    (with-gensyms (obj-var form-var)
+      (let ((expn (expand ^(let* ((,obj-var ,obj)
+                                  (,form-var ,context))
+                             ,(expand-bind-mac-params form-var
+                                                      form-var
+                                                      params menv
+                                                      obj-var t nil body)))))
+        me.(compile oreg env expn)))))
+
 (defmeth compiler comp-tree-case (me oreg env form)
   (mac-param-bind form (op obj . cases) form
     (let* ((ncases (len cases))
diff --git a/share/txr/stdlib/doc-syms.tl b/share/txr/stdlib/doc-syms.tl
index b980e6b3..64ad54dd 100644
--- a/share/txr/stdlib/doc-syms.tl
+++ b/share/txr/stdlib/doc-syms.tl
@@ -931,7 +931,7 @@
      ("o-rdwr" "N-034BF6C9")
      ("len" "N-03AD172A")
      ("progn" "N-03F7A8B8")
-     ("tree-bind" "N-00A580D9")
+     ("tree-bind" "N-021A9008")
      ("tb" "N-02AB6E53")
      ("rpos" "N-01F68300")
      ("buf-get-int" "N-03C7C985")
@@ -1150,6 +1150,7 @@
      ("make-random-state" "N-032BEE6C")
      ("dir-name" "N-02C01721")
      ("rfind-if" "N-0301CDB6")
+     ("mac-env-param-bind" "N-021A9008")
      ("scan" "N-03E989D0")
      ("vmin" "N-01812D70")
      ("copy-list" "N-006ED237")
@@ -1712,7 +1713,7 @@
      ("indent-foff" "N-00512FDD")
      ("env-fbindings" "N-0018DCDC")
      ("keep-if*" "N-01413802")
-     ("mac-param-bind" "N-00A580D9")
+     ("mac-param-bind" "N-021A9008")
      ("ignerr" "N-007287AC")
      (":match" "N-03B92C0D")
      ("set-max-length" "N-031FA9E5")
-- 
cgit v1.2.3