1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;; Confidential and proprietary information of ITA Software, Inc. ;;;
5 ;;; Copyright (c) 2012 ITA Software, Inc. All rights reserved. ;;;
7 ;;; Original author: Scott McKay ;;;
9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11 (in-package "PROTO-IMPL")
14 ;;; .proto file parsing
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)))))
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)))))
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)
33 (member ch '(#\_ #\.))))))
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)))
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."
47 (unless (eql (peek-char nil stream nil) #\/)
50 (case (peek-char nil stream nil)
52 (skip-line-comment stream))
54 (skip-block-comment stream))
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))
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))
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)
72 (error "Premature end of file while skipping block comment"))
74 (eql (peek-char nil stream nil) #\/))
75 (read-char stream nil)
77 (skip-whitespace stream))
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."
84 (member (peek-char nil stream nil) ch)
85 (eql (peek-char nil stream nil) ch))
87 (error "No '~C' found~@[ within '~A'~] at position ~D"
88 ch within (file-position stream)))
89 (skip-whitespace stream))
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)
99 until (or (null ch1) (not (proto-token-char-p ch1)))
101 (skip-whitespace stream)
102 (return (coerce token 'string))))))
104 (defun parse-parenthesized-token (stream)
105 "Parse the next token in the stream, then skip the following whitespace.
106 The token might be surrounded by parentheses.
107 The returned value is the token."
108 (let ((left (peek-char nil stream nil)))
111 (when (proto-token-char-p (peek-char nil stream nil))
112 (loop for ch = (read-char stream nil)
113 for ch1 = (peek-char nil stream nil)
114 collect ch into token
115 until (or (null ch1) (not (proto-token-char-p ch1)))
117 (skip-whitespace stream)
119 (expect-char stream #\)))
120 (return (coerce token 'string)))))))
122 (defun parse-token-or-string (stream)
123 (if (eql (peek-char nil stream nil) #\")
124 (values (parse-string stream) 'string)
125 (values (parse-token stream) 'symbol)))
127 (defun parse-string (stream)
128 "Parse the next quoted string in the stream, then skip the following whitespace.
129 The returned value is the string, without the quotation marks."
130 (loop with ch0 = (read-char stream nil)
131 for ch = (read-char stream nil)
132 until (or (null ch) (char= ch ch0))
133 collect ch into string
135 (skip-whitespace stream)
136 (return (coerce string 'string)))))
138 (defun parse-int (stream)
139 "Parse the next token in the stream as an integer, then skip the following whitespace.
140 The returned value is the integer."
141 (when (digit-char-p (peek-char nil stream nil))
142 (loop for ch = (read-char stream nil)
143 for ch1 = (peek-char nil stream nil)
144 collect ch into token
145 until (or (null ch1) (not (digit-char-p ch1)))
147 (skip-whitespace stream)
148 (return (parse-integer (coerce token 'string)))))))
150 (defun parse-float (stream)
151 "Parse the next token in the stream as a float, then skip the following whitespace. The returned value is the float."
152 (when (let ((ch (peek-char nil stream nil)))
153 (or (digit-char-p ch) (eql ch #\-)))
154 (let ((token (parse-token stream)))
156 (skip-whitespace stream)
157 (coerce (read-from-string token) 'float)))))
160 ;;; The parser itself
162 (defun parse-protobuf-from-file (filename)
163 "Parses the named file as a .proto file, and returns the Protobufs schema."
164 (with-open-file (stream filename
166 :external-format :utf-8
167 :element-type 'character)
168 (parse-protobuf-from-stream stream
169 :name (class-name->proto (pathname-name (pathname stream)))
170 :class (pathname-name (pathname stream)))))
172 ;; The syntax for Protocol Buffers is so simple that it doesn't seem worth
173 ;; writing a sophisticated parser
174 ;; Note that we don't put the result into *all-protobufs*; do that at a higher level
175 (defun parse-protobuf-from-stream (stream &key name class)
176 "Parses a top-level .proto file from the stream 'stream'.
177 Returns the protobuf schema that describes the .proto file."
178 (let* ((protobuf (make-instance 'protobuf
181 (*protobuf* protobuf)
182 (*protobuf-package* nil))
184 (skip-whitespace stream)
185 (maybe-skip-comments stream)
186 (let ((char (peek-char nil stream nil)))
188 (return-from parse-protobuf-from-stream protobuf))
189 ((proto-token-char-p char)
190 (let ((token (parse-token stream)))
191 (cond ((string= token "syntax")
192 (parse-proto-syntax stream protobuf))
193 ((string= token "package")
194 (parse-proto-package stream protobuf))
195 ((string= token "import")
196 (parse-proto-import stream protobuf))
197 ((string= token "option")
198 (let* ((option (parse-proto-option stream protobuf))
199 (name (and option (proto-name option)))
200 (value (and option (proto-value option))))
202 (cond ((option-name= name "optimize_for")
203 (let ((value (cond ((string= value "SPEED") :speed)
204 ((string= value "CODE_SIZE") :space)
206 (setf (proto-optimize protobuf) value)))
207 ((option-name= name "lisp_package")
208 (let ((package (or (find-package value)
209 (find-package (string-upcase value)))))
210 (setf (proto-lisp-package protobuf) value)
211 (setq *protobuf-package* package)))))))
212 ((string= token "enum")
213 (parse-proto-enum stream protobuf))
214 ((string= token "extend")
215 (parse-proto-extend stream protobuf))
216 ((string= token "message")
217 (parse-proto-message stream protobuf))
218 ((string= token "service")
219 (parse-proto-service stream protobuf)))))
221 (error "Syntax error at position ~D" (file-position stream))))))))
223 (defun parse-proto-syntax (stream protobuf &optional (terminator #\;))
224 "Parse a Protobufs syntax line from 'stream'.
225 Updates the 'protobuf' object to use the syntax."
226 (let ((syntax (prog2 (expect-char stream #\= "syntax")
227 (parse-string stream)
228 (expect-char stream terminator "syntax")
229 (maybe-skip-comments stream))))
230 (setf (proto-syntax protobuf) syntax)))
232 (defun parse-proto-package (stream protobuf &optional (terminator #\;))
233 "Parse a Protobufs package line from 'stream'.
234 Updates the 'protobuf' object to use the package."
235 (check-type protobuf protobuf)
236 (let* ((package (prog1 (parse-token stream)
237 (expect-char stream terminator "package")
238 (maybe-skip-comments stream)))
239 (lisp-pkg (or (proto-lisp-package protobuf)
240 (substitute #\- #\_ package))))
241 (setf (proto-package protobuf) package)
242 (unless (proto-lisp-package protobuf)
243 (setf (proto-lisp-package protobuf) lisp-pkg))
244 (let ((package (or (find-package lisp-pkg)
245 (find-package (string-upcase lisp-pkg)))))
246 (setq *protobuf-package* package))))
248 (defun parse-proto-import (stream protobuf &optional (terminator #\;))
249 "Parse a Protobufs import line from 'stream'.
250 Updates the 'protobuf' object to use the package."
251 (check-type protobuf protobuf)
252 (let ((import (prog1 (parse-string stream)
253 (expect-char stream terminator "package")
254 (maybe-skip-comments stream))))
255 ;;---*** This needs to parse the imported file(s)
256 (setf (proto-imports protobuf) (nconc (proto-imports protobuf) (list import)))))
258 (defun parse-proto-option (stream protobuf &optional (terminator #\;))
259 "Parse a Protobufs option line from 'stream'.
260 Updates the 'protobuf' (or message, service, method) to have the option."
261 (check-type protobuf (or null base-protobuf))
262 (let* ((key (prog1 (parse-parenthesized-token stream)
263 (expect-char stream #\= "option")))
264 (val (prog1 (if (eql (peek-char nil stream nil) #\")
265 (parse-string stream)
266 (parse-token stream))
267 (expect-char stream terminator "option")
268 (maybe-skip-comments stream)))
269 (option (make-instance 'protobuf-option
273 (setf (proto-options protobuf) (nconc (proto-options protobuf) (list option)))
276 ;; If nothing to graft the option into, just return it as the value
280 (defun parse-proto-enum (stream protobuf)
281 "Parse a Protobufs 'enum' from 'stream'.
282 Updates the 'protobuf' or 'protobuf-message' object to have the enum."
283 (check-type protobuf (or protobuf protobuf-message))
284 (let* ((name (prog1 (parse-token stream)
285 (expect-char stream #\{ "enum")
286 (maybe-skip-comments stream)))
287 (enum (make-instance 'protobuf-enum
288 :class (proto->class-name name *protobuf-package*)
291 (let ((name (parse-token stream)))
293 (expect-char stream #\} "enum")
294 (maybe-skip-comments stream)
295 (setf (proto-enums protobuf) (nconc (proto-enums protobuf) (list enum)))
296 (let ((type (find-option enum "lisp_name")))
298 (setf (proto-class enum) (make-lisp-symbol type))))
299 (let ((alias (find-option enum "lisp_alias")))
301 (setf (proto-alias-for enum) (make-lisp-symbol alias))))
302 (return-from parse-proto-enum))
303 (if (string= name "option")
304 (parse-proto-option stream enum #\;)
305 (parse-proto-enum-value stream enum name))))))
307 (defun parse-proto-enum-value (stream enum name)
308 "Parse a Protobufs enum value from 'stream'.
309 Updates the 'protobuf-enum' object to have the enum value."
310 (check-type enum protobuf-enum)
311 (expect-char stream #\= "enum")
312 (let* ((idx (prog1 (parse-int stream)
313 (expect-char stream #\; "enum")
314 (maybe-skip-comments stream)))
315 (value (make-instance 'protobuf-enum-value
318 :value (proto->enum-name name *protobuf-package*))))
319 (setf (proto-values enum) (nconc (proto-values enum) (list value)))))
322 (defun parse-proto-message (stream protobuf)
323 "Parse a Protobufs 'message' from 'stream'.
324 Updates the 'protobuf' or 'protobuf-message' object to have the message."
325 (check-type protobuf (or protobuf protobuf-message))
326 (let* ((name (prog1 (parse-token stream)
327 (expect-char stream #\{ "message")
328 (maybe-skip-comments stream)))
329 (message (make-instance 'protobuf-message
330 :class (proto->class-name name *protobuf-package*)
333 (*protobuf* message))
335 (let ((token (parse-token stream)))
337 (expect-char stream #\} "message")
338 (maybe-skip-comments stream)
339 (setf (proto-messages protobuf) (nconc (proto-messages protobuf) (list message)))
340 (let ((type (find-option message "lisp_name")))
342 (setf (proto-class message) (make-lisp-symbol type))))
343 (let ((alias (find-option message "lisp_alias")))
345 (setf (proto-alias-for message) (make-lisp-symbol alias))))
346 (return-from parse-proto-message))
347 (cond ((string= token "enum")
348 (parse-proto-enum stream message))
349 ((string= token "extend")
350 (parse-proto-extend stream message))
351 ((string= token "message")
352 (parse-proto-message stream message))
353 ((member token '("required" "optional" "repeated") :test #'string=)
354 (parse-proto-field stream message token))
355 ((string= token "option")
356 (parse-proto-option stream message #\;))
357 ((string= token "extensions")
358 (parse-proto-extension stream message))
360 (error "Unrecognized token ~A at position ~D"
361 token (file-position stream))))))))
363 (defun parse-proto-extend (stream protobuf)
364 "Parse a Protobufs 'extend' from 'stream'.
365 Updates the 'protobuf' or 'protobuf-message' object to have the message."
366 (check-type protobuf (or protobuf protobuf-message))
367 (let* ((name (prog1 (parse-token stream)
368 (expect-char stream #\{ "extend")
369 (maybe-skip-comments stream)))
370 (message (find-message *protobuf* name))
371 (extends (and message
372 (make-instance 'protobuf-message
373 :class (proto->class-name name *protobuf-package*)
375 :parent (proto-parent message)
376 :conc-name (proto-conc-name message)
377 :alias-for (proto-alias-for message)
378 :enums (copy-list (proto-enums message))
379 :messages (copy-list (proto-messages message))
380 :fields (copy-list (proto-fields message))
381 :extension-p t)))) ;this message is an extension
383 (let ((token (parse-token stream)))
385 (expect-char stream #\} "extend")
386 (maybe-skip-comments stream)
387 (setf (proto-messages protobuf) (nconc (proto-messages protobuf) (list extends)))
388 (setf (proto-extenders protobuf) (nconc (proto-extenders protobuf) (list extends)))
389 (let ((type (find-option extends "lisp_name")))
391 (setf (proto-class extends) (make-lisp-symbol type))))
392 (let ((alias (find-option extends "lisp_alias")))
394 (setf (proto-alias-for extends) (make-lisp-symbol alias))))
395 (return-from parse-proto-extend))
396 (cond ((member token '("required" "optional" "repeated") :test #'string=)
397 (parse-proto-field stream extends token message))
398 ((string= token "option")
399 (parse-proto-option stream extends #\;))
401 (error "Unrecognized token ~A at position ~D"
402 token (file-position stream))))))))
404 (defun parse-proto-field (stream message required &optional extended-from)
405 "Parse a Protobufs field from 'stream'.
406 Updates the 'protobuf-message' object to have the field."
407 (check-type message protobuf-message)
408 (let* ((type (parse-token stream))
409 (name (prog1 (parse-token stream)
410 (expect-char stream #\= "message")))
411 (idx (parse-int stream))
412 (opts (prog1 (parse-proto-field-options stream)
413 (expect-char stream #\; "message")
414 (maybe-skip-comments stream)))
415 (dflt (find-option opts "default"))
416 (packed (find-option opts "packed"))
417 (ptype (if (member type '("int32" "int64" "uint32" "uint64" "sint32" "sint64"
418 "fixed32" "fixed64" "sfixed32" "sfixed64"
419 "string" "bytes" "bool" "float" "double") :test #'string=)
422 (class (if (keywordp ptype) ptype (proto->class-name type *protobuf-package*)))
423 (field (make-instance 'protobuf-field
425 :value (proto->slot-name name *protobuf-package*)
428 ;; One of :required, :optional or :repeated
429 :required (kintern required)
432 :packed (and packed (string= packed "true"))
433 :extension-p (proto-extension-p message))))
435 (assert (index-within-extensions-p idx extended-from) ()
436 "The index ~D is not in range for extending ~S"
437 idx (proto-class extended-from)))
438 (let ((slot (find-option opts "lisp_name")))
440 (setf (proto-value field) (make-lisp-symbol type))))
441 (setf (proto-fields message) (nconc (proto-fields message) (list field)))))
443 (defun parse-proto-field-options (stream)
444 "Parse any options in a Protobufs field from 'stream'.
445 Returns a list of 'protobuf-option' objects."
446 (with-collectors ((options collect-option))
448 (unless (eql (peek-char nil stream nil) #\[)
449 (return-from parse-proto-field-options options))
450 (expect-char stream #\[ "message")
451 (collect-option (parse-proto-option stream nil #\])))
454 (defun parse-proto-extension (stream message)
455 (check-type message protobuf-message)
456 (let* ((from (parse-int stream))
457 (token (parse-token stream))
458 (to (if (digit-char-p (peek-char nil stream nil))
460 (parse-token stream))))
461 (expect-char stream #\; "message")
462 (assert (string= token "to") ()
463 "Expected 'to' in 'extensions' at position ~D" (file-position stream))
464 (assert (or (integerp to) (string= to "max")) ()
465 "Extension value is not an integer or 'max' as position ~D" (file-position stream))
466 (setf (proto-extensions message)
467 (nconc (proto-extensions message)
468 (list (make-instance 'protobuf-extension
470 :to (if (integerp to) to #.(1- (ash 1 29)))))))))
473 (defun parse-proto-service (stream protobuf)
474 "Parse a Protobufs 'service' from 'stream'.
475 Updates the 'protobuf-protobuf' object to have the service."
476 (check-type protobuf protobuf)
477 (let* ((name (prog1 (parse-token stream)
478 (expect-char stream #\{ "service")
479 (maybe-skip-comments stream)))
480 (service (make-instance 'protobuf-service
481 :class (proto->class-name name *protobuf-package*)
484 (let ((token (parse-token stream)))
486 (expect-char stream #\} "service")
487 (maybe-skip-comments stream)
488 (setf (proto-services protobuf) (nconc (proto-services protobuf) (list service)))
489 (return-from parse-proto-service))
490 (cond ((string= token "option")
491 (parse-proto-option stream service #\;))
492 ((string= token "rpc")
493 (parse-proto-method stream service))
495 (error "Unrecognized token ~A at position ~D"
496 token (file-position stream))))))))
498 (defun parse-proto-method (stream service)
499 "Parse a Protobufs method from 'stream'.
500 Updates the 'protobuf-service' object to have the method."
501 (check-type service protobuf-service)
502 (let* ((name (parse-token stream))
503 (in (prog2 (expect-char stream #\( "service")
505 (expect-char stream #\) "service")))
506 (ret (parse-token stream))
507 (out (prog2 (expect-char stream #\( "service")
509 (expect-char stream #\) "service")))
510 (opts (let ((opts (parse-proto-method-options stream)))
511 (when (or (null opts) (eql (peek-char nil stream nil) #\;))
512 (expect-char stream #\; "service"))
513 (maybe-skip-comments stream)
515 (method (make-instance 'protobuf-method
516 :class (proto->class-name name *protobuf-package*)
518 :input-type (proto->class-name in *protobuf-package*)
520 :output-type (proto->class-name out *protobuf-package*)
523 (let ((name (find-option method "lisp_name")))
525 (setf (proto-function method) (make-lisp-symbol name))))
526 (assert (string= ret "returns") ()
527 "Syntax error in 'message' at position ~D" (file-position stream))
528 (setf (proto-methods service) (nconc (proto-methods service) (list method)))))
530 (defun parse-proto-method-options (stream)
531 "Parse any options in a Protobufs method from 'stream'.
532 Returns a list of 'protobuf-option' objects."
533 (when (eql (peek-char nil stream nil) #\{)
534 (expect-char stream #\{ "service")
535 (maybe-skip-comments stream)
536 (with-collectors ((options collect-option))
538 (when (eql (peek-char nil stream nil) #\})
540 (assert (string= (parse-token stream) "option") ()
541 "Syntax error in 'message' at position ~D" (file-position stream))
542 (collect-option (parse-proto-option stream nil #\;)))
543 (expect-char stream #\} "service")
544 (maybe-skip-comments stream)