Tweak the .proto parser a bit to handle some cases not in the documentation

git-svn-id: http://svn.internal.itasoftware.com/svn/ita/trunk/qres/lisp/quux/protobufs@543135 f8382938-511b-0410-9cdd-bb47b084005c

diff --git a/parser.lisp b/parser.lisp
index 5df9bacbb0c5145a05c626a78c2ca329be05d18d..1a08efbe961de3a296b7ea2354bfbb8febe573d4 100644 (file)
--- a/parser.lisp
+++ b/parser.lisp
@@ -39,6 +39,30 @@
         until (or (null ch) (not (proto-whitespace-char-p ch)))
         do (read-char stream nil)))
 
+(defun expect-char (stream char &optional chars within)
+  "Expect to see 'char' as the next character in the stream; signal an error if it's not there.
+   Then skip all of the following whitespace."
+  (if (if (listp char)
+        (member (peek-char nil stream nil) char)
+        (eql (peek-char nil stream nil) char))
+    (read-char stream)
+    (error "No '~C' found~@[ within '~A'~] at position ~D"
+           char within (file-position stream)))
+  (maybe-skip-chars stream chars))
+
+(defun maybe-skip-chars (stream chars)
+  "Skip some optional characters in the stream,
+   then skip all of the following whitespace."
+  (skip-whitespace stream)
+  (when chars
+    (loop
+      (let ((ch (peek-char nil stream nil)))
+        (when (or (null ch) (not (member ch chars)))
+          (skip-whitespace stream)
+          (return-from maybe-skip-chars)))
+      (read-char stream))))
+
+
 ;;--- 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,
@@ -80,18 +104,6 @@
   (skip-whitespace stream))
 
 
-(defun expect-char (stream ch &optional within)
-  "Expect to see 'ch' as the next character in the stream; signal an error if it's not there.
-   Then skip all of the following whitespace."
-  (if (if (listp ch)
-        (member (peek-char nil stream nil) ch)
-        (eql (peek-char nil stream nil) ch))
-    (read-char stream)
-    (error "No '~C' found~@[ within '~A'~] at position ~D"
-           ch within (file-position stream)))
-  (skip-whitespace stream))
-
-
 (defun parse-token (stream)
   "Parse the next token in the stream, then skip the following whitespace.
    The returned value is the token."
@@ -221,9 +233,9 @@
 (defun parse-proto-syntax (stream protobuf &optional (terminator #\;))
   "Parse a Protobufs syntax line from 'stream'.
    Updates the 'protobuf' object to use the syntax."
-  (let ((syntax (prog2 (expect-char stream #\= "syntax")
+  (let ((syntax (prog2 (expect-char stream #\= () "syntax")
                     (parse-string stream)
-                  (expect-char stream terminator "syntax")
+                  (expect-char stream terminator () "syntax")
                   (maybe-skip-comments stream))))
     (setf (proto-syntax protobuf) syntax)))
 
@@ -232,7 +244,7 @@
    Updates the 'protobuf' object to use the package."
   (check-type protobuf protobuf)
   (let* ((package  (prog1 (parse-token stream)
-                     (expect-char stream terminator "package")
+                     (expect-char stream terminator () "package")
                      (maybe-skip-comments stream)))
          (lisp-pkg (or (proto-lisp-package protobuf)
                        (substitute #\- #\_ package))))
@@ -249,7 +261,7 @@
    Updates the 'protobuf' object to use the package."
   (check-type protobuf protobuf)
   (let ((import (prog1 (parse-string stream)
-                  (expect-char stream terminator "package")
+                  (expect-char stream terminator () "package")
                   (maybe-skip-comments stream))))
     (process-imports import)
     (setf (proto-imports protobuf) (nconc (proto-imports protobuf) (list import)))))
@@ -259,11 +271,11 @@
    Updates the 'protobuf' (or message, service, method) to have the option."
   (check-type protobuf (or null base-protobuf))
   (let* ((key (prog1 (parse-parenthesized-token stream)
-                (expect-char stream #\= "option")))
+                (expect-char stream #\= () "option")))
          (val (prog1 (if (eql (peek-char nil stream nil) #\")
                        (parse-string stream)
                        (parse-token stream))
-                (expect-char stream terminator "option")
+                (expect-char stream terminator () "option")
                 (maybe-skip-comments stream)))
          (option (make-instance 'protobuf-option
                    :name  key
@@ -281,7 +293,7 @@
    Updates the 'protobuf' or 'protobuf-message' object to have the enum."
   (check-type protobuf (or protobuf protobuf-message))
   (let* ((name (prog1 (parse-token stream)
-                 (expect-char stream #\{ "enum")
+                 (expect-char stream #\{ () "enum")
                  (maybe-skip-comments stream)))
          (enum (make-instance 'protobuf-enum
                  :class (proto->class-name name *protobuf-package*)
@@ -289,7 +301,7 @@
     (loop
       (let ((name (parse-token stream)))
         (when (null name)
-          (expect-char stream #\} "enum")
+          (expect-char stream #\} '(#\;) "enum")
           (maybe-skip-comments stream)
           (setf (proto-enums protobuf) (nconc (proto-enums protobuf) (list enum)))
           (let ((type (find-option enum "lisp_name")))
@@ -307,9 +319,9 @@
   "Parse a Protobufs enum value from 'stream'.
    Updates the 'protobuf-enum' object to have the enum value."
   (check-type enum protobuf-enum)
-  (expect-char stream #\= "enum")
+  (expect-char stream #\= () "enum")
   (let* ((idx  (prog1 (parse-int stream)
-                 (expect-char stream #\; "enum")
+                 (expect-char stream #\; () "enum")
                  (maybe-skip-comments stream)))
          (value (make-instance 'protobuf-enum-value
                   :name  name
@@ -324,7 +336,7 @@
    Updates the 'protobuf' or 'protobuf-message' object to have the message."
   (check-type protobuf (or protobuf protobuf-message))
   (let* ((name (prog1 (or name (parse-token stream))
-                 (expect-char stream #\{ "message")
+                 (expect-char stream #\{ () "message")
                  (maybe-skip-comments stream)))
          (message (make-instance 'protobuf-message
                     :class (proto->class-name name *protobuf-package*)
@@ -334,7 +346,7 @@
     (loop
       (let ((token (parse-token stream)))
         (when (null token)
-          (expect-char stream #\} "message")
+          (expect-char stream #\} '(#\;) "message")
           (maybe-skip-comments stream)
           (setf (proto-messages protobuf) (nconc (proto-messages protobuf) (list message)))
           (let ((type (find-option message "lisp_name")))
@@ -365,7 +377,7 @@
    Updates the 'protobuf' or 'protobuf-message' object to have the message."
   (check-type protobuf (or protobuf protobuf-message))
   (let* ((name (prog1 (parse-token stream)
-                 (expect-char stream #\{ "extend")
+                 (expect-char stream #\{ () "extend")
                  (maybe-skip-comments stream)))
          (message (find-message *protobuf* name))
          (extends (and message
@@ -382,7 +394,7 @@
     (loop
       (let ((token (parse-token stream)))
         (when (null token)
-          (expect-char stream #\} "extend")
+          (expect-char stream #\} '(#\;) "extend")
           (maybe-skip-comments stream)
           (setf (proto-messages protobuf) (nconc (proto-messages protobuf) (list extends)))
           (setf (proto-extenders protobuf) (nconc (proto-extenders protobuf) (list extends)))
@@ -409,10 +421,10 @@
     (if (string= type "group")
       (parse-proto-group stream message required extended-from)
       (let* ((name (prog1 (parse-token stream)
-                     (expect-char stream #\= "message")))
+                     (expect-char stream #\= () "message")))
              (idx  (parse-int stream))
              (opts (prog1 (parse-proto-field-options stream)
-                     (expect-char stream #\; "message")
+                     (expect-char stream #\; () "message")
                      (maybe-skip-comments stream)))
              (dflt   (find-option opts "default"))
              (packed (find-option opts "packed"))
@@ -448,7 +460,7 @@
    Updates the 'protobuf-message' object to have the group type and field."
   (check-type message protobuf-message)
   (let* ((type (prog1 (parse-token stream)
-                 (expect-char stream #\= "message")))
+                 (expect-char stream #\= () "message")))
          (name (slot-name->proto (proto->slot-name type)))
          (idx  (parse-int stream))
          (msg  (parse-proto-message stream message type))
@@ -477,7 +489,7 @@
     (loop
       (unless (eql (peek-char nil stream nil) #\[)
         (return-from parse-proto-field-options options))
-      (expect-char stream #\[ "message")
+      (expect-char stream #\[ () "message")
       (collect-option (parse-proto-option stream nil #\])))
     options))
 
@@ -488,7 +500,7 @@
          (to    (if (digit-char-p (peek-char nil stream nil))
                   (parse-int stream)
                   (parse-token stream))))
-    (expect-char stream #\; "message")
+    (expect-char stream #\; () "message")
     (assert (string= token "to") ()
             "Expected 'to' in 'extensions' at position ~D" (file-position stream))
     (assert (or (integerp to) (string= to "max")) ()
@@ -507,7 +519,7 @@
    Updates the 'protobuf-protobuf' object to have the service."
   (check-type protobuf protobuf)
   (let* ((name (prog1 (parse-token stream)
-                 (expect-char stream #\{ "service")
+                 (expect-char stream #\{ () "service")
                  (maybe-skip-comments stream)))
          (service (make-instance 'protobuf-service
                     :class (proto->class-name name *protobuf-package*)
@@ -515,7 +527,7 @@
     (loop
       (let ((token (parse-token stream)))
         (when (null token)
-          (expect-char stream #\} "service")
+          (expect-char stream #\} '(#\;) "service")
           (maybe-skip-comments stream)
           (setf (proto-services protobuf) (nconc (proto-services protobuf) (list service)))
           (return-from parse-proto-service service))
@@ -532,16 +544,16 @@
    Updates the 'protobuf-service' object to have the method."
   (check-type service protobuf-service)
   (let* ((name (parse-token stream))
-         (in   (prog2 (expect-char stream #\( "service")
+         (in   (prog2 (expect-char stream #\( () "service")
                    (parse-token stream)
-                 (expect-char stream #\) "service")))
+                 (expect-char stream #\) () "service")))
          (ret  (parse-token stream))
-         (out  (prog2 (expect-char stream #\( "service")
+         (out  (prog2 (expect-char stream #\( () "service")
                    (parse-token stream)
-                 (expect-char stream #\) "service")))
+                 (expect-char stream #\) () "service")))
          (opts (let ((opts (parse-proto-method-options stream)))
                  (when (or (null opts) (eql (peek-char nil stream nil) #\;))
-                   (expect-char stream #\; "service"))
+                   (expect-char stream #\; () "service"))
                  (maybe-skip-comments stream)
                  opts))
          (method (make-instance 'protobuf-method
@@ -564,7 +576,7 @@
   "Parse any options in a Protobufs method from 'stream'.
    Returns a list of 'protobuf-option' objects."
   (when (eql (peek-char nil stream nil) #\{)
-    (expect-char stream #\{ "service")
+    (expect-char stream #\{ () "service")
     (maybe-skip-comments stream)
     (with-collectors ((options collect-option))
       (loop
@@ -573,6 +585,6 @@
         (assert (string= (parse-token stream) "option") ()
                 "Syntax error in 'message' at position ~D" (file-position stream))
         (collect-option (parse-proto-option stream nil #\;)))
-      (expect-char stream #\} "service")
+      (expect-char stream #\} '(#\;) "service")
       (maybe-skip-comments stream)
       options)))

diff --git a/printer.lisp b/printer.lisp
index 10451358a1716fffc9788c1a8889a43f12679b52..55d8fd0958e5801ee354eae5d09d70ea63b39740 100644 (file)
--- a/printer.lisp
+++ b/printer.lisp
@@ -13,11 +13,12 @@
 
 ;;; Protobufs schema pretty printing
 
-(defun write-protobuf (protobuf &key (stream *standard-output*) (type :proto))
+(defun write-protobuf (protobuf &rest keys
+                       &key (stream *standard-output*) (type :proto) &allow-other-keys)
   "Writes the protobuf object 'protobuf' (schema, message, enum, etc) onto
    the given stream 'stream'in the format given by 'type' (:proto, :text, etc)."
    (let ((*protobuf* protobuf))
-     (write-protobuf-as type protobuf stream)))
+     (apply #'write-protobuf-as type protobuf stream keys)))
 
 (defgeneric write-protobuf-as (type protobuf stream &key indentation &allow-other-keys)
   (:documentation
@@ -258,8 +259,13 @@
 
 ;;; Pretty print a schema as a .lisp file
 
+(defvar *show-lisp-enum-indexes* t)
+(defvar *show-lisp-field-indexes* t)
+
 (defmethod write-protobuf-as ((type (eql :lisp)) (protobuf protobuf) stream
-                              &key (indentation 0))
+                              &key (indentation 0)
+                                   (show-field-indexes *show-lisp-field-indexes*)
+                                   (show-enum-indexes *show-lisp-enum-indexes*))
   (with-prefixed-accessors (name class documentation package lisp-package imports) (proto- protobuf)
     (let* ((optimize (let ((opt (find-option protobuf "optimize_for")))
                        (and opt (cond ((string= opt "SPEED") :speed)
@@ -268,6 +274,8 @@
            (options  (remove "optimize_for" (proto-options protobuf) :test #'string-equal :key #'proto-name))
            (pkg      (and package (if (stringp package) package (string package))))
            (lisp-pkg (and lisp-package (if (stringp lisp-package) lisp-package (string lisp-package))))
+           (*show-lisp-enum-indexes* show-enum-indexes)
+           (*show-lisp-field-indexes* show-field-indexes)
            (*protobuf-package* (or (find-package lisp-pkg)
                                    (find-package (string-upcase lisp-pkg))
                                    *package*))
@@ -361,8 +369,11 @@
                               &key (indentation 0) more)
   (declare (ignore more))
   (with-prefixed-accessors (value index) (proto- val)
-    (format stream "~&~@[~VT~](~(~A~) ~D)"
-            (and (not (zerop indentation)) indentation) value index)))
+    (if *show-lisp-enum-indexes*
+      (format stream "~&~@[~VT~](~(~A~) ~D)"
+              (and (not (zerop indentation)) indentation) value index)
+      (format stream "~&~@[~VT~]~(~A~)"
+              (and (not (zerop indentation)) indentation) value))))
 
 
 (defmethod write-protobuf-as ((type (eql :lisp)) (message protobuf-message) stream
@@ -473,17 +484,20 @@
       (cond (group
              (write-protobuf-as type group stream :indentation indentation :index index :arity required))
             (t
-             (format stream (if (keywordp class)
-                              ;; Keyword means a primitive type, print default with ~S
-                              "~&~@[~VT~](~(~S~) :type ~(~S~)~@[ :default ~S~]~
-                               ~@[ :reader ~(~S~)~]~@[ :writer ~(~S~)~])~:[~*~*~;~VT; ~A~]"
-                              ;; Non-keyword must mean an enum type, print default with ~A
-                              "~&~@[~VT~](~(~S~) :type ~(~S~)~@[ :default ~(:~A~)~]~
-                               ~@[ :reader ~(~S~)~]~@[ :writer ~(~S~)~])~:[~*~*~;~VT; ~A~]")
-                     (and (not (zerop indentation)) indentation)
-                     value clss dflt reader writer
-                     ;; Don't write the comment if we'll insert a close paren after it
-                     (and more documentation) *protobuf-slot-comment-column* documentation))))))
+             (let ((slot (if *show-lisp-field-indexes*
+                           (format nil "(~(~S~) ~D)" value index)
+                           (format nil "~(~S~)" value))))
+               (format stream (if (keywordp class)
+                                ;; Keyword means a primitive type, print default with ~S
+                                "~&~@[~VT~](~A :type ~(~S~)~@[ :default ~S~]~
+                                 ~@[ :reader ~(~S~)~]~@[ :writer ~(~S~)~])~:[~*~*~;~VT; ~A~]"
+                                ;; Non-keyword must mean an enum type, print default with ~A
+                                "~&~@[~VT~](~A :type ~(~S~)~@[ :default ~(:~A~)~]~
+                                 ~@[ :reader ~(~S~)~]~@[ :writer ~(~S~)~])~:[~*~*~;~VT; ~A~]")
+                       (and (not (zerop indentation)) indentation)
+                       slot clss dflt reader writer
+                       ;; Don't write the comment if we'll insert a close paren after it
+                       (and more documentation) *protobuf-slot-comment-column* documentation)))))))
 
 (defmethod write-protobuf-as ((type (eql :lisp)) (extension protobuf-extension) stream
                               &key (indentation 0) more)