Uniform handling of options and documentation

git-svn-id: http://svn.internal.itasoftware.com/svn/ita/branches/qres/swm/borgify-1/qres/lisp/quux/protobufs@533680 f8382938-511b-0410-9cdd-bb47b084005c

diff --git a/define-proto.lisp b/define-proto.lisp
index 73938a9885929dff2ca47c3824e31c16c26f13ed..f4d0aa02002290ae365df01f6b6aefbc6ca6ce25 100644 (file)
--- a/define-proto.lisp
+++ b/define-proto.lisp
@@ -14,7 +14,7 @@
 ;;; Protocol buffer defining macros
 
 ;; Define a schema named 'name', corresponding to a .proto file of that name
 ;;; Protocol buffer defining macros
 
 ;; Define a schema named 'name', corresponding to a .proto file of that name

-(defmacro define-proto (name (&key proto-name syntax package import options)
+(defmacro define-proto (name (&key proto-name syntax package import options documentation)

                         &body messages &environment env)
   "Define a schema named 'name', corresponding to a .proto file of that name.
    'proto-name' can be used to override the defaultly generated name.
                         &body messages &environment env)
   "Define a schema named 'name', corresponding to a .proto file of that name.
    'proto-name' can be used to override the defaultly generated name.


@@ -68,14 +68,15 @@
                            :options  (list ,@options)
                            :enums    (list ,@enums)
                            :messages (list ,@msgs)
                            :options  (list ,@options)
                            :enums    (list ,@enums)
                            :messages (list ,@msgs)

-                           :services (list ,@svcs))))
+                           :services (list ,@svcs)
+                           :documentation ,documentation)))

            (setq ,vname protobuf)
            (setf (gethash ',pname *all-protobufs*) protobuf)
            (setf (gethash ',cname *all-protobufs*) protobuf)
            protobuf)))))
 
 ;; Define an enum type named 'name' and a Lisp 'deftype'
            (setq ,vname protobuf)
            (setf (gethash ',pname *all-protobufs*) protobuf)
            (setf (gethash ',cname *all-protobufs*) protobuf)
            protobuf)))))
 
 ;; Define an enum type named 'name' and a Lisp 'deftype'

-(defmacro define-enum (name (&key proto-name conc-name) &body values)
+(defmacro define-enum (name (&key proto-name conc-name options documentation) &body values)

   "Define an enum type named 'name' and a Lisp 'deftype'.
   'proto-name' can be used to override the defaultly generated name.
    The body consists of the enum values in the form (name &key index)."
   "Define an enum type named 'name' and a Lisp 'deftype'.
   'proto-name' can be used to override the defaultly generated name.
    The body consists of the enum values in the form (name &key index)."


@@ -94,16 +95,23 @@
                            :index ,idx
                            :value ,val-name)))))
     (collect-form `(deftype ,name () '(member ,@vals)))
                            :index ,idx
                            :value ,val-name)))))
     (collect-form `(deftype ,name () '(member ,@vals)))

-    `(progn
-       define-enum
-       (make-instance 'protobuf-enum
-         :name   ,(or proto-name (class-name->proto name))
-         :class  ',name
-         :values (list ,@evals))
-       ,forms)))
+    (let ((options (loop for (key val) on options by #'cddr
+                         collect `(make-instance 'protobuf-option
+                                    :name ,key
+                                    :value ,val))))
+      `(progn
+         define-enum
+         (make-instance 'protobuf-enum
+           :name   ,(or proto-name (class-name->proto name))
+           :class  ',name
+           :options (list ,@options)
+           :values  (list ,@evals)
+           :documentation ,documentation)
+         ,forms))))

 
 ;; Define a message named 'name' and a Lisp 'defclass'
 
 ;; Define a message named 'name' and a Lisp 'defclass'

-(defmacro define-message (name (&key proto-name conc-name) &body fields &environment env)
+(defmacro define-message (name (&key proto-name conc-name options documentation)
+                          &body fields &environment env)

   "Define a message named 'name' and a Lisp 'defclass'.
    'proto-name' can be used to override the defaultly generated name.
    The body consists of fields, or 'define-enum' or 'define-message' forms.
   "Define a message named 'name' and a Lisp 'defclass'.
    'proto-name' can be used to override the defaultly generated name.
    The body consists of fields, or 'define-enum' or 'define-message' forms.


@@ -153,16 +161,22 @@
                                    :packed  ,(and (eq reqd :repeated)
                                                   (packed-type-p pclass)))))))))))
     (collect-form `(defclass ,name () (,@slots)))
                                    :packed  ,(and (eq reqd :repeated)
                                                   (packed-type-p pclass)))))))))))
     (collect-form `(defclass ,name () (,@slots)))

-    `(progn
-       define-message
-       (make-instance 'protobuf-message
-         :name  ,(or proto-name (class-name->proto name))
-         :class ',name
-         :conc-name ,(and conc-name (string conc-name))
-         :enums    (list ,@enums)
-         :messages (list ,@msgs)
-         :fields   (list ,@flds))
-       ,forms)))
+    (let ((options (loop for (key val) on options by #'cddr
+                         collect `(make-instance 'protobuf-option
+                                    :name ,key
+                                    :value ,val))))
+      `(progn
+         define-message
+         (make-instance 'protobuf-message
+           :name  ,(or proto-name (class-name->proto name))
+           :class ',name
+           :conc-name ,(and conc-name (string conc-name))
+           :options  (list ,@options)
+           :enums    (list ,@enums)
+           :messages (list ,@msgs)
+           :fields   (list ,@flds)
+           :documentation ,documentation)
+         ,forms))))

 
 (defmacro define-extension (from to)
   "Define an extension range within a message.
 
 (defmacro define-extension (from to)
   "Define an extension range within a message.


@@ -175,7 +189,7 @@
      ()))
 
 ;; Define a service named 'name' and a Lisp 'defun'
      ()))
 
 ;; Define a service named 'name' and a Lisp 'defun'

-(defmacro define-service (name (&key proto-name) &body rpc-specs)
+(defmacro define-service (name (&key proto-name options documentation) &body rpc-specs)

   "Define a service named 'name' and a Lisp 'defun'.
    'proto-name' can be used to override the defaultly generated name.
    The body consists of a set of RPC specs of the form (name input-type output-type)."
   "Define a service named 'name' and a Lisp 'defun'.
    'proto-name' can be used to override the defaultly generated name.
    The body consists of a set of RPC specs of the form (name input-type output-type)."


@@ -192,10 +206,16 @@
                           :input-type  ,(and input-type  (class-name->proto input-type))
                           :output-type ,(and output-type (class-name->proto output-type))
                           :options (list ,@options))))))
                           :input-type  ,(and input-type  (class-name->proto input-type))
                           :output-type ,(and output-type (class-name->proto output-type))
                           :options (list ,@options))))))

-    `(progn
-       define-service
-       (make-instance 'protobuf-service
-         :name ,(or proto-name (class-name->proto name))
-         :class ',name
-         :rpcs (list ,@rpcs))
-       ())))                                            ;---*** DEFINE LISP STUB HERE
+    (let ((options (loop for (key val) on options by #'cddr
+                         collect `(make-instance 'protobuf-option
+                                    :name ,key
+                                    :value ,val))))
+      `(progn
+         define-service
+         (make-instance 'protobuf-service
+           :name ,(or proto-name (class-name->proto name))
+           :class ',name
+           :options  (list ,@options)
+           :rpcs (list ,@rpcs)
+           :documentation ,documentation)
+         ()))))                                         ;---*** define Lisp stub here

diff --git a/examples.lisp b/examples.lisp
index 10bd4e5b8731bee881483a9bb4417745ac8d3888..6c671c569198166b13af54f281730dc7a980ed6c 100644 (file)
--- a/examples.lisp
+++ b/examples.lisp
@@ -199,18 +199,20 @@
 
 #||
 (proto:define-proto color-wheel (:package ita.color
 
 #||
 (proto:define-proto color-wheel (:package ita.color

-                                 :import "descriptor.proto")
-  (proto:define-enum color-name ()
+                                 :import "descriptor.proto"
+                                 :documentation "Color wheel example")
+  (proto:define-enum color-name (:documentation "A color name")

     red
     green
     blue)
     red
     green
     blue)

-  (proto:define-message color (:conc-name color-)
-    (proto:define-enum contrast-name ()
+  (proto:define-message color (:conc-name color-
+                               :documentation "Color and constrast")
+    (proto:define-enum contrast-name (:documentation "A contrast name")

       (low    1)
       (high 100))
     (color    :type color-name)
     (contrast :type (or null contrast-name) :default :low))
       (low    1)
       (high 100))
     (color    :type color-name)
     (contrast :type (or null contrast-name) :default :low))

-  (proto:define-service color-wheel ()
+  (proto:define-service color-wheel (:documentation "Get and set colors")

     (get-color nil color)
     (set-color color color :options ("deadline" "1.0"))))
 
     (get-color nil color)
     (set-color color color :options ("deadline" "1.0"))))
 

diff --git a/model-classes.lisp b/model-classes.lisp
index 7f70e9ce6cb46e1ac1ffd65a85d2b8ef94b29cfa..ed6877fb3c136a09702bdeff4087f937691b0443 100644 (file)
--- a/model-classes.lisp
+++ b/model-classes.lisp
@@ -13,25 +13,45 @@
 
 ;;; Protol buffers model classes
 
 
 ;;; Protol buffers model classes
 

-(defvar *all-protobufs* (make-hash-table :test #'equal))
+(defvar *all-protobufs* (make-hash-table :test #'equal)
+  "A table mapping names to 'protobuf' schemas.")
+

 (defun find-protobuf (name)
 (defun find-protobuf (name)

+  "Given a name (a string or a symbol), return the 'protobuf' schema having that name."

   (gethash name *all-protobufs*))
 
 ;; A few things (the pretty printer) want to keep track of the current schema
 (defvar *protobuf* nil)
 
 
   (gethash name *all-protobufs*))
 
 ;; A few things (the pretty printer) want to keep track of the current schema
 (defvar *protobuf* nil)
 
 

-;; The protobuf, corresponds to one .proto file
-(defclass protobuf ()
-  ((name :type (or null string)                 ;the name of this .proto file
+;;; The model classes
+
+(defclass abstract-protobuf () ())
+
+(defclass base-protobuf (abstract-protobuf)
+  ((name :type (or null string)                 ;the name of this .proto file/enum/message, etc

          :reader proto-name
          :initarg :name
          :initform nil)
          :reader proto-name
          :initarg :name
          :initform nil)

-   (class :type (or null symbol)                ;a "class name" for this protobuf, for Lisp
+   (class :type (or null symbol)                ;a Lisp "class name" for this object

           :accessor proto-class
           :initarg :class
           :initform nil)
           :accessor proto-class
           :initarg :class
           :initform nil)

-   (syntax :type (or null string)               ;syntax, passed on but otherwise ignored
+   (options :type (list-of protobuf-option)     ;options, mostly just passed along
+            :accessor proto-options
+            :initarg :options
+            :initform ())
+   (doc :type (or null string)                  ;documentation for this object
+        :accessor proto-documentation
+        :initarg :documentation
+        :initform nil))
+  (:documentation
+   "The base class for all Protobufs model classes."))
+
+
+;; The protobuf, corresponds to one .proto file
+(defclass protobuf (base-protobuf)
+  ((syntax :type (or null string)               ;syntax, passed on but otherwise ignored

            :accessor proto-syntax
            :initarg :syntax
            :initform nil)
            :accessor proto-syntax
            :initarg :syntax
            :initform nil)


@@ -44,10 +64,6 @@
             :accessor proto-imports
             :initarg :imports
             :initform ())
             :accessor proto-imports
             :initarg :imports
             :initform ())

-   (options :type (list-of protobuf-option)     ;options, passed on but otherwise ignored
-           :accessor proto-options
-           :initarg :options
-           :initform ())

    (enums :type (list-of protobuf-enum)         ;the set of enum types
           :accessor proto-enums
           :initarg :enums
    (enums :type (list-of protobuf-enum)         ;the set of enum types
           :accessor proto-enums
           :initarg :enums


@@ -61,7 +77,7 @@
              :initarg :services
              :initform ()))
   (:documentation
              :initarg :services
              :initform ()))
   (:documentation

-   "The model class that represents a protobufs schema, i.e., one .proto file."))
+   "The model class that represents a Protobufs schema, i.e., one .proto file."))

 
 (defmethod print-object ((p protobuf) stream)
   (print-unprintable-object (p stream :type t :identity t)
 
 (defmethod print-object ((p protobuf) stream)
   (print-unprintable-object (p stream :type t :identity t)


@@ -98,9 +114,9 @@
       (some #'(lambda (msg) (find-enum-for-type msg type)) (proto-messages protobuf))))
 
 
       (some #'(lambda (msg) (find-enum-for-type msg type)) (proto-messages protobuf))))
 
 

-;;--- For now, we support only the built-in options in the .proto file
-;;--- and in RPCs. We will want to extend this to custom options.
-(defclass protobuf-option ()
+;;--- For now, we support only the built-in options.
+;;--- We will want to extend this to customizable options as well.
+(defclass protobuf-option (abstract-protobuf)

   ((name :type string                           ;the key
          :reader proto-name
          :initarg :name)
   ((name :type string                           ;the key
          :reader proto-name
          :initarg :name)


@@ -109,36 +125,27 @@
           :initarg :value
           :initform nil))
   (:documentation
           :initarg :value
           :initform nil))
   (:documentation

-   "The model class that represents a protobufs options, i.e., a keyword/value pair."))
+   "The model class that represents a Protobufs options, i.e., a keyword/value pair."))

 
 (defmethod print-object ((o protobuf-option) stream)
   (print-unprintable-object (o stream :type t :identity t)
     (format stream "~A~@[ = ~S~]" (proto-name o) (proto-value o))))
 
 (defun cl-user::protobuf-option (stream option colon-p atsign-p)
 
 (defmethod print-object ((o protobuf-option) stream)
   (print-unprintable-object (o stream :type t :identity t)
     (format stream "~A~@[ = ~S~]" (proto-name o) (proto-value o))))
 
 (defun cl-user::protobuf-option (stream option colon-p atsign-p)

-  (declare (ignore colon-p atsign-p))
-  (format stream "~A~@[ = ~S~]" (proto-name option) (proto-value option)))
+  (declare (ignore atsign-p))
+  (if colon-p
+    (format stream "~A~@[ = ~S~]" (proto-name option) (proto-value option))
+    (format stream "~(:~A~) ~S" (proto-name option) (proto-value option))))

 
 
 ;; A protobuf enumeration
 
 
 ;; A protobuf enumeration

-(defclass protobuf-enum ()
-  ((name :type string                           ;the Protobuf name for the enum type
-         :reader proto-name
-         :initarg :name)
-   (class :type (or null symbol)                ;the Lisp type it represents
-          :accessor proto-class
-          :initarg :class
-          :initform nil)
-   (values :type (list-of protobuf-enum-value)  ;all the values for this enum type
+(defclass protobuf-enum (base-protobuf)
+  ((values :type (list-of protobuf-enum-value)  ;all the values for this enum type

            :accessor proto-values
            :initarg :values
            :accessor proto-values
            :initarg :values

-           :initform ())
-   (comment :type (or null string)
-            :accessor proto-comment
-            :initarg :comment
-            :initform nil))
+           :initform ()))

   (:documentation
   (:documentation

-   "The model class that represents a protobufs enumeration type."))
+   "The model class that represents a Protobufs enumeration type."))

 
 (defmethod print-object ((e protobuf-enum) stream)
   (print-unprintable-object (e stream :type t :identity t)
 
 (defmethod print-object ((e protobuf-enum) stream)
   (print-unprintable-object (e stream :type t :identity t)


@@ -147,11 +154,8 @@
 
 
 ;; A protobuf value within an enumeration
 
 
 ;; A protobuf value within an enumeration

-(defclass protobuf-enum-value ()
-  ((name :type string                           ;the name of the enum value
-         :reader proto-name
-         :initarg :name)
-   (index :type (integer #.(- (ash 1 31)) #.(1- (ash 1 31)))
+(defclass protobuf-enum-value (base-protobuf)
+  ((index :type (integer #.(- (ash 1 31)) #.(1- (ash 1 31)))

           :accessor proto-index                 ;the index of the enum value
           :initarg :index)
    (value :type (or null symbol)
           :accessor proto-index                 ;the index of the enum value
           :initarg :index)
    (value :type (or null symbol)


@@ -159,7 +163,7 @@
           :initarg :value
           :initform nil))
   (:documentation
           :initarg :value
           :initform nil))
   (:documentation

-   "The model class that represents a protobufs enumeration value."))
+   "The model class that represents a Protobufs enumeration value."))

 
 (defmethod print-object ((v protobuf-enum-value) stream)
   (print-unprintable-object (v stream :type t :identity t)
 
 (defmethod print-object ((v protobuf-enum-value) stream)
   (print-unprintable-object (v stream :type t :identity t)


@@ -168,15 +172,8 @@
 
 
 ;; A protobuf message
 
 
 ;; A protobuf message

-(defclass protobuf-message ()
-  ((name :type string                           ;the Protobuf name for the message
-         :reader proto-name
-         :initarg :name)
-   (class :type (or null symbol)                ;the Lisp class it represents
-          :accessor proto-class
-          :initarg :class
-          :initform nil)
-   (conc :type (or null string)                 ;the conc-name used for Lisp accessors
+(defclass protobuf-message (base-protobuf)
+  ((conc :type (or null string)                 ;the conc-name used for Lisp accessors

          :accessor proto-conc-name
          :initarg :conc-name
          :initform nil)
          :accessor proto-conc-name
          :initarg :conc-name
          :initform nil)


@@ -195,13 +192,9 @@
    (extensions :type (list-of protobuf-extension) ;any extensions
                :accessor proto-extensions
                :initarg :extensions
    (extensions :type (list-of protobuf-extension) ;any extensions
                :accessor proto-extensions
                :initarg :extensions

-               :initform ())
-   (comment :type (or null string)
-            :accessor proto-comment
-            :initarg :comment
-            :initform nil))
+               :initform ()))

     (:documentation
     (:documentation

-   "The model class that represents a protobufs message."))
+   "The model class that represents a Protobufs message."))

 
 (defmethod print-object ((m protobuf-message) stream)
   (print-unprintable-object (m stream :type t :identity t)
 
 (defmethod print-object ((m protobuf-message) stream)
   (print-unprintable-object (m stream :type t :identity t)


@@ -225,17 +218,10 @@
 
 
 ;; A protobuf field within a message
 
 
 ;; A protobuf field within a message

-(defclass protobuf-field ()
-  ((name :type string                           ;the Protobuf name for the field
-         :accessor proto-name
-         :initarg :name)
-   (type :type string                           ;the name of the Protobuf type for the field
+(defclass protobuf-field (base-protobuf)
+  ((type :type string                           ;the name of the Protobuf type for the field

          :accessor proto-type
          :initarg :type)
          :accessor proto-type
          :initarg :type)

-   (class :type (or null symbol)                ;the Lisp class (or a keyword such as :fixed64)
-          :accessor proto-class
-          :initarg :class
-          :initform nil)

    (required :type (member :required :optional :repeated)
              :accessor proto-required
              :initarg :required)
    (required :type (member :required :optional :repeated)
              :accessor proto-required
              :initarg :required)


@@ -246,20 +232,16 @@
           :accessor proto-value
           :initarg :value
           :initform nil)
           :accessor proto-value
           :initarg :value
           :initform nil)

-   (default :type (or null string)
+   (default :type (or null string)              ;default value, pulled out of the options

             :accessor proto-default
             :initarg :default
             :initform nil)
             :accessor proto-default
             :initarg :default
             :initform nil)

-   (packed :type (member t nil)
+   (packed :type (member t nil)                 ;packed, pulled out of the options

            :accessor proto-packed
            :initarg :packed
            :accessor proto-packed
            :initarg :packed

-           :initform nil)
-   (comment :type (or null string)
-            :accessor proto-comment
-            :initarg :comment
-            :initform nil))
+           :initform nil))

   (:documentation
   (:documentation

-   "The model class that represents one field within a protobufs message."))
+   "The model class that represents one field within a Protobufs message."))

 
 (defmethod print-object ((f protobuf-field) stream)
   (print-unprintable-object (f stream :type t :identity t)
 
 (defmethod print-object ((f protobuf-field) stream)
   (print-unprintable-object (f stream :type t :identity t)


@@ -271,7 +253,7 @@
 
 ;; An extension within a message
 ;;--- We still need to support 'extend', which depends on supporting 'import'
 
 ;; An extension within a message
 ;;--- We still need to support 'extend', which depends on supporting 'import'

-(defclass protobuf-extension ()
+(defclass protobuf-extension (abstract-protobuf)

   ((from :type (integer 1 #.(1- (ash 1 29)))    ;the index number for this field
          :accessor proto-extension-from
          :initarg :from)
   ((from :type (integer 1 #.(1- (ash 1 29)))    ;the index number for this field
          :accessor proto-extension-from
          :initarg :from)


@@ -279,7 +261,7 @@
        :accessor proto-extension-to
        :initarg :to))
   (:documentation
        :accessor proto-extension-to
        :initarg :to))
   (:documentation

-   "The model class that represents an extension with a protobufs message."))
+   "The model class that represents an extension with a Protobufs message."))

 
 (defmethod print-object ((e protobuf-extension) stream)
   (print-unprintable-object (e stream :type t :identity t)
 
 (defmethod print-object ((e protobuf-extension) stream)
   (print-unprintable-object (e stream :type t :identity t)


@@ -288,24 +270,13 @@
 
 
 ;; A protobuf service
 
 
 ;; A protobuf service

-(defclass protobuf-service ()
-  ((name :type string                           ;the Protobuf name for the service
-         :reader proto-name
-         :initarg :name)
-   (class :type (or null symbol)                ;a "class name" for this service, for Lisp
-          :accessor proto-class
-          :initarg :class
-          :initform nil)
-   (rpcs :type (list-of protobuf-rpc)           ;the RPCs in the service
+(defclass protobuf-service (base-protobuf)
+  ((rpcs :type (list-of protobuf-rpc)           ;the RPCs in the service

          :accessor proto-rpcs
          :initarg :rpcs
          :accessor proto-rpcs
          :initarg :rpcs

-         :initform ())
-   (comment :type (or null string)
-            :accessor proto-comment
-            :initarg :comment
-            :initform nil))
+         :initform ()))

   (:documentation
   (:documentation

-   "The model class that represents a protobufs service."))
+   "The model class that represents a Protobufs service."))

 
 (defmethod print-object ((s protobuf-service) stream)
   (print-unprintable-object (s stream :type t :identity t)
 
 (defmethod print-object ((s protobuf-service) stream)
   (print-unprintable-object (s stream :type t :identity t)


@@ -314,15 +285,8 @@
 
 
 ;; A protobuf RPC within a service
 
 
 ;; A protobuf RPC within a service

-(defclass protobuf-rpc ()
-  ((name :type string                           ;the Protobuf name for the RPC
-         :reader proto-name
-         :initarg :name)
-   (class :type (or null symbol)                ;a "class name" for this RPC, for Lisp
-          :accessor proto-class
-          :initarg :class
-          :initform nil)
-   (itype :type (or null string)                ;the name of the input message type
+(defclass protobuf-rpc (base-protobuf)
+  ((itype :type (or null string)                ;the name of the input message type

           :accessor proto-input-type
           :initarg :input-type)
    (iclass :type (or null symbol)               ;the name of the input message type
           :accessor proto-input-type
           :initarg :input-type)
    (iclass :type (or null symbol)               ;the name of the input message type


@@ -333,17 +297,9 @@
           :initarg :output-type)
    (oclass :type (or null symvol)               ;the name of the output message type
            :accessor proto-output-class
           :initarg :output-type)
    (oclass :type (or null symvol)               ;the name of the output message type
            :accessor proto-output-class

-           :initarg :output-class)
-   (options :type (list-of protobuf-option)     ;options, passed on but otherwise ignored
-            :accessor proto-options
-            :initarg :options
-            :initform ())
-   (comment :type (or null string)
-            :accessor proto-comment
-            :initarg :comment
-            :initform nil))
+           :initarg :output-class))

   (:documentation
   (:documentation

-   "The model class that represents one RPC with a protobufs service."))
+   "The model class that represents one RPC with a Protobufs service."))

 
 (defmethod print-object ((r protobuf-rpc) stream)
   (print-unprintable-object (r stream :type t :identity t)
 
 (defmethod print-object ((r protobuf-rpc) stream)
   (print-unprintable-object (r stream :type t :identity t)

diff --git a/parser.lisp b/parser.lisp
index 851a5aa9603748366be3fd071bf2114202b35887..72fe5ec9df65dd505a4331fba725e935672e0301 100644 (file)
--- a/parser.lisp
+++ b/parser.lisp
@@ -34,22 +34,41 @@
         until (or (null ch) (not (proto-whitespace-char-p ch)))
         do (read-char stream nil)))
 
         until (or (null ch) (not (proto-whitespace-char-p ch)))
         do (read-char stream nil)))
 

-(defun skip-comment (stream)
-  "Skip to the end of a comment, that is, to the end of the line.
+;;--- Collect the comment so we can attach it to its associated object
+(defun maybe-skip-comments (stream)
+  "If what appears next in the stream is a comment, skip it and any following comments,
+   then skip any following whitespace."
+  (loop
+    (unless (eql (peek-char nil stream nil) #\/)
+      (return)
+      (read-char stream)
+      (case (peek-char nil stream nil)
+        ((#\/)
+         (skip-line-comment stream))
+        ((#\*)
+         (skip-block-comment stream))
+        (otherwise
+         (error "Found a '~C' at position ~D to start a comment, but no following '~C' or '~C'"
+                #\/ (file-position stream) #\/ #\*)))))
+  (skip-whitespace stream))
+
+(defun skip-line-comment (stream)
+  "Skip to the end of a line comment, that is, to the end of the line.

    Then skip any following whitespace."
   (loop for ch = (read-char stream nil)
         until (or (null ch) (proto-eol-char-p ch)))
   (skip-whitespace stream))
 
    Then skip any following whitespace."
   (loop for ch = (read-char stream nil)
         until (or (null ch) (proto-eol-char-p ch)))
   (skip-whitespace stream))
 

-(defun maybe-skip-comments (stream)
-  "If what appears next in the stream is a comment, skip it and any following comments,
-   then skip any following whitespace."
-  (when (eql (peek-char nil stream nil) #\/)
-    (read-char stream)
-    (if (eql (peek-char nil stream nil) #\/)
-      (skip-comment stream)
-      (error "Found a '~C' at position ~D to start a comment, but no following '~C'"
-             #\/ (file-position stream) #\/)))
+(defun skip-block-comment (stream)
+  "Skip to the end of a block comment, that is, until a '*/' is seen.
+   Then skip any following whitespace."
+  (loop for ch = (read-char stream nil)
+        do (cond ((null ch)
+                  (error "Premature end of file while skipping block comment"))
+                 ((and (eql ch #\*)
+                       (eql (peek-char nil stream nil) #\/))
+                  (read-char stream nil)
+                  (return))))

   (skip-whitespace stream))
 
 (defun expect-char (stream ch &optional within)
   (skip-whitespace stream))
 
 (defun expect-char (stream ch &optional within)


@@ -108,7 +127,7 @@
 
 
 (defun parse-protobuf-from-file (filename)
 
 
 (defun parse-protobuf-from-file (filename)

-  "Parses the named file as a .proto file, and returns the protobufs schema."
+  "Parses the named file as a .proto file, and returns the Protobufs schema."

   (with-open-file (stream filename
                    :direction :input
                    :external-format :utf-8
   (with-open-file (stream filename
                    :direction :input
                    :external-format :utf-8

diff --git a/printer.lisp b/printer.lisp
index b9f85c8e3bd789ebd1830993acd27ac4f5f2ff47..78125cd0e8239e03c24e4c640eac7737d59d5ec1 100644 (file)
--- a/printer.lisp
+++ b/printer.lisp
@@ -22,14 +22,21 @@
 (defgeneric write-protobuf-as (type protobuf stream &key indentation)
   (:documentation
    "Writes the protobuf object 'protobuf' (schema, message, enum, etc) onto
 (defgeneric write-protobuf-as (type protobuf stream &key indentation)
   (:documentation
    "Writes the protobuf object 'protobuf' (schema, message, enum, etc) onto

-    the given stream 'stream'in the format given by 'type' (:proto, :text, etc)."))
+    the given stream 'stream' in the format given by 'type' (:proto, :text, etc)."))
+
+(defgeneric write-protobuf-documentation (type docstring stream &key indentation)
+  (:documentation
+   "Writes a the docstring as a \"block comment\" onto the given stream 'stream'
+    in the format given by 'type' (:proto, :text, etc)."))

 
 
 ;;; Pretty print as a .proto file
 
 (defmethod write-protobuf-as ((type (eql :proto)) (protobuf protobuf) stream
                               &key (indentation 0))
 
 
 ;;; Pretty print as a .proto file
 
 (defmethod write-protobuf-as ((type (eql :proto)) (protobuf protobuf) stream
                               &key (indentation 0))

-  (with-prefixed-accessors (name class syntax package imports options) (proto- protobuf)
+  (with-prefixed-accessors (name class documentation syntax package imports options) (proto- protobuf)
+    (when documentation
+      (write-protobuf-documentation type documentation stream :indentation indentation))

     (when syntax
       (format stream "~&syntax = \"~A\";~%~%" syntax))
     (when package
     (when syntax
       (format stream "~&syntax = \"~A\";~%~%" syntax))
     (when package


@@ -40,7 +47,7 @@
       (terpri stream))
     (when options
       (dolist (option options)
       (terpri stream))
     (when options
       (dolist (option options)

-        (format stream "~&option ~A~@[ = ~S~];~%" (proto-name option) (proto-value option)))
+        (format stream "~&option ~:/protobuf-option/;~%" option))

       (terpri stream))
     (dolist (enum (proto-enums protobuf))
       (write-protobuf-as type enum stream :indentation indentation)
       (terpri stream))
     (dolist (enum (proto-enums protobuf))
       (write-protobuf-as type enum stream :indentation indentation)


@@ -52,13 +59,19 @@
       (write-protobuf-as type svc stream :indentation indentation)
       (terpri stream))))
 
       (write-protobuf-as type svc stream :indentation indentation)
       (terpri stream))))
 

+(defmethod write-protobuf-documentation ((type (eql :proto)) docstring stream
+                                         &key (indentation 0))
+  (let ((lines (split-string docstring :separators '(#\newline #\return))))
+    (dolist (line lines)
+      (format stream "~&~@[~VT~]// ~A~%"
+              (and (not (zerop indentation)) indentation) line))))
+

 
 (defmethod write-protobuf-as ((type (eql :proto)) (enum protobuf-enum) stream
                               &key (indentation 0))
 
 (defmethod write-protobuf-as ((type (eql :proto)) (enum protobuf-enum) stream
                               &key (indentation 0))

-  (with-prefixed-accessors (comment name) (proto- enum)
-    (when comment
-      (format stream "~&~@[~VT~]// ~A~%"
-              (and (not (zerop indentation)) indentation) comment))
+  (with-prefixed-accessors (name documentation) (proto- enum)
+    (when documentation
+      (write-protobuf-documentation type documentation stream :indentation indentation))

     (format stream "~&~@[~VT~]enum ~A {~%"
             (and (not (zerop indentation)) indentation) name)
     (dolist (value (proto-values enum))
     (format stream "~&~@[~VT~]enum ~A {~%"
             (and (not (zerop indentation)) indentation) name)
     (dolist (value (proto-values enum))


@@ -66,19 +79,20 @@
     (format stream "~&~@[~VT~]}~%"
             (and (not (zerop indentation)) indentation))))
 
     (format stream "~&~@[~VT~]}~%"
             (and (not (zerop indentation)) indentation))))
 

+(defparameter *protobuf-enum-comment-column* 56)

 (defmethod write-protobuf-as ((type (eql :proto)) (val protobuf-enum-value) stream
                               &key (indentation 0))
 (defmethod write-protobuf-as ((type (eql :proto)) (val protobuf-enum-value) stream
                               &key (indentation 0))

-  (with-prefixed-accessors (name index) (proto- val)
-    (format stream "~&~@[~VT~]~A = ~D;~%"
-            (and (not (zerop indentation)) indentation) name index)))
+  (with-prefixed-accessors (name documentation index) (proto- val)
+    (format stream "~&~@[~VT~]~A = ~D;~:[~*~*~;~VT// ~A~]~%"
+            (and (not (zerop indentation)) indentation) name index
+            documentation *protobuf-enum-comment-column* documentation)))

 
 
 (defmethod write-protobuf-as ((type (eql :proto)) (message protobuf-message) stream
                               &key (indentation 0))
 
 
 (defmethod write-protobuf-as ((type (eql :proto)) (message protobuf-message) stream
                               &key (indentation 0))

-  (with-prefixed-accessors (comment name) (proto- message)
-    (when comment
-      (format stream "~&~@[~VT~]// ~A~%"
-              (and (not (zerop indentation)) indentation) comment))
+  (with-prefixed-accessors (name documentation) (proto- message)
+    (when documentation
+      (write-protobuf-documentation type documentation stream :indentation indentation))

     (format stream "~&~@[~VT~]message ~A {~%"
             (and (not (zerop indentation)) indentation) name)
     (dolist (enum (proto-enums message))
     (format stream "~&~@[~VT~]message ~A {~%"
             (and (not (zerop indentation)) indentation) name)
     (dolist (enum (proto-enums message))


@@ -95,14 +109,14 @@
 (defparameter *protobuf-field-comment-column* 56)
 (defmethod write-protobuf-as ((type (eql :proto)) (field protobuf-field) stream
                               &key (indentation 0))
 (defparameter *protobuf-field-comment-column* 56)
 (defmethod write-protobuf-as ((type (eql :proto)) (field protobuf-field) stream
                               &key (indentation 0))

-  (with-prefixed-accessors (name type required index default packed comment) (proto- field)
+  (with-prefixed-accessors (name type documentation required index default packed) (proto- field)

     (let ((dflt (if (stringp default)
                   (if (string-empty-p default) nil default)
                   default)))
       (format stream "~&~@[~VT~]~(~A~) ~A ~A = ~D~@[ [default = ~A]~]~@[ [packed=true]~*~];~:[~*~*~;~VT// ~A~]~%"
               (and (not (zerop indentation)) indentation)
               required type name index dflt packed
     (let ((dflt (if (stringp default)
                   (if (string-empty-p default) nil default)
                   default)))
       (format stream "~&~@[~VT~]~(~A~) ~A ~A = ~D~@[ [default = ~A]~]~@[ [packed=true]~*~];~:[~*~*~;~VT// ~A~]~%"
               (and (not (zerop indentation)) indentation)
               required type name index dflt packed

-              comment *protobuf-field-comment-column* comment))))
+              documentation *protobuf-field-comment-column* documentation))))

 
 (defmethod write-protobuf-as ((type (eql :proto)) (extension protobuf-extension) stream
                               &key (indentation 0))
 
 (defmethod write-protobuf-as ((type (eql :proto)) (extension protobuf-extension) stream
                               &key (indentation 0))


@@ -114,10 +128,9 @@
 
 (defmethod write-protobuf-as ((type (eql :proto)) (service protobuf-service) stream
                               &key (indentation 0))
 
 (defmethod write-protobuf-as ((type (eql :proto)) (service protobuf-service) stream
                               &key (indentation 0))

-  (with-prefixed-accessors (comment name) (proto- service)
-    (when comment
-      (format stream "~&~@[~VT~]// ~A~%"
-              (and (not (zerop indentation)) indentation) comment))
+  (with-prefixed-accessors (name doc documentation) (proto- service)
+    (when documentation
+      (write-protobuf-documentation type documentation stream :indentation indentation))

     (format stream "~&~@[~VT~]service ~A {~%"
             (and (not (zerop indentation)) indentation) name)
     (dolist (rpc (proto-rpcs service))
     (format stream "~&~@[~VT~]service ~A {~%"
             (and (not (zerop indentation)) indentation) name)
     (dolist (rpc (proto-rpcs service))


@@ -127,16 +140,17 @@
 
 (defmethod write-protobuf-as ((type (eql :proto)) (rpc protobuf-rpc) stream
                               &key (indentation 0))
 
 (defmethod write-protobuf-as ((type (eql :proto)) (rpc protobuf-rpc) stream
                               &key (indentation 0))

-  (with-prefixed-accessors (name input-type output-type options) (proto- rpc)
+  (with-prefixed-accessors (name documentation input-type output-type options) (proto- rpc)
+    (when documentation
+      (write-protobuf-documentation type documentation stream :indentation indentation))

     (format stream "~&~@[~VT~]rpc ~A (~@[~A~])~@[ returns (~A)~]"
             (and (not (zerop indentation)) indentation)
             name input-type output-type)
     (cond (options
            (format stream " {~%")
            (dolist (option options)
     (format stream "~&~@[~VT~]rpc ~A (~@[~A~])~@[ returns (~A)~]"
             (and (not (zerop indentation)) indentation)
             name input-type output-type)
     (cond (options
            (format stream " {~%")
            (dolist (option options)

-             (format stream "~&~@[~VT~]option ~A~@[ = ~S~];~%"
-                     (+ indentation 2)
-                     (proto-name option) (proto-value option)))
+             (format stream "~&~@[~VT~]option ~:/protobuf-option/;~%"
+                     (+ indentation 2) option))

            (format stream "~@[~VT~]}"
                    (and (not (zerop indentation)) indentation)))
           (t
            (format stream "~@[~VT~]}"
                    (and (not (zerop indentation)) indentation)))
           (t


@@ -147,18 +161,19 @@
 
 (defmethod write-protobuf-as ((type (eql :lisp)) (protobuf protobuf) stream
                               &key (indentation 0))
 
 (defmethod write-protobuf-as ((type (eql :lisp)) (protobuf protobuf) stream
                               &key (indentation 0))

-  (declare (ignore indentation))
-  (with-prefixed-accessors (name class package imports options) (proto- protobuf)
+  (with-prefixed-accessors (name class documentation package imports options) (proto- protobuf)

     (when package
       (format stream "~&(in-package \"~A\")~%~%" package))
     (when package
       (format stream "~&(in-package \"~A\")~%~%" package))

+    (when documentation
+      (write-protobuf-documentation type documentation stream :indentation indentation))

     (format stream "~&(proto:define-proto ~(~A~)" (or class name))
     (format stream "~&(proto:define-proto ~(~A~)" (or class name))

-    (if (or package imports options)
+    (if (or package imports options documentation)

       (format stream "~%    (")
       (format stream " ("))
     (let ((spaces ""))
       (when package
         (format stream "~A:package ~A" spaces package)
       (format stream "~%    (")
       (format stream " ("))
     (let ((spaces ""))
       (when package
         (format stream "~A:package ~A" spaces package)

-        (when (or imports options)
+        (when (or imports options documentation)

           (terpri stream))
         (setq spaces "     "))
       (when imports
           (terpri stream))
         (setq spaces "     "))
       (when imports


@@ -168,13 +183,18 @@
                (format stream "~A:import (" spaces)
                (format stream "~{\"~A\"~^ ~}" imports)
                (format stream ")")))
                (format stream "~A:import (" spaces)
                (format stream "~{\"~A\"~^ ~}" imports)
                (format stream ")")))

-        (when options
+        (when (or options documentation)

           (terpri stream))
         (setq spaces "     "))
       (when options
         (format stream "~A:options (" spaces)
         (format stream "~{~/protobuf-option/~^ ~}" options)
           (terpri stream))
         (setq spaces "     "))
       (when options
         (format stream "~A:options (" spaces)
         (format stream "~{~/protobuf-option/~^ ~}" options)

-        (format stream ")~%"))))
+        (when documentation
+          (terpri stream))
+        (setq spaces "     "))
+      (when documentation
+        (format stream "~A:documentation ~S" spaces documentation))
+      (format stream ")")))

   (format stream ")")
   (dolist (enum (proto-enums protobuf))
     (write-protobuf-as type enum stream :indentation 2))
   (format stream ")")
   (dolist (enum (proto-enums protobuf))
     (write-protobuf-as type enum stream :indentation 2))


@@ -184,16 +204,27 @@
     (write-protobuf-as type svc stream :indentation 2))
   (format stream ")~%"))
 
     (write-protobuf-as type svc stream :indentation 2))
   (format stream ")~%"))
 

+(defmethod write-protobuf-documentation ((type (eql :lisp)) docstring stream
+                                         &key (indentation 0))
+  (let ((lines (split-string docstring :separators '(#\newline #\return))))
+    (dolist (line lines)
+      (format stream "~&~@[~VT~];; ~A~%"
+              (and (not (zerop indentation)) indentation) line))))
+

 
 (defmethod write-protobuf-as ((type (eql :lisp)) (enum protobuf-enum) stream
                               &key (indentation 0))
   (terpri stream)
 
 (defmethod write-protobuf-as ((type (eql :lisp)) (enum protobuf-enum) stream
                               &key (indentation 0))
   (terpri stream)

-  (with-prefixed-accessors (comment class) (proto- enum)
-    (when comment
-      (format stream "~@[~VT~];; ~A~%"
-              (and (not (zerop indentation)) indentation) comment))
-    (format stream "~@[~VT~](proto:define-enum ~(~S~) ()"
+  (with-prefixed-accessors (class documentation) (proto- enum)
+    (when documentation
+      (write-protobuf-documentation type documentation stream :indentation indentation))
+    (format stream "~@[~VT~](proto:define-enum ~(~S~)"

             (and (not (zerop indentation)) indentation) class)
             (and (not (zerop indentation)) indentation) class)

+    (cond (documentation
+           (format stream "~%~@[~VT~](:documentation ~S)"
+                   (+ indentation 4) documentation))
+          (t
+           (format stream " ()")))

     (loop for (value . more) on (proto-values enum) doing
       (write-protobuf-as type value stream :indentation (+ indentation 2))
       (when more
     (loop for (value . more) on (proto-values enum) doing
       (write-protobuf-as type value stream :indentation (+ indentation 2))
       (when more


@@ -209,17 +240,22 @@
 
 (defmethod write-protobuf-as ((type (eql :lisp)) (message protobuf-message) stream
                               &key (indentation 0))
 
 (defmethod write-protobuf-as ((type (eql :lisp)) (message protobuf-message) stream
                               &key (indentation 0))

-  (with-prefixed-accessors (comment class conc-name) (proto- message)
-    (when comment
-      (format stream "~&~@[~VT~];; ~A~%"
-              (and (not (zerop indentation)) indentation) comment))
+  (with-prefixed-accessors (class conc-name documentation) (proto- message)
+    (when documentation
+      (write-protobuf-documentation type documentation stream :indentation indentation))

     (format stream "~&~@[~VT~](proto:define-message ~(~S~)"
             (and (not (zerop indentation)) indentation) class)
     (format stream "~&~@[~VT~](proto:define-message ~(~S~)"
             (and (not (zerop indentation)) indentation) class)

-    (if conc-name
+    (if (or conc-name documentation)

       (format stream "~%~VT(" (+ indentation 4))
       (format stream " ("))
       (format stream "~%~VT(" (+ indentation 4))
       (format stream " ("))

-    (when conc-name
-      (format stream ":conc-name ~(~A~)" conc-name))
+    (when (or conc-name documentation)
+      (when conc-name
+        (format stream ":conc-name ~(~A~)" conc-name))
+      (when documentation
+        (if conc-name 
+          (format stream "~%~VT:documentation ~S"
+                  (+ indentation 5) documentation)
+          (format stream ":documentation ~S" documentation))))

     (format stream ")")
     (loop for (enum . more) on (proto-enums message) doing
       (write-protobuf-as type enum stream :indentation (+ indentation 2))
     (format stream ")")
     (loop for (enum . more) on (proto-enums message) doing
       (write-protobuf-as type enum stream :indentation (+ indentation 2))


@@ -242,7 +278,7 @@
 (defparameter *protobuf-slot-comment-column* 56)
 (defmethod write-protobuf-as ((type (eql :lisp)) (field protobuf-field) stream
                               &key (indentation 0))
 (defparameter *protobuf-slot-comment-column* 56)
 (defmethod write-protobuf-as ((type (eql :lisp)) (field protobuf-field) stream
                               &key (indentation 0))

-  (with-prefixed-accessors (value type class required default comment) (proto- field)
+  (with-prefixed-accessors (value type class documentation required default) (proto- field)

     (let ((dflt (cond ((or (null default)
                            (and (stringp default) (string-empty-p default)))
                        nil)
     (let ((dflt (cond ((or (null default)
                            (and (stringp default) (string-empty-p default)))
                        nil)


@@ -274,7 +310,7 @@
                        "~&~@[~VT~](~(~S~) :type ~(~S~)~@[ :default ~(:~A~)~])~:[~*~*~;~VT; ~A~]")
               (and (not (zerop indentation)) indentation)
               value clss dflt
                        "~&~@[~VT~](~(~S~) :type ~(~S~)~@[ :default ~(:~A~)~])~:[~*~*~;~VT; ~A~]")
               (and (not (zerop indentation)) indentation)
               value clss dflt

-              comment *protobuf-slot-comment-column* comment))))
+              documentation *protobuf-slot-comment-column* documentation))))

 
 (defmethod write-protobuf-as ((type (eql :lisp)) (extension protobuf-extension) stream
                               &key (indentation 0))
 
 (defmethod write-protobuf-as ((type (eql :lisp)) (extension protobuf-extension) stream
                               &key (indentation 0))


@@ -286,12 +322,16 @@
 
 (defmethod write-protobuf-as ((type (eql :lisp)) (service protobuf-service) stream
                               &key (indentation 0))
 
 (defmethod write-protobuf-as ((type (eql :lisp)) (service protobuf-service) stream
                               &key (indentation 0))

-  (with-prefixed-accessors (comment class conc-name) (proto- service)
-    (when comment
-      (format stream "~&~@[~VT~];; ~A~%"
-              (and (not (zerop indentation)) indentation) comment))
-    (format stream "~&~@[~VT~](proto:define-service ~(~S~) ()"
+  (with-prefixed-accessors (class documentation conc-name) (proto- service)
+    (when documentation
+      (write-protobuf-documentation type documentation stream :indentation indentation))
+    (format stream "~&~@[~VT~](proto:define-service ~(~S~)"

             (and (not (zerop indentation)) indentation) (proto-class service))
             (and (not (zerop indentation)) indentation) (proto-class service))

+    (cond (documentation
+           (format stream "~%~@[~VT~](:documentation ~S)"
+                   (+ indentation 4) documentation))
+          (t
+           (format stream " ()")))

     (loop for (rpc . more) on (proto-rpcs service) doing
       (write-protobuf-as type rpc stream :indentation (+ indentation 2))
       (when more
     (loop for (rpc . more) on (proto-rpcs service) doing
       (write-protobuf-as type rpc stream :indentation (+ indentation 2))
       (when more


@@ -300,21 +340,16 @@
 
 (defmethod write-protobuf-as ((type (eql :lisp)) (rpc protobuf-rpc) stream
                               &key (indentation 0))
 
 (defmethod write-protobuf-as ((type (eql :lisp)) (rpc protobuf-rpc) stream
                               &key (indentation 0))

-  (with-prefixed-accessors (class input-type output-type options) (proto- rpc)
+  (with-prefixed-accessors (class documentation input-type output-type options) (proto- rpc)
+    (when documentation
+      (write-protobuf-documentation type documentation stream :indentation indentation))

     (let ((in  (find-message-for-class *protobuf* input-type))
           (out (find-message-for-class *protobuf* output-type)))
       (format stream "~&~@[~VT~](~(~S~) ~(~S~) ~(~S~)"
               (and (not (zerop indentation)) indentation) class
               (if in  (proto-class in)  input-type)
               (if out (proto-class out) output-type))
     (let ((in  (find-message-for-class *protobuf* input-type))
           (out (find-message-for-class *protobuf* output-type)))
       (format stream "~&~@[~VT~](~(~S~) ~(~S~) ~(~S~)"
               (and (not (zerop indentation)) indentation) class
               (if in  (proto-class in)  input-type)
               (if out (proto-class out) output-type))

-      (cond (options
-             (format stream "~%~VT:options ("
-                     (+ indentation 3))
-             (loop for (option . more) on options doing
-               (format stream "~S ~S"
-                       (proto-name option) (proto-value option))
-               (when more
-                 (format stream " ")))
-             (format stream "))"))
-            (t
-             (format stream ")"))))))
+      (when options
+        (format stream "~%~VT:options (~{~/protobuf-option/~^ ~})"
+                (+ indentation 2) options))
+      (format stream ")"))))

diff --git a/proto-pkgdcl.lisp b/proto-pkgdcl.lisp
index 89011485e56982e3d4b14c5b6ad3849994af9b95..03fb04e413dd8027c0f35338249c6ebf3901ef64 100644 (file)
--- a/proto-pkgdcl.lisp
+++ b/proto-pkgdcl.lisp
@@ -65,9 +65,11 @@
 
   (:export
    ;; Model class protocol
 
   (:export
    ;; Model class protocol

+   "ABSTRACT-PROTOBUF"
+   "BASE-PROTOBUF"

    "PROTO-CLASS"
    "PROTO-CLASS"

-   "PROTO-COMMENT"

    "PROTO-DEFAULT"
    "PROTO-DEFAULT"

+   "PROTO-DOCUMENTATION"

    "PROTO-ENUM-NAME"
    "PROTO-ENUMS"
    "PROTO-EXTENSION-FROM"
    "PROTO-ENUM-NAME"
    "PROTO-ENUMS"
    "PROTO-EXTENSION-FROM"

diff --git a/serialize.lisp b/serialize.lisp
index 512d87fa69ef75334c86d7c12490703cc4859882..bc2a4d27328bf26a054ae555fad07f60de3f6bc7 100644 (file)
--- a/serialize.lisp
+++ b/serialize.lisp
@@ -169,7 +169,7 @@
                             ;; that has the field, but our current message does not
                             ;; We still have to deserialize everything, though
                             (slot  (proto-value field)))
                             ;; that has the field, but our current message does not
                             ;; We still have to deserialize everything, though
                             (slot  (proto-value field)))

-                       ;;---*** Check for mismatched types, running past end of buffer, etc
+                       ;;--- Check for mismatched types, running past end of buffer, etc

                        (declare (ignore type))
                        (cond ((eq (proto-required field) :repeated)
                               (cond ((and (proto-packed field) (packed-type-p cl))
                        (declare (ignore type))
                        (cond ((eq (proto-required field) :repeated)
                               (cond ((and (proto-packed field) (packed-type-p cl))


@@ -183,20 +183,23 @@
                                          (deserialize-prim cl field buffer index)
                                        (setq index idx)
                                        (when slot
                                          (deserialize-prim cl field buffer index)
                                        (setq index idx)
                                        (when slot

-                                         (setf (slot-value object slot) (nconc (slot-value object slot) (list val))))))
+                                         (setf (slot-value object slot)
+                                               (nconc (slot-value object slot) (list val))))))

                                     ((typep msg 'protobuf-enum)
                                      (multiple-value-bind (val idx)
                                          (deserialize-enum msg field buffer index)
                                        (setq index idx)
                                        (when slot
                                     ((typep msg 'protobuf-enum)
                                      (multiple-value-bind (val idx)
                                          (deserialize-enum msg field buffer index)
                                        (setq index idx)
                                        (when slot

-                                         (setf (slot-value object slot) (nconc (slot-value object slot) (list val))))))
+                                         (setf (slot-value object slot)
+                                               (nconc (slot-value object slot) (list val))))))

                                     ((typep msg 'protobuf-message)
                                      (multiple-value-bind (len idx)
                                          (decode-uint32 buffer index)
                                        (setq index idx)
                                        (let ((obj (deserialize cl (cons msg trace) (+ index len))))
                                          (when slot
                                     ((typep msg 'protobuf-message)
                                      (multiple-value-bind (len idx)
                                          (decode-uint32 buffer index)
                                        (setq index idx)
                                        (let ((obj (deserialize cl (cons msg trace) (+ index len))))
                                          (when slot

-                                           (setf (slot-value object slot) (nconc (slot-value object slot) (list obj)))))))))
+                                           (setf (slot-value object slot)
+                                                 (nconc (slot-value object slot) (list obj)))))))))

                              (t
                               (cond ((keywordp cl)
                                      (multiple-value-bind (val idx)
                              (t
                               (cond ((keywordp cl)
                                      (multiple-value-bind (val idx)

diff --git a/upgradable.lisp b/upgradable.lisp
index 2ccde28c7f262d2501bfe5cd0f711529f854bd14..345ec062579af04e114a6bd19e6d6230cd8a1a41 100644 (file)
--- a/upgradable.lisp
+++ b/upgradable.lisp
@@ -83,11 +83,11 @@
 
 (defmethod protobuf-upgradable ((old protobuf-field) (new protobuf-field))
   (flet ((arity-upgradable (old new)
 
 (defmethod protobuf-upgradable ((old protobuf-field) (new protobuf-field))
   (flet ((arity-upgradable (old new)

-           ;;--- We need to handle conversions between non-required fields and extensions
+           ;;--- Handle conversions between non-required fields and extensions

            (or (eq old new)
                (not (eq new :required))))
          (type-upgradable (old new)
            (or (eq old new)
                (not (eq new :required))))
          (type-upgradable (old new)

-           ;;--- We need to handle conversions between embedded messages and bytes
+           ;;--- Handle conversions between embedded messages and bytes

            (or 
             (string= old new)
             ;; These varint types are all compatible
            (or 
             (string= old new)
             ;; These varint types are all compatible

diff --git a/wire-format.lisp b/wire-format.lisp
index 66d7fee33a3141d957e0bb500c39fb09277301b7..0573eb11192dbaaa1ba54d799812a3c4cbb9d1d6 100644 (file)
--- a/wire-format.lisp
+++ b/wire-format.lisp
@@ -17,7 +17,7 @@
 
 ;; Serialize 'val' of primitive type 'type' into the buffer
 (defun serialize-prim (val type field buffer index)
 
 ;; Serialize 'val' of primitive type 'type' into the buffer
 (defun serialize-prim (val type field buffer index)

-  "Serializes a protobufs primitive (scalar) value into the buffer at the given index.
+  "Serializes a Protobufs primitive (scalar) value into the buffer at the given index.

    The value is given by 'val', the primitive type by 'type'.
    'field' is the protobuf-field describing the value.
    Modifies the buffer in place, and returns the new index into the buffer."
    The value is given by 'val', the primitive type by 'type'.
    'field' is the protobuf-field describing the value.
    Modifies the buffer in place, and returns the new index into the buffer."


@@ -145,7 +145,7 @@
 
 ;; Serialize 'val' of enum type 'type' into the buffer
 (defun serialize-enum (val enum field buffer index)
 
 ;; Serialize 'val' of enum type 'type' into the buffer
 (defun serialize-enum (val enum field buffer index)

-  "Serializes a protobufs enum value into the buffer at the given index.
+  "Serializes a Protobufs enum value into the buffer at the given index.

    The value is given by 'val', the enum type by 'enum'.
    'field' is the protobuf-field describing the value.
    Modifies the buffer in place, and returns the new index into the buffer."
    The value is given by 'val', the enum type by 'enum'.
    'field' is the protobuf-field describing the value.
    Modifies the buffer in place, and returns the new index into the buffer."


@@ -388,7 +388,7 @@
   (declare (type fixnum index)
            (type (simple-array (unsigned-byte 8)) buffer))
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
   (declare (type fixnum index)
            (type (simple-array (unsigned-byte 8)) buffer))
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))

-    ;;---*** DO ENCODING OF SINGLE FLOATS
+    ;;---*** Do encoding of single floats

     val buffer index))
 
 (defun encode-double (val buffer index)
     val buffer index))
 
 (defun encode-double (val buffer index)


@@ -397,7 +397,7 @@
   (declare (type fixnum index)
            (type (simple-array (unsigned-byte 8)) buffer))
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
   (declare (type fixnum index)
            (type (simple-array (unsigned-byte 8)) buffer))
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))

-    ;;---*** DO ENCODING OF DOUBLE FLOATS
+    ;;---*** Do encoding of double floats

     val buffer index))
 
 (defun encode-octets (octets buffer index)
     val buffer index))
 
 (defun encode-octets (octets buffer index)


@@ -464,7 +464,7 @@
   (declare (type fixnum index)
            (type (simple-array (unsigned-byte 8)) buffer))
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
   (declare (type fixnum index)
            (type (simple-array (unsigned-byte 8)) buffer))
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))

-    ;;---*** DO DECODING OF SINGLE FLOATS
+    ;;---*** Do decoding of single floats

     buffer index))
 
 (defun decode-double (buffer index)
     buffer index))
 
 (defun decode-double (buffer index)


@@ -473,7 +473,7 @@
   (declare (type fixnum index)
            (type (simple-array (unsigned-byte 8)) buffer))
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
   (declare (type fixnum index)
            (type (simple-array (unsigned-byte 8)) buffer))
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))

-    ;;---*** DO DECODING OF DOUBLE FLOATS
+    ;;---*** Do decoding of double floats

     buffer index))
 
 (defun decode-octets (buffer index)
     buffer index))
 
 (defun decode-octets (buffer index)