Practical Common Lisp

read-value with the appropriate slot types as the first argument. The code you want to generate is going to look like this:

(defmethod read-value ((type (eql 'id3-tag)) in &key)
  (let ((object (make-instance 'id3-tag)))
    (with-slots (identifier major-version revision flags size frames) object
      (setf identifier    (read-value 'iso-8859-1-string in :length 3))
      (setf major-version (read-value 'u1 in))
      (setf revision      (read-value 'u1 in))
      (setf flags         (read-value 'u1 in))
      (setf size          (read-value 'id3-encoded-size in))
      (setf frames        (read-value 'id3-frames in :tag-size size)))
    object))

So, just as you needed a function to translate a define-binary-class slot specifier to a DEFCLASS slot specifier in order to generate the DEFCLASS form, now you need a function that takes a define-binary- class slot specifier and generates the appropriate SETF form, that is, something that takes this:

(identifier (iso-8859-1-string :length 3))

and returns this:

(setf identifier (read-value 'iso-8859-1-string in :length 3))

However, there's a difference between this code and the DEFCLASS slot specifier: it includes a reference to a variable in—the method parameter from the read- value method—that wasn't derived from the slot specifier. It doesn't have to be called in, but whatever name you use has to be the same as the one used in the method's parameter list and in the other calls to read-value. For now you can dodge the issue of where that name comes from by defining slot->read-value to take a second argument of the name of the stream variable.

(defun slot->read-value (spec stream)
  (destructuring-bind (name (type &rest args)) (normalize-slot-spec spec)
    `(setf ,name (read-value ',type ,stream ,@args))))

The function normalize-slot-spec normalizes the second element of the slot specifier, converting a symbol like u1 to the list (u1) so the DESTRUCTURING-BIND can parse it. It looks like this:

(defun normalize-slot-spec (spec)
  (list (first spec) (mklist (second spec))))
(defun mklist (x) (if (listp x) x (list x)))

You can test slot->read-value with each type of slot specifier.

BINARY-DATA> (slot->read-value '(major-version u1) 'stream)
(SETF MAJOR-VERSION (READ-VALUE 'U1 STREAM))
BINARY-DATA> (slot->read-value '(identifier (iso-8859-1-string :length 3)) 'stream)
(SETF IDENTIFIER (READ-VALUE 'ISO-8859-1-STRING STREAM :LENGTH 3))

With these functions you're ready to add read-value to define-binary-class. If you take the handwritten read-value method and strip out anything that's tied to a particular class, you're left with this skeleton:

(defmethod read-value ((type (eql ...)) stream &key)
  (let ((object (make-instance ...)))
    (with-slots (...) object
      ...
    object)))

All you need to do is add this skeleton to the define-binary-class template, replacing ellipses with code that fills in the skeleton with the appropriate names and code. You'll also want to replace the variables type, stream, and object with gensymed names to avoid potential conflicts with slot names,[268] which you can do with the with-gensyms macro from Chapter 8.

Also, because a macro must expand into a single form, you need to wrap some form around the DEFCLASS and DEFMETHOD. PROGN is the customary form to use for macros that expand into multiple definitions because of the special treatment it gets from the file compiler when appearing at the top level of a file, as I discussed in Chapter 20.

So, you can change define-binary-class as follows:

(defmacro define-binary-class (name slots)
  (with-gensyms (typevar objectvar streamvar)
    `(progn
       (defclass ,name ()
         ,(mapcar #'slot->defclass-slot slots))
       (defmethod read-value ((,typevar (eql ',name)) ,streamvar &key)
         (let ((,objectvar (make-instance ',name)))
           (with-slots ,(mapcar #'first slots) ,objectvar
             ,@(mapcar #'(lambda (x) (slot->read-value x streamvar)) slots))
           ,objectvar)))))

Writing Binary Objects

Generating code to write out an instance of a binary class will proceed similarly. First you can define a write-value generic function.

(defgeneric write-value (type stream value &key)
  (:documentation 'Write a value as the given type to the stream.'))

Then you define a helper function that translates a define-binary-class slot specifier into code that writes out the slot using write-value. As with the slot->read-value function, this helper function needs to take the name of the stream variable as an argument.

(defun slot->write-value (spec stream)
  (destructuring-bind (name (type &rest args)) (normalize-slot-spec spec)
    `(write-value ',type ,stream ,name ,@args)))

Now you can add a write-value template to the define-binary-class macro.

(defmacro define-binary-class (name slots)
  (with-gensyms (typevar objectvar streamvar)
    `(progn
       (defclass ,name ()
         ,(mapcar #'slot->defclass-slot slots))
       (defmethod read-value ((,typevar (eql ',name)) ,streamvar &key)
         (let ((,objectvar (make-instance ',name)))
           (with-slots ,(mapcar #'first slots) ,objectvar
             ,@(mapcar #'(lambda (x) (slot->read-value x streamvar)) slots))