parser.lisp

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;;                                                                  ;;;
   3 ;;; Confidential and proprietary information of ITA Software, Inc.   ;;;
   4 ;;;                                                                  ;;;
   5 ;;; Copyright (c) 2012 ITA Software, Inc.  All rights reserved.      ;;;
   6 ;;;                                                                  ;;;
   7 ;;; Original author: Scott McKay                                     ;;;
   8 ;;;                                                                  ;;;
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 (in-package "PROTO-IMPL")
  12
  13
  14 ;;; .proto file parsing
  15
  16 (defun-inline proto-whitespace-char-p (ch)
  17   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
  18     (and ch (member ch '(#\space #\tab #\return #\newline)))))
  19
  20 (defun-inline proto-eol-char-p (ch)
  21   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
  22     (and ch (member ch '(#\return #\newline)))))
  23
  24 (defun-inline proto-token-char-p (ch)
  25   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
  26     (and ch (or (alpha-char-p ch)
  27                 (digit-char-p ch)
  28                 (member ch '(#\_ #\.))))))
  29
  30
  31 (defun skip-whitespace (stream)
  32   "Skip all the whitespace characters that are coming up in the stream."
  33   (loop for ch = (peek-char nil stream nil)
  34         until (or (null ch) (not (proto-whitespace-char-p ch)))
  35         do (read-char stream nil)))
  36
  37 (defun skip-comment (stream)
  38   "Skip to the end of a comment, that is, to the end of the line.
  39    Then skip any following whitespace."
  40   (loop for ch = (read-char stream nil)
  41         until (or (null ch) (proto-eol-char-p ch)))
  42   (skip-whitespace stream))
  43
  44 (defun maybe-skip-comments (stream)
  45   "If what appears next in the stream is a comment, skip it and any following comments,
  46    then skip any following whitespace."
  47   (when (eql (peek-char nil stream nil) #\/)
  48     (read-char stream)
  49     (if (eql (peek-char nil stream nil) #\/)
  50       (skip-comment stream)
  51       (error "Found a '~C' at position ~D to start a comment, but no following '~C'"
  52              #\/ (file-position stream) #\/)))
  53   (skip-whitespace stream))
  54
  55 (defun expect-char (stream ch &optional within)
  56   "Expect to see 'ch' as the next character in the stream; signal an error if it's not there.
  57    Then skip all of the following whitespace."
  58   (if (if (listp ch)
  59         (member (peek-char nil stream) ch)
  60         (eql (peek-char nil stream) ch))
  61     (read-char stream)
  62     (error "No '~C' found~@[ within '~A'~] at position ~D"
  63            ch within (file-position stream)))
  64   (skip-whitespace stream))
  65
  66
  67 (defun parse-token (stream)
  68   "Parse the next token in the stream, then skip the following whitespace.
  69    The returned value is the token."
  70   (when (proto-token-char-p (peek-char nil stream nil))
  71     (loop for ch = (read-char stream nil)
  72           for ch1 = (peek-char nil stream nil)
  73           collect ch into token
  74           until (or (null ch1) (not (proto-token-char-p ch1)))
  75           finally (progn
  76                     (skip-whitespace stream)
  77                     (return (coerce token 'string))))))
  78
  79 (defun parse-int (stream)
  80   "Parse the next token in the stream as an integer, then skip the following whitespace.
  81    The returned value is the integer."
  82   (when (digit-char-p (peek-char nil stream nil))
  83     (loop for ch = (read-char stream nil)
  84           for ch1 = (peek-char nil stream nil)
  85           collect ch into token
  86           until (or (null ch1) (not (digit-char-p ch1)))
  87           finally (progn
  88                     (skip-whitespace stream)
  89                     (return (parse-integer (coerce token 'string)))))))
  90
  91 (defun parse-string (stream)
  92   "Parse the next quoted string in the stream, then skip the following whitespace.
  93    The returned value is the string, without the quotation marks."
  94   (loop with ch0 = (read-char stream nil)
  95         for ch = (read-char stream nil)
  96         until (or (null ch) (char= ch ch0))
  97         collect ch into string
  98         finally (progn
  99                   (skip-whitespace stream)
 100                   (return (coerce string 'string)))))
 101
 102
 103 (defun proto-intern (name intern-fn)
 104   (let ((package (and *protobuf*
 105                       (proto-package *protobuf*)
 106                       (find-package (proto-package *protobuf*)))))
 107     (funcall intern-fn name package)))
 108
 109
 110 (defun parse-protobuf-from-file (filename)
 111   "Parses the named file as a .proto file, and returns the protobufs schema."
 112   (with-open-file (stream filename
 113                    :direction :input
 114                    :external-format :utf-8
 115                    :element-type 'character)
 116     (parse-protobuf-from-stream stream :name (pathname-name (pathname stream)))))
 117
 118 ;; The syntax for Protocol Buffers is so simple that it doesn't seem worth
 119 ;; writing a complicated parser
 120 ;; Note that we don't put the result into *all-protobufs*; do that at a higher level
 121 (defun parse-protobuf-from-stream (stream &key name)
 122   "Parses a top-level .proto file from the stream 'stream'.
 123    Returns the protobuf schema that describes the .proto file."
 124   (let* ((protobuf   (make-instance 'protobuf
 125                        :name name))
 126          (*protobuf* protobuf))
 127     (loop
 128       (skip-whitespace stream)
 129       (maybe-skip-comments stream)
 130       (let ((char (peek-char nil stream nil)))
 131         (cond ((null char)
 132                (return-from parse-protobuf-from-stream protobuf))
 133               ((proto-token-char-p char)
 134                (let ((token (parse-token stream)))
 135                  (cond ((string= token "package")
 136                         (parse-proto-package stream protobuf))
 137                        ((string= token "import")
 138                         (parse-proto-import stream protobuf))
 139                        ((string= token "option")
 140                         (parse-proto-option stream protobuf))
 141                        ((string= token "enum")
 142                         (parse-proto-enum stream protobuf))
 143                        ((string= token "message")
 144                         (parse-proto-message stream protobuf))
 145                        ((string= token "service")
 146                         (parse-proto-service stream protobuf)))))
 147               (t
 148                (error "Syntax error at position ~D" (file-position stream))))))))
 149
 150 (defun parse-proto-package (stream protobuf &optional (terminator #\;))
 151   "Parse a Protobufs package line from 'stream'.
 152    Updates the 'protobuf' object to use the package."
 153   (let ((package (prog1 (parse-token stream)
 154                    (expect-char stream terminator "package")
 155                    (maybe-skip-comments stream))))
 156     (setf (proto-package protobuf) package)))
 157
 158 (defun parse-proto-import (stream protobuf &optional (terminator #\;))
 159   "Parse a Protobufs import line from 'stream'.
 160    Updates the 'protobuf' object to use the package."
 161   (let ((import (prog1 (parse-string stream)
 162                   (expect-char stream terminator "package")
 163                   (maybe-skip-comments stream))))
 164     (setf (proto-imports protobuf) (nconc (proto-imports protobuf) (list import)))))
 165
 166 (defun parse-proto-option (stream protobuf &optional (terminator #\;))
 167   "Parse a Protobufs option from 'stream'.
 168    Updates the 'protobuf' (or message, service, RPC) to have the option."
 169   (let* ((key (prog1 (parse-token stream)
 170                 (expect-char stream #\= "option")))
 171          (val (prog1 (if (eql (peek-char nil stream nil) #\")
 172                        (parse-string stream)
 173                        (parse-token stream))
 174                 (expect-char stream terminator "option")
 175                 (maybe-skip-comments stream)))
 176          (option (make-instance 'protobuf-option
 177                    :name  key
 178                    :value val)))
 179     (if protobuf
 180       (setf (proto-options protobuf) (nconc (proto-options protobuf) (list option)))
 181       ;; If nothing to graft the option into, just return it as the value
 182       option)))
 183
 184
 185 (defun parse-proto-enum (stream protobuf)
 186   "Parse a Protobufs enum from 'stream'.
 187    Updates the 'protobuf' or 'protobuf-message' object to have the enum."
 188   (let* ((name (prog1 (parse-token stream)
 189                  (expect-char stream #\{ "enum")
 190                  (maybe-skip-comments stream)))
 191          (enum (make-instance 'protobuf-enum
 192                  :name name
 193                  :class (proto-intern name #'proto->class-name))))
 194     (loop
 195       (let ((name (parse-token stream)))
 196         (when (null name)
 197           (expect-char stream #\} "enum")
 198           (maybe-skip-comments stream)
 199           (setf (proto-enums protobuf) (nconc (proto-messages protobuf) (list enum)))
 200           (return-from parse-proto-enum))
 201         (parse-proto-enum-value stream enum name)))))
 202
 203 (defun parse-proto-enum-value (stream enum name)
 204   "Parse a Protobufs enum vvalue from 'stream'.
 205    Updates the 'protobuf-enum' object to have the enum value."
 206   (expect-char stream #\= "enum")
 207   (let* ((idx  (prog1 (parse-int stream)
 208                  (expect-char stream #\; "enum")
 209                  (maybe-skip-comments stream)))
 210          (value (make-instance 'protobuf-enum-value
 211                   :name  name
 212                   :index idx
 213                   :value (proto-intern name #'proto->enum-name))))
 214     (setf (proto-values enum) (nconc (proto-values enum) (list value)))))
 215
 216
 217 (defun parse-proto-message (stream protobuf)
 218   "Parse a Protobufs message from 'stream'.
 219    Updates the 'protobuf' or 'protobuf-message' object to have the message."
 220   (let* ((name (prog1 (parse-token stream)
 221                  (expect-char stream #\{ "message")
 222                  (maybe-skip-comments stream)))
 223          (message (make-instance 'protobuf-message
 224                     :name name
 225                     :class (proto-intern name #'proto->class-name))))
 226     (loop
 227       (let ((token (parse-token stream)))
 228         (when (null token)
 229           (expect-char stream #\} "message")
 230           (maybe-skip-comments stream)
 231           (setf (proto-messages protobuf) (nconc (proto-messages protobuf) (list message)))
 232           (return-from parse-proto-message))
 233         (cond ((string= token "enum")
 234                (parse-proto-enum stream message))
 235               ((string= token "message")
 236                (parse-proto-message stream message))
 237               ((member token '("required" "optional" "repeated") :test #'string=)
 238                (parse-proto-field stream message token))
 239               (t
 240                (error "Unrecognized token ~A at position ~D"
 241                       token (file-position stream))))))))
 242
 243 (defun parse-proto-field (stream message required)
 244   "Parse a Protobufs field from 'stream'.
 245    Updates the 'protobuf-message' object to have the field."
 246   (let* ((type (parse-token stream))
 247          (name (prog1 (parse-token stream)
 248                  (expect-char stream #\= "message")))
 249          (idx  (parse-int stream))
 250          (opts (prog1 (parse-proto-field-options stream)
 251                  (expect-char stream #\; "message")
 252                  (maybe-skip-comments stream)))
 253          (dflt   (let ((opt (find "default" opts :key #'proto-name :test #'string=)))
 254                    (and opt (proto-value opt))))
 255          (packed (let ((opt (find "packed" opts :key #'proto-name :test #'string=)))
 256                    (and opt (string= (proto-value opt) "true"))))
 257          (ptype  (if (member type '("int32" "int64" "uint32" "uint64" "sint32" "sint64"
 258                                     "fixed32" "fixed64" "sfixed32" "sfixed64"
 259                                     "string" "bytes" "bool" "float" "double") :test #'string=)
 260                    (kintern type)
 261                    type))
 262          (class  (if (keywordp ptype) ptype (proto-intern type #'proto->class-name)))
 263          (field  (make-instance 'protobuf-field
 264                    :name  name
 265                    :value (proto-intern name #'proto->slot-name)
 266                    :type  type
 267                    :class class
 268                    ;; One of :required, :optional or :repeated
 269                    :required (kintern required)
 270                    :index idx
 271                    :default dflt
 272                    :packed packed)))
 273     (setf (proto-fields message) (nconc (proto-fields message) (list field)))))
 274
 275 (defun parse-proto-field-options (stream)
 276   "Parse any options in a Protobufs field from 'stream'.
 277    Returns a list of 'protobuf-option' objects."
 278   (with-collectors ((options collect-option))
 279     (loop
 280       (unless (eql (peek-char nil stream) #\[)
 281         (return-from parse-proto-field-options options))
 282       (expect-char stream #\[ "message")
 283       (collect-option (parse-proto-option stream nil #\])))
 284     options))
 285
 286
 287 (defun parse-proto-service (stream protobuf)
 288   "Parse a Protobufs service from 'stream'.
 289    Updates the 'protobuf-message' object to have the service."
 290   (let* ((name (prog1 (parse-token stream)
 291                  (expect-char stream #\{ "service")
 292                  (maybe-skip-comments stream)))
 293          (service (make-instance 'protobuf-service
 294                     :name name)))
 295     (loop
 296       (let ((token (parse-token stream)))
 297         (when (null token)
 298           (expect-char stream #\} "service")
 299           (maybe-skip-comments stream)
 300           (setf (proto-services protobuf) (nconc (proto-services protobuf) (list service)))
 301           (return-from parse-proto-service))
 302         (cond ((string= token "rpc")
 303                (parse-proto-rpc stream service token))
 304               (t
 305                (error "Unrecognized token ~A at position ~D"
 306                       token (file-position stream))))))))
 307
 308 (defun parse-proto-rpc (stream service rpc)
 309   "Parse a Protobufs enum vvalue from 'stream'.
 310    Updates the 'protobuf-enum' object to have the enum value."
 311   (declare (ignore rpc))
 312   (let* ((name (parse-token stream))
 313          (in   (prog2 (expect-char stream #\( "service")
 314                    (parse-token stream)
 315                  (expect-char stream #\) "service")))
 316          (ret  (parse-token stream))
 317          (out  (prog2 (expect-char stream #\( "service")
 318                    (parse-token stream)
 319                  (expect-char stream #\) "service")))
 320          (opts (let ((opts (parse-proto-rpc-options stream)))
 321                  (when (or (null opts) (eql (peek-char nil stream) #\;))
 322                    (expect-char stream #\; "service"))
 323                  (maybe-skip-comments stream)
 324                  opts))
 325          (rpc (make-instance 'protobuf-rpc
 326                 :name  name
 327                 :class (proto-intern name #'proto->class-name)
 328                 :input-type  in
 329                 :input-class (proto-intern in #'proto->class-name)
 330                 :output-type  out
 331                 :output-class (proto-intern out #'proto->class-name)
 332                 :options opts)))
 333     (assert (string= ret "returns") ()
 334             "Syntax error in 'message' at position ~D" (file-position stream))
 335     (setf (proto-rpcs service) (nconc (proto-rpcs service) (list rpc)))))
 336
 337 (defun parse-proto-rpc-options (stream)
 338   "Parse any options in a Protobufs RPC from 'stream'.
 339    Returns a list of 'protobuf-option' objects."
 340   (when (eql (peek-char nil stream) #\{)
 341     (expect-char stream #\{ "service")
 342     (maybe-skip-comments stream)
 343     (with-collectors ((options collect-option))
 344       (loop
 345         (when (eql (peek-char nil stream) #\})
 346           (return))
 347         (assert (string= (parse-token stream) "option") ()
 348                 "Syntax error in 'message' at position ~D" (file-position stream))
 349         (collect-option (parse-proto-option stream nil #\;)))
 350       (expect-char stream #\} "service")
 351       (maybe-skip-comments stream)
 352       options)))