From d8cdb95b8278f427591536caf0c8a8730ee0ff5d Mon Sep 17 00:00:00 2001 From: Scott McKay Date: Sun, 1 Apr 2012 21:31:57 +0000 Subject: [PATCH] Some cleanups to enable some more cleanups :-) git-svn-id: http://svn.internal.itasoftware.com/svn/ita/branches/qres/swm/borgify-1/qres/lisp/quux/protobufs@537059 f8382938-511b-0410-9cdd-bb47b084005c --- define-proto.lisp | 4 +- examples.lisp | 98 +++++++++++++++++++++++----------------------- model-classes.lisp | 61 +++++++++++++++-------------- parser.lisp | 25 ++++++++---- printer.lisp | 12 ++++-- proto-pkgdcl.lisp | 10 +++-- serialize.lisp | 56 +++++++++++++------------- text-format.lisp | 6 +-- utilities.lisp | 8 ++++ wire-format.lisp | 7 +--- 10 files changed, 155 insertions(+), 132 deletions(-) diff --git a/define-proto.lisp b/define-proto.lisp index 0859dd0..f1e8226 100644 --- a/define-proto.lisp +++ b/define-proto.lisp @@ -327,7 +327,7 @@ (defun ensure-type (trace message field type) (unless (keywordp type) (let ((msg (loop for p in trace - thereis (or (find-message-for-class p type) - (find-enum-for-type p type))))) + thereis (or (find-message p type) + (find-enum p type))))) (unless msg (push (cons message field) (gethash type *undefined-messages*)))))) diff --git a/examples.lisp b/examples.lisp index 53bd07a..0c64606 100644 --- a/examples.lisp +++ b/examples.lisp @@ -60,9 +60,9 @@ qres-core::currency qres-core::country-currencies geodata)) - (eval (generate-object-size bdschema (find-message-for-class bdschema class))) - (eval (generate-serializer bdschema (find-message-for-class bdschema class))) - (eval (generate-deserializer bdschema (find-message-for-class bdschema class)))) + (eval (proto-impl:generate-object-size bdschema (proto-impl:find-message bdschema class))) + (eval (proto-impl:generate-serializer bdschema (proto-impl:find-message bdschema class))) + (eval (proto-impl:generate-deserializer bdschema (proto-impl:find-message bdschema class)))) (let* ((countries (loop for v being the hash-values of (qres-core::country-business-data) collect (car v))) (regions (loop for v being the hash-values of (qres-core::region-business-data) collect v)) @@ -98,35 +98,35 @@ (proto:print-text-format pschema pschema) (proto:print-text-format (proto:deserialize-object 'proto:protobuf pschema pser 0) pschema) -(eval (generate-object-size pschema (find-message-for-class pschema 'proto:protobuf))) -(eval (generate-object-size pschema (find-message-for-class pschema 'proto:protobuf-option))) -(eval (generate-object-size pschema (find-message-for-class pschema 'proto:protobuf-enum))) -(eval (generate-object-size pschema (find-message-for-class pschema 'proto:protobuf-enum-value))) -(eval (generate-object-size pschema (find-message-for-class pschema 'proto:protobuf-message))) -(eval (generate-object-size pschema (find-message-for-class pschema 'proto:protobuf-field))) -(eval (generate-object-size pschema (find-message-for-class pschema 'proto:protobuf-extension))) -(eval (generate-object-size pschema (find-message-for-class pschema 'proto:protobuf-service))) -(eval (generate-object-size pschema (find-message-for-class pschema 'proto:protobuf-rpc))) - -(eval (generate-serializer pschema (find-message-for-class pschema 'proto:protobuf))) -(eval (generate-serializer pschema (find-message-for-class pschema 'proto:protobuf-option))) -(eval (generate-serializer pschema (find-message-for-class pschema 'proto:protobuf-enum))) -(eval (generate-serializer pschema (find-message-for-class pschema 'proto:protobuf-enum-value))) -(eval (generate-serializer pschema (find-message-for-class pschema 'proto:protobuf-message))) -(eval (generate-serializer pschema (find-message-for-class pschema 'proto:protobuf-field))) -(eval (generate-serializer pschema (find-message-for-class pschema 'proto:protobuf-extension))) -(eval (generate-serializer pschema (find-message-for-class pschema 'proto:protobuf-service))) -(eval (generate-serializer pschema (find-message-for-class pschema 'proto:protobuf-rpc))) - -(eval (generate-deserializer pschema (find-message-for-class pschema 'proto:protobuf))) -(eval (generate-deserializer pschema (find-message-for-class pschema 'proto:protobuf-option))) -(eval (generate-deserializer pschema (find-message-for-class pschema 'proto:protobuf-enum))) -(eval (generate-deserializer pschema (find-message-for-class pschema 'proto:protobuf-enum-value))) -(eval (generate-deserializer pschema (find-message-for-class pschema 'proto:protobuf-message))) -(eval (generate-deserializer pschema (find-message-for-class pschema 'proto:protobuf-field))) -(eval (generate-deserializer pschema (find-message-for-class pschema 'proto:protobuf-extension))) -(eval (generate-deserializer pschema (find-message-for-class pschema 'proto:protobuf-service))) -(eval (generate-deserializer pschema (find-message-for-class pschema 'proto:protobuf-rpc))) +(eval (generate-object-size pschema (find-message pschema 'proto:protobuf))) +(eval (generate-object-size pschema (find-message pschema 'proto:protobuf-option))) +(eval (generate-object-size pschema (find-message pschema 'proto:protobuf-enum))) +(eval (generate-object-size pschema (find-message pschema 'proto:protobuf-enum-value))) +(eval (generate-object-size pschema (find-message pschema 'proto:protobuf-message))) +(eval (generate-object-size pschema (find-message pschema 'proto:protobuf-field))) +(eval (generate-object-size pschema (find-message pschema 'proto:protobuf-extension))) +(eval (generate-object-size pschema (find-message pschema 'proto:protobuf-service))) +(eval (generate-object-size pschema (find-message pschema 'proto:protobuf-rpc))) + +(eval (generate-serializer pschema (find-message pschema 'proto:protobuf))) +(eval (generate-serializer pschema (find-message pschema 'proto:protobuf-option))) +(eval (generate-serializer pschema (find-message pschema 'proto:protobuf-enum))) +(eval (generate-serializer pschema (find-message pschema 'proto:protobuf-enum-value))) +(eval (generate-serializer pschema (find-message pschema 'proto:protobuf-message))) +(eval (generate-serializer pschema (find-message pschema 'proto:protobuf-field))) +(eval (generate-serializer pschema (find-message pschema 'proto:protobuf-extension))) +(eval (generate-serializer pschema (find-message pschema 'proto:protobuf-service))) +(eval (generate-serializer pschema (find-message pschema 'proto:protobuf-rpc))) + +(eval (generate-deserializer pschema (find-message pschema 'proto:protobuf))) +(eval (generate-deserializer pschema (find-message pschema 'proto:protobuf-option))) +(eval (generate-deserializer pschema (find-message pschema 'proto:protobuf-enum))) +(eval (generate-deserializer pschema (find-message pschema 'proto:protobuf-enum-value))) +(eval (generate-deserializer pschema (find-message pschema 'proto:protobuf-message))) +(eval (generate-deserializer pschema (find-message pschema 'proto:protobuf-field))) +(eval (generate-deserializer pschema (find-message pschema 'proto:protobuf-extension))) +(eval (generate-deserializer pschema (find-message pschema 'proto:protobuf-service))) +(eval (generate-deserializer pschema (find-message pschema 'proto:protobuf-rpc))) ||# #|| @@ -180,23 +180,23 @@ (proto:write-protobuf tschema) (proto:write-protobuf tschema :type :lisp) -(eval (generate-object-size tschema (find-message-for-class tschema 'proto-test1))) -(eval (generate-object-size tschema (find-message-for-class tschema 'proto-test2))) -(eval (generate-object-size tschema (find-message-for-class tschema 'proto-test3))) -(eval (generate-object-size tschema (find-message-for-class tschema 'proto-test4))) -(eval (generate-object-size tschema (find-message-for-class tschema 'proto-test5))) - -(eval (generate-serializer tschema (find-message-for-class tschema 'proto-test1))) -(eval (generate-serializer tschema (find-message-for-class tschema 'proto-test2))) -(eval (generate-serializer tschema (find-message-for-class tschema 'proto-test3))) -(eval (generate-serializer tschema (find-message-for-class tschema 'proto-test4))) -(eval (generate-serializer tschema (find-message-for-class tschema 'proto-test5))) - -(eval (generate-deserializer tschema (find-message-for-class tschema 'proto-test1))) -(eval (generate-deserializer tschema (find-message-for-class tschema 'proto-test2))) -(eval (generate-deserializer tschema (find-message-for-class tschema 'proto-test3))) -(eval (generate-deserializer tschema (find-message-for-class tschema 'proto-test4))) -(eval (generate-deserializer tschema (find-message-for-class tschema 'proto-test5))) +(eval (generate-object-size tschema (find-message tschema 'proto-test1))) +(eval (generate-object-size tschema (find-message tschema 'proto-test2))) +(eval (generate-object-size tschema (find-message tschema 'proto-test3))) +(eval (generate-object-size tschema (find-message tschema 'proto-test4))) +(eval (generate-object-size tschema (find-message tschema 'proto-test5))) + +(eval (generate-serializer tschema (find-message tschema 'proto-test1))) +(eval (generate-serializer tschema (find-message tschema 'proto-test2))) +(eval (generate-serializer tschema (find-message tschema 'proto-test3))) +(eval (generate-serializer tschema (find-message tschema 'proto-test4))) +(eval (generate-serializer tschema (find-message tschema 'proto-test5))) + +(eval (generate-deserializer tschema (find-message tschema 'proto-test1))) +(eval (generate-deserializer tschema (find-message tschema 'proto-test2))) +(eval (generate-deserializer tschema (find-message tschema 'proto-test3))) +(eval (generate-deserializer tschema (find-message tschema 'proto-test4))) +(eval (generate-deserializer tschema (find-message tschema 'proto-test5))) (setq test1 (make-instance 'proto-test1 :intval 150)) (setq test2 (make-instance 'proto-test2 :strval "testing")) diff --git a/model-classes.lisp b/model-classes.lisp index 8b91220..f636b2a 100644 --- a/model-classes.lisp +++ b/model-classes.lisp @@ -89,36 +89,36 @@ (format stream "~@[~A~]~@[ (package ~A)~]" (proto-name p) (proto-package p)))) -(defgeneric find-message-for-class (protobuf class) +(defgeneric find-message (protobuf type) (:documentation - "Given a protobuf schema or message and a class or class name, - returns the protobuf message corresponding to the class.")) + "Given a protobuf schema or message and a type name or class name, + returns the protobuf message corresponding to the type.")) -(defgeneric find-enum-for-type (protobuf type) - (:documentation - "Given a protobuf schema or message and the name of an enum type, - returns the protobuf enum corresponding to the type.")) +(defmethod find-message ((protobuf protobuf) (type symbol)) + (or (find type (proto-messages protobuf) :key #'proto-class) + (find type (proto-messages protobuf) :key #'proto-class-override) + (some #'(lambda (msg) (find-message msg type)) (proto-messages protobuf)))) -(defmethod find-message-for-class ((protobuf protobuf) (class symbol)) - (or (find class (proto-messages protobuf) :key #'proto-class) - (find class (proto-messages protobuf) :key #'proto-class-override) - (some #'(lambda (msg) (find-message-for-class msg class)) (proto-messages protobuf)))) +(defmethod find-message ((protobuf protobuf) (type class)) + (find-message protobuf (class-name type))) -(defmethod find-message-for-class ((protobuf protobuf) (class class)) - (find-message-for-class protobuf (class-name class))) +(defmethod find-message ((protobuf protobuf) (type string)) + (or (find type (proto-messages protobuf) :key #'proto-name :test #'string=) + (some #'(lambda (msg) (find-message msg type)) (proto-messages protobuf)))) -(defmethod find-message-for-class ((protobuf protobuf) (class string)) - (or (find class (proto-messages protobuf) :key #'proto-name :test #'string=) - (some #'(lambda (msg) (find-message-for-class msg class)) (proto-messages protobuf)))) +(defgeneric find-enum (protobuf type) + (:documentation + "Given a protobuf schema or message and the name of an enum type, + returns the protobuf enum corresponding to the type.")) -(defmethod find-enum-for-type ((protobuf protobuf) type) +(defmethod find-enum ((protobuf protobuf) type) (or (find type (proto-enums protobuf) :key #'proto-class) (find type (proto-enums protobuf) :key #'proto-class-override) - (some #'(lambda (msg) (find-enum-for-type msg type)) (proto-messages protobuf)))) + (some #'(lambda (msg) (find-enum msg type)) (proto-messages protobuf)))) -(defmethod find-enum-for-type ((protobuf protobuf) (type string)) +(defmethod find-enum ((protobuf protobuf) (type string)) (or (find type (proto-enums protobuf) :key #'proto-name :test #'string=) - (some #'(lambda (msg) (find-enum-for-type msg type)) (proto-messages protobuf)))) + (some #'(lambda (msg) (find-enum msg type)) (proto-messages protobuf)))) ;;--- For now, we support only the built-in options @@ -146,6 +146,9 @@ (t ;~/protobuf-option/ -- keyword/value format (format stream "~(:~A~) ~S" (proto-name option) (proto-value option))))) +(defmethod find-option ((protobuf base-protobuf) (name string)) + (find name (proto-options protobuf) :key #'proto-name :test #'string=)) + ;; A protobuf enumeration (defclass protobuf-enum (base-protobuf) @@ -218,21 +221,21 @@ (format stream "~A~@[ (~S)~]" (proto-name m) (or (proto-class-override m) (proto-class m))))) -(defmethod find-message-for-class ((message protobuf-message) (class symbol)) - (or (find class (proto-messages message) :key #'proto-class) - (find class (proto-messages message) :key #'proto-class-override))) +(defmethod find-message ((message protobuf-message) (type symbol)) + (or (find type (proto-messages message) :key #'proto-class) + (find type (proto-messages message) :key #'proto-class-override))) -(defmethod find-message-for-class ((message protobuf-message) (class class)) - (find-message-for-class message (class-name class))) +(defmethod find-message ((message protobuf-message) (type class)) + (find-message message (class-name type))) -(defmethod find-message-for-class ((message protobuf-message) (class string)) - (find class (proto-messages message) :key #'proto-name :test #'string=)) +(defmethod find-message ((message protobuf-message) (type string)) + (find type (proto-messages message) :key #'proto-name :test #'string=)) -(defmethod find-enum-for-type ((message protobuf-message) type) +(defmethod find-enum ((message protobuf-message) type) (or (find type (proto-enums message) :key #'proto-class) (find type (proto-enums message) :key #'proto-class-override))) -(defmethod find-enum-for-type ((message protobuf-message) (type string)) +(defmethod find-enum ((message protobuf-message) (type string)) (find type (proto-enums message) :key #'proto-name :test #'string=)) diff --git a/parser.lisp b/parser.lisp index ae91547..80744fd 100644 --- a/parser.lisp +++ b/parser.lisp @@ -130,16 +130,19 @@ :direction :input :external-format :utf-8 :element-type 'character) - (parse-protobuf-from-stream stream :name (pathname-name (pathname stream))))) + (parse-protobuf-from-stream stream + :name (class-name->proto (pathname-name (pathname stream))) + :class (pathname-name (pathname stream))))) ;; The syntax for Protocol Buffers is so simple that it doesn't seem worth ;; writing a sophisticated parser ;; Note that we don't put the result into *all-protobufs*; do that at a higher level -(defun parse-protobuf-from-stream (stream &key name) +(defun parse-protobuf-from-stream (stream &key name class) "Parses a top-level .proto file from the stream 'stream'. Returns the protobuf schema that describes the .proto file." (let* ((protobuf (make-instance 'protobuf - :name name)) + :name name + :class class)) (*protobuf* protobuf) (*protobuf-package* nil)) (loop @@ -209,10 +212,10 @@ :value val))) (cond (protobuf (setf (proto-options protobuf) (nconc (proto-options protobuf) (list option))) - (when (and (string-equal key "optimize_for") + (when (and (string= key "optimize_for") (typep protobuf 'protobuf)) - (let ((value (cond ((string-equal val "SPEED") :speed) - ((string-equal val "CODE_SIZE") :space) + (let ((value (cond ((string= val "SPEED") :speed) + ((string= val "CODE_SIZE") :space) (t nil)))) (setf (proto-optimize protobuf) value)))) (t @@ -236,7 +239,9 @@ (maybe-skip-comments stream) (setf (proto-enums protobuf) (nconc (proto-messages protobuf) (list enum))) (return-from parse-proto-enum)) - (parse-proto-enum-value stream enum name))))) + (if (string= name "option") + (parse-proto-option stream enum #\;) + (parse-proto-enum-value stream enum name)))))) (defun parse-proto-enum-value (stream enum name) "Parse a Protobufs enum vvalue from 'stream'. @@ -272,6 +277,8 @@ (parse-proto-enum stream message)) ((string= token "message") (parse-proto-message stream message)) + ((string= token "option") + (parse-proto-option stream message #\;)) ((member token '("required" "optional" "repeated") :test #'string=) (parse-proto-field stream message token)) (t @@ -337,7 +344,9 @@ (maybe-skip-comments stream) (setf (proto-services protobuf) (nconc (proto-services protobuf) (list service))) (return-from parse-proto-service)) - (cond ((string= token "rpc") + (cond ((string= token "option") + (parse-proto-option stream service #\;)) + ((string= token "rpc") (parse-proto-rpc stream service token)) (t (error "Unrecognized token ~A at position ~D" diff --git a/printer.lisp b/printer.lisp index 49fbaa5..cedbd47 100644 --- a/printer.lisp +++ b/printer.lisp @@ -72,11 +72,13 @@ (defmethod write-protobuf-as ((type (eql :proto)) (enum protobuf-enum) stream &key (indentation 0)) - (with-prefixed-accessors (name documentation) (proto- enum) + (with-prefixed-accessors (name documentation options) (proto- enum) (when documentation (write-protobuf-documentation type documentation stream :indentation indentation)) (format stream "~&~@[~VT~]enum ~A {~%" (and (not (zerop indentation)) indentation) name) + (dolist (option options) + (format stream "~&option ~:/protobuf-option/;~%" option)) (dolist (value (proto-values enum)) (write-protobuf-as type value stream :indentation (+ indentation 2))) (format stream "~&~@[~VT~]}~%" @@ -93,11 +95,13 @@ (defmethod write-protobuf-as ((type (eql :proto)) (message protobuf-message) stream &key (indentation 0)) - (with-prefixed-accessors (name documentation) (proto- message) + (with-prefixed-accessors (name documentation options) (proto- message) (when documentation (write-protobuf-documentation type documentation stream :indentation indentation)) (format stream "~&~@[~VT~]message ~A {~%" (and (not (zerop indentation)) indentation) name) + (dolist (option options) + (format stream "~&option ~:/protobuf-option/;~%" option)) (dolist (enum (proto-enums message)) (write-protobuf-as type enum stream :indentation (+ indentation 2))) (dolist (msg (proto-messages message)) @@ -339,10 +343,10 @@ (when documentation (write-protobuf-documentation type documentation stream :indentation indentation)) (let ((input (or input-class - (let ((m (find-message-for-class *protobuf* input-type))) + (let ((m (find-message *protobuf* input-type))) (and m (proto-class m))))) (output (or output-class - (let ((m (find-message-for-class *protobuf* output-type))) + (let ((m (find-message *protobuf* output-type))) (and m (proto-class m)))))) (format stream "~&~@[~VT~](~(~S~) (~(~S~) ~(~S~))" (and (not (zerop indentation)) indentation) diff --git a/proto-pkgdcl.lisp b/proto-pkgdcl.lisp index 67f20cf..74172b6 100644 --- a/proto-pkgdcl.lisp +++ b/proto-pkgdcl.lisp @@ -20,14 +20,13 @@ ;; Model classes "PROTOBUF" "PROTOBUF-OPTION" - "PROTOBUF-MESSAGE" "PROTOBUF-ENUM" "PROTOBUF-ENUM-VALUE" + "PROTOBUF-MESSAGE" "PROTOBUF-FIELD" "PROTOBUF-EXTENSION" "PROTOBUF-SERVICE" "PROTOBUF-RPC" - "FIND-PROTOBUF" ;; Printing "WRITE-PROTOBUF" @@ -40,6 +39,7 @@ "DEFINE-PROTO" "DEFINE-ENUM" "DEFINE-MESSAGE" + "DEFINE-EXTENSION" "DEFINE-SERVICE" ;; Upgradability testing @@ -94,8 +94,10 @@ "PROTO-TYPE" "PROTO-VALUE" "PROTO-VALUES" - "FIND-MESSAGE-FOR-CLASS" - "FIND-ENUM-FOR-TYPE" + "FIND-PROTOBUF" + "FIND-MESSAGE" + "FIND-ENUM" + "FIND-OPTION" ;; Printing "WRITE-PROTOBUF-AS" diff --git a/serialize.lisp b/serialize.lisp index 6e45ca7..b7be933 100644 --- a/serialize.lisp +++ b/serialize.lisp @@ -52,7 +52,7 @@ (type fixnum index)) (check-type protobuf (or protobuf protobuf-message)) (let* ((class (class-of object)) - (message (find-message-for-class protobuf class)) + (message (find-message protobuf class)) (visited (or visited (make-hash-table)))) (assert message () "There is no Protobuf message for the class ~S" class) @@ -82,8 +82,8 @@ (setq index (serialize-prim v cl tag buffer index))) (read-slot object slot reader)))) ((typep (setq msg (and cl (loop for p in trace - thereis (or (find-message-for-class p cl) - (find-enum-for-type p cl))))) + thereis (or (find-message p cl) + (find-enum p cl))))) 'protobuf-message) (dolist (v (if slot (read-slot object slot reader) (list object))) ;; To serialize an embedded message, first say that it's @@ -106,8 +106,8 @@ (let ((tag (make-tag cl (proto-index field)))) (setq index (serialize-prim v cl tag buffer index)))))) ((typep (setq msg (and cl (loop for p in trace - thereis (or (find-message-for-class p cl) - (find-enum-for-type p cl))))) + thereis (or (find-message p cl) + (find-enum p cl))))) 'protobuf-message) (let ((v (if slot (read-slot object slot reader) object))) (when v @@ -159,8 +159,8 @@ (labels ((deserialize (class trace &optional (end length)) (declare (type fixnum end)) (let* ((message (loop for p in trace - thereis (or (find-message-for-class p class) - (find-enum-for-type p class)))) + thereis (or (find-message p class) + (find-enum p class)))) (object (make-instance (or (proto-class-override message) class))) ;; Map from the name of a repeated slot to the value ;; that should be stored in the slot @@ -209,8 +209,8 @@ (setq index idx) (when slot (push val (map:get slot (or rslots (setq rslots (map:make-map)))))))) - ((typep (setq msg (and cl (or (find-message-for-class protobuf cl) - (find-enum-for-type protobuf cl)))) + ((typep (setq msg (and cl (or (find-message protobuf cl) + (find-enum protobuf cl)))) 'protobuf-message) (multiple-value-bind (len idx) (decode-uint32 buffer index) @@ -231,8 +231,8 @@ (setq index idx) (when slot (setf (slot-value object slot) val)))) - ((typep (setq msg (and cl (or (find-message-for-class protobuf cl) - (find-enum-for-type protobuf cl)))) + ((typep (setq msg (and cl (or (find-message protobuf cl) + (find-enum protobuf cl)))) 'protobuf-message) (multiple-value-bind (len idx) (decode-uint32 buffer index) @@ -269,7 +269,7 @@ (when size (return-from object-size size))) (let* ((class (class-of object)) - (message (find-message-for-class protobuf class)) + (message (find-message protobuf class)) (size 0)) (declare (type fixnum size)) (assert message () @@ -299,8 +299,8 @@ (iincf size (prim-size v cl tag))) (read-slot object slot reader)))) ((typep (setq msg (and cl (loop for p in trace - thereis (or (find-message-for-class p cl) - (find-enum-for-type p cl))))) + thereis (or (find-message p cl) + (find-enum p cl))))) 'protobuf-message) (dolist (v (if slot (read-slot object slot reader) (list object))) (let ((tag (make-tag $wire-type-string (proto-index field))) @@ -321,8 +321,8 @@ (let ((tag (make-tag cl (proto-index field)))) (iincf size (prim-size v cl tag)))))) ((typep (setq msg (and cl (loop for p in trace - thereis (or (find-message-for-class p cl) - (find-enum-for-type p cl))))) + thereis (or (find-message p cl) + (find-enum p cl))))) 'protobuf-message) (let ((v (if slot (read-slot object slot reader) object))) (when v @@ -353,10 +353,10 @@ (dolist (field (proto-fields message)) (let* ((class (if (eq (proto-class field) 'boolean) :bool (proto-class field))) (msg (and class (not (keywordp class)) - (or (or (find-message-for-class message class) - (find-enum-for-type message class)) - (or (find-message-for-class protobuf class) - (find-enum-for-type protobuf class))))) + (or (or (find-message message class) + (find-enum message class)) + (or (find-message protobuf class) + (find-enum protobuf class))))) (reader (cond ((proto-reader field) `(,(proto-reader field) ,vobj)) ((proto-value field) @@ -430,10 +430,10 @@ (dolist (field (proto-fields message)) (let* ((class (if (eq (proto-class field) 'boolean) :bool (proto-class field))) (msg (and class (not (keywordp class)) - (or (or (find-message-for-class message class) - (find-enum-for-type message class)) - (or (find-message-for-class protobuf class) - (find-enum-for-type protobuf class))))) + (or (or (find-message message class) + (find-enum message class)) + (or (find-message protobuf class) + (find-enum protobuf class))))) (slot (proto-value field)) (index (proto-index field))) (cond ((eq (proto-required field) :repeated) @@ -528,10 +528,10 @@ (dolist (field (proto-fields message)) (let* ((class (if (eq (proto-class field) 'boolean) :bool (proto-class field))) (msg (and class (not (keywordp class)) - (or (or (find-message-for-class message class) - (find-enum-for-type message class)) - (or (find-message-for-class protobuf class) - (find-enum-for-type protobuf class))))) + (or (or (find-message message class) + (find-enum message class)) + (or (find-message protobuf class) + (find-enum protobuf class))))) (reader (cond ((proto-reader field) `(,(proto-reader field) ,vobj)) ((proto-value field) diff --git a/text-format.lisp b/text-format.lisp index 563e2a2..69a9e7f 100644 --- a/text-format.lisp +++ b/text-format.lisp @@ -21,7 +21,7 @@ (defmethod print-text-format ((object standard-object) protobuf &key (stream *standard-output*)) (check-type protobuf (or protobuf protobuf-message)) (let* ((class (class-of object)) - (message (find-message-for-class protobuf class))) + (message (find-message protobuf class))) (assert message () "There is no Protobuf message for the class ~S" class) (labels ((safe-slot-value (object slot) @@ -34,8 +34,8 @@ ;; method to clean things up first (let* ((cl (if (eq (proto-class field) 'boolean) :bool (proto-class field))) (msg (and cl (loop for p in trace - thereis (or (find-message-for-class p cl) - (find-enum-for-type p cl))))) + thereis (or (find-message p cl) + (find-enum p cl))))) (slot (proto-value field))) (cond ((eq (proto-required field) :repeated) (cond ((and slot (keywordp cl)) diff --git a/utilities.lisp b/utilities.lisp index 411b8b7..b57194b 100644 --- a/utilities.lisp +++ b/utilities.lisp @@ -47,6 +47,14 @@ (if package (intern name package) (make-symbol name)))) +(defun make-lisp-symbol (string) + "Intern a string of the 'package:string' and return the symbol." + (let* ((colon (position #\: string)) + (pkg (subseq string 0 colon)) + (sym (subseq string (i+ colon 1)))) + (intern sym pkg))) + + (define-condition protobufs-warning (warning simple-condition) ()) (defun protobufs-warn (format-control &rest format-arguments) diff --git a/wire-format.lisp b/wire-format.lisp index f355a3c..2d2aaeb 100644 --- a/wire-format.lisp +++ b/wire-format.lisp @@ -342,11 +342,8 @@ ;; Note that this is consy, avoid it if possible (multiple-value-bind (val idx) (decode-octets buffer index) - (let* ((val (babel:octets-to-string val :encoding :utf-8)) - (colon (position #\: val)) - (pkg (subseq val 0 colon)) - (sym (subseq val (i+ colon 1)))) - (values (intern sym pkg) idx)))) + (let ((val (babel:octets-to-string val :encoding :utf-8))) + (values (make-lisp-symbol val) idx)))) ((:date :time :datetime :timestamp) (decode-uint64 buffer index))))) -- 2.45.2