(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))
,objectvar))
(defmethod write-value ((,typevar (eql ',name)) ,streamvar ,objectvar &key)
(with-slots ,(mapcar #'first slots) ,objectvar
,@(mapcar #'(lambda (x) (slot->write-value x streamvar)) slots))))))
Adding Inheritance and Tagged Structures
While this version of define-binary-class will handle stand-alone structures, binary file formats often define on-disk structures that would be natural to model with subclasses and superclasses. So you might want to extend define-binary-class to support inheritance.
A related technique used in many binary formats is to have several on-disk structures whose exact type can be determined only by reading some data that indicates how to parse the following bytes. For instance, the frames that make up the bulk of an ID3 tag all share a common header structure consisting of a string identifier and a length. To read a frame, you need to read the identifier and use its value to determine what kind of frame you're looking at and thus how to parse the body of the frame.
The current define-binary-class macro has no way to handle this kind of reading—you could use define-binary-class to define a class to represent each kind of frame, but you'd have no way to know what type of frame to read without reading at least the identifier. And if other code reads the identifier in order to determine what type to pass to read-value, then that will break read-value since it's expecting to read all the data that makes up the instance of the class it instantiates.
You can solve this problem by adding inheritance to define-binary-class and then writing another macro, define-tagged-binary-class, for defining "abstract" classes that aren't instantiated directly but that can be specialized on by read-value methods that know how to read enough data to determine what kind of class to create.
The first step to adding inheritance to define-binary-class is to add a parameter to the macro to accept a list of superclasses.
(defmacro define-binary-class (name (&rest superclasses) slots) ...
Then, in the DEFCLASS template, interpolate that value instead of the empty list.
(defclass ,name ,superclasses
...)
However, there's a bit more to it than that. You also need to change the read-value and write-value methods so the methods generated when defining a superclass can be used by the methods generated as part of a subclass to read and write inherited slots.
The current way read-value works is particularly problematic since it instantiates the object before filling it in—obviously, you can't have the method responsible for reading the superclass's fields instantiate one object while the subclass's method instantiates and fills in a different object.
You can fix that problem by splitting read-value into two parts—one responsible for instantiating the correct kind of object and another responsible for filling slots in an existing object. On the writing side it's a bit simpler, but you can use the same technique.
268
Technically there's no possibility of type or object conflicting with slot names—at worst they'd be shadowed within the WITH-SLOTS form. But it doesn't hurt anything to simply GENSYM all local variable names used within a macro template.