;;; Protocol buffers model classes
(defvar *all-schemas* (make-hash-table :test #'equal)
- "A table mapping names to 'protobuf-schema' objects.")
+ "A global table mapping names to 'protobuf-schema' objects.")
(defgeneric find-schema (name)
(:documentation
"Given a name (a symbol or string), return the 'protobuf-schema' object having that name."))
(defmethod find-schema ((name symbol))
- (values (gethash (keywordify name) *all-schemas*)))
-
-(defmethod find-schema ((name string))
- (values (gethash (string-upcase name) *all-schemas*)))
+ (assert (not (keywordp name)))
+ (values (gethash name *all-schemas*)))
(defmethod find-schema ((path pathname))
"Given a pathname, return the 'protobuf-schema' object that came from that path."
- (values (gethash (make-pathname :type nil :defaults path) *all-schemas*)))
+ (values (gethash path *all-schemas*)))
(defvar *all-messages* (make-hash-table :test #'equal)
- "A table mapping Lisp class names to 'protobuf-message' objects.")
+ "A global table mapping Lisp class names to 'protobuf-message' objects.")
(defgeneric find-message-for-class (class)
(:documentation
(values (gethash (class-name class) *all-messages*)))
-;; A few things (the pretty printer) want to keep track of the current schema
+;;; "Thread-local" variables
+
+;; Parsing (and even pretty printing schemas) want to keep track of the current schema
(defvar *protobuf* nil
- "The Protobufs object currently being defined, either a schema or a message.")
+ "Bound to the Protobufs object currently being defined, either a schema or a message.")
(defvar *protobuf-package* nil
- "The Lisp package in which the Protobufs schema is being defined.")
+ "Bound to 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.")
+ "Bound to 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.
- When it's nil, there is no global conc-name.
+ "Bound to a conc-name to use for all the messages in the schema being defined.
+ This controls the name of the accessors the fields of each message.
+ When it's nil, there is no \"global\" conc-name.
When it's t, each message will use the message name as the conc-name.
When it's a string, that string will be used as the conc-name for each message.
'parse-schema-from-file' defaults conc-name to \"\", meaning that each field in
every message has an accessor whose name is the name of the field.")
(defvar *protobuf-pathname* nil
- "The name of the file from where the .proto file is being parsed.")
+ "Bound to he name of the file from where the .proto file is being parsed.")
(defvar *protobuf-search-path* ()
- "A search-path to use to resolve any relative pathnames.")
+ "Bound to the search-path to use to resolve any relative pathnames.")
(defvar *protobuf-output-path* ()
- "A path to use to direct output during imports, etc.")
+ "Bound to the path to use to direct output during imports, etc.")
;;; The model classes
(defclass abstract-protobuf () ())
+;; It would be nice if most of the slots had only reader functions, but
+;; that makes writing the Protobufs parser a good deal more complicated.
+;; Too bad Common Lisp exports '(setf foo)' when you only want to export 'foo'
(defclass base-protobuf (abstract-protobuf)
((class :type (or null symbol) ;the Lisp name for this object
:accessor proto-class ;this often names a type or class
"The model class that represents a Protobufs schema, i.e., one .proto file."))
(defmethod make-load-form ((s protobuf-schema) &optional environment)
- (with-slots (class name) s
+ (with-slots (class) s
(multiple-value-bind (constructor initializer)
(make-load-form-saving-slots s :environment environment)
(values `(let ((s ,constructor))
- (record-protobuf s ',class ',name nil)
+ (record-protobuf s ',class nil)
s)
initializer))))
-(defgeneric record-protobuf (schema &optional symbol name type)
+(defgeneric record-protobuf (schema &optional symbol type)
(:documentation
"Record all the names by which the Protobufs schema might be known.")
- (:method ((schema protobuf-schema) &optional symbol name type)
+ (:method ((schema protobuf-schema) &optional symbol type)
(declare (ignore type))
- (let ((symbol (or symbol (proto-class schema)))
- (name (or name (proto-name schema))))
+ (let ((symbol (or symbol (proto-class schema))))
(when symbol
- (setf (gethash (keywordify symbol) *all-schemas*) schema))
- (when name
- (setf (gethash (string-upcase name) *all-schemas*) schema))
- (let ((path (or *protobuf-pathname* *compile-file-pathname*)))
- (when path
- ;; Record the file from which the Protobufs schema came, sans file type
- (setf (gethash (make-pathname :type nil :defaults path) *all-schemas*) schema))))))
+ (setf (gethash symbol *all-schemas*) schema))
+ (when *protobuf-pathname*
+ ;; Record the file from which the Protobufs schema came
+ (setf (gethash *protobuf-pathname* *all-schemas*) schema)))))
(defmethod print-object ((s protobuf-schema) stream)
(if *print-escape*
(defun make-option (name value &optional (type 'string))
(check-type name string)
(make-instance 'protobuf-option
- :name key :value val :type type))
+ :name name :value value :type type))
(defgeneric find-option (protobuf name)
(:documentation
;; This side-effects 'proto-options'
(setf (proto-options protobuf)
(append (proto-options protobuf)
- (list (make-option key val type)))))))
+ (list (make-option name value type)))))))
(defmethod add-option ((options list) (name string) value &optional (type 'string))
(let ((option (find name options :key #'proto-name :test #'option-name=)))
- (setq options (append (remove option options)
- (list (make-option key val type))))))
+ (append (remove option options)
+ (list (make-option name value type)))))
(defgeneric remove-options (protobuf &rest names)
(:documentation
"The model class that represents a Protobufs message."))
(defmethod make-load-form ((m protobuf-message) &optional environment)
- (with-slots (class name message-type) m
+ (with-slots (class message-type) m
(multiple-value-bind (constructor initializer)
(make-load-form-saving-slots m :environment environment)
(values (if (eq message-type :extends)
constructor
`(let ((m ,constructor))
- (record-protobuf m ',class ',name ',message-type)
+ (record-protobuf m ',class ',message-type)
m))
initializer))))
-(defmethod record-protobuf ((message protobuf-message) &optional class name type)
+(defmethod record-protobuf ((message protobuf-message) &optional class type)
;; No need to record an extension, it's already been recorded
(let ((class (or class (proto-class message)))
- (name (or name (proto-name message)))
(type (or type (proto-message-type message))))
(unless (eq type :extends)
(when class
- (setf (gethash class *all-messages*) message))
- (when name
- (setf (gethash name *all-messages*) message)))))
+ (setf (gethash class *all-messages*) message)))))
(defmethod print-object ((m protobuf-message) stream)
(if *print-escape*
projects / cl-protobufs.git / blobdiff