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 ;;; Parsing utilities
  17
  18 (declaim (inline proto-whitespace-char-p))
  19 (defun proto-whitespace-char-p (ch)
  20   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
  21     (and ch (member ch '(#\space #\tab #\return #\newline)))))
  22
  23 (declaim (inline proto-eol-char-p))
  24 (defun proto-eol-char-p (ch)
  25   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
  26     (and ch (member ch '(#\return #\newline)))))
  27
  28 (declaim (inline proto-token-char-p))
  29 (defun proto-token-char-p (ch)
  30   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
  31     (and ch (or (alpha-char-p ch)
  32                 (digit-char-p ch)
  33                 (member ch '(#\_ #\.))))))
  34
  35
  36 (defun skip-whitespace (stream)
  37   "Skip all the whitespace characters that are coming up in the stream."
  38   (loop for ch = (peek-char nil stream nil)
  39         until (or (null ch) (not (proto-whitespace-char-p ch)))
  40         do (read-char stream nil)))
  41
  42 ;;--- Collect the comment so we can attach it to its associated object
  43 (defun maybe-skip-comments (stream)
  44   "If what appears next in the stream is a comment, skip it and any following comments,
  45    then skip any following whitespace."
  46   (loop
  47     (unless (eql (peek-char nil stream nil) #\/)
  48       (return)
  49       (read-char stream)
  50       (case (peek-char nil stream nil)
  51         ((#\/)
  52          (skip-line-comment stream))
  53         ((#\*)
  54          (skip-block-comment stream))
  55         (otherwise
  56          (error "Found a '~C' at position ~D to start a comment, but no following '~C' or '~C'"
  57                 #\/ (file-position stream) #\/ #\*)))))
  58   (skip-whitespace stream))
  59
  60 (defun skip-line-comment (stream)
  61   "Skip to the end of a line comment, that is, to the end of the line.
  62    Then skip any following whitespace."
  63   (loop for ch = (read-char stream nil)
  64         until (or (null ch) (proto-eol-char-p ch)))
  65   (skip-whitespace stream))
  66
  67 (defun skip-block-comment (stream)
  68   "Skip to the end of a block comment, that is, until a '*/' is seen.
  69    Then skip any following whitespace."
  70   (loop for ch = (read-char stream nil)
  71         do (cond ((null ch)
  72                   (error "Premature end of file while skipping block comment"))
  73                  ((and (eql ch #\*)
  74                        (eql (peek-char nil stream nil) #\/))
  75                   (read-char stream nil)
  76                   (return))))
  77   (skip-whitespace stream))
  78
  79
  80 (defun expect-char (stream ch &optional within)
  81   "Expect to see 'ch' as the next character in the stream; signal an error if it's not there.
  82    Then skip all of the following whitespace."
  83   (if (if (listp ch)
  84         (member (peek-char nil stream nil) ch)
  85         (eql (peek-char nil stream nil) ch))
  86     (read-char stream)
  87     (error "No '~C' found~@[ within '~A'~] at position ~D"
  88            ch within (file-position stream)))
  89   (skip-whitespace stream))
  90
  91
  92 (defun parse-token (stream)
  93   "Parse the next token in the stream, then skip the following whitespace.
  94    The returned value is the token."
  95   (when (proto-token-char-p (peek-char nil stream nil))
  96     (loop for ch = (read-char stream nil)
  97           for ch1 = (peek-char nil stream nil)
  98           collect ch into token
  99           until (or (null ch1) (not (proto-token-char-p ch1)))
 100           finally (progn
 101                     (skip-whitespace stream)
 102                     (return (coerce token 'string))))))
 103
 104 (defun parse-string (stream)
 105   "Parse the next quoted string in the stream, then skip the following whitespace.
 106    The returned value is the string, without the quotation marks."
 107   (loop with ch0 = (read-char stream nil)
 108         for ch = (read-char stream nil)
 109         until (or (null ch) (char= ch ch0))
 110         collect ch into string
 111         finally (progn
 112                   (skip-whitespace stream)
 113                   (return (coerce string 'string)))))
 114
 115 (defun parse-int (stream)
 116   "Parse the next token in the stream as an integer, then skip the following whitespace.
 117    The returned value is the integer."
 118   (when (digit-char-p (peek-char nil stream nil))
 119     (loop for ch = (read-char stream nil)
 120           for ch1 = (peek-char nil stream nil)
 121           collect ch into token
 122           until (or (null ch1) (not (digit-char-p ch1)))
 123           finally (progn
 124                     (skip-whitespace stream)
 125                     (return (parse-integer (coerce token 'string)))))))
 126
 127 (defun parse-float (stream)
 128   "Parse the next token in the stream as a float, then skip the following whitespace.                                     The returned value is the float."
 129   (when (let ((ch (peek-char nil stream nil)))
 130             (or (digit-char-p ch) (eql ch #\-)))
 131     (let ((token (parse-token stream)))
 132       (when token
 133         (skip-whitespace stream)
 134         (coerce (read-from-string token) 'float)))))
 135
 136
 137 ;;; The parser itself
 138
 139 (defun parse-protobuf-from-file (filename)
 140   "Parses the named file as a .proto file, and returns the Protobufs schema."
 141   (with-open-file (stream filename
 142                    :direction :input
 143                    :external-format :utf-8
 144                    :element-type 'character)
 145     (parse-protobuf-from-stream stream
 146                                 :name  (class-name->proto (pathname-name (pathname stream)))
 147                                 :class (pathname-name (pathname stream)))))
 148
 149 ;; The syntax for Protocol Buffers is so simple that it doesn't seem worth
 150 ;; writing a sophisticated parser
 151 ;; Note that we don't put the result into *all-protobufs*; do that at a higher level
 152 (defun parse-protobuf-from-stream (stream &key name class)
 153   "Parses a top-level .proto file from the stream 'stream'.
 154    Returns the protobuf schema that describes the .proto file."
 155   (let* ((protobuf   (make-instance 'protobuf
 156                        :class class
 157                        :name  name))
 158          (*protobuf* protobuf)
 159          (*protobuf-package* nil))
 160     (loop
 161       (skip-whitespace stream)
 162       (maybe-skip-comments stream)
 163       (let ((char (peek-char nil stream nil)))
 164         (cond ((null char)
 165                (return-from parse-protobuf-from-stream protobuf))
 166               ((proto-token-char-p char)
 167                (let ((token (parse-token stream)))
 168                  (cond ((string= token "syntax")
 169                         (parse-proto-syntax stream protobuf))
 170                        ((string= token "package")
 171                         (parse-proto-package stream protobuf))
 172                        ((string= token "import")
 173                         (parse-proto-import stream protobuf))
 174                        ((string= token "option")
 175                         (let* ((option (parse-proto-option stream protobuf))
 176                                (name   (and option (proto-name option)))
 177                                (value  (and option (proto-value option))))
 178                           (when option
 179                             (cond ((string= name "optimize_for")
 180                                    (let ((value (cond ((string= value "SPEED") :speed)
 181                                                       ((string= value "CODE_SIZE") :space)
 182                                                       (t nil))))
 183                                      (setf (proto-optimize protobuf) value)))
 184                                   ((string= name "lisp_package")
 185                                    (let ((package (or (find-package value)
 186                                                       (find-package (string-upcase value)))))
 187                                      (setf (proto-lisp-package protobuf) value)
 188                                      (setq *protobuf-package* package)))))))
 189                        ((string= token "enum")
 190                         (parse-proto-enum stream protobuf))
 191                        ;;---*** Handle "extends" here
 192                        ((string= token "message")
 193                         (parse-proto-message stream protobuf))
 194                        ((string= token "service")
 195                         (parse-proto-service stream protobuf)))))
 196               (t
 197                (error "Syntax error at position ~D" (file-position stream))))))))
 198
 199 (defun parse-proto-syntax (stream protobuf &optional (terminator #\;))
 200   "Parse a Protobufs syntax line from 'stream'.
 201    Updates the 'protobuf' object to use the syntax."
 202   (let ((syntax (prog1 (parse-token stream)
 203                   (expect-char stream terminator "syntax")
 204                   (maybe-skip-comments stream))))
 205     (setf (proto-syntax protobuf) syntax)))
 206
 207 (defun parse-proto-package (stream protobuf &optional (terminator #\;))
 208   "Parse a Protobufs package line from 'stream'.
 209    Updates the 'protobuf' object to use the package."
 210   (let* ((package  (prog1 (parse-token stream)
 211                      (expect-char stream terminator "package")
 212                      (maybe-skip-comments stream)))
 213          (lisp-pkg (or (proto-lisp-package protobuf)
 214                        (substitute #\- #\_ package))))
 215     (setf (proto-package protobuf) package)
 216     (unless (proto-lisp-package protobuf)
 217       (setf (proto-lisp-package protobuf) lisp-pkg))
 218     (let ((package (or (find-package lisp-pkg)
 219                        (find-package (string-upcase lisp-pkg)))))
 220       (setq *protobuf-package* package))))
 221
 222 (defun parse-proto-import (stream protobuf &optional (terminator #\;))
 223   "Parse a Protobufs import line from 'stream'.
 224    Updates the 'protobuf' object to use the package."
 225   (let ((import (prog1 (parse-string stream)
 226                   (expect-char stream terminator "package")
 227                   (maybe-skip-comments stream))))
 228     ;;---*** This needs to parse the imported file(s)
 229     (setf (proto-imports protobuf) (nconc (proto-imports protobuf) (list import)))))
 230
 231 (defun parse-proto-option (stream protobuf &optional (terminator #\;))
 232   "Parse a Protobufs option from 'stream'.
 233    Updates the 'protobuf' (or message, service, method) to have the option."
 234   (let* ((key (prog1 (parse-token stream)
 235                 (expect-char stream #\= "option")))
 236          (val (prog1 (if (eql (peek-char nil stream nil) #\")
 237                        (parse-string stream)
 238                        (parse-token stream))
 239                 (expect-char stream terminator "option")
 240                 (maybe-skip-comments stream)))
 241          (option (make-instance 'protobuf-option
 242                    :name  key
 243                    :value val)))
 244     (cond (protobuf
 245            (setf (proto-options protobuf) (nconc (proto-options protobuf) (list option)))
 246            option)
 247           (t
 248            ;; If nothing to graft the option into, just return it as the value
 249            option))))
 250
 251
 252 (defun parse-proto-enum (stream protobuf)
 253   "Parse a Protobufs enum from 'stream'.
 254    Updates the 'protobuf' or 'protobuf-message' object to have the enum."
 255   (let* ((name (prog1 (parse-token stream)
 256                  (expect-char stream #\{ "enum")
 257                  (maybe-skip-comments stream)))
 258          (enum (make-instance 'protobuf-enum
 259                  :class (proto->class-name name *protobuf-package*)
 260                  :name name)))
 261     (loop
 262       (let ((name (parse-token stream)))
 263         (when (null name)
 264           (expect-char stream #\} "enum")
 265           (maybe-skip-comments stream)
 266           (setf (proto-enums protobuf) (nconc (proto-messages protobuf) (list enum)))
 267           (let ((type (find-option enum "lisp_name")))
 268             (when type
 269               (setf (proto-class enum) (make-lisp-symbol type))))
 270           (let ((alias (find-option enum "lisp_alias")))
 271             (when alias
 272               (setf (proto-alias-for enum) (make-lisp-symbol alias))))
 273           (return-from parse-proto-enum))
 274         (if (string= name "option")
 275           (parse-proto-option stream enum #\;)
 276           (parse-proto-enum-value stream enum name))))))
 277
 278 (defun parse-proto-enum-value (stream enum name)
 279   "Parse a Protobufs enum vvalue from 'stream'.
 280    Updates the 'protobuf-enum' object to have the enum value."
 281   (expect-char stream #\= "enum")
 282   (let* ((idx  (prog1 (parse-int stream)
 283                  (expect-char stream #\; "enum")
 284                  (maybe-skip-comments stream)))
 285          (value (make-instance 'protobuf-enum-value
 286                   :name  name
 287                   :index idx
 288                   :value (proto->enum-name name *protobuf-package*))))
 289     (setf (proto-values enum) (nconc (proto-values enum) (list value)))))
 290
 291
 292 (defun parse-proto-message (stream protobuf)
 293   "Parse a Protobufs message from 'stream'.
 294    Updates the 'protobuf' or 'protobuf-message' object to have the message."
 295   (let* ((name (prog1 (parse-token stream)
 296                  (expect-char stream #\{ "message")
 297                  (maybe-skip-comments stream)))
 298          (message (make-instance 'protobuf-message
 299                     :class (proto->class-name name *protobuf-package*)
 300                     :name name)))
 301     (loop
 302       (let ((token (parse-token stream)))
 303         (when (null token)
 304           (expect-char stream #\} "message")
 305           (maybe-skip-comments stream)
 306           (setf (proto-messages protobuf) (nconc (proto-messages protobuf) (list message)))
 307           (let ((type (find-option message "lisp_name")))
 308             (when type
 309               (setf (proto-class message) (make-lisp-symbol type))))
 310           (let ((alias (find-option message "lisp_alias")))
 311             (when alias
 312               (setf (proto-alias-for message) (make-lisp-symbol alias))))
 313           (return-from parse-proto-message))
 314         (cond ((string= token "enum")
 315                (parse-proto-enum stream message))
 316               ;;---*** Handle "extends" here
 317               ((string= token "message")
 318                (parse-proto-message stream message))
 319               ((member token '("required" "optional" "repeated") :test #'string=)
 320                (parse-proto-field stream message token))
 321               ((string= token "option")
 322                (parse-proto-option stream message #\;))
 323               ((string= token "extensions")
 324                (parse-proto-extension stream message))
 325               (t
 326                (error "Unrecognized token ~A at position ~D"
 327                       token (file-position stream))))))))
 328
 329 (defun parse-proto-field (stream message required)
 330   "Parse a Protobufs field from 'stream'.
 331    Updates the 'protobuf-message' object to have the field."
 332   (let* ((type (parse-token stream))
 333          (name (prog1 (parse-token stream)
 334                  (expect-char stream #\= "message")))
 335          (idx  (parse-int stream))
 336          (opts (prog1 (parse-proto-field-options stream)
 337                  (expect-char stream #\; "message")
 338                  (maybe-skip-comments stream)))
 339          (dflt   (find-option opts "default"))
 340          (packed (find-option opts "packed"))
 341          (ptype  (if (member type '("int32" "int64" "uint32" "uint64" "sint32" "sint64"
 342                                     "fixed32" "fixed64" "sfixed32" "sfixed64"
 343                                     "string" "bytes" "bool" "float" "double") :test #'string=)
 344                    (kintern type)
 345                    type))
 346          (class  (if (keywordp ptype) ptype (proto->class-name type *protobuf-package*)))
 347          (field  (make-instance 'protobuf-field
 348                    :name  name
 349                    :value (proto->slot-name name *protobuf-package*)
 350                    :type  type
 351                    :class class
 352                    ;; One of :required, :optional or :repeated
 353                    :required (kintern required)
 354                    :index idx
 355                    :default dflt
 356                    :packed  (and packed (string= packed "true")))))
 357     (let ((slot (find-option opts "lisp_name")))
 358       (when slot
 359         (setf (proto-value field) (make-lisp-symbol type))))
 360     (setf (proto-fields message) (nconc (proto-fields message) (list field)))))
 361
 362 (defun parse-proto-field-options (stream)
 363   "Parse any options in a Protobufs field from 'stream'.
 364    Returns a list of 'protobuf-option' objects."
 365   (with-collectors ((options collect-option))
 366     (loop
 367       (unless (eql (peek-char nil stream nil) #\[)
 368         (return-from parse-proto-field-options options))
 369       (expect-char stream #\[ "message")
 370       (collect-option (parse-proto-option stream nil #\])))
 371     options))
 372
 373 (defun parse-proto-extension (stream message)
 374   (let* ((from  (parse-int stream))
 375          (token (parse-token stream))
 376          (to    (if (digit-char-p (peek-char nil stream nil))
 377                   (parse-int stream)
 378                   (parse-token stream))))
 379     (expect-char stream #\; "message")
 380     (assert (string= token "to") ()
 381             "Expected 'to' in 'extensions' at position ~D" (file-position stream))
 382     (assert (or (integerp to) (string= to "max")) ()
 383             "Extension value is not an integer or 'max' as position ~D" (file-position stream))
 384     (push (make-instance 'protobuf-extension
 385             :from from
 386             :to   (if (integerp to) to #.(1- (ash 1 29)))) (proto-extensions message))))
 387
 388
 389 (defun parse-proto-service (stream protobuf)
 390   "Parse a Protobufs service from 'stream'.
 391    Updates the 'protobuf-message' object to have the service."
 392   (let* ((name (prog1 (parse-token stream)
 393                  (expect-char stream #\{ "service")
 394                  (maybe-skip-comments stream)))
 395          (service (make-instance 'protobuf-service
 396                     :class (proto->class-name name *protobuf-package*)
 397                     :name name)))
 398     (loop
 399       (let ((token (parse-token stream)))
 400         (when (null token)
 401           (expect-char stream #\} "service")
 402           (maybe-skip-comments stream)
 403           (setf (proto-services protobuf) (nconc (proto-services protobuf) (list service)))
 404           (return-from parse-proto-service))
 405         (cond ((string= token "option")
 406                (parse-proto-option stream service #\;))
 407               ((string= token "rpc")
 408                (parse-proto-method stream service token))
 409               (t
 410                (error "Unrecognized token ~A at position ~D"
 411                       token (file-position stream))))))))
 412
 413 (defun parse-proto-method (stream service method)
 414   "Parse a Protobufs enum vvalue from 'stream'.
 415    Updates the 'protobuf-enum' object to have the enum value."
 416   (declare (ignore method))
 417   (let* ((name (parse-token stream))
 418          (in   (prog2 (expect-char stream #\( "service")
 419                    (parse-token stream)
 420                  (expect-char stream #\) "service")))
 421          (ret  (parse-token stream))
 422          (out  (prog2 (expect-char stream #\( "service")
 423                    (parse-token stream)
 424                  (expect-char stream #\) "service")))
 425          (opts (let ((opts (parse-proto-method-options stream)))
 426                  (when (or (null opts) (eql (peek-char nil stream nil) #\;))
 427                    (expect-char stream #\; "service"))
 428                  (maybe-skip-comments stream)
 429                  opts))
 430          (method (make-instance 'protobuf-method
 431                    :class (proto->class-name name *protobuf-package*)
 432                    :name  name
 433                    :input-type  (proto->class-name in *protobuf-package*)
 434                    :input-name  in
 435                    :output-type (proto->class-name out *protobuf-package*)
 436                    :output-name out
 437                    :options opts)))
 438     (let ((name (find-option method "lisp_name")))
 439       (when name
 440         (setf (proto-function method) (make-lisp-symbol name))))
 441     (assert (string= ret "returns") ()
 442             "Syntax error in 'message' at position ~D" (file-position stream))
 443     (setf (proto-methods service) (nconc (proto-methods service) (list method)))))
 444
 445 (defun parse-proto-method-options (stream)
 446   "Parse any options in a Protobufs method from 'stream'.
 447    Returns a list of 'protobuf-option' objects."
 448   (when (eql (peek-char nil stream nil) #\{)
 449     (expect-char stream #\{ "service")
 450     (maybe-skip-comments stream)
 451     (with-collectors ((options collect-option))
 452       (loop
 453         (when (eql (peek-char nil stream nil) #\})
 454           (return))
 455         (assert (string= (parse-token stream) "option") ()
 456                 "Syntax error in 'message' at position ~D" (file-position stream))
 457         (collect-option (parse-proto-option stream nil #\;)))
 458       (expect-char stream #\} "service")
 459       (maybe-skip-comments stream)
 460       options)))