Decorate service method stubs and intern them in a different package

The client-side stub is now CALL-FOO
The server-side stub is now FOO-IMPL

They are interned in package XXX-RPC, where XXX is the name of the
package being used by the rest of the schema.

diff --git a/define-proto.lisp b/define-proto.lisp
index 5944fa8448289cbbdc231ecebb4d75d197547c02..52587bb506d0a496418cec12112407e3293e5aea 100644 (file)
--- a/define-proto.lisp
+++ b/define-proto.lisp
@@ -2,7 +2,7 @@
 ;;;                                                                  ;;;
 ;;; Free Software published under an MIT-like license. See LICENSE   ;;;
 ;;;                                                                  ;;;
-;;; Copyright (c) 2012 Google, Inc.  All rights reserved.            ;;;
+;;; Copyright (c) 2012-2013 Google, Inc.  All rights reserved.       ;;;
 ;;;                                                                  ;;;
 ;;; Original author: Scott McKay                                     ;;;
 ;;;                                                                  ;;;
@@ -53,7 +53,8 @@
                                  options)
                      :documentation documentation))
          (*protobuf* schema)
-         (*protobuf-package* (or (find-proto-package lisp-pkg) *package*)))
+         (*protobuf-package* (or (find-proto-package lisp-pkg) *package*))
+         (*protobuf-rpc-package* (or (find-proto-package (format nil "~A-~A" lisp-pkg 'rpc)) *package*)))
     (process-imports schema imports)
     (with-collectors ((forms collect-form))
       (dolist (msg messages)
@@ -762,9 +763,9 @@
                                 collect (make-instance 'protobuf-option
                                           :name  (if (symbolp key) (slot-name->proto key) key)
                                           :value val)))
-                 (package   *protobuf-package*)
-                 (client-fn function)
-                 (server-fn (intern (format nil "~A-~A" 'do function) package))
+                 (package   *protobuf-rpc-package*)
+                 (client-fn (intern (format nil "~A-~A" 'call function) package))
+                 (server-fn (intern (format nil "~A-~A" function 'impl) package))
                  (method  (make-instance 'protobuf-method
                             :class function
                             :name  (or name (class-name->proto function))

diff --git a/model-classes.lisp b/model-classes.lisp
index c343c4bf13ff825bc998a833de71d4dcc5be27e9..6d99a66b3f11ff281ab6e98c14a087fc58e8891a 100644 (file)
--- a/model-classes.lisp
+++ b/model-classes.lisp
@@ -2,7 +2,7 @@
 ;;;                                                                  ;;;
 ;;; Free Software published under an MIT-like license. See LICENSE   ;;;
 ;;;                                                                  ;;;
-;;; Copyright (c) 2012 Google, Inc.  All rights reserved.            ;;;
+;;; Copyright (c) 2012-2013 Google, Inc.  All rights reserved.       ;;;
 ;;;                                                                  ;;;
 ;;; Original author: Scott McKay                                     ;;;
 ;;;                                                                  ;;;
@@ -53,6 +53,9 @@
 (defvar *protobuf-package* nil
   "The Lisp package in which the Protobufs schema is being defined.")
 
+(defvar *protobuf-rpc-package* nil
+  "The Lisp package in which the Protobufs schema's service definitions are being defined.")
+
 (defvar *protobuf-conc-name* nil
   "A global conc-name to use for all the messages in this schema. This controls
    the name of the accessors the fields of each message.

diff --git a/parser.lisp b/parser.lisp
index 21408320527c72642b6cd26f2a7dab8695038c06..26c72053905756e254ddbfeb07c85595b9fea72e 100644 (file)
--- a/parser.lisp
+++ b/parser.lisp
@@ -2,7 +2,7 @@
 ;;;                                                                  ;;;
 ;;; Free Software published under an MIT-like license. See LICENSE   ;;;
 ;;;                                                                  ;;;
-;;; Copyright (c) 2012 Google, Inc.  All rights reserved.            ;;;
+;;; Copyright (c) 2012-2013 Google, Inc.  All rights reserved.       ;;;
 ;;;                                                                  ;;;
 ;;; Original author: Scott McKay                                     ;;;
 ;;;                                                                  ;;;
@@ -304,16 +304,24 @@
                    :name  name))
          (*protobuf* schema)
          *protobuf-package*
+         *protobuf-rpc-package*
          (*protobuf-conc-name* conc-name))
-    (flet ((ensure-package ()
-             "Find a fallback for our Lisp package if we don't have an obvious one already.
-              * java_package
-              * *package*"
-             (unless *protobuf-package*
-               (let ((java-package (find-option schema "java_package")))
-                 (if java-package
-                     (set-lisp-package schema java-package)
-                     (setq *protobuf-package* *package*))))))
+    (labels ((ensure-package ()
+               "Find a fallback for our Lisp package if we don't have an obvious one already.
+                * java_package
+                * *package*"
+               (unless *protobuf-package*
+                 (let ((java-package (find-option schema "java_package")))
+                   (if java-package
+                       (set-lisp-package schema java-package)
+                       (setq *protobuf-package* *package*)))))
+             (ensure-rpc-package ()
+               (ensure-package)
+               (unless *protobuf-rpc-package*
+                 (let ((rpc-package-name (format nil "~A-~A" (package-name *protobuf-package*) 'rpc)))
+                   (setq *protobuf-rpc-package*
+                         (or (find-proto-package rpc-package-name)
+                             (make-package (string-upcase rpc-package-name) :use ())))))))
       (loop
         (skip-whitespace stream)
         (maybe-skip-comments stream)
@@ -346,7 +354,7 @@
                           (ensure-package)
                           (parse-proto-message stream schema))
                          ((string= token "service")
-                          (ensure-package)
+                          (ensure-rpc-package)
                           (parse-proto-service stream schema)))))
                 (t
                  (error "Syntax error at position ~D" (file-position stream)))))))))
@@ -794,8 +802,8 @@
            (stub (or (and name (make-lisp-symbol name))
                      stub)))
       (setf (proto-class method) stub
-            (proto-client-stub method) stub
-            (proto-server-stub method) (intern (format nil "~A-~A" 'do stub) *protobuf-package*)))
+            (proto-client-stub method) (intern (format nil "~A-~A" 'call stub) *protobuf-rpc-package*)
+            (proto-server-stub method) (intern (format nil "~A-~A" stub 'impl) *protobuf-rpc-package*)))
     (let ((strm (find-option method "stream_type")))
       (when strm
         (setf (proto-streams-name method) strm)))

diff --git a/printer.lisp b/printer.lisp
index c083f576fabcddc16a7d8ef4800cbd2346db294a..24578bb7cfe8c83425a1d3f65dd74bd57f3846aa 100644 (file)
--- a/printer.lisp
+++ b/printer.lisp
@@ -2,7 +2,7 @@
 ;;;                                                                  ;;;
 ;;; Free Software published under an MIT-like license. See LICENSE   ;;;
 ;;;                                                                  ;;;
-;;; Copyright (c) 2012 Google, Inc.  All rights reserved.            ;;;
+;;; Copyright (c) 2012-2013 Google, Inc.  All rights reserved.       ;;;
 ;;;                                                                  ;;;
 ;;; Original author: Scott McKay                                     ;;;
 ;;;                                                                  ;;;
@@ -440,10 +440,13 @@
                                 (proto-options schema)))
            (pkg      (and package (if (stringp package) package (string package))))
            (lisp-pkg (and lisp-package (if (stringp lisp-package) lisp-package (string lisp-package))))
+           (rpc-pkg  (and (or lisp-pkg pkg)
+                          (format nil "~A-~A" (or lisp-pkg pkg) 'rpc)))
            (*show-lisp-enum-indexes*  show-enum-indexes)
            (*show-lisp-field-indexes* show-field-indexes)
            (*use-common-lisp-package* use-common-lisp)
            (*protobuf-package* (find-proto-package lisp-pkg))
+           (*protobuf-rpc-package* (find-proto-package rpc-pkg))
            ;; If *protobuf-package* has not been defined, print symbols
            ;; from :common-lisp if *use-common-lisp-package* is true; or
            ;; :keyword otherwise.  This ensures that all symbols will be
@@ -453,7 +456,27 @@
            ;; Keywords are always printed as :keyword.)
            (*package* (or *protobuf-package*
                           (when *use-common-lisp-package* (find-package :common-lisp))
-                          (find-package :keyword))))
+                          (find-package :keyword)))
+           (exports (collect-exports schema)))
+      (when rpc-pkg
+        (let* ((pkg (string-upcase rpc-pkg))
+               (rpc-exports (remove-if-not
+                             #'(lambda (sym)
+                                 (string=
+                                  (package-name (symbol-package sym))
+                                  pkg))
+                             exports))
+               (*package* (or *protobuf-rpc-package*
+                              (when *use-common-lisp-package* (find-package :common-lisp))
+                              (find-package :keyword))))
+          (when rpc-exports
+            (format stream "~&(cl:eval-when (:execute :compile-toplevel :load-toplevel)~
+                            ~%  (cl:unless (cl:find-package \"~A\")~
+                            ~%    (cl:defpackage ~A (:use~@[ ~(~S~)~]))))~
+                            ~%(cl:in-package \"~A\")~
+                            ~%(cl:export '(~{~A~^~%             ~}))~%~%"
+                    pkg pkg (and *use-common-lisp-package* :common-lisp) pkg
+                    rpc-exports))))
       (when (or lisp-pkg pkg)
         (let ((pkg (string-upcase (or lisp-pkg pkg))))
           (format stream "~&(cl:eval-when (:execute :compile-toplevel :load-toplevel)~
@@ -467,7 +490,7 @@
                        (string=
                         (package-name (symbol-package sym))
                         pkg))
-                   (collect-exports schema)))))
+                   exports))))
       (when documentation
         (write-schema-documentation type documentation stream :indentation indentation))
       (format stream "~&(proto:define-schema ~(~A~)" (or class name))