Peter Siebel - Practical Common Lisp

`(progn

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

(setf (get ',name 'slots) ',(mapcar #'first slots))

(setf (get ',name 'superclasses) ',superclasses))

(defclass ,name ,superclasses

,(mapcar #'slot->defclass-slot slots))

,read-method

(defmethod write-object progn ((,objectvar ,name) ,streamvar)

(declare (ignorable ,streamvar))

(with-slots ,(new-class-all-slots slots superclasses) ,objectvar

,@(mapcar #'(lambda (x) (slot->write-value x streamvar)) slots))))))

Now you can define both define-binary-classand define-tagged-binary-classto expand into a call to define-generic-binary-class. Here's a new version of define-binary-classthat generates the same code as the earlier version when it's fully expanded:

(defmacro define-binary-class (name (&rest superclasses) slots)

(with-gensyms (objectvar streamvar)

`(define-generic-binary-class ,name ,superclasses ,slots

(defmethod read-object progn ((,objectvar ,name) ,streamvar)

(declare (ignorable ,streamvar))

(with-slots ,(new-class-all-slots slots superclasses) ,objectvar

,@(mapcar #'(lambda (x) (slot->read-value x streamvar)) slots))))))

And here's define-tagged-binary-classalong with two new helper functions it uses:

(defmacro define-tagged-binary-class (name (&rest superclasses) slots &rest options)

(with-gensyms (typevar objectvar streamvar)

`(define-generic-binary-class ,name ,superclasses ,slots

(defmethod read-value ((,typevar (eql ',name)) ,streamvar &key)

(let* ,(mapcar #'(lambda (x) (slot->binding x streamvar)) slots)

(let ((,objectvar

(make-instance

,@(or (cdr (assoc :dispatch options))

(error "Must supply :dispatch form."))

,@(mapcan #'slot->keyword-arg slots))))

(read-object ,objectvar ,streamvar)

,objectvar))))))

(defun slot->binding (spec stream)

(destructuring-bind (name (type &rest args)) (normalize-slot-spec spec)

`(,name (read-value ',type ,stream ,@args))))

(defun slot->keyword-arg (spec)

(let ((name (first spec)))

`(,(as-keyword name) ,name)))

While define-binary-classand define-tagged-binary-classmake it easy to define composite structures, you still have to write read-valueand write-valuemethods for primitive data types by hand. You could decide to live with that, specifying that users of the library need to write appropriate methods on read-valueand write-valueto support the primitive types used by their binary classes.

However, rather than having to document how to write a suitable read-value/ write-valuepair, you can provide a macro to do it automatically. This also has the advantage of making the abstraction created by define-binary-classless leaky. Currently, define-binary-classdepends on having methods on read-valueand write-valuedefined in a particular way, but that's really just an implementation detail. By defining a macro that generates the read-valueand write-valuemethods for primitive types, you hide those details behind an abstraction you control. If you decide later to change the implementation of define-binary-class, you can change your primitive-type-defining macro to meet the new requirements without requiring any changes to code that uses the binary data library.

So you should define one last macro, define-binary-type, that will generate read-valueand write-valuemethods for reading values represented by instances of existing classes, rather than by classes defined with define-binary-class.

For a concrete example, consider a type used in the id3-tagclass, a fixed-length string encoded in ISO-8859-1 characters. I'll assume, as I did earlier, that the native character encoding of your Lisp is ISO-8859-1 or a superset, so you can use CODE-CHAR and CHAR-CODE to translate bytes to characters and back.

As always, your goal is to write a macro that allows you to express only the essential information needed to generate the required code. In this case, there are four pieces of essential information: the name of the type, iso-8859-1-string; the &key parameters that should be accepted by the read-valueand write-valuemethods, lengthin this case; the code for reading from a stream; and the code for writing to a stream. Here's an expression that contains those four pieces of information:

(define-binary-type iso-8859-1-string (length)

(:reader (in)

(let ((string (make-string length)))

(dotimes (i length)

(setf (char string i) (code-char (read-byte in))))

string))

(:writer (out string)

(dotimes (i length)

(write-byte (char-code (char string i)) out))))

Now you just need a macro that can take apart this form and put it back together in the form of two DEFMETHOD s wrapped in a PROGN . If you define the parameter list to define-binary-typelike this:

(defmacro define-binary-type (name (&rest args) &body spec) ...

then within the macro the parameter specwill be a list containing the reader and writer definitions. You can then use ASSOC to extract the elements of specusing the tags :readerand :writerand then use DESTRUCTURING-BIND to take apart the REST of each element. [269] Using ASSOC to extract the :reader and :writer elements of spec allows users of define-binary-type to include the elements in either order; if you required the :reader element to be always be first, you could then have used (rest (first spec)) to extract the reader and (rest (second spec)) to extract the writer. However, as long as you require the :reader and :writer keywords to improve the readability of define-binary-type forms, you might as well use them to extract the correct data.

From there it's just a matter of interpolating the extracted values into the backquoted templates of the read-valueand write-valuemethods.

(defmacro define-binary-type (name (&rest args) &body spec)

(with-gensyms (type)

`(progn

,(destructuring-bind ((in) &body body) (rest (assoc :reader spec))

`(defmethod read-value ((,type (eql ',name)) ,in &key ,@args)

,@body))

,(destructuring-bind ((out value) &body body) (rest (assoc :writer spec))

`(defmethod write-value ((,type (eql ',name)) ,out ,value &key ,@args)

,@body)))))

Note how the backquoted templates are nested: the outermost template starts with the backquoted PROGN form. That template consists of the symbol PROGN and two comma-unquoted DESTRUCTURING-BIND expressions. Thus, the outer template is filled in by evaluating the DESTRUCTURING-BIND expressions and interpolating their values. Each DESTRUCTURING-BIND expression in turn contains another backquoted template, which is used to generate one of the method definitions to be interpolated in the outer template.