Peter Siebel - Practical Common Lisp

(defmethod read-value ((type (eql 'iso-8859-1-string)) in &key length) ...)

(defmethod read-value ((type (eql 'u1)) in &key) ...)

Then you can make define-binary-classgenerate a read-valuemethod specialized on the type name id3-tag, and that method can be implemented in terms of calls to read-valuewith 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-classslot specifier to a DEFCLASS slot specifier in order to generate the DEFCLASS form, now you need a function that takes a define-binary-classslot 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-valuemethod—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-valueto 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-specnormalizes the second element of the slot specifier, converting a symbol like u1to 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-valuewith 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-valueto define-binary-class. If you take the handwritten read-valuemethod 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-classtemplate, 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 objectwith gensymed names to avoid potential conflicts with slot names, [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. which you can do with the with-gensymsmacro 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-classas 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)))))

Generating code to write out an instance of a binary class will proceed similarly. First you can define a write-valuegeneric 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-classslot specifier into code that writes out the slot using write-value. As with the slot->read-valuefunction, 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-valuetemplate to the define-binary-classmacro.

(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))))))

While this version of define-binary-classwill 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-classto 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.