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
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)))))
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)))))
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)
28 (member ch '(#\_ #\.))))))
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)))
37 ;;--- Collect the comment so we can attach it to its associated object
38 (defun maybe-skip-comments (stream)
39 "If what appears next in the stream is a comment, skip it and any following comments,
40 then skip any following whitespace."
42 (unless (eql (peek-char nil stream nil) #\/)
45 (case (peek-char nil stream nil)
47 (skip-line-comment stream))
49 (skip-block-comment stream))
51 (error "Found a '~C' at position ~D to start a comment, but no following '~C' or '~C'"
52 #\/ (file-position stream) #\/ #\*)))))
53 (skip-whitespace stream))
55 (defun skip-line-comment (stream)
56 "Skip to the end of a line comment, that is, to the end of the line.
57 Then skip any following whitespace."
58 (loop for ch = (read-char stream nil)
59 until (or (null ch) (proto-eol-char-p ch)))
60 (skip-whitespace stream))
62 (defun skip-block-comment (stream)
63 "Skip to the end of a block comment, that is, until a '*/' is seen.
64 Then skip any following whitespace."
65 (loop for ch = (read-char stream nil)
67 (error "Premature end of file while skipping block comment"))
69 (eql (peek-char nil stream nil) #\/))
70 (read-char stream nil)
72 (skip-whitespace stream))
74 (defun expect-char (stream ch &optional within)
75 "Expect to see 'ch' as the next character in the stream; signal an error if it's not there.
76 Then skip all of the following whitespace."
78 (member (peek-char nil stream) ch)
79 (eql (peek-char nil stream) ch))
81 (error "No '~C' found~@[ within '~A'~] at position ~D"
82 ch within (file-position stream)))
83 (skip-whitespace stream))
86 (defun parse-token (stream)
87 "Parse the next token in the stream, then skip the following whitespace.
88 The returned value is the token."
89 (when (proto-token-char-p (peek-char nil stream nil))
90 (loop for ch = (read-char stream nil)
91 for ch1 = (peek-char nil stream nil)
93 until (or (null ch1) (not (proto-token-char-p ch1)))
95 (skip-whitespace stream)
96 (return (coerce token 'string))))))
98 (defun parse-int (stream)
99 "Parse the next token in the stream as an integer, then skip the following whitespace.
100 The returned value is the integer."
101 (when (digit-char-p (peek-char nil stream nil))
102 (loop for ch = (read-char stream nil)
103 for ch1 = (peek-char nil stream nil)
104 collect ch into token
105 until (or (null ch1) (not (digit-char-p ch1)))
107 (skip-whitespace stream)
108 (return (parse-integer (coerce token 'string)))))))
110 (defun parse-string (stream)
111 "Parse the next quoted string in the stream, then skip the following whitespace.
112 The returned value is the string, without the quotation marks."
113 (loop with ch0 = (read-char stream nil)
114 for ch = (read-char stream nil)
115 until (or (null ch) (char= ch ch0))
116 collect ch into string
118 (skip-whitespace stream)
119 (return (coerce string 'string)))))
122 (defun proto-intern (name intern-fn)
123 (let ((package (and *protobuf*
124 (proto-package *protobuf*)
125 (find-package (proto-package *protobuf*)))))
126 (funcall intern-fn name package)))
129 (defun parse-protobuf-from-file (filename)
130 "Parses the named file as a .proto file, and returns the Protobufs schema."
131 (with-open-file (stream filename
133 :external-format :utf-8
134 :element-type 'character)
135 (parse-protobuf-from-stream stream :name (pathname-name (pathname stream)))))
137 ;; The syntax for Protocol Buffers is so simple that it doesn't seem worth
138 ;; writing a complicated parser
139 ;; Note that we don't put the result into *all-protobufs*; do that at a higher level
140 (defun parse-protobuf-from-stream (stream &key name)
141 "Parses a top-level .proto file from the stream 'stream'.
142 Returns the protobuf schema that describes the .proto file."
143 (let* ((protobuf (make-instance 'protobuf
145 (*protobuf* protobuf))
147 (skip-whitespace stream)
148 (maybe-skip-comments stream)
149 (let ((char (peek-char nil stream nil)))
151 (return-from parse-protobuf-from-stream protobuf))
152 ((proto-token-char-p char)
153 (let ((token (parse-token stream)))
154 (cond ((string= token "package")
155 (parse-proto-package stream protobuf))
156 ((string= token "import")
157 (parse-proto-import stream protobuf))
158 ((string= token "option")
159 (parse-proto-option stream protobuf))
160 ((string= token "enum")
161 (parse-proto-enum stream protobuf))
162 ((string= token "message")
163 (parse-proto-message stream protobuf))
164 ((string= token "service")
165 (parse-proto-service stream protobuf)))))
167 (error "Syntax error at position ~D" (file-position stream))))))))
169 (defun parse-proto-package (stream protobuf &optional (terminator #\;))
170 "Parse a Protobufs package line from 'stream'.
171 Updates the 'protobuf' object to use the package."
172 (let ((package (prog1 (parse-token stream)
173 (expect-char stream terminator "package")
174 (maybe-skip-comments stream))))
175 (setf (proto-package protobuf) package)))
177 (defun parse-proto-import (stream protobuf &optional (terminator #\;))
178 "Parse a Protobufs import line from 'stream'.
179 Updates the 'protobuf' object to use the package."
180 (let ((import (prog1 (parse-string stream)
181 (expect-char stream terminator "package")
182 (maybe-skip-comments stream))))
183 (setf (proto-imports protobuf) (nconc (proto-imports protobuf) (list import)))))
185 (defun parse-proto-option (stream protobuf &optional (terminator #\;))
186 "Parse a Protobufs option from 'stream'.
187 Updates the 'protobuf' (or message, service, RPC) to have the option."
188 (let* ((key (prog1 (parse-token stream)
189 (expect-char stream #\= "option")))
190 (val (prog1 (if (eql (peek-char nil stream nil) #\")
191 (parse-string stream)
192 (parse-token stream))
193 (expect-char stream terminator "option")
194 (maybe-skip-comments stream)))
195 (option (make-instance 'protobuf-option
199 (setf (proto-options protobuf) (nconc (proto-options protobuf) (list option)))
200 ;; If nothing to graft the option into, just return it as the value
204 (defun parse-proto-enum (stream protobuf)
205 "Parse a Protobufs enum from 'stream'.
206 Updates the 'protobuf' or 'protobuf-message' object to have the enum."
207 (let* ((name (prog1 (parse-token stream)
208 (expect-char stream #\{ "enum")
209 (maybe-skip-comments stream)))
210 (enum (make-instance 'protobuf-enum
212 :class (proto-intern name #'proto->class-name))))
214 (let ((name (parse-token stream)))
216 (expect-char stream #\} "enum")
217 (maybe-skip-comments stream)
218 (setf (proto-enums protobuf) (nconc (proto-messages protobuf) (list enum)))
219 (return-from parse-proto-enum))
220 (parse-proto-enum-value stream enum name)))))
222 (defun parse-proto-enum-value (stream enum name)
223 "Parse a Protobufs enum vvalue from 'stream'.
224 Updates the 'protobuf-enum' object to have the enum value."
225 (expect-char stream #\= "enum")
226 (let* ((idx (prog1 (parse-int stream)
227 (expect-char stream #\; "enum")
228 (maybe-skip-comments stream)))
229 (value (make-instance 'protobuf-enum-value
232 :value (proto-intern name #'proto->enum-name))))
233 (setf (proto-values enum) (nconc (proto-values enum) (list value)))))
236 (defun parse-proto-message (stream protobuf)
237 "Parse a Protobufs message from 'stream'.
238 Updates the 'protobuf' or 'protobuf-message' object to have the message."
239 (let* ((name (prog1 (parse-token stream)
240 (expect-char stream #\{ "message")
241 (maybe-skip-comments stream)))
242 (message (make-instance 'protobuf-message
244 :class (proto-intern name #'proto->class-name))))
246 (let ((token (parse-token stream)))
248 (expect-char stream #\} "message")
249 (maybe-skip-comments stream)
250 (setf (proto-messages protobuf) (nconc (proto-messages protobuf) (list message)))
251 (return-from parse-proto-message))
252 (cond ((string= token "enum")
253 (parse-proto-enum stream message))
254 ((string= token "message")
255 (parse-proto-message stream message))
256 ((member token '("required" "optional" "repeated") :test #'string=)
257 (parse-proto-field stream message token))
259 (error "Unrecognized token ~A at position ~D"
260 token (file-position stream))))))))
262 (defun parse-proto-field (stream message required)
263 "Parse a Protobufs field from 'stream'.
264 Updates the 'protobuf-message' object to have the field."
265 (let* ((type (parse-token stream))
266 (name (prog1 (parse-token stream)
267 (expect-char stream #\= "message")))
268 (idx (parse-int stream))
269 (opts (prog1 (parse-proto-field-options stream)
270 (expect-char stream #\; "message")
271 (maybe-skip-comments stream)))
272 (dflt (let ((opt (find "default" opts :key #'proto-name :test #'string=)))
273 (and opt (proto-value opt))))
274 (packed (let ((opt (find "packed" opts :key #'proto-name :test #'string=)))
275 (and opt (string= (proto-value opt) "true"))))
276 (ptype (if (member type '("int32" "int64" "uint32" "uint64" "sint32" "sint64"
277 "fixed32" "fixed64" "sfixed32" "sfixed64"
278 "string" "bytes" "bool" "float" "double") :test #'string=)
281 (class (if (keywordp ptype) ptype (proto-intern type #'proto->class-name)))
282 (field (make-instance 'protobuf-field
284 :value (proto-intern name #'proto->slot-name)
287 ;; One of :required, :optional or :repeated
288 :required (kintern required)
292 (setf (proto-fields message) (nconc (proto-fields message) (list field)))))
294 (defun parse-proto-field-options (stream)
295 "Parse any options in a Protobufs field from 'stream'.
296 Returns a list of 'protobuf-option' objects."
297 (with-collectors ((options collect-option))
299 (unless (eql (peek-char nil stream) #\[)
300 (return-from parse-proto-field-options options))
301 (expect-char stream #\[ "message")
302 (collect-option (parse-proto-option stream nil #\])))
306 (defun parse-proto-service (stream protobuf)
307 "Parse a Protobufs service from 'stream'.
308 Updates the 'protobuf-message' object to have the service."
309 (let* ((name (prog1 (parse-token stream)
310 (expect-char stream #\{ "service")
311 (maybe-skip-comments stream)))
312 (service (make-instance 'protobuf-service
315 (let ((token (parse-token stream)))
317 (expect-char stream #\} "service")
318 (maybe-skip-comments stream)
319 (setf (proto-services protobuf) (nconc (proto-services protobuf) (list service)))
320 (return-from parse-proto-service))
321 (cond ((string= token "rpc")
322 (parse-proto-rpc stream service token))
324 (error "Unrecognized token ~A at position ~D"
325 token (file-position stream))))))))
327 (defun parse-proto-rpc (stream service rpc)
328 "Parse a Protobufs enum vvalue from 'stream'.
329 Updates the 'protobuf-enum' object to have the enum value."
330 (declare (ignore rpc))
331 (let* ((name (parse-token stream))
332 (in (prog2 (expect-char stream #\( "service")
334 (expect-char stream #\) "service")))
335 (ret (parse-token stream))
336 (out (prog2 (expect-char stream #\( "service")
338 (expect-char stream #\) "service")))
339 (opts (let ((opts (parse-proto-rpc-options stream)))
340 (when (or (null opts) (eql (peek-char nil stream) #\;))
341 (expect-char stream #\; "service"))
342 (maybe-skip-comments stream)
344 (rpc (make-instance 'protobuf-rpc
346 :class (proto-intern name #'proto->class-name)
348 :input-class (proto-intern in #'proto->class-name)
350 :output-class (proto-intern out #'proto->class-name)
352 (assert (string= ret "returns") ()
353 "Syntax error in 'message' at position ~D" (file-position stream))
354 (setf (proto-rpcs service) (nconc (proto-rpcs service) (list rpc)))))
356 (defun parse-proto-rpc-options (stream)
357 "Parse any options in a Protobufs RPC from 'stream'.
358 Returns a list of 'protobuf-option' objects."
359 (when (eql (peek-char nil stream) #\{)
360 (expect-char stream #\{ "service")
361 (maybe-skip-comments stream)
362 (with-collectors ((options collect-option))
364 (when (eql (peek-char nil stream) #\})
366 (assert (string= (parse-token stream) "option") ()
367 "Syntax error in 'message' at position ~D" (file-position stream))
368 (collect-option (parse-proto-option stream nil #\;)))
369 (expect-char stream #\} "service")
370 (maybe-skip-comments stream)