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