object-accessors: with-named-array-references

Author: tfeb

README.md

@@ -1707,8 +1707,46 @@ As with `with-accessors` you can provide names which are different than the acce
 
 There is absolutely nothing special about `with-object-accessors`: it's just the obvious thing you would write using `symbol-macrolet`.  Its only reason to exist is so that it *does* exist: versions of it no longer have to be endlessly rewritten.  It is careful to evaluate the object only once, so `(with-object-accessors (car cdr) (cons 1 2) ...)` would work, say.
 
+Additionally, `object-accessors` now provides a macro for named access to array elements.  This is `with-named-array-references`.  It has independent origin from `with-object-accessors` and takes its arguments in the opposite order.  That's slightly unfortunate.  Its syntax is
+
+```lisp
+(with-named-array-references (<array> [<type>]) ((<name> <index> ...) ...)
+  ...)
+```
+
+The type declaration applies to the binding established for the array.  As an example:
+
+```lisp
+(with-named-array-references (state (array double-float (*))) ((x 0) (y 1) (vx 2) (vy 3))
+  (incf x vx)
+  (incf y vy)
+  state)
+```
+
+will update some 2d state-vector for an object.
+
+Note that the indices are not cached by this macro.  If you have a vector representing lots of object states you might want to define something like:
+
+```lisp
+(defmacro with-state-slots-at ((v n) &body decls/forms)
+  ;; Named access to the state at n in the state vector
+  (with-names (<xi> <yi> <vxi> <vyi>)
+    `(let* ((,<xi> (* ,n 4))
+            (,<yi> (+ ,<xi> 1))
+            (,<vxi> (+ ,<yi> 1))
+            (,<vyi> (+ ,<vxi> 1)))
+       (declare (type array-index ,<xi> ,<yi> ,<vxi> ,<vyi>)
+                (ignorable ,<xi> ,<yi> ,<vxi> ,<vyi>))
+       (with-named-array-references (,v state-vector) ((x ,<xi>) (y ,<yi>)
+                                                       (vx ,<vxi>) (vy ,<vyi>))
+         (declare (ignorable x y vx vy))
+         ,@decls/forms))))
+```
+
+This avoids recomputing the indices each time.
+
 ### Package, module
-`object-accessors` lives in `org.tfeb.hax.object-accessors` and provides `:org.tfeb.hax.object-accessors`.
+`object-accessors` depends on `utilities`, lives in `org.tfeb.hax.object-accessors` and provides `:org.tfeb.hax.object-accessors`.
 
 ## Decomposing iteration: `simple-loops`
 Like a lot of people I have mixed feelings about `loop`.  For a long time I thought that, well, if I wasn't going to use `loop`, I'd need some other elaborate iteration system, although perhaps one which was more principled and extensible such as Richard C Waters' [Series](https://github.com/tfeb/series "Series")[^14].  And I am sure the CL community has invented other tools while I've not been watching.

VERSION

@@ -1 +1 @@
-10.1.0
+10.2.0

object-accessors.lisp

@@ -9,9 +9,16 @@
 ;;; bug fixes.
 ;;;
 
+#+org.tfeb.tools.require-module
+(org.tfeb.tools.require-module:needs
+ (:org.tfeb.hax.utilities :compile t))
+
 (defpackage :org.tfeb.hax.object-accessors
   (:use :cl)
-  (:export #:with-object-accessors))
+  (:use :org.tfeb.hax.utilities)
+  (:export
+   #:with-object-accessors
+   #:with-named-array-references))
 
 (in-package :org.tfeb.hax.object-accessors)
 
@@ -24,19 +31,32 @@ For instance:
     (with-oject-accessors ((kar car) cdr) (cons 1 2)
       ... kar ... cdr ...)
 "
-  (let ((itn (make-symbol "IT")))
-    `(let ((,itn ,object))
+  (with-names (<it>)
+    `(let ((,<it> ,object))
        (symbol-macrolet
            ,(mapcar (lambda (s)
                       (typecase s
                         (symbol
-                         `(,s (,s ,itn)))
+                         `(,s (,s ,<it>)))
                         (cons
                          (unless (and (= (list-length s) 2)
                                       (symbolp (first s)))
                            (error "bad accessor spec ~A" s))
-                         `(,(first s) (,(second s) ,itn)))
+                         `(,(first s) (,(second s) ,<it>)))
                         (t
                          (error "bad accessor spec ~A" s))))
                     accessor-specs)
          ,@decls/forms))))
+
+(defmacro with-named-array-references ((array &optional (type 'array)) (&rest refs)
+                                       &body decls/forms)
+  ;; Arguments are in the other order than WITH-OBJECT-ACCESSORS: I'm
+  ;; uncomfortable about that.
+  "Provide named accessors for elements of an array"
+  (with-names (<a>)
+    `(let ((,<a> ,array))
+       (declare (type ,type ,<a>))
+       (symbol-macrolet ,(mapcar (lambda (ref)
+                                   `(,(first ref) (aref ,<a> ,@(rest ref))))
+                                 refs)
+         ,@decls/forms))))

org.tfeb.hax.asd

@@ -28,7 +28,8 @@
     :depends-on ("collecting" "iterate"))
    (:file "stringtable"
     :depends-on ("collecting" "iterate"))
-   (:file "object-accessors")
+   (:file "object-accessors"
+    :depends-on ("utilities"))
    (:file "utilities"
     :depends-on ("collecting" "iterate"))
    (:file "simple-loops"
@@ -65,7 +66,8 @@
   :depends-on ("org.tfeb.hax" "parachute")
   :pathname "test/"
   :components
-  ((:file "test-binding")
+  ((:file "test-utilities")
+   (:file "test-binding")
    (:file "test-iterate")
    (:file "test-collecting")
    (:file "test-simple-loops")

org.tfeb.hax.object-accessors.asd

@@ -14,5 +14,7 @@
   "MIT"
   :homepage
   "https://github.com/tfeb/tfeb-lisp-hax"
+  :depends-on
+  "utilities"
   :components
   ((:file "object-accessors")))