CLOS objects with many slots

[jakykong]

I'm working on a small game, and I found a situation where with-slots seems cumbersome. Specifically, I'm writing a method that calculates whether a game object's bounding rectangle will collide before it actually does collide. Actually checking a collision isn't hard conceptually, it just has a large number of slots to consider. Here's a stripped down version of the class in question:

Code: Select all

(defclass block ()
  (x y                ; Location of upper-left corner
   w h                ; Dimensions
   vx vy              ; Movement speed in pixels per second
   last-update-time)) ; Time at last movement update as returned by (sdl2:get-ticks), milliseconds

The issue is that the collision function code becomes unwieldy when using with-slots:

Code: Select all

; Elided for brevity
(defun blocks-will-collide-p ((b1 block) (b2 block))
  (with-slots ((x1 x) (y1 y) (w1 w) (h1 h) ...) b1
    (with-slots ((x2 x) ...) b2
      ( #| collision check |# ))))

What is the conventional way to deal with objects like this, where a fairly large number of slots are required for a computation?

I tried to simplify this particular case with a macro called with-object I wrote, but I'm really wondering if there's a cleaner or more "standard" solution, besides explicitly typing out every object and slot combination. See working code below for the solution I came up with.

Code: Select all

;;; Supporting macro definition for (with-object...)

(require :closer-mop)
(require :alexandria)

(defun all-direct-slots (class)
  "Returns list of all slots for a given class."
  ;Credits: This answer: https://stackoverflow.com/a/38473905
  (append (closer-mop:class-direct-slots class)
          (alexandria:mappend #'all-direct-slots
                   (closer-mop:class-direct-superclasses class))))

(defun all-direct-slot-names (class)
  "Returns list of all slot names for a given object"
  (mapcar #'closer-mop:slot-definition-name
          (all-direct-slots class)))

(defmacro with-object ((name object class &optional (separator ".")) &body body)
  "Binds symbols such that C++-style dot syntax can be used for slots.
   Example usage:
   (defclass tst () (x y z))
   (setf mx (make-instance 'tst))

   (with-object (var mx tst) (setf var.x 1 var.y 2 var.z 3))"
  (let* ((slot-names (all-direct-slot-names (find-class class)))
         (new-slot-symbols (mapcar (lambda (sname)
                                     (intern (concatenate 'string
                                                          (symbol-name name)
                                                          separator
                                                          (symbol-name sname))))
                                   slot-names)))
    `(with-slots ,(map 'list #'list new-slot-symbols slot-names)
                 ,object
                 ,@body)))


;;; Working future-collision function
(require :sdl2)

(defmethod block-will-collide-p ((b1 block) (b2 block))
  (with-object (a b1 block)
    (with-object (b b2 block)
      (let* ((time-a (- (sdl2:get-ticks) a.last-update-tick))
             (a.xp (truncate (+ a.x (* 1/1000 a.vx time-a))))
             (a.yp (truncate (+ a.y (* 1/1000 a.vy time-a))))

             (time-b (- (sdl2:get-ticks) b.last-update-tick))
             (b.xp (truncate (+ b.x (* 1/1000 b.vx time-b))))
             (b.yp (truncate (+ b.y (* 1/1000 b.vy time-b)))))
        (sdl2:has-intersect (sdl2:make-rect a.xp a.yp a.w a.h)
                            (sdl2:make-rect b.xp b.yp b.w b.h))))))

[David Mullen]

This should be okay, except you might want to pass the environment to find-class (from the &environment parameter of the macro). There's an access library that has a with-dot macro, and it operates in an "inverse" way (so to speak) from what you're doing. It scans the body looking for any symbol with a dot in its name, then splits that symbol into two symbols. So it's a mechanical transformation from dot notation to accessor forms.

[pjstirling]

Hmm, I really can't imagine a use of the ENV parameter that isn't deeply icky. It implies you mucking around with classes in a way that must surely break existing instances in a way that the normal method (evaluating a new DEFCLASS form) would safely navigate.

Am I wrong?

http://www.lispworks.com/documentation/ ... find-class

[David Mullen]

Hmm, I really can't imagine a use of the ENV parameter that isn't deeply icky.

I don't know, I was just referring to this, from defclass:

If a defclass form appears as a top level form, the compiler must make the class name be recognized as a valid type name in subsequent declarations (as for deftype) and be recognized as a valid class name for defmethod parameter specializers and for use as the :metaclass option of a subsequent defclass. The compiler must make the class definition available to be returned by find-class when its environment argument is a value received as the environment parameter of a macro.

[jakykong]

This should be okay, except you might want to pass the environment to find-class (from the &environment parameter of the macro).

Somehow I had entirely missed that &environment exists - learned something new about macro expansion here. Just pulled up the hyperspec to get details, that seems pretty straightforward.

There's an access library that has a with-dot macro, and it operates in an "inverse" way (so to speak) from what you're doing. It scans the body looking for any symbol with a dot in its name, then splits that symbol into two symbols. So it's a mechanical transformation from dot notation to accessor forms.

That's an interesting approach; it wouldn't rely on knowing the class at compile time. The access library feels a little heavy-handed to me, but now I'm wondering if that approach wouldn't work better - (with-object-2 (symbol object) body) expanding body such that symbols with a dot that start with (symbol-name symbol) are expanded, which allows the more compact syntax but avoids the MOP stuff.

I'll give that a try. Thank you!

[David Mullen]

That's an interesting approach; it wouldn't rely on knowing the class at compile time. The access library feels a little heavy-handed to me, but now I'm wondering if that approach wouldn't work better - (with-object-2 (symbol object) body) expanding body such that symbols with a dot that start with (symbol-name symbol) are expanded, which allows the more compact syntax but avoids the MOP stuff.

Yeah, simple enough—here's my take on it. The macro creates a prefix with the name and separator baked in; then each symbol is compared against that prefix. The slot-name is obtained by interning it into the symbol-package of the original (dotted) symbol, where it would (hopefully) already exist in that package.

Code: Select all

(eval-when
    (:compile-toplevel
     :load-toplevel
     :execute)

  (defun slot-symbol-p (symbol prefix)
    (let ((prefix-length (length prefix)))
      (and (symbolp symbol)
           (> (length (string symbol)) prefix-length)
           (string= symbol prefix :end1 prefix-length))))

  (defun slot-value-expand (symbol prefix object)
    (cond ((not (slot-symbol-p symbol prefix)) symbol)
          (t (let* ((symbol-name (symbol-name symbol))
                    (package (symbol-package symbol))
                    (prefix-length (length prefix))
                    (slot-name (subseq symbol-name prefix-length)))
               `(slot-value ,object ',(intern slot-name package))))))

  (defun slot-transform (form prefix object)
    (cond ((atom form) (slot-value-expand form prefix object))
          (t (cons (slot-transform (car form) prefix object)
                   (slot-transform (cdr form) prefix object))))))

(defmacro with-object ((name object &optional (separator ".")) &body body)
  (let ((prefix (concatenate 'string (symbol-name name) (string separator))))
    (slot-transform `(let ((,name ,object)) ,@body) prefix name)))

[pjstirling]

Watch out on sbcl because that's a naive walker

[David Mullen]

You mean it can interfere with SBCL's internal macro-expanded constructs?

[pjstirling]

In sbcl back-quote READs into an internal structure-type (this is allowed by the standard, even if inconvenient), which means that any symbols that you are trying to grovel in that back-quote would be ignored by your walker. I don't know if other things are also allowed to READ non-portably (I'm unaware of anything else that actually READs non-portably in any implementation, but that doesn't mean much)

FLATTEN from the let-over-lambda book code library shows how you can get access to the contents of sbcl back-quote in a naive walker