;;; Protocol buffer defining macros
;; Define a schema named 'name', corresponding to a .proto file of that name
-(defmacro define-proto (name (&key proto-name syntax package import options)
+(defmacro define-proto (name (&key proto-name syntax package import options documentation)
&body messages &environment env)
"Define a schema named 'name', corresponding to a .proto file of that name.
'proto-name' can be used to override the defaultly generated name.
(collect-svc model)))))
;;--- This should warn if the old one isn't upgradable to the new one
(let ((vname (fintern "*~A*" name))
- (pname (or proto-name (proto-class-name name)))
+ (pname (or proto-name (class-name->proto name)))
(cname name)
(options (loop for (key val) on options by #'cddr
collect `(make-instance 'protobuf-option
:options (list ,@options)
:enums (list ,@enums)
:messages (list ,@msgs)
- :services (list ,@svcs))))
+ :services (list ,@svcs)
+ :documentation ,documentation)))
(setq ,vname protobuf)
(setf (gethash ',pname *all-protobufs*) protobuf)
(setf (gethash ',cname *all-protobufs*) protobuf)
protobuf)))))
;; Define an enum type named 'name' and a Lisp 'deftype'
-(defmacro define-enum (name (&key proto-name conc-name) &body values)
+(defmacro define-enum (name (&key proto-name conc-name options documentation) &body values)
"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)."
(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)
+ :name ,(enum-name->proto enum-name)
:index ,idx
:value ,val-name)))))
(collect-form `(deftype ,name () '(member ,@vals)))
- `(progn
- define-enum
- (make-instance 'protobuf-enum
- :name ,(or proto-name (proto-class-name name))
- :class ',name
- :values (list ,@evals))
- ,forms)))
+ (let ((options (loop for (key val) on options by #'cddr
+ collect `(make-instance 'protobuf-option
+ :name ,key
+ :value ,val))))
+ `(progn
+ define-enum
+ (make-instance 'protobuf-enum
+ :name ,(or proto-name (class-name->proto name))
+ :class ',name
+ :options (list ,@options)
+ :values (list ,@evals)
+ :documentation ,documentation)
+ ,forms))))
;; Define a message named 'name' and a Lisp 'defclass'
-(defmacro define-message (name (&key proto-name conc-name) &body fields &environment env)
+(defmacro define-message (name (&key proto-name conc-name options documentation)
+ &body fields &environment env)
"Define a message named 'name' and a Lisp 'defclass'.
'proto-name' can be used to override the defaultly generated name.
The body consists of fields, or 'define-enum' or 'define-message' forms.
(slots collect-slot)
(forms collect-form))
(let ((index 0))
+ (declare (type fixnum index))
(dolist (fld fields)
(case (car fld)
((define-enum define-message define-extension)
((define-extension)
(collect-msg model)))))
(otherwise
+ (when (i= index 18999) ;skip over the restricted range
+ (setq index 19999))
(destructuring-bind (slot &key type default) fld
- (let* ((idx (if (listp slot) (second slot) (incf index)))
+ (let* ((idx (if (listp slot) (second slot) (iincf index)))
(slot (if (listp slot) (first slot) slot))
+ (reqd (clos-type-to-protobuf-required type))
(accessor (intern (if conc-name (format nil "~A~A" conc-name slot) (symbol-name slot))
(symbol-package slot))))
(multiple-value-bind (ptype pclass)
:initarg ,(kintern (symbol-name slot))
,@(and default (list :initform default))))
(collect-field `(make-instance 'protobuf-field
- :name ,(proto-field-name slot)
+ :name ,(slot-name->proto slot)
:type ,ptype
:class ',pclass
- :required ,(clos-type-to-protobuf-required type)
+ :required ,reqd
:index ,idx
:value ',slot
:default ,(and default (format nil "~A" default))
- :packed ,(packed-type-p pclass))))))))))
+ :packed ,(and (eq reqd :repeated)
+ (packed-type-p pclass)))))))))))
(collect-form `(defclass ,name () (,@slots)))
- `(progn
- define-message
- (make-instance 'protobuf-message
- :name ,(or proto-name (proto-class-name name))
- :class ',name
- :conc-name ,(and conc-name (string conc-name))
- :enums (list ,@enums)
- :messages (list ,@msgs)
- :fields (list ,@flds))
- ,forms)))
+ (let ((options (loop for (key val) on options by #'cddr
+ collect `(make-instance 'protobuf-option
+ :name ,key
+ :value ,val))))
+ `(progn
+ define-message
+ (make-instance 'protobuf-message
+ :name ,(or proto-name (class-name->proto name))
+ :class ',name
+ :conc-name ,(and conc-name (string conc-name))
+ :options (list ,@options)
+ :enums (list ,@enums)
+ :messages (list ,@msgs)
+ :fields (list ,@flds)
+ :documentation ,documentation)
+ ,forms))))
(defmacro define-extension (from to)
"Define an extension range within a message.
()))
;; Define a service named 'name' and a Lisp 'defun'
-(defmacro define-service (name (&key proto-name) &body rpc-specs)
+(defmacro define-service (name (&key proto-name options documentation) &body rpc-specs)
"Define a service named 'name' and a Lisp 'defun'.
'proto-name' can be used to override the defaultly generated name.
The body consists of a set of RPC specs of the form (name input-type output-type)."
- (with-collectors ((rpcs collect-rpc))
+ (with-collectors ((rpcs collect-rpc)
+ (forms collect-form))
(dolist (rpc rpc-specs)
- (destructuring-bind (name input-type output-type &key options) rpc
+ (destructuring-bind (name input-class output-class &key options) rpc
(let ((options (loop for (key val) on options by #'cddr
collect `(make-instance 'protobuf-option
:name ,key
:value ,val))))
(collect-rpc `(make-instance 'protobuf-rpc
- :name ,(proto-class-name name)
+ :name ,(class-name->proto name)
:class ',name
- :input-type ,(and input-type (proto-class-name input-type))
- :output-type ,(and output-type (proto-class-name output-type))
- :options (list ,@options))))))
- `(progn
- define-service
- (make-instance 'protobuf-service
- :name ,(or proto-name (proto-class-name name))
- :class ',name
- :rpcs (list ,@rpcs))
- ()))) ;---*** DEFINE LISP STUB HERE
+ :input-type ,(and input-class (class-name->proto input-class))
+ :input-class ',input-class
+ :output-type ,(and output-class (class-name->proto output-class))
+ :output-class ',output-class
+ :options (list ,@options)))
+ ;;--- Is this really all we need as the stub for the RPC?
+ (collect-form `(defgeneric ,name (,@(and input-class (list input-class)))
+ (declare (values ,output-class)))))))
+ (let ((options (loop for (key val) on options by #'cddr
+ collect `(make-instance 'protobuf-option
+ :name ,key
+ :value ,val))))
+ `(progn
+ define-service
+ (make-instance 'protobuf-service
+ :name ,(or proto-name (class-name->proto name))
+ :class ',name
+ :options (list ,@options)
+ :rpcs (list ,@rpcs)
+ :documentation ,documentation)
+ ,forms))))
projects / cl-protobufs.git / blobdiff