Adding with-slots macro.

* lisplib.c (place_set_entries): Add with-slots to autoload
name list.

* share/txr/stdlib/struct.tl (with-slots): New macro.

* txr.1: Documented.

3 files changed, 98 insertions, 0 deletions

diff --git a/lisplib.c b/lisplib.c
index fcaf05f1..6c6dd2d7 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -72,6 +72,7 @@ static val place_set_entries(val dlt, val fun)
     lit("pushnew"), lit("del"),
     lit("defplace"), lit("define-place-macro"), lit("define-modify-macro"),
     lit("placelet"), lit("placelet*"), lit("define-acessor"),
+    lit("with-slots"),
     nil
   };
 
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index c9d19e91..bc463274 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -236,3 +236,12 @@
 (defmacro defmeth (type-sym name arglist . body)
   ^(sys:defmeth ',type-sym ',name (lambda ,arglist
                                     (block ,name ,*body))))
+
+(defmacro with-slots ((. slot-specs) obj-expr . body)
+  (with-gensyms (obj-sym)
+    ^(let ((,obj-sym ,obj-expr))
+       (symacrolet (,*(mapcar [iff consp
+                                   (aret ^(,@1 (slot ,obj-sym ',@2)))
+                                   (ret ^(,@1 (slot ,obj-sym ',@1)))]
+                              slot-specs))
+         ,*body))))
diff --git a/txr.1 b/txr.1
index 19b9f58d..af09e88b 100644
--- a/txr.1
+++ b/txr.1
@@ -19311,6 +19311,94 @@ arranged by
 by a non-local exit such as an exception throw, the object's
 finalizers, if any, are invoked.
 
+.coNP Macro @ with-slots
+.synb
+.mets (with-slots >> ({ slot | >> ( sym << slot )}*) < struct-expr
+.mets \ \  << body-form *)
+.syne
+.desc
+The
+.code with-slots
+binds lexical macros to serve as aliases for the slots of a structure.
+
+The
+.meta struct-expr
+argument is expected to be an expression which evaluates to a struct
+object. It is evaluated once, and its value is retained. The aliases are then
+established to the slots of the resulting struct value.
+
+The aliases are specified as zero or more expressions which consist of either
+a single symbol
+.meta slot
+or a
+.cblk
+.meti >> ( sym << slot )
+.cble
+pair. The simple form binds a macro named
+.meta slot
+to a slot also named
+.metn slot .
+The pair form binds a macro named
+.meta sym
+to a slot named
+.metn slot .
+
+The lexical aliases are syntactic places: assigning to an alias causes
+the value to be stored into the slot which it denotes.
+
+After evaluating
+.meta struct-expr
+the
+.code with-slots
+macro arranges for the evaluation of
+.metn body-form -s
+in the lexical scope in which the aliases are visible.
+
+.TP* "Dialect Notes:"
+
+The intent of the
+.code with-slots
+macro is to help reduce the verbosity of code which makes multiple
+references to the same slot. Use of
+.code with-slots
+is less necessary in \*(TL than other Lisp dialects
+thanks to the dot operator for accessing struct slots.
+
+Lexical aliases to struct places can also be
+arranged with considerable convenience using the
+.code placelet
+operator. However,
+.code placelet
+will not bind multiple aliases to multiple slots of the same object
+such that the expression which produces the object is evaluated only
+once.
+
+.TP* Example:
+.cblk
+  (defstruct point nil x y)
+
+  ;; Here, with-slots introduces verbosity because
+  ;; each slot is accessed only once. The function
+  ;; is equivalent to:
+  ;;
+  ;; (defun point-delta (p0 p1)
+  ;;   (new point x (- p1.x p0.x) y (- p1.y p0.y)))
+  ;;
+  ;; Also contrast with the use of placelet:
+  ;;
+  ;; (defun point-delta (p0 p1)
+  ;;   (placelet ((x0 p0.x) (y0 p0.y)
+  ;;              (x1 p1.x) (y1 p1.y))
+  ;;     (new point x (- x1 x0) y (- y1 y0)))))
+
+  (defun point-delta (p0 p1)
+    (with-slots ((x0 x) (y0 y)) p0
+      (with-slots ((x1 x) (y1 y)) p1
+        (new point x (- x1 x0) y (- y1 y0)))))
+
+
+.cble
+
 .coNP Macro @ qref
 .synb
 .mets (qref < object-form