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

diff --git a/define-proto.lisp b/define-proto.lisp
index 0859dd0dee2ee2fa167de8708be6736dc5f4be8b..f1e82266c9f9256d7d248b7a4a35480d35832096 100644 (file)
--- 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 53bd07a585cb2ac77002f5ae443ed88f030934e9..0c64606381036601283bca42aafd58a02978a037 100644 (file)
--- 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 8b912209a78935a8ca6608aa2189387b3e00b30d..f636b2acadbd19148d39b4e47bb5c14339885147 100644 (file)
--- 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 ae9154789053daa1cb43491625b882c817b608bb..80744fd375aaa69a57f3b07baee5bfdb95f21da2 100644 (file)
--- 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 49fbaa5561075323283aa9b889b6b6cb19fedf07..cedbd47bb50c70bc14dd5880ce4fc6ba02ab73fd 100644 (file)
--- 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 67f20cf6ba641d2ff072a06b22fc8dbfa79f07d5..74172b62572dad815ba09555fc18826d765b78db 100644 (file)
--- 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 6e45ca70811fcbc6e7b45f6c2f16500788976570..b7be93376663c2deb12f82ef695348f37755cdbf 100644 (file)
--- 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 563e2a2488e918c62de5d7b55d9235b633dbe693..69a9e7f0140b293d5185ec7e0eeca0a2689d7ce1 100644 (file)
--- 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 411b8b7829b30ac32b4f6f3a41f1c5413d75d517..b57194bb7a36ae2b76cca47a0e4af3b2096916b5 100644 (file)
--- 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 f355a3c0390641e95f75f166294e9a72a76571d7..2d2aaeb0f3423f67ff837a237c9c2592e3f71dc8 100644 (file)
--- 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)))))