batch macro creation

Discussion of Common Lisp
Post Reply
humpolec
Posts: 14
Joined: Sun Aug 17, 2008 1:37 pm
Location: Poland

batch macro creation

Post by humpolec » Sun Aug 17, 2008 1:52 pm

Hello everyone, I'm just starting with Lisp and I want to ask for your opinion on some things.
The situation is:

Code: Select all

(defclass square ()
  ((type :initarg :type :initform :wall :accessor square-type))) ; more slots will be added later

;; The default level
(defvar *level*)

(defclass level ()
  ((width :initarg :width :reader level-width)
   (height :initarg :height :reader level-height)
   (data :reader level-data)))

(defmethod initialize-instance :after ((l level) &key)
  (with-slots (width height data)
    (setf data (make-array (list width height)))
    (loop for x from 0 below width do
	 (loop for y from 0 below height do
	      (setf (aref data x y) (make-instance 'square))))))
I have a game level, consisting of squares (the 'data' array). Now, I would want a sane way to access each square's parameters, and (square-type (aref (level-data level) x y)) looks ugly to me. So I wrote this:

Code: Select all

(defclass square ()
  ((type :initarg :type :initform :wall))) ; without accessors

(defconstant +square-slots+ '(type))

(labels ((define-square-accessor (accessor-name slot-name)
	   (eval
	    `(defmacro ,accessor-name (x y &optional (level '*level*))
	       `(slot-value (aref (level-data ,level) ,x ,y) ',',slot-name)))))
  (dolist (slot +square-slots+)
    (define-square-accessor
	(intern (concatenate 'string "SQUARE-" (string slot)))
	slot)))
I define a series of macros so that I can refer to square's slots by forms like (square-type x y level), or even (square-type x y), if I want the default level.
Is this code any good, or is there a better way?

danb
Posts: 35
Joined: Sat Jun 28, 2008 1:05 pm
Location: Urbana, Illinois, US
Contact:

Re: batch macro creation

Post by danb » Sun Aug 17, 2008 3:40 pm

humpolec wrote:

Code: Select all

(labels ((define-square-accessor (accessor-name slot-name)
	   (eval
	    `(defmacro ,accessor-name (x y &optional (level '*level*))
	       `(slot-value (aref (level-data ,level) ,x ,y) ',',slot-name)))))
  (dolist (slot +square-slots+)
    (define-square-accessor
	(intern (concatenate 'string "SQUARE-" (string slot)))
	slot)))
To define an accessor, define a reader function, and then defsetf the function. You can avoid using eval by returning the definition code instead of executing it, splicing the list of definition forms into a progn inside a macro, and then calling the macro. Your definition-returning function has to be defined at expansion time, so I think you have to either make it a lambda or define it globally inside an eval-when form.

Code: Select all

(macrolet ((define-square-slots ()
`(progn
  ,@(mapcar (lambda (slot)
              (let ((fname (intern (concatenate 'string "SQUARE-" (string slot)))))
                `(progn
                  (defun ,fname (x y &optional (level *level*))
                    (slot-value (aref (level-data level) x y) ',slot))
                  (defsetf ,fname (x y &optional (level *level*)) (val)
                    `(setf (slot-value (aref (level-data ,level) ,x ,y) ',',slot) ,val)))))
            *square-slots*))))
(define-square-slots))
Last edited by danb on Sun Aug 17, 2008 6:32 pm, edited 1 time in total.

Harnon
Posts: 78
Joined: Wed Jul 30, 2008 9:59 am

Re: batch macro creation

Post by Harnon » Sun Aug 17, 2008 4:36 pm

Don't you also have to define *square-slots* at compile time, since you're using it at compile time?
(eval-when (:compile-toplevel :load-toplevel :execute)
(defconstant *square-slots* 'type))
I think the code above will work if you just load the file, but not if you do (compile-file "...") and then load the compiled-file (extension:fasl, fas, etc.)

Paul Donnelly
Posts: 148
Joined: Wed Jul 30, 2008 11:26 pm

Re: batch macro creation

Post by Paul Donnelly » Sun Aug 17, 2008 5:05 pm

Personally, I would have done something like:

Code: Select all

(defclass level ()
  ((width :initarg :width :initform 80 :reader level-width)
   (height :initarg :height :initform 24 :reader level-height)
   (data :reader level-data)))

;; I could subclass level and write a specific INITIALIZE-INSTANCE if
;; I wanted different default date based on level type.

(defmethod initialize-instance :after ((l level) &key)
  (with-slots (width height data) l
    (setf data (make-array (list width height)))
    (dotimes (x width)
      (dotimes (y height)
        (setf (aref data x y) (make-instance 'wall))))))

(defvar *level*)

(defclass square ()
  () ;; Some slots.
  )

(defclass wall (square)
  () ;; More slots?
  )

;; More wall types to come.

(defun mapref (x y level)
  (aref (level-data level) x y))

(defun set-mapref (x y level new-value)
  (setf (aref (level-data level) x y) new-value))
(defsetf mapref set-mapref)

(defun type-at (x y level)
  (type-of (mapref x y level)))
And I realize I've totally sidestepped your actual question, but I felt moved to comment on other issues, and I wouldn't even bother making a "quick and easy" way to define all these accessors, because I don't think I'd find them useful. Generally, I find myself getting the accessee in question, then messing with it directly several times in a row:

Code: Select all

     ...(let ((c (board-value board l)))
          (setf (litp c) t)
          (when (opaquep c) (return)))))))
rather than

Code: Select all

     ...(setf (lit-at-p x y level) t)
         (when (opaque-at-p x y level) (return))))))
or

Code: Select all

     ...(setf (litp (board-value board l)) t)
         (when (opaquep (board-value board l)) (return))))))
Your approach seems like an odd way to avoid binding a variable, since it requires you to remember to use a new set of indirect accessors, and to recreate them all if you add new slots.

Post Reply