Add :conc-name so we can generate better Lisp code.

Add explicit indices so we can generate better Protobufs code.

git-svn-id: http://svn.internal.itasoftware.com/svn/ita/branches/qres/swm/borgify-1/qres/lisp/quux/protobufs@532435 f8382938-511b-0410-9cdd-bb47b084005c

diff --git a/define-proto.lisp b/define-proto.lisp
index ca275a0e8ba844b95b7b11cfc877a76cbae4712b..89206500f7fe5fe04544879b98bcc1400fb34aac 100644 (file)
--- a/define-proto.lisp
+++ b/define-proto.lisp
@@ -15,9 +15,9 @@
 
 ;; Define a schema named 'name', corresponding to a .proto file of that name
 ;; 'proto-name' can be used to override the defaultly generated name
-;; 'package' and 'imports' are as in .proto files
+;; 'syntax', 'package', 'imports' and 'options' are as in .proto files
 ;; The body consists of 'define-enum', 'define-message' or 'define-service' forms
-(defmacro define-proto (name (&key proto-name package import syntax options)
+(defmacro define-proto (name (&key proto-name syntax package import options)
                         &body messages &environment env)
   (with-collectors ((enums collect-enum)
                     (msgs  collect-msg)
@@ -61,20 +61,21 @@
 ;; Define an enum type named 'name' and a Lisp 'deftype'
 ;; 'proto-name' can be used to override the defaultly generated name
 ;; The body consists of the enum values in the form (name &key index)
-(defmacro define-enum (name (&key proto-name) &body values)
+(defmacro define-enum (name (&key proto-name conc-name) &body values)
   (with-collectors ((vals  collect-val)
                     (evals collect-eval)
                     (forms collect-form))
     (let ((index 0))
       (dolist (val values)
-        (destructuring-bind (name)
-            (if (listp val) val (list val))             ;---*** &KEY INDEX?
-          (let ((lname (kintern (symbol-name name))))
-            (collect-val lname)
-            (collect-eval `(make-instance 'protobuf-enum-value
-                             :name  ,(proto-enum-name name)
-                             :index ,(incf index)
-                             :value ,lname))))))
+        (let* ((idx  (if (listp val) (second val) (incf index)))
+               (name (if (listp val) (first val)  val))
+               (val-name  (kintern (if conc-name (format nil "~A~A" conc-name name) (symbol-name name))))
+               (enum-name (if conc-name (format nil "~A~A" conc-name name) (symbol-name name))))
+          (collect-val val-name)
+          (collect-eval `(make-instance 'protobuf-enum-value
+                           :name  ,(proto-enum-name enum-name)
+                           :index ,idx
+                           :value ,val-name)))))
     (collect-form `(deftype ,name () '(member ,@vals)))
     `(progn
        define-enum
@@ -88,7 +89,7 @@
 ;; 'proto-name' can be used to override the defaultly generated name
 ;; The body consists of fields, or 'define-enum' or 'define-message' forms
 ;; Fields take the form (name &key type default index)
-(defmacro define-message (name (&key proto-name) &body fields &environment env)
+(defmacro define-message (name (&key proto-name conc-name) &body fields &environment env)
   (with-collectors ((enums collect-enum)
                     (msgs  collect-msg)
                     (flds  collect-field)
@@ -109,22 +110,26 @@
                ((define-message)
                 (collect-msg model)))))
           (otherwise
-           (destructuring-bind (slot &key type default) fld ;---*** &KEY INDEX?
-             (multiple-value-bind (ptype pclass)
-                 (clos-type-to-protobuf-type type)
-               (collect-slot `(,slot :type ,type
-                                     :ACCESSOR ,SLOT    ;---*** BETTER ACCESSOR NAME VIA :CONC-NAME
-                                     :initarg ,(kintern (symbol-name slot))
-                                     ,@(and default (list :initform default))))
-               (collect-field `(make-instance 'protobuf-field
-                                 :name  ,(proto-field-name slot)
-                                 :type  ,ptype
-                                 :class ',pclass
-                                 :required ,(clos-type-to-protobuf-required type)
-                                 :index ,(incf index)
-                                 :value ',slot
-                                 :default ,(and default (FORMAT NIL "~A" DEFAULT))      ;---***
-                                 :packed  ,(packed-type-p pclass)))))))))
+           (destructuring-bind (slot &key type default) fld
+             (let* ((idx  (if (listp slot) (second slot) (incf index)))
+                    (slot (if (listp slot) (first slot) slot))
+                    (accessor (intern (if conc-name (format nil "~A~A" conc-name slot) (symbol-name slot))
+                                      (symbol-package slot))))
+               (multiple-value-bind (ptype pclass)
+                   (clos-type-to-protobuf-type type)
+                 (collect-slot `(,slot :type ,type
+                                       :accessor ,accessor
+                                       :initarg ,(kintern (symbol-name slot))
+                                       ,@(and default (list :initform default))))
+                 (collect-field `(make-instance 'protobuf-field
+                                   :name  ,(proto-field-name slot)
+                                   :type  ,ptype
+                                   :class ',pclass
+                                   :required ,(clos-type-to-protobuf-required type)
+                                   :index ,idx
+                                   :value ',slot
+                                   :default ,(and default (format nil "~A" default))
+                                   :packed  ,(packed-type-p pclass))))))))))
     (collect-form `(defclass ,name () (,@slots)))
     `(progn
        define-message

diff --git a/examples.lisp b/examples.lisp
index 0dbabe2fdab98da963f0336480f64188e1708177..df35080251cd80fa4c302010cbea5d1d14105e51 100644 (file)
--- a/examples.lisp
+++ b/examples.lisp
@@ -138,7 +138,7 @@
                                                       :value :high)
                                                     (make-instance 'proto:protobuf-enum-value
                                                       :name "HIGH"
-                                                      :index 2
+                                                      :index 100
                                                       :value :low))))
                       :fields (list (make-instance 'proto:protobuf-field
                                       :name "color"
@@ -181,10 +181,10 @@
     red
     green
     blue)
-  (proto:define-message color ()
+  (proto:define-message color (:conc-name color-)
     (proto:define-enum contrast-name ()
-      low
-      high)
+      (low    1)
+      (high 100))
     (color    :type color)
     (contrast :type (or null contrast) :default :low))
   (proto:define-service color-wheel ()
@@ -195,13 +195,15 @@
      (DEFTYPE COLOR-NAME () '(MEMBER :RED :GREEN :BLUE))
      (DEFTYPE CONTRAST-NAME () '(MEMBER :LOW :HIGH))
      (DEFCLASS COLOR ()
-       ((COLOR    :TYPE COLOR              :ACCESSOR COLOR    :INITARG :COLOR)
-        (CONTRAST :TYPE (OR NULL CONTRAST) :ACCESSOR CONTRAST :INITARG :CONTRAST :INITFORM :LOW)))
+       ((COLOR :TYPE COLOR :ACCESSOR COLOR-COLOR :INITARG :COLOR)
+        (CONTRAST :TYPE (OR NULL CONTRAST) :ACCESSOR COLOR-CONTRAST :INITARG :CONTRAST :INITFORM :LOW)))
      (DEFVAR *COLOR-WHEEL*
        (MAKE-INSTANCE 'PROTOBUF
          :NAME "ColorWheel"
          :PACKAGE "ita.color"
          :IMPORTS '("descriptor.proto")
+         :SYNTAX NIL
+         :OPTIONS 'NIL
          :ENUMS (LIST (MAKE-INSTANCE 'PROTOBUF-ENUM
                         :NAME "ColorName"
                         :CLASS 'COLOR-NAME
@@ -229,7 +231,7 @@
                                                           :VALUE :LOW)
                                                         (MAKE-INSTANCE 'PROTOBUF-ENUM-VALUE
                                                           :NAME "HIGH"
-                                                          :INDEX 2
+                                                          :INDEX 100
                                                           :VALUE :HIGH))))
                            :MESSAGES (LIST)
                            :FIELDS (LIST (MAKE-INSTANCE 'PROTOBUF-FIELD

diff --git a/model-classes.lisp b/model-classes.lisp
index 7c28be5055376aeeb64a184cc7f07923ec74c1ec..3800020ce50bd1360389104042b248adbe144d39 100644 (file)
--- a/model-classes.lisp
+++ b/model-classes.lisp
@@ -19,6 +19,10 @@
          :reader proto-name
          :initarg :name
          :initform nil)
+   (syntax :type (or null string)               ;syntax, passed on but otherwise ignored
+           :reader proto-syntax
+           :initarg :syntax
+           :initform nil)
    (package :type (or null string)              ;the package
             :reader proto-package
             :initarg :package
@@ -27,10 +31,6 @@
             :reader proto-imports
             :initarg :imports
             :initform ())
-   (syntax :type (or null string)               ;syntax, passed on but otherwise ignored
-           :reader proto-syntax
-           :initarg :syntax
-           :initform nil)
    (options :type (list-of string)              ;options, passed on but otherwise ignored
            :reader proto-options
            :initarg :options