asdf-support: simplify do-process-import internals

[cl-protobufs.git] / serialize.lisp

diff --git a/serialize.lisp b/serialize.lisp
index 595df40c863a5ed0de8d1a0c65be1e9f831ea20d..cb48a1424ace8582c78a2be7772f293f886c6c35 100644 (file)
--- a/serialize.lisp
+++ b/serialize.lisp
@@ -2,7 +2,7 @@
 ;;;                                                                  ;;;
 ;;; Free Software published under an MIT-like license. See LICENSE   ;;;
 ;;;                                                                  ;;;
 ;;;                                                                  ;;;
 ;;; Free Software published under an MIT-like license. See LICENSE   ;;;
 ;;;                                                                  ;;;

-;;; Copyright (c) 2012 Google, Inc.  All rights reserved.            ;;;
+;;; Copyright (c) 2012-2013 Google, Inc.  All rights reserved.       ;;;

 ;;;                                                                  ;;;
 ;;; Original author: Scott McKay                                     ;;;
 ;;;                                                                  ;;;
 ;;;                                                                  ;;;
 ;;; Original author: Scott McKay                                     ;;;
 ;;;                                                                  ;;;


@@ -13,6 +13,93 @@
 
 ;;; Protobuf serialization from Lisp objects
 
 
 ;;; Protobuf serialization from Lisp objects
 

+;;; Size caches
+
+(defgeneric make-size-cache (object type)
+  (:documentation
+   "Make an object size cache for 'object'."))
+
+;; Note that this gets called on the top-level object being serialized
+;; This means that either all the objects in the tree should be subclasses
+;; of 'base-protobuf-message', or none of them should be. If the root is
+;; not a 'base-protobuf-message', then things will work but be slower; if
+;; the root is a 'base-protobuf-message', but some children are not, then
+;; serialization will fail.
+(defmethod make-size-cache ((object standard-object) type)
+  (declare (ignore type))
+  ;; No '%cached-size' slot in standard objects, create a "visited" table
+  (make-hash-table))
+
+(defmethod make-size-cache ((object base-protobuf-message) type)
+  ;; In classes defined by Protobufs, we will use the '%cached-size' slot
+  ;; This clears the size cache for the tree of objects
+  (clear-size-cache object type)
+  nil)
+
+
+(declaim (inline cached-object-size))
+(defun cached-object-size (object visited)
+  (declare #.$optimize-fast-unsafe)
+  (if visited
+    (gethash object visited)
+    ;; Warning, Will Robinson! Danger!
+    ;; If there's no 'visited' table, assume there's a cached size slot.
+    ;; We should use methods speciaized on 'base-protobuf-message',
+    ;; but we're trying to max out the speed.
+    (slot-value object '%cached-size)))
+
+(defun (setf cached-object-size) (size object visited)
+  (declare #.$optimize-fast-unsafe)
+  (if visited
+    (setf (gethash object visited) size)
+    (setf (slot-value object '%cached-size) size)))
+
+
+(defgeneric clear-size-cache (object type)
+  (:documentation
+   "Clear the size cache for a tree of objects."))
+
+(defmethod clear-size-cache ((object standard-object) type)
+  (declare (ignore type))
+  nil)
+
+(defmethod clear-size-cache ((object base-protobuf-message) type)
+  (let ((message (find-message-for-class type)))
+    (assert message ()
+            "There is no Protobuf message having the type ~S" type)
+    (macrolet ((read-slot (object slot reader)
+                 `(if ,reader
+                    (funcall ,reader ,object)
+                    (slot-value ,object ,slot))))
+      (labels ((do-field (object trace field)
+                 (let* ((type   (if (eq (proto-class field) 'boolean) :bool (proto-class field)))
+                        (slot   (proto-value field))
+                        (reader (proto-reader field))
+                        msg)
+                   (when (or slot reader)
+                     (cond ((eq (proto-required field) :repeated)
+                            (cond ((or (and (proto-packed field) (packed-type-p type))
+                                       (keywordp type)))
+                                  ((typep (setq msg (and type (find-message trace type))) 'protobuf-message)
+                                   (setf (slot-value object '%cached-size) nil)
+                                   (doseq (v (if slot (read-slot object slot reader) (list object)))
+                                     (dolist (f (proto-fields msg))
+                                       (do-field v msg f))))))
+                           (t
+                            (cond ((keywordp type))
+                                  ((typep (setq msg (and type (find-message trace type))) 'protobuf-message)
+                                   (setf (slot-value object '%cached-size) nil)
+                                   (let ((v (if slot (read-slot object slot reader) object)))
+                                     (when v
+                                       (dolist (f (proto-fields msg))
+                                         (do-field v msg f))))))))))))
+          (declare (dynamic-extent #'do-field))
+          (setf (slot-value object '%cached-size) nil)
+          (dolist (field (proto-fields message))
+            (do-field object message field))
+          nil))))
+
+

 ;;; Serialization
 
 (defun serialize-object-to-file (filename object type &key visited)
 ;;; Serialization
 
 (defun serialize-object-to-file (filename object type &key visited)


@@ -38,12 +125,13 @@
    'type' is the Lisp name of a Protobufs message (usually the name of a 
    Lisp class) or a 'protobuf-message'.
    'visited' is a hash table used to cache object sizes. If it is supplied, it will be
    'type' is the Lisp name of a Protobufs message (usually the name of a 
    Lisp class) or a 'protobuf-message'.
    'visited' is a hash table used to cache object sizes. If it is supplied, it will be

-   cleared before it is used; otherwise, a fresh table will be created.
+   cleared before it is used; otherwise, a fresh table will be created if necessary.

    The return value is the buffer containing the serialized object. If the stream is
    nil, the buffer is not actually written to anywhere."
    The return value is the buffer containing the serialized object. If the stream is
    nil, the buffer is not actually written to anywhere."

-  (let* ((visited (let ((v (or visited (make-hash-table))))
-                    (clrhash v)
+  (let* ((visited (let ((v (or visited (make-size-cache object type))))
+                    (when v (clrhash v))

                     v))
                     v))

+         ;; Use 'object-size' to forcibly recompute all the sizes

          (size    (object-size object type visited))
          (buffer  (make-byte-vector size)))
     (serialize-object object type buffer 0 visited)
          (size    (object-size object type visited))
          (buffer  (make-byte-vector size)))
     (serialize-object object type buffer 0 visited)


@@ -63,7 +151,8 @@
     Lisp class) or a 'protobuf-message'.
     The object is serialized into the byte array given by 'buffer' starting
     at the fixnum index 'index' using the wire format.
     Lisp class) or a 'protobuf-message'.
     The object is serialized into the byte array given by 'buffer' starting
     at the fixnum index 'index' using the wire format.

-    'visited' is a hash table used to cache object sizes.
+    'visited' is a hash table used to cache object sizes; if this is nil, then
+    the object caches its size itself in a '%cached-size' slot.

     The return value is the buffer containing the serialized object."))
 
 (defmethod serialize-object (object type buffer &optional start visited)
     The return value is the buffer containing the serialized object."))
 
 (defmethod serialize-object (object type buffer &optional start visited)


@@ -73,12 +162,12 @@
     (serialize-object object message buffer start visited)))
 
 ;; 'visited' is used to cache object sizes
     (serialize-object object message buffer start visited)))
 
 ;; 'visited' is used to cache object sizes

-;; If it's passed in explicitly, it is assumed to already have the sizes within it
+;; If it's non-nil. it must to be a table with the sizes already in it
+;; If it's nil, then the objects must have a '%cached-size' slot

 ;; The default method uses metadata from the protobuf "schema" for the message
 (defmethod serialize-object (object (message protobuf-message) buffer &optional start visited)
   (declare (type (simple-array (unsigned-byte 8)) buffer))
 ;; The default method uses metadata from the protobuf "schema" for the message
 (defmethod serialize-object (object (message protobuf-message) buffer &optional start visited)
   (declare (type (simple-array (unsigned-byte 8)) buffer))

-  (let ((visited (or visited (make-hash-table)))
-        (index   (or start 0)))
+  (let ((index (or start 0)))

     (declare (type fixnum index))
     (macrolet ((read-slot (object slot reader)
                  ;; Don't do a boundp check, we assume the object is fully populated
     (declare (type fixnum index))
     (macrolet ((read-slot (object slot reader)
                  ;; Don't do a boundp check, we assume the object is fully populated


@@ -104,34 +193,31 @@
                                                                    type tag buffer index))))
                                   ((keywordp type)
                                    (let ((tag (make-tag type (proto-index field))))
                                                                    type tag buffer index))))
                                   ((keywordp type)
                                    (let ((tag (make-tag type (proto-index field))))

-                                     (map () #'(lambda (v)
-                                                 (setq index (serialize-prim v type tag buffer index)))
-                                             (read-slot object slot reader))))
+                                     (doseq (v (read-slot object slot reader))
+                                       (setq index (serialize-prim v type tag buffer index)))))

                                   ((typep (setq msg (and type (or (find-message trace type)
                                                                   (find-enum trace type)
                                                                   (find-type-alias trace type))))
                                           'protobuf-message)
                                    (if (eq (proto-message-type msg) :group)
                                   ((typep (setq msg (and type (or (find-message trace type)
                                                                   (find-enum trace type)
                                                                   (find-type-alias trace type))))
                                           'protobuf-message)
                                    (if (eq (proto-message-type msg) :group)

-                                     (map () #'(lambda (v)
-                                                 ;; To serialize a group, we encode a start tag,
-                                                 ;; serialize the fields, then encode an end tag
-                                                 (let ((tag1 (make-tag $wire-type-start-group (proto-index field)))
-                                                       (tag2 (make-tag $wire-type-end-group   (proto-index field))))
-                                                   (setq index (encode-uint32 tag1 buffer index))
-                                                   (map () (curry #'do-field v msg)
-                                                           (proto-fields msg))
-                                                   (setq index (encode-uint32 tag2 buffer index))))
-                                             (if slot (read-slot object slot reader) (list object)))
-                                     (map () #'(lambda (v)
-                                                 ;; To serialize an embedded message, first say that it's
-                                                 ;; a string, then encode its size, then serialize its fields
-                                                 (let ((tag (make-tag $wire-type-string (proto-index field)))
-                                                       (len (object-size v msg visited)))
-                                                   (setq index (encode-uint32 tag buffer index))
-                                                   (setq index (encode-uint32 len buffer index)))
-                                                 (map () (curry #'do-field v msg)
-                                                         (proto-fields msg)))
-                                             (if slot (read-slot object slot reader) (list object)))))
+                                     (doseq (v (if slot (read-slot object slot reader) (list object)))
+                                       ;; To serialize a group, we encode a start tag,
+                                       ;; serialize the fields, then encode an end tag
+                                       (let ((tag1 (make-tag $wire-type-start-group (proto-index field)))
+                                             (tag2 (make-tag $wire-type-end-group   (proto-index field))))
+                                         (setq index (encode-uint32 tag1 buffer index))
+                                         (dolist (f (proto-fields msg))
+                                           (do-field v msg f))
+                                         (setq index (encode-uint32 tag2 buffer index))))
+                                     (doseq (v (if slot (read-slot object slot reader) (list object)))
+                                       ;; To serialize an embedded message, first say that it's
+                                       ;; a string, then encode its size, then serialize its fields
+                                       (let ((tag (make-tag $wire-type-string (proto-index field)))
+                                             (len (cached-object-size v visited)))
+                                         (setq index (encode-uint32 tag buffer index))
+                                         (setq index (encode-uint32 len buffer index)))
+                                       (dolist (f (proto-fields msg))
+                                         (do-field v msg f)))))

                                   ((typep msg 'protobuf-enum)
                                    (let ((tag (make-tag $wire-type-varint (proto-index field))))
                                      ;; 'proto-packed-p' of enum types returns nil,
                                   ((typep msg 'protobuf-enum)
                                    (let ((tag (make-tag $wire-type-varint (proto-index field))))
                                      ;; 'proto-packed-p' of enum types returns nil,


@@ -139,16 +225,17 @@
                                      (if (proto-packed field)
                                        (setq index (serialize-packed-enum (read-slot object slot reader)
                                                                           (proto-values msg) tag buffer index))
                                      (if (proto-packed field)
                                        (setq index (serialize-packed-enum (read-slot object slot reader)
                                                                           (proto-values msg) tag buffer index))

-                                       (map () #'(lambda (v)
-                                                   (setq index (serialize-enum v (proto-values msg) tag buffer index)))
-                                               (read-slot object slot reader)))))
+                                       (doseq (v (read-slot object slot reader))
+                                         (setq index (serialize-enum v (proto-values msg) tag buffer index))))))

                                   ((typep msg 'protobuf-type-alias)
                                    (let* ((type (proto-proto-type msg))
                                           (tag  (make-tag type (proto-index field))))
                                   ((typep msg 'protobuf-type-alias)
                                    (let* ((type (proto-proto-type msg))
                                           (tag  (make-tag type (proto-index field))))

-                                     (map () #'(lambda (v)
-                                                 (let ((v (funcall (proto-serializer msg) v)))
-                                                   (setq index (serialize-prim v type tag buffer index))))
-                                             (read-slot object slot reader))))))
+                                     (doseq (v (read-slot object slot reader))
+                                       (let ((v (funcall (proto-serializer msg) v)))
+                                         (setq index (serialize-prim v type tag buffer index))))))
+                                  (t
+                                   (undefined-field-type "While serializing ~S,"
+                                                         object type field))))

                            (t
                             (cond ((eq type :bool)
                                    ;; We have to handle optional boolean fields specially
                            (t
                             (cond ((eq type :bool)
                                    ;; We have to handle optional boolean fields specially


@@ -164,7 +251,7 @@
                                          (setq index (serialize-prim v type tag buffer index))))))
                                   ((keywordp type)
                                    (let ((v (read-slot object slot reader)))
                                          (setq index (serialize-prim v type tag buffer index))))))
                                   ((keywordp type)
                                    (let ((v (read-slot object slot reader)))

-                                     (when v
+                                     (when (and v (not (equal v (proto-default field))))

                                        (let ((tag (make-tag type (proto-index field))))
                                          (setq index (serialize-prim v type tag buffer index))))))
                                   ((typep (setq msg (and type (or (find-message trace type)
                                        (let ((tag (make-tag type (proto-index field))))
                                          (setq index (serialize-prim v type tag buffer index))))))
                                   ((typep (setq msg (and type (or (find-message trace type)


@@ -177,18 +264,18 @@
                                          (let ((tag1 (make-tag $wire-type-start-group (proto-index field)))
                                                (tag2 (make-tag $wire-type-end-group   (proto-index field))))
                                            (setq index (encode-uint32 tag1 buffer index))
                                          (let ((tag1 (make-tag $wire-type-start-group (proto-index field)))
                                                (tag2 (make-tag $wire-type-end-group   (proto-index field))))
                                            (setq index (encode-uint32 tag1 buffer index))

-                                           (map () (curry #'do-field v msg)
-                                                   (proto-fields msg))
+                                           (dolist (f (proto-fields msg))
+                                             (do-field v msg f))

                                            (setq index (encode-uint32 tag2 buffer index)))
                                          (let ((tag (make-tag $wire-type-string (proto-index field)))
                                            (setq index (encode-uint32 tag2 buffer index)))
                                          (let ((tag (make-tag $wire-type-string (proto-index field)))

-                                               (len (object-size v msg visited)))
+                                               (len (cached-object-size v visited)))

                                            (setq index (encode-uint32 tag buffer index))
                                            (setq index (encode-uint32 len buffer index))
                                            (setq index (encode-uint32 tag buffer index))
                                            (setq index (encode-uint32 len buffer index))

-                                           (map () (curry #'do-field v msg)
-                                                   (proto-fields msg)))))))
+                                           (dolist (f (proto-fields msg))
+                                             (do-field v msg f)))))))

                                   ((typep msg 'protobuf-enum)
                                    (let ((v (read-slot object slot reader)))
                                   ((typep msg 'protobuf-enum)
                                    (let ((v (read-slot object slot reader)))

-                                     (when v
+                                     (when (and v (not (eql v (proto-default field))))

                                        (let ((tag (make-tag $wire-type-varint (proto-index field))))
                                          (setq index (serialize-enum v (proto-values msg) tag buffer index))))))
                                   ((typep msg 'protobuf-type-alias)
                                        (let ((tag (make-tag $wire-type-varint (proto-index field))))
                                          (setq index (serialize-enum v (proto-values msg) tag buffer index))))))
                                   ((typep msg 'protobuf-type-alias)


@@ -197,9 +284,13 @@
                                        (let* ((v    (funcall (proto-serializer msg) v))
                                               (type (proto-proto-type msg))
                                               (tag  (make-tag type (proto-index field))))
                                        (let* ((v    (funcall (proto-serializer msg) v))
                                               (type (proto-proto-type msg))
                                               (tag  (make-tag type (proto-index field))))

-                                         (setq index (serialize-prim v type tag buffer index)))))))))))))
+                                         (setq index (serialize-prim v type tag buffer index))))))
+                                  (t
+                                   (undefined-field-type "While serializing ~S,"
+                                                         object type field)))))))))

         (declare (dynamic-extent #'do-field))
         (declare (dynamic-extent #'do-field))

-        (map () (curry #'do-field object message) (proto-fields message))))
+        (dolist (field (proto-fields message))
+          (do-field object message field))))

     (values buffer index)))
 
 
     (values buffer index)))
 
 


@@ -446,7 +537,8 @@
    "Computes the size in bytes of the object 'object' of type 'type'.
     'type' is the Lisp name of a Protobufs message (usually the name of a 
     Lisp class) or a 'protobuf-message'.
    "Computes the size in bytes of the object 'object' of type 'type'.
     'type' is the Lisp name of a Protobufs message (usually the name of a 
     Lisp class) or a 'protobuf-message'.

-    'visited' is a hash table used to cache object sizes.
+    'visited' is either a hash table used to cache object sizes,
+    or is nil, in which case the objects must have a '%cached-size' slot in them.

     The return value is the size of the object in bytes."))
 
 (defmethod object-size (object type &optional visited)
     The return value is the size of the object in bytes."))
 
 (defmethod object-size (object type &optional visited)


@@ -458,9 +550,6 @@
 ;; 'visited' is used to cache object sizes
 ;; The default method uses metadata from the protobuf "schema" for the message
 (defmethod object-size (object (message protobuf-message) &optional visited)
 ;; 'visited' is used to cache object sizes
 ;; The default method uses metadata from the protobuf "schema" for the message
 (defmethod object-size (object (message protobuf-message) &optional visited)

-  (let ((size (and visited (gethash object visited))))
-    (when size
-      (return-from object-size size)))

   (let ((size 0))
     (declare (type fixnum size))
     (macrolet ((read-slot (object slot reader)
   (let ((size 0))
     (declare (type fixnum size))
     (macrolet ((read-slot (object slot reader)


@@ -484,44 +573,43 @@
                                      (iincf size (packed-size (read-slot object slot reader) type tag))))
                                   ((keywordp type)
                                    (let ((tag (make-tag type (proto-index field))))
                                      (iincf size (packed-size (read-slot object slot reader) type tag))))
                                   ((keywordp type)
                                    (let ((tag (make-tag type (proto-index field))))

-                                     (map () #'(lambda (v)
-                                                 (iincf size (prim-size v type tag)))
-                                             (read-slot object slot reader))))
+                                     (doseq (v (read-slot object slot reader))
+                                       (iincf size (prim-size v type tag)))))

                                   ((typep (setq msg (and type (or (find-message trace type)
                                                                   (find-enum trace type)
                                                                   (find-type-alias trace type))))
                                           'protobuf-message)
                                    (if (eq (proto-message-type msg) :group)
                                   ((typep (setq msg (and type (or (find-message trace type)
                                                                   (find-enum trace type)
                                                                   (find-type-alias trace type))))
                                           'protobuf-message)
                                    (if (eq (proto-message-type msg) :group)

-                                     (map () #'(lambda (v)
-                                                 (let ((tag1 (make-tag $wire-type-start-group (proto-index field)))
-                                                       (tag2 (make-tag $wire-type-end-group   (proto-index field))))
-                                                   (iincf size (length32 tag1))
-                                                   (map () (curry #'do-field v msg)
-                                                           (proto-fields msg))
-                                                   (iincf size (length32 tag2))))
-                                             (if slot (read-slot object slot reader) (list object)))
-                                     (map () #'(lambda (v)
-                                                 (let ((tag (make-tag $wire-type-string (proto-index field)))
-                                                       (len (object-size v msg visited)))
-                                                   (iincf size (length32 tag))
-                                                   (iincf size (length32 len))
-                                                   (map () (curry #'do-field v msg)
-                                                           (proto-fields msg))))
-                                             (if slot (read-slot object slot reader) (list object)))))
+                                     (doseq (v (if slot (read-slot object slot reader) (list object)))
+                                       (let ((tag1 (make-tag $wire-type-start-group (proto-index field)))
+                                             (tag2 (make-tag $wire-type-end-group   (proto-index field))))
+                                         (iincf size (length32 tag1))
+                                         (dolist (f (proto-fields msg))
+                                           (do-field v msg f))
+                                         (iincf size (length32 tag2))))
+                                     (doseq (v (if slot (read-slot object slot reader) (list object)))
+                                       (let ((tag (make-tag $wire-type-string (proto-index field)))
+                                             (len (or (cached-object-size v visited)
+                                                      (object-size v msg visited))))
+                                         (iincf size (length32 tag))
+                                         (iincf size (length32 len))
+                                         (dolist (f (proto-fields msg))
+                                           (do-field v msg f))))))

                                   ((typep msg 'protobuf-enum)
                                    (let ((tag (make-tag $wire-type-varint (proto-index field))))
                                      (if (proto-packed field)
                                        (iincf size (packed-enum-size (read-slot object slot reader) type tag))
                                   ((typep msg 'protobuf-enum)
                                    (let ((tag (make-tag $wire-type-varint (proto-index field))))
                                      (if (proto-packed field)
                                        (iincf size (packed-enum-size (read-slot object slot reader) type tag))

-                                       (map () #'(lambda (v)
-                                                   (iincf size (enum-size v (proto-values msg) tag)))
-                                               (read-slot object slot reader)))))
+                                       (doseq (v (read-slot object slot reader))
+                                         (iincf size (enum-size v (proto-values msg) tag))))))

                                   ((typep msg 'protobuf-type-alias)
                                    (let* ((type (proto-proto-type msg))
                                           (tag  (make-tag type (proto-index field))))
                                   ((typep msg 'protobuf-type-alias)
                                    (let* ((type (proto-proto-type msg))
                                           (tag  (make-tag type (proto-index field))))

-                                     (map () #'(lambda (v)
-                                                 (let ((v (funcall (proto-serializer msg) v)))
-                                                   (iincf size (prim-size v type tag))))
-                                             (read-slot object slot reader))))))
+                                     (doseq (v (read-slot object slot reader))
+                                       (let ((v (funcall (proto-serializer msg) v)))
+                                         (iincf size (prim-size v type tag))))))
+                                  (t
+                                   (undefined-field-type "While computing the size of ~S,"
+                                                         object type field))))

                            (t
                             (cond ((eq type :bool)
                                    (let ((v (cond ((or (eq (proto-required field) :required)
                            (t
                             (cond ((eq type :bool)
                                    (let ((v (cond ((or (eq (proto-required field) :required)


@@ -535,7 +623,7 @@
                                          (iincf size (prim-size v type tag))))))
                                   ((keywordp type)
                                    (let ((v (read-slot object slot reader)))
                                          (iincf size (prim-size v type tag))))))
                                   ((keywordp type)
                                    (let ((v (read-slot object slot reader)))

-                                     (when v
+                                     (when (and v (not (equal v (proto-default field))))

                                        (let ((tag (make-tag type (proto-index field))))
                                          (iincf size (prim-size v type tag))))))
                                   ((typep (setq msg (and type (or (find-message trace type)
                                        (let ((tag (make-tag type (proto-index field))))
                                          (iincf size (prim-size v type tag))))))
                                   ((typep (setq msg (and type (or (find-message trace type)


@@ -546,20 +634,21 @@
                                      (when v
                                        (if (eq (proto-message-type msg) :group)
                                          (let ((tag1 (make-tag $wire-type-start-group (proto-index field)))
                                      (when v
                                        (if (eq (proto-message-type msg) :group)
                                          (let ((tag1 (make-tag $wire-type-start-group (proto-index field)))

-                                             (tag2 (make-tag $wire-type-end-group   (proto-index field))))
+                                               (tag2 (make-tag $wire-type-end-group   (proto-index field))))

                                            (iincf size (length32 tag1))
                                            (iincf size (length32 tag1))

-                                           (map () (curry #'do-field v msg)
-                                                   (proto-fields msg))
+                                           (dolist (f (proto-fields msg))
+                                             (do-field v msg f))

                                            (iincf size (length32 tag2)))
                                          (let ((tag (make-tag $wire-type-string (proto-index field)))
                                            (iincf size (length32 tag2)))
                                          (let ((tag (make-tag $wire-type-string (proto-index field)))

-                                               (len (object-size v msg visited)))
+                                               (len (or (cached-object-size v visited)
+                                                        (object-size v msg visited))))

                                            (iincf size (length32 tag))
                                            (iincf size (length32 len))
                                            (iincf size (length32 tag))
                                            (iincf size (length32 len))

-                                           (map () (curry #'do-field v msg)
-                                                (proto-fields msg)))))))
+                                           (dolist (f (proto-fields msg))
+                                             (do-field v msg f)))))))

                                   ((typep msg 'protobuf-enum)
                                    (let ((v (read-slot object slot reader)))
                                   ((typep msg 'protobuf-enum)
                                    (let ((v (read-slot object slot reader)))

-                                     (when v
+                                     (when (and v (not (eql v (proto-default field))))

                                        (let ((tag (make-tag $wire-type-varint (proto-index field))))
                                          (iincf size (enum-size (read-slot object slot reader) (proto-values msg) tag))))))
                                   ((typep msg 'protobuf-type-alias)
                                        (let ((tag (make-tag $wire-type-varint (proto-index field))))
                                          (iincf size (enum-size (read-slot object slot reader) (proto-values msg) tag))))))
                                   ((typep msg 'protobuf-type-alias)


@@ -568,11 +657,14 @@
                                        (let* ((v    (funcall (proto-serializer msg) v))
                                               (type (proto-proto-type msg))
                                               (tag  (make-tag type (proto-index field))))
                                        (let* ((v    (funcall (proto-serializer msg) v))
                                               (type (proto-proto-type msg))
                                               (tag  (make-tag type (proto-index field))))

-                                         (iincf size (prim-size v type tag)))))))))))))
+                                         (iincf size (prim-size v type tag))))))
+                                  (t
+                                   (undefined-field-type "While computing the size of ~S,"
+                                                         object type field)))))))))

         (declare (dynamic-extent #'do-field))
         (declare (dynamic-extent #'do-field))

-        (map () (curry #'do-field object message) (proto-fields message))
-        (when visited
-          (setf (gethash object visited) size))   ;cache the size
+        (dolist (field (proto-fields message))
+          (do-field object message field))
+        (setf (cached-object-size object visited) size)          ;cache the size

         size))))
 
 \f
         size))))
 
 \f


@@ -607,11 +699,13 @@
                (index  (proto-index field)))
           (when reader
             (cond ((eq (proto-required field) :repeated)
                (index  (proto-index field)))
           (when reader
             (cond ((eq (proto-required field) :repeated)

-                   (let ((iterator (if (vector-field-p field) 'dovector 'dolist)))
+                   (let* ((vectorp  (vector-field-p field))
+                          (iterator (if vectorp 'dovector 'dolist)))

                      (cond ((and (proto-packed field) (packed-type-p class))
                             (collect-serializer
                              (let ((tag (make-tag class index)))
                      (cond ((and (proto-packed field) (packed-type-p class))
                             (collect-serializer
                              (let ((tag (make-tag class index)))

-                               `(setq ,vidx (serialize-packed ,reader ,class ,tag ,vbuf ,vidx)))))
+                               `(setq ,vidx (serialize-packed ,reader ,class ,tag ,vbuf ,vidx
+                                                              ,vectorp)))))

                            ((keywordp class)
                             (collect-serializer
                              (let ((tag (make-tag class index)))
                            ((keywordp class)
                             (collect-serializer
                              (let ((tag (make-tag class index)))


@@ -623,16 +717,14 @@
                                (let ((tag1 (make-tag $wire-type-start-group index))
                                      (tag2 (make-tag $wire-type-end-group   index)))
                                  `(,iterator (,vval ,reader)
                                (let ((tag1 (make-tag $wire-type-start-group index))
                                      (tag2 (make-tag $wire-type-end-group   index)))
                                  `(,iterator (,vval ,reader)

-                                    (let ((len (or (and visited (gethash ,vval visited))
-                                                   (object-size ,vval ,msg visited))))
+                                    (let ((len (cached-object-size ,vval visited)))

                                       (setq ,vidx (encode-uint32 ,tag1 ,vbuf ,vidx))
                                       (serialize-object ,vval ,msg ,vbuf ,vidx visited)
                                       (iincf ,vidx len)
                                       (setq ,vidx (encode-uint32 ,tag2 ,vbuf ,vidx)))))
                                (let ((tag (make-tag $wire-type-string index)))
                                  `(,iterator (,vval ,reader)
                                       (setq ,vidx (encode-uint32 ,tag1 ,vbuf ,vidx))
                                       (serialize-object ,vval ,msg ,vbuf ,vidx visited)
                                       (iincf ,vidx len)
                                       (setq ,vidx (encode-uint32 ,tag2 ,vbuf ,vidx)))))
                                (let ((tag (make-tag $wire-type-string index)))
                                  `(,iterator (,vval ,reader)

-                                    (let ((len (or (and visited (gethash ,vval visited))
-                                                   (object-size ,vval ,msg visited))))
+                                    (let ((len (cached-object-size ,vval visited)))

                                       (setq ,vidx (encode-uint32 ,tag ,vbuf ,vidx))
                                       (setq ,vidx (encode-uint32 len ,vbuf ,vidx))
                                       (serialize-object ,vval ,msg ,vbuf ,vidx visited)
                                       (setq ,vidx (encode-uint32 ,tag ,vbuf ,vidx))
                                       (setq ,vidx (encode-uint32 len ,vbuf ,vidx))
                                       (serialize-object ,vval ,msg ,vbuf ,vidx visited)


@@ -641,7 +733,8 @@
                             (collect-serializer
                              (let ((tag (make-tag $wire-type-varint index)))
                                (if (proto-packed field)
                             (collect-serializer
                              (let ((tag (make-tag $wire-type-varint index)))
                                (if (proto-packed field)

-                                 `(setq ,vidx (serialize-packed-enum ,reader '(,@(proto-values msg)) ,tag ,vbuf ,vidx))
+                                 `(setq ,vidx (serialize-packed-enum ,reader '(,@(proto-values msg)) ,tag ,vbuf ,vidx
+                                                                     ,vectorp))

 
                                  `(,iterator (,vval ,reader)
                                     (setq ,vidx (serialize-enum ,vval '(,@(proto-values msg)) ,tag ,vbuf ,vidx)))))))
 
                                  `(,iterator (,vval ,reader)
                                     (setq ,vidx (serialize-enum ,vval '(,@(proto-values msg)) ,tag ,vbuf ,vidx)))))))


@@ -651,7 +744,10 @@
                                     (tag   (make-tag class (proto-index field))))
                                `(,iterator (,vval ,reader)
                                   (let ((,vval (funcall #',(proto-serializer msg) ,vval)))
                                     (tag   (make-tag class (proto-index field))))
                                `(,iterator (,vval ,reader)
                                   (let ((,vval (funcall #',(proto-serializer msg) ,vval)))

-                                    (setq ,vidx (serialize-prim ,vval ,class ,tag ,vbuf ,vidx))))))))))
+                                    (setq ,vidx (serialize-prim ,vval ,class ,tag ,vbuf ,vidx)))))))
+                           (t
+                            (undefined-field-type "While generating 'serialize-object' for ~S,"
+                                                  message class field)))))

                   (t
                    (cond ((keywordp class)
                           (collect-serializer
                   (t
                    (cond ((keywordp class)
                           (collect-serializer


@@ -666,9 +762,13 @@
                                                      (t :unbound))))
                                     (unless (eq ,vval :unbound)
                                       (setq ,vidx (serialize-prim ,vval ,class ,tag ,vbuf ,vidx)))))
                                                      (t :unbound))))
                                     (unless (eq ,vval :unbound)
                                       (setq ,vidx (serialize-prim ,vval ,class ,tag ,vbuf ,vidx)))))

-                               `(let ((,vval ,reader))
-                                  (when ,vval
-                                    (setq ,vidx (serialize-prim ,vval ,class ,tag ,vbuf ,vidx))))))))
+                               (if (empty-default-p field)
+                                 `(let ((,vval ,reader))
+                                    (when ,vval
+                                      (setq ,vidx (serialize-prim ,vval ,class ,tag ,vbuf ,vidx))))
+                                 `(let ((,vval ,reader))
+                                    (when (and ,vval (not (equal ,vval ',(proto-default field))))
+                                      (setq ,vidx (serialize-prim ,vval ,class ,tag ,vbuf ,vidx)))))))))

                          ((typep msg 'protobuf-message)
                           (collect-serializer
                            (if (eq (proto-message-type msg) :group)
                          ((typep msg 'protobuf-message)
                           (collect-serializer
                            (if (eq (proto-message-type msg) :group)


@@ -676,8 +776,7 @@
                                    (tag2 (make-tag $wire-type-end-group   index)))
                                `(let ((,vval ,reader))
                                   (when ,vval
                                    (tag2 (make-tag $wire-type-end-group   index)))
                                `(let ((,vval ,reader))
                                   (when ,vval

-                                    (let ((len (or (and visited (gethash ,vval visited))
-                                                   (object-size ,vval ,msg visited))))
+                                    (let ((len (cached-object-size ,vval visited)))

                                       (setq ,vidx (encode-uint32 ,tag1 ,vbuf ,vidx))
                                       (serialize-object ,vval ,msg ,vbuf ,vidx visited)
                                       (iincf ,vidx len)
                                       (setq ,vidx (encode-uint32 ,tag1 ,vbuf ,vidx))
                                       (serialize-object ,vval ,msg ,vbuf ,vidx visited)
                                       (iincf ,vidx len)


@@ -685,8 +784,7 @@
                              (let ((tag (make-tag $wire-type-string index)))
                                `(let ((,vval ,reader))
                                   (when ,vval
                              (let ((tag (make-tag $wire-type-string index)))
                                `(let ((,vval ,reader))
                                   (when ,vval

-                                    (let ((len (or (and visited (gethash ,vval visited))
-                                                   (object-size ,vval ,msg visited))))
+                                    (let ((len (cached-object-size ,vval visited)))

                                       (setq ,vidx (encode-uint32 ,tag ,vbuf ,vidx))
                                       (setq ,vidx (encode-uint32 len ,vbuf ,vidx))
                                       (serialize-object ,vval ,msg ,vbuf ,vidx visited)
                                       (setq ,vidx (encode-uint32 ,tag ,vbuf ,vidx))
                                       (setq ,vidx (encode-uint32 len ,vbuf ,vidx))
                                       (serialize-object ,vval ,msg ,vbuf ,vidx visited)


@@ -694,9 +792,13 @@
                          ((typep msg 'protobuf-enum)
                           (collect-serializer
                            (let ((tag (make-tag $wire-type-varint index)))
                          ((typep msg 'protobuf-enum)
                           (collect-serializer
                            (let ((tag (make-tag $wire-type-varint index)))

-                             `(let ((,vval ,reader))
-                                (when ,vval
-                                  (setq ,vidx (serialize-enum ,vval '(,@(proto-values msg)) ,tag ,vbuf ,vidx)))))))
+                             (if (empty-default-p field)
+                               `(let ((,vval ,reader))
+                                  (when ,vval
+                                    (setq ,vidx (serialize-enum ,vval '(,@(proto-values msg)) ,tag ,vbuf ,vidx))))
+                               `(let ((,vval ,reader))
+                                  (when (and ,vval (not (eql ,vval ',(proto-default field))))
+                                    (setq ,vidx (serialize-enum ,vval '(,@(proto-values msg)) ,tag ,vbuf ,vidx))))))))

                          ((typep msg 'protobuf-type-alias)
                           (collect-serializer
                            (let* ((class (proto-proto-type msg))
                          ((typep msg 'protobuf-type-alias)
                           (collect-serializer
                            (let* ((class (proto-proto-type msg))


@@ -704,7 +806,10 @@
                              `(let ((,vval ,reader))
                                 (when ,vval
                                   (let ((,vval (funcall #',(proto-serializer msg) ,vval)))
                              `(let ((,vval ,reader))
                                 (when ,vval
                                   (let ((,vval (funcall #',(proto-serializer msg) ,vval)))

-                                    (setq ,vidx (serialize-prim ,vval ,class ,tag ,vbuf ,vidx))))))))))))))
+                                    (setq ,vidx (serialize-prim ,vval ,class ,tag ,vbuf ,vidx))))))))
+                         (t
+                          (undefined-field-type "While generating 'serialize-object' for ~S,"
+                                                message class field))))))))

       `(defmethod serialize-object
            (,vobj (,vclass (eql ,message)) ,vbuf &optional (,vidx 0) visited)
          (declare #.$optimize-serialization)
       `(defmethod serialize-object
            (,vobj (,vclass (eql ,message)) ,vbuf &optional (,vidx 0) visited)
          (declare #.$optimize-serialization)


@@ -814,7 +919,10 @@
                                (multiple-value-bind (,vval idx)
                                    (deserialize-prim ,class ,vbuf ,vidx)
                                  (setq ,vidx idx)
                                (multiple-value-bind (,vval idx)
                                    (deserialize-prim ,class ,vbuf ,vidx)
                                  (setq ,vidx idx)

-                                 (push (funcall #',(proto-deserializer msg) ,vval) ,temp))))))))
+                                 (push (funcall #',(proto-deserializer msg) ,vval) ,temp))))))
+                         (t
+                          (undefined-field-type "While generating 'deserialize-object' for ~S,"
+                                                message class field))))

                   (t
                    (cond ((keywordp class)
                           (collect-deserializer
                   (t
                    (cond ((keywordp class)
                           (collect-deserializer


@@ -855,7 +963,10 @@
                                      (deserialize-prim ,class ,vbuf ,vidx)
                                    (let ((,vval (funcall #',(proto-deserializer msg) ,vval)))
                                      (setq ,vidx idx)
                                      (deserialize-prim ,class ,vbuf ,vidx)
                                    (let ((,vval (funcall #',(proto-deserializer msg) ,vval)))
                                      (setq ,vidx idx)

-                                     ,(write-slot vobj field vval)))))))))))))
+                                     ,(write-slot vobj field vval)))))))
+                         (t
+                          (undefined-field-type "While generating 'deserialize-object' for ~S,"
+                                                message class field))))))))

       (let* ((rslots  (delete-duplicates rslots :key #'first))
              (rfields (mapcar #'first  rslots))
              (rtemps  (mapcar #'second rslots)))
       (let* ((rslots  (delete-duplicates rslots :key #'first))
              (rfields (mapcar #'first  rslots))
              (rtemps  (mapcar #'second rslots)))


@@ -923,11 +1034,12 @@
                (index  (proto-index field)))
           (when reader
             (cond ((eq (proto-required field) :repeated)
                (index  (proto-index field)))
           (when reader
             (cond ((eq (proto-required field) :repeated)

-                   (let ((iterator (if (vector-field-p field) 'dovector 'dolist)))
+                   (let* ((vectorp  (vector-field-p field))
+                          (iterator (if vectorp 'dovector 'dolist)))

                      (cond ((and (proto-packed field) (packed-type-p class))
                             (collect-sizer
                              (let ((tag (make-tag class index)))
                      (cond ((and (proto-packed field) (packed-type-p class))
                             (collect-sizer
                              (let ((tag (make-tag class index)))

-                               `(iincf ,vsize (packed-size ,reader ,class ,tag)))))
+                               `(iincf ,vsize (packed-size ,reader ,class ,tag ,vectorp)))))

                            ((keywordp class)
                             (collect-sizer
                              (let ((tag (make-tag class index)))
                            ((keywordp class)
                             (collect-sizer
                              (let ((tag (make-tag class index)))


@@ -939,14 +1051,14 @@
                                (let ((tag1 (make-tag $wire-type-start-group index))
                                      (tag2 (make-tag $wire-type-end-group   index)))
                                  `(,iterator (,vval ,reader)
                                (let ((tag1 (make-tag $wire-type-start-group index))
                                      (tag2 (make-tag $wire-type-end-group   index)))
                                  `(,iterator (,vval ,reader)

-                                    (let ((len (or (and visited (gethash ,vval visited))
+                                    (let ((len (or (cached-object-size ,vval visited)

                                                    (object-size ,vval ,msg visited))))
                                       (iincf ,vsize (length32 ,tag1))
                                       (iincf ,vsize len)
                                       (iincf ,vsize ,tag2))))
                                (let ((tag (make-tag $wire-type-string index)))
                                  `(,iterator (,vval ,reader)
                                                    (object-size ,vval ,msg visited))))
                                       (iincf ,vsize (length32 ,tag1))
                                       (iincf ,vsize len)
                                       (iincf ,vsize ,tag2))))
                                (let ((tag (make-tag $wire-type-string index)))
                                  `(,iterator (,vval ,reader)

-                                    (let ((len (or (and visited (gethash ,vval visited))
+                                    (let ((len (or (cached-object-size ,vval visited)

                                                    (object-size ,vval ,msg visited))))
                                       (iincf ,vsize (length32 ,tag))
                                       (iincf ,vsize (length32 len))
                                                    (object-size ,vval ,msg visited))))
                                       (iincf ,vsize (length32 ,tag))
                                       (iincf ,vsize (length32 len))


@@ -964,7 +1076,10 @@
                                     (tag   (make-tag class index)))
                                `(,iterator (,vval ,reader)
                                   (let ((,vval (funcall #',(proto-serializer msg) ,vval)))
                                     (tag   (make-tag class index)))
                                `(,iterator (,vval ,reader)
                                   (let ((,vval (funcall #',(proto-serializer msg) ,vval)))

-                                    (iincf ,vsize (prim-size ,vval ,class ,tag))))))))))
+                                    (iincf ,vsize (prim-size ,vval ,class ,tag)))))))
+                           (t
+                            (undefined-field-type "While generating 'object-size' for ~S,"
+                                                  message class field)))))

                   (t
                    (cond ((keywordp class)
                           (let ((tag (make-tag class index)))
                   (t
                    (cond ((keywordp class)
                           (let ((tag (make-tag class index)))


@@ -980,9 +1095,13 @@
                                                      (t :unbound))))
                                     (unless (eq ,vval :unbound)
                                       (iincf ,vsize (prim-size ,vval ,class ,tag)))))
                                                      (t :unbound))))
                                     (unless (eq ,vval :unbound)
                                       (iincf ,vsize (prim-size ,vval ,class ,tag)))))

-                               `(let ((,vval ,reader))
-                                  (when ,vval
-                                    (iincf ,vsize (prim-size ,vval ,class ,tag))))))))
+                               (if (empty-default-p field)
+                                 `(let ((,vval ,reader))
+                                    (when ,vval
+                                      (iincf ,vsize (prim-size ,vval ,class ,tag))))
+                                 `(let ((,vval ,reader))
+                                    (when (and ,vval (not (equal ,vval ',(proto-default field))))
+                                      (iincf ,vsize (prim-size ,vval ,class ,tag)))))))))

                          ((typep msg 'protobuf-message)
                           (collect-sizer
                            (if (eq (proto-message-type msg) :group)
                          ((typep msg 'protobuf-message)
                           (collect-sizer
                            (if (eq (proto-message-type msg) :group)


@@ -990,7 +1109,7 @@
                                    (tag2 (make-tag $wire-type-end-group   index)))
                                `(let ((,vval ,reader))
                                   (when ,vval
                                    (tag2 (make-tag $wire-type-end-group   index)))
                                `(let ((,vval ,reader))
                                   (when ,vval

-                                    (let ((len (or (and visited (gethash ,vval visited))
+                                    (let ((len (or (cached-object-size ,vval visited)

                                                    (object-size ,vval ,msg visited))))
                                       (iincf ,vsize (length32 ,tag1))
                                       (iincf ,vsize len)
                                                    (object-size ,vval ,msg visited))))
                                       (iincf ,vsize (length32 ,tag1))
                                       (iincf ,vsize len)


@@ -998,7 +1117,7 @@
                              (let ((tag (make-tag $wire-type-string index)))
                                `(let ((,vval ,reader))
                                   (when ,vval
                              (let ((tag (make-tag $wire-type-string index)))
                                `(let ((,vval ,reader))
                                   (when ,vval

-                                    (let ((len (or (and visited (gethash ,vval visited))
+                                    (let ((len (or (cached-object-size ,vval visited)

                                                    (object-size ,vval ,msg visited))))
                                       (iincf ,vsize (length32 ,tag))
                                       (iincf ,vsize (length32 len))
                                                    (object-size ,vval ,msg visited))))
                                       (iincf ,vsize (length32 ,tag))
                                       (iincf ,vsize (length32 len))


@@ -1006,27 +1125,30 @@
                          ((typep msg 'protobuf-enum)
                           (let ((tag (make-tag $wire-type-varint index)))
                             (collect-sizer
                          ((typep msg 'protobuf-enum)
                           (let ((tag (make-tag $wire-type-varint index)))
                             (collect-sizer

-                             `(let ((,vval ,reader))
-                                (when ,vval
-                                  (iincf ,vsize (enum-size ,vval '(,@(proto-values msg)) ,tag)))))))
+                             (if (empty-default-p field)
+                               `(let ((,vval ,reader))
+                                  (when ,vval
+                                    (iincf ,vsize (enum-size ,vval '(,@(proto-values msg)) ,tag))))
+                               `(let ((,vval ,reader))
+                                  (when (and ,vval (not (eql ,vval ',(proto-default field))))
+                                    (iincf ,vsize (enum-size ,vval '(,@(proto-values msg)) ,tag))))))))

                          ((typep msg 'protobuf-type-alias)
                           (collect-sizer
                            (let* ((class (proto-proto-type msg))
                                   (tag   (make-tag class index)))
                              `(let ((,vval ,reader))
                                 (when ,vval
                          ((typep msg 'protobuf-type-alias)
                           (collect-sizer
                            (let* ((class (proto-proto-type msg))
                                   (tag   (make-tag class index)))
                              `(let ((,vval ,reader))
                                 (when ,vval

-                                  (let ((,vval (funcall #',(proto-serializer msg) ,vval)))
-                                    (iincf ,vsize (prim-size ,vval ,class ,tag))))))))))))))
+                                  (iincf ,vsize (prim-size (funcall #',(proto-serializer msg) ,vval)
+                                                           ,class ,tag)))))))
+                         (t
+                          (undefined-field-type "While generating 'object-size' for ~S,"
+                                                message class field))))))))

       `(defmethod object-size
            (,vobj (,vclass (eql ,message)) &optional visited)
          (declare #.$optimize-serialization)
          (declare (ignorable visited))
       `(defmethod object-size
            (,vobj (,vclass (eql ,message)) &optional visited)
          (declare #.$optimize-serialization)
          (declare (ignorable visited))

-         (let ((,vsize (and visited (gethash ,vobj visited))))
-           (when ,vsize
-             (return-from object-size ,vsize)))

          (let ((,vsize 0))
            (declare (type fixnum ,vsize))
            ,@sizers
          (let ((,vsize 0))
            (declare (type fixnum ,vsize))
            ,@sizers

-           (when visited
-             (setf (gethash ,vobj visited) ,vsize))
+           (setf (cached-object-size ,vobj visited) ,vsize)

            ,vsize)))))
            ,vsize)))))