(declare (type fixnum index))
(macrolet ((read-slot (object slot reader)
;; Don't do a boundp check, we assume the object is fully populated
- ;; Unpopulated slots should be "nullable" and should contain nil
+ ;; Unpopulated slots should be "nullable" and will contain nil when empty
`(if ,reader
(funcall ,reader ,object)
(slot-value ,object ,slot))))
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)
- (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 (object-size v msg 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,
(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))))
- (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
(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 ((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)))
(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)))))))
+ (dolist (f (proto-fields msg))
+ (do-field v msg f)))))))
((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* ((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))
- (map () (curry #'do-field object message) (proto-fields message))))
+ (dolist (field (proto-fields message))
+ (do-field object message field))))
(values buffer index)))
(declare (type fixnum size))
(macrolet ((read-slot (object slot reader)
;; Don't do a boundp check, we assume the object is fully populated
- ;; Unpopulated slots should be "nullable" and should contain nil
+ ;; Unpopulated slots should be "nullable" and will contain nil when empty
`(if ,reader
(funcall ,reader ,object)
(slot-value ,object ,slot))))
(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)
- (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 (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))
- (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))))
- (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)
(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 ((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))
+ (dolist (f (proto-fields msg))
+ (do-field v msg f))
(iincf size (length32 tag2)))
(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)))))))
+ (dolist (f (proto-fields msg))
+ (do-field v msg f)))))))
((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* ((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))
- (map () (curry #'do-field object message) (proto-fields message))
+ (dolist (field (proto-fields message))
+ (do-field object message field))
(when visited
(setf (gethash object visited) size)) ;cache the size
size))))
(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)))
- `(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)))
(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)))))))
(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
(let ((tag (make-tag class index)))
(if (eq class :bool)
(if (or (eq (proto-required field) :required)
- reader)
+ (null (proto-value field)))
`(let ((,vval ,reader))
(setq ,vidx (serialize-prim ,vval ,class ,tag ,vbuf ,vidx)))
`(let ((,vval (cond ((slot-boundp ,vobj ',(proto-value field))
(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-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))
`(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)
(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
(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)))
(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)))
- `(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)))
(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)))
(collect-sizer
(if (eq class :bool)
(if (or (eq (proto-required field) :required)
- reader)
+ (null (proto-value field)))
`(let ((,vval ,reader))
(declare (ignorable ,vval))
(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-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
- (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)
projects / cl-protobufs.git / blobdiff