From e8c82e36e231d65fafde4c1b6b56089ab52ea66c Mon Sep 17 00:00:00 2001 From: Lovro Lugovic Date: Fri, 10 May 2019 10:41:22 +0200 Subject: [PATCH] LCP: Remove Cap'n Proto Summary: Depends on D1947 Reviewers: mtomic, teon.banek Reviewed By: teon.banek Subscribers: pullbot Differential Revision: https://phabricator.memgraph.io/D2034 --- src/lisp/lcp.lisp | 1135 +---------------------------------------- src/lisp/package.lisp | 9 - src/lisp/types.lisp | 49 +- 3 files changed, 8 insertions(+), 1185 deletions(-) diff --git a/src/lisp/lcp.lisp b/src/lisp/lcp.lisp index d1a2913ec..d616bf0a9 100644 --- a/src/lisp/lcp.lisp +++ b/src/lisp/lcp.lisp @@ -235,1065 +235,8 @@ which generate the corresponding C++ keywords." until (or (not char) (and stop-position (> pos stop-position))) when (char= #\Newline char) count it)) -;;; Cap'n Proto schema and C++ serialization code generation - -;;; Schema generation ;;; -;;; The basic algorthm should work as follows. -;;; 1) C++ class (or struct) is converted to the same named Capnp struct. -;;; 2) C++ class members are converted to camelCased members of Capnp struct. -;;; a) Primitive C++ types are mapped to primitive Capnp types. -;;; b) C++ std types are converted to our Capnp wrappers found in -;;; rpc/serialization.capnp. This process is hardcoded. -;;; c) For other composite types, we assume that a Capnp struct exists -;;; with the same PascalCase name as the *top-most* base class. -;;; d) The user may provide a :CAPNP-TYPE string, which overrides our -;;; decision making. Alternatively, a user may register the conversion -;;; with `CAPNP-TYPE-CONVERSION'. -;;; 3) Handle C++ inheritance by checking direct subclasses of C++ class. -;;; * Inheritance can be modeled with a union or composition. -;;; -;;; Since with Capnp we cannot use the pointer casting trick from C -;;; when modeling inheritance with composition, we are only left with -;;; union. This is an ok solution for single inheritance trees, but C++ -;;; allows for multiple inheritance. This poses a problem. -;;; -;;; Luckily, most of our use cases of multiple inheritance are only for -;;; mixin classes to reuse some functionality. This allows us to model -;;; multiple inheritance via composition. These classes need to be -;;; marked as such for Capnp. Obviously, this precludes serialization -;;; of pointers to mixin classes, but we should deal with that in C++ -;;; code on a case by case basis. -;;; -;;; The algorithm is then the following. -;;; a) If C++ class is the only parent of the direct sublcass, add the -;;; direct subclass to union. -;;; b) If C++ class isn't the only parent (multiple inheritance), then -;;; check whether our class marked to be composed in the derived. If -;;; yes, don't generate the union for direct subclass. Otherwise, -;;; behave as 3.a) -;;; 4) Handle C++ template parameters of a class -;;; Currently we require that explicit instantiations be listed in -;;; TYPE-ARGS of `CAPNP-OPTS'. These arguments are then used to generate -;;; a union, similarly to how inheritance is handled. This approach does -;;; not support inheriting from template classes. -(defun capnp-union-subclasses (cpp-class) - "Get direct subclasses of CPP-CLASS which should be modeled as a union in -Cap'n Proto schema." - (declare (type (or symbol cpp-class) cpp-class)) - (let ((class-name (if (symbolp cpp-class) cpp-class (cpp-type-base-name cpp-class)))) - (remove-if (lambda (subclass) - (let ((capnp-opts (cpp-class-capnp-opts subclass))) - (or - ;; Remove if we are a parent that should be ignored (not - ;; the 1st in the list). - (and (capnp-opts-ignore-other-base-classes capnp-opts) - (not (eq class-name (car (cpp-class-super-classes subclass))))) - ;; Remove if we are a parent that should be treated as - ;; composition. - (member class-name - (capnp-opts-inherit-compose (cpp-class-capnp-opts subclass)))))) - (direct-subclasses-of cpp-class)))) - -(defun capnp-union-and-compose-parents (cpp-class) - "Get direct parents of CPP-CLASS that model the inheritance via union. The -secondary value contains parents which are modeled as being composed inside -CPP-CLASS." - (declare (type (or symbol cpp-class) cpp-class)) - (let* ((class (if (symbolp cpp-class) (find-cpp-class cpp-class) cpp-class)) - (capnp-opts (cpp-class-capnp-opts class))) - (when (not capnp-opts) - (error "Class ~A should be marked for capnp serialization, -or its derived classes set as :CAPNP :BASE T" (cpp-type-base-name class))) - (when (not (capnp-opts-base capnp-opts)) - (if (capnp-opts-ignore-other-base-classes capnp-opts) - ;; Since we are ignoring multiple inheritance, return the 1st class - ;; (as union parent). - (list (car (cpp-class-super-classes class))) - ;; We aren't ignoring multiple inheritance, collect union and - ;; compose parents. - (let (union compose) - (dolist (parent (cpp-class-super-classes class)) - (if (member parent (capnp-opts-inherit-compose capnp-opts)) - (push parent compose) - (push parent union))) - (values union compose)))))) - -(defun capnp-union-parents-rec (cpp-class) - "Return a list of all parent clases recursively for CPP-CLASS that should be -encoded as union inheritance in Cap'n Proto." - (declare (type cpp-class cpp-class)) - (labels ((capnp-base-p (class) - (declare (type cpp-class class)) - (let ((opts (cpp-class-capnp-opts class))) - (and opts (capnp-opts-base opts)))) - (rec (class) - (declare (type cpp-class class)) - (cons (cpp-type-base-name class) - ;; Continue to supers only if this isn't marked as capnp base class. - (when (and (not (capnp-base-p class)) - (capnp-union-and-compose-parents class)) - (let ((first-parent (find-cpp-class - (first (capnp-union-and-compose-parents class))))) - (if first-parent - (rec first-parent) - (list (first (capnp-union-and-compose-parents class))))))))) - (cdr (rec cpp-class)))) - -(defvar *capnp-type-converters* nil - "Pairs of (cpp-type capnp-type) which map the conversion of C++ types to - Cap'n Proto types.") - -(defun capnp-type-conversion (cpp-type capnp-type) - (declare (type string cpp-type capnp-type)) - (push (cons cpp-type capnp-type) *capnp-type-converters*)) - -(defun capnp-type<-cpp-type (cpp-type &key boxp) - (flet ((convert-primitive-type (name) - (when (member name '(:int :uint)) - (error "Unable to get Capnp type for integer without specified width.")) - (let ((capnp-type - (case name - (:bool "Bool") - (:float "Float32") - (:double "Float64") - (otherwise - (let ((pos-of-i (position #\I (string name)))) - ;; Delete the _t suffix - (cl-ppcre:regex-replace - "_t$" (string-downcase name :start (1+ pos-of-i)) "")))))) - (if boxp - (concatenate 'string "Utils.Box" capnp-type) - capnp-type)))) - (typecase cpp-type - (cpp-primitive-type-keywords (convert-primitive-type cpp-type)) - (cpp-primitive-type (convert-primitive-type (cpp-type-base-name cpp-type))) - (string - (let ((type (parse-cpp-type-declaration cpp-type))) - (cond - ((typep type 'cpp-primitive-type) - (convert-primitive-type (cpp-type-base-name type))) - ((string= "string" (cpp-type-base-name type)) - "Text") - ((string= "shared_ptr" (cpp-type-base-name type)) - (let ((class (find-cpp-class - ;; TODO: Use full type - (cpp-type-base-name (first (cpp-type-type-args type)))))) - (unless class - (error "Unable to determine base type for '~A'; use :capnp-type" - cpp-type)) - (let* ((parents (capnp-union-parents-rec class)) - (top-parent (if parents (car (last parents)) (cpp-type-base-name class)))) - (format nil "Utils.SharedPtr(~A)" (cpp-type-name top-parent))))) - ((string= "vector" (cpp-type-base-name type)) - (format nil "List(~A)" - (capnp-type<-cpp-type - (cpp-type-decl (first (cpp-type-type-args type)))))) - ((string= "optional" (cpp-type-base-name type)) - (format nil "Utils.Optional(~A)" - (capnp-type<-cpp-type (cpp-type-decl (first (cpp-type-type-args type))) - :boxp t))) - ((assoc cpp-type *capnp-type-converters* :test #'string=) - (cdr (assoc cpp-type *capnp-type-converters* :test #'string=))) - (t (cpp-type-name cpp-type))))) - ;; Capnp only accepts uppercase first letter in types (PascalCase), so - ;; this is the same as our conversion to C++ type name. - (otherwise (cpp-type-name cpp-type))))) - -(defun capnp-type-of-member (member) - (declare (type cpp-member member)) - (if (cpp-member-capnp-type member) - (cpp-member-capnp-type member) - (capnp-type<-cpp-type (cpp-member-type member)))) - -(defun capnp-primitive-type-p (capnp-type) - (declare (type (or list string) capnp-type)) - (and (stringp capnp-type) - (member capnp-type - '("Bool" - "Int8" "Int16" "Int32" "Int64" - "UInt8" "UInt16" "UInt32" "UInt64" - "Float32" "Float64" - "Text" "Void") - :test #'string=))) - -(defun capnp-schema-for-enum (cpp-enum) - "Generate Cap'n Proto serialization schema for CPP-ENUM" - (declare (type cpp-enum cpp-enum)) - (with-output-to-string (s) - (with-cpp-block-output (s :name (format nil "enum ~A" (cpp-type-name cpp-enum))) - (loop for val in (cpp-enum-values cpp-enum) and field-number from 0 - do (format s " ~A @~A;~%" - (string-downcase (cpp-type-name val) :end 1) - field-number))))) - -(defun capnp-schema (cpp-class) - "Generate Cap'n Proto serialiation schema for CPP-CLASS" - (declare (type (or cpp-class cpp-enum symbol) cpp-class)) - (when (null cpp-class) - (return-from capnp-schema)) - (when (typep cpp-class 'cpp-enum) - (return-from capnp-schema (capnp-schema-for-enum cpp-class))) - (let ((class-name (if (symbolp cpp-class) cpp-class (cpp-type-base-name cpp-class))) - (members (when (typep cpp-class 'cpp-class) - (cpp-class-members-for-save cpp-class))) - (inner-types (when (typep cpp-class 'cpp-class) (cpp-class-inner-types cpp-class))) - (union-subclasses (capnp-union-subclasses cpp-class)) - (type-params (when (typep cpp-class 'cpp-class) (cpp-type-type-params cpp-class))) - (capnp-type-args (when (typep cpp-class 'cpp-class) - (capnp-opts-type-args (cpp-class-capnp-opts cpp-class)))) - (field-number 0)) - (when (and type-params (not capnp-type-args)) - (error "Don't know how to create schema for template class '~A'" class-name)) - (when (and capnp-type-args union-subclasses) - (error "Don't know how to handle templates and inheritance of ~A" class-name)) - (flet ((field-name<-symbol (symbol) - "Get Capnp compatible field name (camelCase)." - (string-downcase (cpp-type-name symbol) :end 1))) - (multiple-value-bind (union-parents compose-parents) - (capnp-union-and-compose-parents cpp-class) - (when (> (list-length union-parents) 1) - (error "Class ~A has multiple inheritance. Use :inherit-compose for - remaining parents." class-name)) - (with-output-to-string (s) - (with-cpp-block-output (s :name (format nil "struct ~A" (cpp-type-name class-name))) - (dolist (compose compose-parents) - (format s " ~A @~A :~A;~%" - (field-name<-symbol compose) - field-number - (capnp-type<-cpp-type compose)) - (incf field-number)) - (when capnp-type-args - (with-cpp-block-output (s :name "union") - (dolist (type-arg capnp-type-args) - (format s " ~A @~A :Void;~%" (field-name<-symbol type-arg) field-number) - (incf field-number)))) - (dolist (member members) - (let ((capnp-type (capnp-type-of-member member)) - (field-name (field-name<-symbol (cpp-member-symbol member)))) - (if (stringp capnp-type) - (progn - (format s " ~A @~A :~A;~%" - field-name field-number capnp-type) - (incf field-number)) - ;; capnp-type is a list specifying a union type - (progn - (with-cpp-block-output (s :name (format nil " ~A :union" field-name)) - (dolist (union-member capnp-type) - (format s " ~A @~A :~A;~%" - (field-name<-symbol (first union-member)) - field-number (second union-member)) - (incf field-number))))))) - (dolist (inner inner-types) - (when (or (and (typep inner 'cpp-class) (cpp-class-capnp-opts inner)) - (and (typep inner 'cpp-enum) (cpp-enum-serializep inner))) - (write-line (capnp-schema inner) s))) - (when union-subclasses - (with-cpp-block-output (s :name "union") - (when (not (cpp-class-abstractp cpp-class)) - ;; Allow instantiating classes in the middle of inheritance - ;; hierarchy. - (format s " ~A @~A :Void;~%" - (field-name<-symbol class-name) field-number) - (incf field-number)) - (dolist (subclass union-subclasses) - (format s " ~A @~A :~A;~%" - (field-name<-symbol (cpp-type-base-name subclass)) - field-number - (capnp-type<-cpp-type (cpp-type-base-name subclass))) - (incf field-number)))))))))) - -;;; Capnp C++ serialization code generation -;;; -;;; Algorithm is closely tied with the generated schema (see above). -;;; -;;; 1) Generate the function declaration. -;;; -;;; We are using top level functions, so that we can easily decouple the -;;; serialization code from class definitions. This requires the class to -;;; have public access to its serializable fields. -;;; -;;; Two problems arise: -;;; -;;; * inheritance and -;;; * helper arguments (for tracking pointers or similar). -;;; -;;; The function will always take a `const &T` and a pointer to a -;;; `capnp::::Builder` class. Additional arguments are optional, and are -;;; supplied when declaring that the class should be serialized with capnp. -;;; -;;; To determine the concrete T we need to know whether this class is a -;;; derived one or is inherited from. If it is, then T needs to be the -;;; top-most parent that is modeled by union and not composition. (For the -;;; inheritance modeling problem, refer to the description of schema -;;; generation.) Since we opted for using top level functions, we cannot use -;;; virtual call dispatch to get the concrete type. (We could use the visitor -;;; pattern, but that introduces the coupling we are avoiding with regular -;;; functions.) Therefore, we use dynamic_cast in functions to determine the -;;; concrete serialization code. If this class has no inheritance in any -;;; direction, then we just serialize T to its corresponding capnp::T schema -;;; type. -;;; -;;; Helper arguments are obtained from SAVE-ARGS of `CAPNP-OPTS'. -;;; -;;; 2) Generate parent calls for serialization (if we have parent classes). -;;; -;;; For the first (and only) parent which is modeled through union, generate -;;; the parent serialization code. This is done recursively for each union -;;; parent. The generated code sees all of the arguments from our function -;;; declaration. -;;; -;;; Then, find our own concrete builder by traversing through the union schema -;;; of the base builder. It is expected (and required) that the parent code -;;; has initialized them correctly. We just need to initialize the most -;;; concrete builder. -;;; -;;; Other parents are required to be modeled through composition. Therefore, -;;; we generate calls to parents by passing builders for the composed structs. -;;; -;;; auto parent_builder = builder->initParent(); -;;; // Parent Save code -;;; -;;; Any additional helper arguments are also visited in the generated code. -;;; -;;; 3) Generate member serialization. -;;; -;;; For primitive typed members, generate `builder->setMember(member);` calls. -;;; -;;; For `std` types, generate hard-coded calls to our wrapper functions. Most -;;; of these require a lambda function which serializes the element inside the -;;; `std` class. This can be done recursively with this step. -;;; -;;; For composite types, check whether we have been given a custom save -;;; invocation. If not, assume that the type has an accompanying function -;;; called `Save` which expects an instance of that type and a builder for it, -;;; as well as any additional helper arguments. - -(defun capnp-extra-args (cpp-class save-or-load) - "Get additional arguments to Save/Load function for CPP-CLASS." - (declare (type cpp-class cpp-class) - (type (member :save :load) save-or-load)) - (loop for parent in (cons (cpp-type-base-name cpp-class) (capnp-union-parents-rec cpp-class)) - for opts = (cpp-class-capnp-opts (find-cpp-class parent)) - for args = (ecase save-or-load - (:save (capnp-opts-save-args opts)) - (:load (capnp-opts-load-args opts))) - when args return args)) - -(defun capnp-save-function-declaration (cpp-class) - "Generate Cap'n Proto save function declaration for CPP-CLASS." - (declare (type cpp-class cpp-class)) - (let* ((parents (capnp-union-parents-rec cpp-class)) - (top-parent-class - (if parents - (cpp-type-decl (find-cpp-class (car (last parents))) :type-params nil :namespace nil) - (cpp-type-decl cpp-class :type-params nil :namespace nil))) - (self-arg - (list 'self (format nil "const ~A &" - (cpp-type-decl cpp-class :namespace nil)))) - (builder-arg - (list (if parents 'base-builder 'builder) - (format nil "capnp::~A::Builder *" top-parent-class)))) - (cpp-function-declaration - "Save" - :args (cons self-arg - (cons builder-arg (capnp-extra-args cpp-class :save))) - :type-params (cpp-type-type-params cpp-class)))) - -(defun capnp-cpp-type<-cpp-type (cpp-type &key boxp) - (declare (type cpp-type cpp-type)) - (when (cpp-type-type-params cpp-type) - (error "Don't know how to convert '~A' to capnp equivalent" - (cpp-type-decl cpp-type))) - (let ((name (cpp-type-base-name cpp-type)) - (namespace (cpp-type-namespace cpp-type))) - (cond - ((and boxp (typep cpp-type 'cpp-primitive-type)) - (setf name (concatenate 'string "Box" (capnp-type<-cpp-type cpp-type)) - namespace '("utils" "capnp"))) - ((string= "string" (cpp-type-base-name cpp-type)) - (setf name "Text" - namespace '("capnp"))) - (t ;; Just append capnp as final namespace - (setf namespace (append namespace '("capnp"))))) - (make-cpp-type name :namespace namespace - :enclosing-class (cpp-type-enclosing-class cpp-type)))) - -(defun cpp-enum-to-capnp-function-name (cpp-enum &key namespace) - "Generate the name of the C++ function for converting a C++ enum to -equivalent Cap'n Proto schema enum. If NAMESPACE is T, prepend the name with -namespace of CPP-ENUM." - (concatenate - 'string - (if namespace (cpp-type-namespace-string cpp-enum) "") - ;; Remove namespace demarkations of any potential enclosing classses. - (remove #\: (cpp-type-decl cpp-enum :namespace nil)) - "ToCapnp")) - -(defun cpp-enum-to-capnp-function-declaration (cpp-enum) - "Generate C++ function declaration for converting a C++ enum to equivalent -Cap'n Proto schema enum." - (let ((name (cpp-enum-to-capnp-function-name cpp-enum)) - (capnp-type (cpp-type-decl (capnp-cpp-type<-cpp-type cpp-enum)))) - (cpp-function-declaration - name :args `((value ,(cpp-type-decl cpp-enum))) - :returns capnp-type))) - -(defun cpp-enum-to-capnp-function-definition (cpp-enum) - "Generate C++ function for converting a C++ enum to equivalent Cap'n Proto -schema enum." - (with-output-to-string (out) - (with-cpp-block-output (out :name (cpp-enum-to-capnp-function-declaration cpp-enum)) - (let* ((cpp-type (cpp-type-decl cpp-enum)) - (capnp-type (cpp-type-decl (capnp-cpp-type<-cpp-type cpp-enum))) - (cases (mapcar (lambda (value-symbol) - (let ((value (cl-ppcre:regex-replace-all "-" (string value-symbol) "_"))) - #>cpp - case ${cpp-type}::${value}: - return ${capnp-type}::${value}; - cpp<#)) - (cpp-enum-values cpp-enum)))) - (format out "switch (value) {~%~{~A~%~}}" (mapcar #'raw-cpp-string cases)))))) - -(defun cpp-enum-from-capnp-function-name (cpp-enum &key namespace) - "Generate the name of the C++ function for converting a C++ enum from -equivalent Cap'n Proto schema enum. If NAMESPACE is T, prepend the name with -namespace of CPP-ENUM." - (concatenate - 'string - (if namespace (cpp-type-namespace-string cpp-enum) "") - ;; Remove namespace demarkations of any potential enclosing classses. - (remove #\: (cpp-type-decl cpp-enum :namespace nil)) - "FromCapnp")) - -(defun cpp-enum-from-capnp-function-declaration (cpp-enum) - "Generate C++ function declaration for converting a C++ enum from equivalent -Cap'n Proto schema enum." - (let ((name (cpp-enum-from-capnp-function-name cpp-enum)) - (capnp-type (cpp-type-decl (capnp-cpp-type<-cpp-type cpp-enum)))) - (cpp-function-declaration - name :args `((value ,capnp-type)) - :returns (cpp-type-decl cpp-enum)))) - -(defun cpp-enum-from-capnp-function-definition (cpp-enum) - "Generate C++ function for converting a C++ enum from equivalent Cap'n Proto -schema enum." - (with-output-to-string (out) - (with-cpp-block-output (out :name (cpp-enum-from-capnp-function-declaration cpp-enum)) - (let* ((cpp-type (cpp-type-decl cpp-enum)) - (capnp-type (cpp-type-decl (capnp-cpp-type<-cpp-type cpp-enum))) - (cases (mapcar (lambda (value-symbol) - (let ((value (cl-ppcre:regex-replace-all "-" (string value-symbol) "_"))) - #>cpp - case ${capnp-type}::${value}: - return ${cpp-type}::${value}; - cpp<#)) - (cpp-enum-values cpp-enum)))) - (format out "switch (value) {~%~{~A~%~}}" (mapcar #'raw-cpp-string cases)))))) - -(defun capnp-save-enum-vector (builder-name member-name cpp-enum) - (let ((enum-to-capnp (cpp-enum-to-capnp-function-name cpp-enum :namespace t))) - (raw-cpp-string - #>cpp - for (size_t i = 0; - i < ${member-name}.size(); - ++i) { - ${builder-name}.set(i, ${enum-to-capnp}(${member-name}[i])); - } - cpp<#))) - -(defun capnp-save-default (member-name member-type member-builder capnp-name &key cpp-class) - "Generate the default call to save for member. MEMBER-NAME and MEMBER-TYPE -are strings describing the member being serialized. MEMBER-BUILDER is the -name of the builder variable. CAPNP-NAME is the name of the member in Cap'n -Proto schema." - (declare (type string member-name member-type member-builder capnp-name)) - (declare (type cpp-class cpp-class)) - (let* ((type (parse-cpp-type-declaration member-type)) - (type-name (cpp-type-base-name type)) - (cpp-enum (or - ;; Look for potentially nested enum first - (find-cpp-enum - (concatenate 'string (cpp-type-decl cpp-class) "::" member-type)) - (find-cpp-enum member-type)))) - (cond - (cpp-enum - (let ((enum-to-capnp (cpp-enum-to-capnp-function-name cpp-enum :namespace t))) - (raw-cpp-string - #>cpp - ${member-builder}->set${capnp-name}(${enum-to-capnp}(${member-name})); - cpp<#))) - ((string= "vector" type-name) - (let* ((elem-type (car (cpp-type-type-args type))) - (elem-type-enum (or (find-cpp-enum (concatenate 'string (cpp-type-decl cpp-class) - "::" (cpp-type-decl elem-type))) - (find-cpp-enum (cpp-type-decl elem-type)))) - (capnp-cpp-type (capnp-cpp-type<-cpp-type (or elem-type-enum elem-type)))) - (cond - ((capnp-primitive-type-p (capnp-type<-cpp-type (cpp-type-base-name elem-type))) - (raw-cpp-string - #>cpp - utils::SaveVector(${member-name}, &${member-builder}); - cpp<#)) - (elem-type-enum - (capnp-save-enum-vector member-builder member-name elem-type-enum)) - (t - (raw-cpp-string - (funcall (capnp-save-vector (cpp-type-decl capnp-cpp-type) (cpp-type-decl elem-type)) - member-builder member-name capnp-name)))))) - ((string= "optional" type-name) - (let* ((elem-type (car (cpp-type-type-args type))) - (capnp-cpp-type (capnp-cpp-type<-cpp-type elem-type :boxp t)) - (lambda-code (when (typep elem-type 'cpp-primitive-type) - "[](auto *builder, const auto &v){ builder->setValue(v); }"))) - (raw-cpp-string - (funcall (capnp-save-optional - (cpp-type-decl capnp-cpp-type) (cpp-type-decl elem-type) lambda-code) - member-builder member-name capnp-name)))) - ((member type-name '("unique_ptr" "shared_ptr" "vector") :test #'string=) - (error "Use a custom :capnp-save function for ~A ~A" type-name member-name)) - (t - (let* ((cpp-class (find-cpp-class type-name)) ;; TODO: full type-name search - (extra-args (when cpp-class - (mapcar (lambda (name-and-type) - (cpp-variable-name (first name-and-type))) - (capnp-extra-args cpp-class :save))))) - (format nil "Save(~A, &~A~{, ~A~});" - member-name member-builder extra-args)))))) - -(defun capnp-save-members (cpp-class builder &key instance-access) - "Generate Cap'n Proto saving code for members of CPP-CLASS. INSTANCE-ACCESS - is a C++ string which is prefixed to member access. For example, - INSTANCE-ACCESS could be `my_struct->`" - (declare (type cpp-class cpp-class)) - (declare (type string instance-access)) - (with-output-to-string (s) - (dolist (member (cpp-class-members-for-save cpp-class)) - (let ((member-access - (concatenate 'string instance-access - (if (eq :public (cpp-member-scope member)) - (cpp-member-name member :struct (cpp-class-structp cpp-class)) - (format nil "~A()" (cpp-member-name member :struct t))))) - (member-builder (format nil "~A_builder" (cpp-member-name member :struct t))) - (capnp-name (cpp-type-name (cpp-member-symbol member)))) - (cond - ((and (not (cpp-member-capnp-save member)) - (capnp-primitive-type-p (capnp-type-of-member member))) - (format s " ~A->set~A(~A);~%" builder capnp-name member-access)) - (t - ;; Enclose larger save code in new scope - (with-cpp-block-output (s) - (let ((size (if (string= "vector" (cpp-type-base-name - (parse-cpp-type-declaration - (cpp-member-type member)))) - (format nil "~A.size()" member-access) - ""))) - (if (and (cpp-member-capnp-init member) - (not (find-cpp-enum (cpp-member-type member)))) - (format s " auto ~A = ~A->init~A(~A);~%" - member-builder builder capnp-name size) - (setf member-builder builder))) - (if (cpp-member-capnp-save member) - (format s " ~A~%" - (cpp-code (funcall (cpp-member-capnp-save member) - member-builder member-access capnp-name))) - (write-line (capnp-save-default member-access (cpp-member-type member) - member-builder capnp-name - :cpp-class cpp-class) - s))))))))) - -(defun capnp-save-function-code (cpp-class) - "Generate Cap'n Proto save code for CPP-CLASS." - (declare (type cpp-class cpp-class)) - (labels ((save-class (cpp-class builder cpp-out &key (force-builder nil)) - "Output the serialization code for CPP-CLASS and its parent classes." - (let* ((compose-parents (nth-value 1 (capnp-union-and-compose-parents cpp-class))) - (parents (capnp-union-parents-rec cpp-class)) - (first-parent (find-cpp-class (first parents)))) - (when first-parent - (with-cpp-block-output (cpp-out) - (format cpp-out "// Save parent class ~A~%" (cpp-type-name first-parent)) - (save-class first-parent builder cpp-out))) - ;; Initialize CPP-CLASS builder - (when parents - (if (or force-builder compose-parents - (cpp-class-members-for-save cpp-class)) - (progn - (format cpp-out "auto ~A_builder = ~A->~{get~A().~}init~A();~%" - (cpp-variable-name (cpp-type-base-name cpp-class)) - builder - (mapcar #'cpp-type-name (cdr (reverse parents))) - (cpp-type-name cpp-class)) - (format cpp-out "auto *builder = &~A_builder;~%" - (cpp-variable-name (cpp-type-base-name cpp-class))) - (setf builder "builder")) - (format cpp-out "~A->~{get~A().~}init~A();~%" - builder - (mapcar #'cpp-type-name (cdr (reverse parents))) - (cpp-type-name cpp-class)))) - ;; Save composed parent classes - (dolist (parent compose-parents) - (with-cpp-block-output (cpp-out) - (let* ((parent-builder (format nil "~A_builder" (cpp-variable-name parent)))) - (format cpp-out "// Save composed class ~A~%" (cpp-type-name parent)) - (format cpp-out "auto ~A = ~A->init~A();~%" - parent-builder builder (cpp-type-name parent)) - (format cpp-out "Save(self, &~A~{, ~A~});" - parent-builder - (mapcar (lambda (name-and-type) - (cpp-variable-name (first name-and-type))) - (capnp-extra-args (find-cpp-class parent) :save)))))) - ;; Save members - (write-string (capnp-save-members cpp-class builder :instance-access "self.") cpp-out) - ;; Call post-save function if necessary - (let ((capnp-opts (cpp-class-capnp-opts cpp-class))) - (when (capnp-opts-post-save capnp-opts) - (write-string (cpp-code (funcall (capnp-opts-post-save capnp-opts) builder)) cpp-out)))))) - (with-output-to-string (cpp-out) - (let ((subclasses (capnp-union-subclasses cpp-class)) - (builder (if (capnp-union-parents-rec cpp-class) - "base_builder" - "builder"))) - (when subclasses - (write-line "// Forward serialization to most derived type" cpp-out) - (dolist (subclass subclasses) - (let ((derived-name (cpp-type-name subclass)) - (save-args - (format nil "~A~{, ~A~}" - builder - (mapcar (lambda (name-and-type) - (cpp-variable-name (first name-and-type))) - (capnp-extra-args cpp-class :save)))) - (type-args (capnp-opts-type-args (cpp-class-capnp-opts subclass)))) - (if type-args - ;; Handle template instantiation - (dolist (type-arg (mapcar #'cpp-type-name type-args)) - (write-string - (raw-cpp-string - #>cpp - if (const auto *derived = dynamic_cast *>(&self)) { - return Save(*derived, ${save-args}); - } - cpp<#) - cpp-out)) - ;; Just forward the serialization normally. - (write-string - (raw-cpp-string - #>cpp - if (const auto *derived = dynamic_cast(&self)) { - return Save(*derived, ${save-args}); - } - cpp<#) - cpp-out))))) - (cond - ((cpp-class-abstractp cpp-class) - (format cpp-out - "LOG(FATAL) << \"Should not get here -- `~A` should be an abstract class!\";" - (cpp-type-name cpp-class))) - ((capnp-union-subclasses cpp-class) - ;; We are in the middle of inheritance hierarchy, so set our - ;; union Void field. - (save-class cpp-class builder cpp-out :force-builder t) - (format cpp-out "builder->set~A();~%" (cpp-type-name cpp-class))) - (t (save-class cpp-class builder cpp-out))))))) - -(defun capnp-save-function-definition (cpp-class) - "Generate Cap'n Proto save function." - (declare (type cpp-class cpp-class)) - (with-output-to-string (cpp-out) - (with-cpp-block-output (cpp-out :name (capnp-save-function-declaration cpp-class)) - (write-line (capnp-save-function-code cpp-class) cpp-out)))) - -;;; Capnp C++ deserialization code generation -;;; -;;; This is almost the same as serialization, but with a special case for -;;; handling serialized pointers to base classes. -;;; -;;; The usual function signature for data types with no inheritance is: -;;; -;;; void Load(Data *self, const capnp::Data::Reader &, ) -;;; -;;; The function expects that the `Data` type is already allocated and can be -;;; modified via pointer. This way the user can allocate `Data` any way they -;;; see fit. -;;; -;;; With inheritance, the user doesn't know the concrete type to allocate. -;;; Therefore, the signature is changed so that the `Load` can heap allocate -;;; and construct the correct type. The downside of this approach is that the -;;; user of the `Load` function has no control over the allocation. The -;;; signature for loading types with inheritance is: -;;; -;;; void Load(std::unique_ptr *self, const capnp::Data::Reader &, -;;; ) -;;; -;;; The user can now only provide a pointer to unique_ptr which should take -;;; the ownership of the concrete type. - -(defun cpp-class-members-for-capnp-load (cpp-class) - (remove-if (lambda (m) (and (cpp-member-dont-save m) - (not (cpp-member-capnp-load m)))) - (cpp-class-members cpp-class))) - -(defun capnp-load-function-declaration (cpp-class) - "Generate Cap'n Proto load function declaration for CPP-CLASS." - (declare (type cpp-class cpp-class)) - (let* ((parents (capnp-union-parents-rec cpp-class)) - (top-parent-class (if parents - (cpp-type-decl (find-cpp-class (car (last parents))) :type-params nil :namespace nil) - (cpp-type-decl cpp-class :type-params nil :namespace nil))) - (reader-arg (list (if (or parents (capnp-union-subclasses cpp-class)) - 'base-reader - 'reader) - (format nil "const capnp::~A::Reader &" top-parent-class))) - (out-arg (list 'self - (if (or parents (capnp-union-subclasses cpp-class)) - (format nil "std::unique_ptr<~A> *" (cpp-type-decl cpp-class :namespace nil)) - (format nil "~A *" (cpp-type-decl cpp-class :namespace nil)))))) - (cpp-function-declaration - "Load" - :args (cons out-arg (cons reader-arg (capnp-extra-args cpp-class :load))) - :returns "void" - :type-params (cpp-type-type-params cpp-class)))) - -(defun capnp-load-enum-vector (reader-name member-name cpp-enum) - (let ((enum-from-capnp (cpp-enum-from-capnp-function-name cpp-enum :namespace t))) - (raw-cpp-string - #>cpp - ${member-name}.resize(${reader-name}.size()); - for (size_t i = 0; - i < ${reader-name}.size(); - ++i) { - ${member-name}[i] = ${enum-from-capnp}(${reader-name}[i]); - } - cpp<#))) - -(defun capnp-load-default (member-name member-type member-reader capnp-name &key cpp-class) - "Generate default load call for member. MEMBER-NAME and MEMBER-TYPE are -strings describing the member being loaded. MEMBER-READER is the name of the -reader variable. CAPNP-NAME is the name of the member in Cap'n Proto schema." - (declare (type string member-name member-type member-reader)) - (let* ((type (parse-cpp-type-declaration member-type)) - (type-name (cpp-type-base-name type)) - (cpp-enum (or - ;; Look for potentially nested enum first - (find-cpp-enum - (concatenate 'string (cpp-type-decl cpp-class) "::" member-type)) - (find-cpp-enum member-type)))) - (cond - (cpp-enum - (let ((enum-from-capnp (cpp-enum-from-capnp-function-name cpp-enum :namespace t))) - (raw-cpp-string - #>cpp - ${member-name} = ${enum-from-capnp}(${member-reader}.get${capnp-name}()); - cpp<#))) - ((string= "vector" type-name) - (let* ((elem-type (car (cpp-type-type-args type))) - (elem-type-enum (or (find-cpp-enum (concatenate 'string (cpp-type-decl cpp-class) - "::" (cpp-type-decl elem-type))) - (find-cpp-enum (cpp-type-decl elem-type)))) - (capnp-cpp-type (capnp-cpp-type<-cpp-type (or elem-type-enum elem-type)))) - (cond - ((capnp-primitive-type-p (capnp-type<-cpp-type (cpp-type-base-name elem-type))) - (raw-cpp-string - #>cpp - utils::LoadVector(&${member-name}, ${member-reader}); - cpp<#)) - (elem-type-enum - (capnp-load-enum-vector member-reader member-name elem-type-enum)) - (t - (raw-cpp-string - (funcall (capnp-load-vector (cpp-type-decl capnp-cpp-type) (cpp-type-decl elem-type)) - member-reader member-name capnp-name)))))) - ((string= "optional" type-name) - (let* ((elem-type (car (cpp-type-type-args type))) - (capnp-cpp-type (capnp-cpp-type<-cpp-type elem-type :boxp t)) - (lambda-code (when (string= "Box" (cpp-type-name capnp-cpp-type) :end2 (length "Box")) - "[](const auto &reader){ return reader.getValue(); }"))) - (raw-cpp-string - (funcall (capnp-load-optional - (cpp-type-decl capnp-cpp-type) (cpp-type-decl elem-type) lambda-code) - member-reader member-name capnp-name)))) - ((member type-name '("unique_ptr" "shared_ptr" "vector") :test #'string=) - (error "Use a custom :capnp-load function for ~A ~A" type-name member-name)) - (t - (let* ((cpp-class (find-cpp-class type-name)) ;; TODO: full type-name search - (extra-args (when cpp-class - (mapcar (lambda (name-and-type) - (cpp-variable-name (first name-and-type))) - (capnp-extra-args cpp-class :load))))) - (format nil "Load(&~A, ~A~{, ~A~});" - member-name member-reader extra-args)))))) - -(defun capnp-load-members (cpp-class reader &key instance-access) - "Generate Cap'n Proto loading code for members of CPP-CLASS. -INSTANCE-ACCESS is a C++ string which will be prefixed to member access. For -example, INSTANCE-ACCESS could be `my_struct->`" - (declare (type cpp-class cpp-class)) - (declare (type string instance-access)) - (with-output-to-string (s) - (dolist (member (cpp-class-members-for-capnp-load cpp-class)) - (let ((member-access - (concatenate 'string instance-access - (cpp-member-name member :struct (cpp-class-structp cpp-class)))) - (member-reader (format nil "~A_reader" (cpp-member-name member :struct t))) - (capnp-name (cpp-type-name (cpp-member-symbol member)))) - (cond - ((and (not (cpp-member-capnp-load member)) - (capnp-primitive-type-p (capnp-type-of-member member))) - (format s " ~A = ~A.get~A();~%" member-access reader capnp-name)) - (t - ;; Enclose larger load code in new scope - (with-cpp-block-output (s) - (if (and (cpp-member-capnp-init member) - (not (find-cpp-enum (cpp-member-type member)))) - (format s " auto ~A = ~A.get~A();~%" member-reader reader capnp-name) - (setf member-reader reader)) - (if (cpp-member-capnp-load member) - (format s " ~A~%" - (cpp-code (funcall (cpp-member-capnp-load member) - member-reader member-access capnp-name))) - (write-line (capnp-load-default member-access - (cpp-member-type member) - member-reader capnp-name :cpp-class cpp-class) - s))))))))) - -(defun capnp-load-function-code (cpp-class) - "Generate Cap'n Proto load code for CPP-CLASS." - (declare (type cpp-class cpp-class)) - (let ((instance-access (if (or (capnp-union-subclasses cpp-class) - (capnp-union-parents-rec cpp-class)) - "self->get()->" - "self->"))) - (labels ((load-class (cpp-class reader cpp-out) - (let* ((compose-parents (nth-value 1 (capnp-union-and-compose-parents cpp-class))) - (parents (capnp-union-parents-rec cpp-class)) - (first-parent (find-cpp-class (first parents)))) - (when first-parent - (with-cpp-block-output (cpp-out) - (format cpp-out "// Load parent class ~A~%" (cpp-type-name first-parent)) - (load-class first-parent reader cpp-out))) - ;; Initialize CPP-CLASS reader - (when (and parents (or compose-parents - (cpp-class-members-for-capnp-load cpp-class))) - (progn - (format cpp-out "auto reader = ~A.~{get~A().~}get~A();" - reader - (mapcar #'cpp-type-name (cdr (reverse parents))) - (cpp-type-name cpp-class)) - (setf reader "reader"))) - ;; Load composed parent classes - (dolist (parent compose-parents) - (with-cpp-block-output (cpp-out) - (let ((parent-reader (format nil "~A_reader" (cpp-variable-name parent)))) - (format cpp-out "// Load composed class ~A~%" (cpp-type-name parent)) - (format cpp-out "auto ~A = ~A.get~A();~%" - parent-reader reader (cpp-type-name parent)) - (format cpp-out "Load(self->get(), ~A~{, ~A~});~%" - parent-reader - (mapcar (lambda (name-and-type) - (cpp-variable-name (first name-and-type))) - (capnp-extra-args (find-cpp-class parent) :load)))))) - ;; Load members - (write-string (capnp-load-members cpp-class reader :instance-access instance-access) cpp-out)))) - (with-output-to-string (s) - (cond - ((and (capnp-union-and-compose-parents cpp-class) - (not (direct-subclasses-of cpp-class))) - ;; CPP-CLASS is the most derived class, so construct and load. - (if (and (cpp-class-capnp-opts cpp-class) - (capnp-opts-construct (cpp-class-capnp-opts cpp-class))) - (write-line (funcall - (capnp-opts-construct (cpp-class-capnp-opts cpp-class)) - (cpp-type-decl cpp-class :namespace nil)) - s) - (format s "*self = std::make_unique<~A>();~%" (cpp-type-decl cpp-class :namespace nil))) - (load-class cpp-class "base_reader" s)) - ((capnp-union-subclasses cpp-class) - ;; Forward the load to most derived class by switching on reader.which() - (let ((parents (capnp-union-parents-rec cpp-class))) - (if parents - (format s "switch (base_reader.~{get~A().~}get~A().which()) " - (mapcar #'cpp-type-name (cdr (reverse parents))) - (cpp-type-name cpp-class)) - (write-string "switch (base_reader.which()) " s))) - (with-cpp-block-output (s) - (dolist (subclass (capnp-union-subclasses cpp-class)) - (format s " case capnp::~A::~A: " - (cpp-type-name cpp-class) - (cpp-enumerator-name (cpp-type-base-name subclass))) - (flet ((load-derived (derived-type-name) - (with-cpp-block-output (s) - (format s "std::unique_ptr<~A> derived;~%" derived-type-name) - (format s "Load(&derived, base_reader~{, ~A~});~%" - (mapcar (lambda (name-and-type) - (cpp-variable-name (first name-and-type))) - (capnp-extra-args cpp-class :load))) - (write-line "*self = std::move(derived);" s)))) - (if (capnp-opts-type-args (cpp-class-capnp-opts subclass)) - ;; Handle template instantiation - (progn - (format s "switch (base_reader.get~A().which()) " (cpp-type-name subclass)) - (with-cpp-block-output (s) - (dolist (type-arg (capnp-opts-type-args (cpp-class-capnp-opts subclass))) - (format s " case capnp::~A::~A: " - (cpp-type-name subclass) (cpp-enumerator-name type-arg)) - (load-derived (format nil "~A<~A>" - (cpp-type-name subclass) - (cpp-type-name type-arg)))))) - ;; Regular forward to derived - (load-derived (cpp-type-name subclass)))) - (write-line "break;" s)) - (when (not (cpp-class-abstractp cpp-class)) - ;; We are in the middle of the hierarchy, so allow constructing and loading us. - (with-cpp-block-output (s :name (format nil "case capnp::~A::~A:" - (cpp-type-name cpp-class) - (cpp-enumerator-name (cpp-type-base-name cpp-class)))) - (format s "*self = std::make_unique<~A>();~%" - (cpp-type-decl cpp-class :namespace nil)) - (load-class cpp-class "base_reader" s))))) - (t - ;; Regular load for absolutely no inheritance class - (assert (not (capnp-union-subclasses cpp-class))) - (assert (not (capnp-union-and-compose-parents cpp-class))) - (load-class cpp-class "reader" s))))))) - -(defun capnp-load-function-definition (cpp-class) - "Generate Cap'n Proto load function." - (declare (type cpp-class cpp-class)) - (with-output-to-string (cpp-out) - (with-cpp-block-output (cpp-out :name (capnp-load-function-declaration cpp-class)) - (write-line (capnp-load-function-code cpp-class) cpp-out)))) - -(defvar *capnp-imports* nil - "List of pairs (namespace, import-file), which will be imported in Cap'n - Proto schema with the syntax 'using Namespace = import import-file'") - -(defun capnp-import (namespace import-file) - "Import the IMPORT-FILE to Cap'n Proto aliased using NAMESPACE." - (declare (type symbol namespace) - (type string import-file)) - (push (cons namespace import-file) *capnp-imports*)) - -(defvar *capnp-namespace* nil - "Name of the namespace where Cap'n Proto generated C++ will be.") - -(defun capnp-namespace (namespace) - "Set the Cap'n Proto generated c++ namespace." - (declare (type string namespace)) - (setf *capnp-namespace* namespace)) - -(defun capnp-save-optional (capnp-type cpp-type &optional lambda-code) - "Generate the C++ code calling utils::SaveOptional. CAPNP-TYPE and CPP-TYPE -are passed as template parameters, while the optional LAMBDA-CODE is used to -save the value inside the std::optional." - (declare (type string capnp-type cpp-type) - (type (or null string) lambda-code)) - ;; TODO: Try using `capnp-save-default' - (let* ((namespace (cpp-type-namespace-string (parse-cpp-type-declaration cpp-type))) - (lambda-code (if lambda-code - lambda-code - (format nil - "[](auto *builder, const auto &val) { ~ASave(val, builder); }" - namespace)))) - (lambda (builder member capnp-name) - (declare (ignore capnp-name)) - #>cpp - utils::SaveOptional<${capnp-type}, ${cpp-type}>(${member}, &${builder}, ${lambda-code}); - cpp<#))) - -(defun capnp-load-optional (capnp-type cpp-type &optional lambda-code) - "Generate the C++ code calling utils::LoadOptional. CAPNP-TYPE and CPP-TYPE -are passed as template parameters, while the optional LAMBDA-CODE is used to -load the value of std::optional." - (declare (type string capnp-type cpp-type) - (type (or null string) lambda-code)) - (let* ((namespace (cpp-type-namespace-string (parse-cpp-type-declaration cpp-type))) - (lambda-code (if lambda-code - lambda-code - (format nil - "[](const auto &reader) { ~A val; ~ALoad(&val, reader); return val; }" - cpp-type namespace)))) - (lambda (reader member capnp-name) - (declare (ignore capnp-name)) - #>cpp - ${member} = utils::LoadOptional<${capnp-type}, ${cpp-type}>(${reader}, ${lambda-code}); - cpp<#))) - -(defun capnp-save-vector (capnp-type cpp-type &optional lambda-code) - "Generate the C++ code calling utils::SaveVector. CAPNP-TYPE and CPP-TYPE -are passed as template parameters, while LAMBDA-CODE is used to save each -element." - (declare (type string capnp-type cpp-type) - (type (or null string) lambda-code)) - ;; TODO: Why not use our `capnp-save-default' for this? - ;; TODO: namespace doesn't work for enums nested in classes - (let* ((namespace (cpp-type-namespace-string (parse-cpp-type-declaration cpp-type))) - (lambda-code (if lambda-code - lambda-code - (format nil - "[](auto *builder, const auto &val) { ~ASave(val, builder); }" - namespace)))) - (lambda (builder member-name capnp-name) - (declare (ignore capnp-name)) - #>cpp - utils::SaveVector<${capnp-type}, ${cpp-type}>(${member-name}, &${builder}, ${lambda-code}); - cpp<#))) - -(defun capnp-load-vector (capnp-type cpp-type &optional lambda-code) - "Generate the C++ code calling utils::LoadVector. CAPNP-TYPE and CPP-TYPE -are passed as template parameters, while LAMBDA-CODE is used to load each -element." - (declare (type string capnp-type cpp-type) - (type (or null string) lambda-code)) - (let* ((namespace (cpp-type-namespace-string (parse-cpp-type-declaration cpp-type))) - (lambda-code (if lambda-code - lambda-code - (format nil - "[](const auto &reader) { ~A val; ~ALoad(&val, reader); return val; }" - cpp-type namespace)))) - (lambda (reader member-name capnp-name) - (declare (ignore capnp-name)) - #>cpp - utils::LoadVector<${capnp-type}, ${cpp-type}>(&${member-name}, ${reader}, ${lambda-code}); - cpp<#))) - -(defun capnp-save-enum (capnp-type cpp-type enum-values) - "Generate C++ code for saving the enum specified by CPP-TYPE by converting -ENUM-VALUES to CAPNP-TYPE. This function should only be used for saving enums -which aren't defined in LCP." - (check-type capnp-type string) - (check-type cpp-type (or symbol string)) - (check-type enum-values list) - (lambda (builder member capnp-name) - (let ((cases (mapcar (lambda (value-symbol) - (let ((value (cpp-enumerator-name value-symbol))) - #>cpp - case ${cpp-type}::${value}: - ${builder}->set${capnp-name}(${capnp-type}::${value}); - break; - cpp<#)) - enum-values))) - (format nil "switch (~A) {~%~{~A~%~}}" member (mapcar #'raw-cpp-string cases))))) - -(defun capnp-load-enum (capnp-type cpp-type enum-values) - "Generate C++ code for loading the enum specified by CPP-TYPE by converting -ENUM-VALUES from CAPNP-TYPE. This function should only be used for saving -enums which aren't defined in LCP." - (check-type capnp-type string) - (check-type cpp-type (or symbol string)) - (check-type enum-values list) - (lambda (reader member capnp-name) - (let ((cases (mapcar (lambda (value-symbol) - (let ((value (cpp-enumerator-name value-symbol))) - #>cpp - case ${capnp-type}::${value}: - ${member} = ${cpp-type}::${value}; - break; - cpp<#)) - enum-values))) - (format nil "switch (~A.get~A()) {~%~{~A~%~}}" - reader capnp-name (mapcar #'raw-cpp-string cases))))) (defvar *cpp-namespaces* nil "Stack of C++ namespaces we are generating the code in.") @@ -1367,7 +310,7 @@ enums which aren't defined in LCP." (:public ,(decl-type-info req-name) ,(def-constructor req-name (second request))) - (:serialize (:slk) (:capnp))) + (:serialize (:slk))) (let ((req-class (find-cpp-class ',req-sym))) (unless (lcp.slk::save-extra-args req-class) (push ,(progn @@ -1399,7 +342,7 @@ enums which aren't defined in LCP." (:public ,(decl-type-info res-name) ,(def-constructor res-name (second response))) - (:serialize (:slk) (:capnp))) + (:serialize (:slk))) (let ((res-class (find-cpp-class ',res-sym))) (unless (lcp.slk::save-extra-args res-class) (push ,(progn @@ -1454,50 +397,8 @@ formatted and output." (count-newlines in-stream :stop-position (1+ stream-pos)))))))) -(defun generate-capnp (cpp-types &key capnp-file capnp-id cpp-out lcp-file) - "Generate Cap'n Proto serialization code for given CPP-TYPES. The schema -is written to CAPNP-FILE using the CAPNP-ID. The C++ serialization code is -written to CPP-OUT stream. This source file will include the provided HPP-FILE. -Original LCP-FILE is used just to insert a comment about the source of the -code generation." - (with-open-file (out capnp-file :direction :output :if-exists :supersede) - (format out "~@{# ~A~%~}" +emacs-read-only+ +vim-read-only+) - (format out "# DO NOT EDIT! Generated using LCP from '~A'~2%" - (file-namestring lcp-file)) - (format out "~A;~2%" capnp-id) - (write-line "using Cxx = import \"/capnp/c++.capnp\";" out) - (format out "$Cxx.namespace(\"~A::capnp\");~2%" *capnp-namespace*) - (dolist (capnp-import *capnp-imports* (terpri out)) - (format out "using ~A = import ~S;~%" - (remove #\- (string-capitalize (car capnp-import))) - (cdr capnp-import))) - (dolist (cpp-type cpp-types) - ;; Generate schema only for top level classes, inner classes are handled - ;; inside the generation of the enclosing class. - (unless (cpp-type-enclosing-class cpp-type) - (let ((schema (capnp-schema cpp-type))) - (when schema (write-line schema out)))))) - ;; Now generate the save/load C++ code in the cpp file. - (write-line "// Autogenerated Cap'n Proto serialization code" cpp-out) - (write-line "#include \"rpc/serialization.hpp\"" cpp-out) - (with-namespaced-output (cpp-out open-namespace) - (dolist (cpp-type cpp-types) - (open-namespace (cpp-type-namespace cpp-type)) - (ctypecase cpp-type - (cpp-class - (format cpp-out "// Serialize code for ~A~2%" (cpp-type-name cpp-type)) - ;; Top level functions - (write-line (capnp-save-function-definition cpp-type) cpp-out) - (write-line (capnp-load-function-definition cpp-type) cpp-out)) - (cpp-enum - (write-line (cpp-enum-to-capnp-function-definition cpp-type) cpp-out) - (write-line (cpp-enum-from-capnp-function-definition cpp-type) cpp-out)))))) - -(defun process-file (lcp-file &key capnp-id slk-serialize) - "Process a LCP-FILE and write the output to .hpp file in the same directory. -If CAPNP-ID is passed, generates the Cap'n Proto schema to .capnp file in the -same directory, while the loading code is generated in LCP-FILE.cpp source -file." +(defun process-file (lcp-file &key slk-serialize) + "Process a LCP-FILE and write the output to .hpp file in the same directory." (multiple-value-bind (filename extension) (uiop:split-name-type lcp-file) (assert (string= (string-downcase extension) "lcp")) @@ -1505,12 +406,8 @@ file." ;; Unlike hpp, for cpp file use the full path. This allows us to ;; have our own accompanying .cpp files (cpp-file (concatenate 'string lcp-file ".cpp")) - (capnp-file (concatenate 'string filename ".capnp")) (serializep slk-serialize) ;; Reset globals - (*capnp-namespace* nil) - (*capnp-imports* nil) - (*capnp-type-converters* nil) (*cpp-inner-types* nil) (*cpp-impl*) ;; Don't reset *cpp-classes* if we want to have support for @@ -1530,27 +427,9 @@ file." (when *cpp-namespaces* (error "Unclosed namespaces: ~A" (reverse *cpp-namespaces*))) ;; Collect types for serialization - (let ((types-for-capnp (when (and serializep capnp-id) - (append (remove-if (complement #'cpp-class-capnp-opts) *cpp-classes*) - (remove-if (complement #'cpp-enum-serializep) *cpp-enums*)))) - (types-for-slk (when serializep + (let ((types-for-slk (when serializep (append (remove-if (complement #'cpp-class-slk-opts) *cpp-classes*) (remove-if (complement #'cpp-enum-serializep) *cpp-enums*))))) - (when types-for-capnp - ;; Append top-level declarations for Cap'n Proto serialization - (with-open-file (out hpp-file :direction :output :if-exists :append) - (terpri out) - (write-line "// Cap'n Proto serialization declarations" out) - (with-namespaced-output (out open-namespace) - (dolist (type-for-capnp types-for-capnp) - (open-namespace (cpp-type-namespace type-for-capnp)) - (ctypecase type-for-capnp - (cpp-class - (format out "~A;~%" (capnp-save-function-declaration type-for-capnp)) - (format out "~A;~%" (capnp-load-function-declaration type-for-capnp))) - (cpp-enum - (format out "~A;~%" (cpp-enum-to-capnp-function-declaration type-for-capnp)) - (format out "~A;~%" (cpp-enum-from-capnp-function-declaration type-for-capnp)))))))) (when types-for-slk ;; Append top-level declarations for SLK serialization (with-open-file (out hpp-file :direction :output :if-exists :append) @@ -1585,10 +464,6 @@ file." (destructuring-bind (namespaces . code) cpp (open-namespace namespaces) (write-line (cpp-code code) out)))) - ;; Generate Cap'n Proto serialization - (when types-for-capnp - (generate-capnp types-for-capnp :capnp-file capnp-file :capnp-id capnp-id - :cpp-out out :lcp-file lcp-file)) ;; Generate SLK serialization (when types-for-slk (write-line "// Autogenerated SLK serialization code" out) diff --git a/src/lisp/package.lisp b/src/lisp/package.lisp index a4d8f1575..542df571b 100644 --- a/src/lisp/package.lisp +++ b/src/lisp/package.lisp @@ -8,15 +8,6 @@ #:in-impl #:namespace #:pop-namespace - #:capnp-namespace - #:capnp-import - #:capnp-type-conversion - #:capnp-save-optional - #:capnp-load-optional - #:capnp-save-vector - #:capnp-load-vector - #:capnp-save-enum - #:capnp-load-enum #:process-file #:lcp-syntax)) diff --git a/src/lisp/types.lisp b/src/lisp/types.lisp index 718ebd80d..5f5260734 100644 --- a/src/lisp/types.lisp +++ b/src/lisp/types.lisp @@ -66,39 +66,12 @@ ;; If T, skips this member in serialization code generation. The member may ;; still be deserialized with custom load hook. (dont-save nil :type boolean :read-only t) - ;; CAPNP-TYPE may be a string specifying the type, or a list of - ;; (member-symbol "capnp-type") specifying a union type. - (capnp-type nil :type (or null string list) :read-only t) - (capnp-init t :type boolean :read-only t) - ;; Custom saving and loading code. May be a function which takes 2 - ;; args: (builder-or-reader member-name) and needs to return C++ code. - (capnp-save nil :type (or null function (eql :dont-save)) :read-only t) - (capnp-load nil :type (or null function) :read-only t) ;; May be a function which takes 1 argument, member-name. It needs to ;; return C++ code. (slk-save nil :type (or null function) :read-only t) (slk-load nil :type (or null function) :read-only t) (clone t :type (or boolean (eql :copy) function) :read-only t)) -(defstruct capnp-opts - "Cap'n Proto serialization options for C++ class." - ;; BASE is T if the class should be treated as a base class for capnp, even - ;; though it may have parents. - (base nil :type boolean :read-only t) - ;; Extra arguments to the generated save function. List of (name cpp-type). - (save-args nil :read-only t) - (load-args nil :read-only t) - ;; Function to be called after saving the instance. Lambda taking builder name as only argument. - (post-save nil :read-only t) - (construct nil :read-only t) - ;; Explicit instantiation of template to generate schema with enum. - (type-args nil :read-only t) - ;; In case of multiple inheritance, list of classes which should be handled - ;; as a composition. - (inherit-compose nil :read-only t) - ;; In case of multiple inheritance, pretend we only inherit the 1st base class. - (ignore-other-base-classes nil :type boolean :read-only t)) - (defstruct slk-opts "SLK serialization options for C++ class." ;; BASE is T if the class should be treated as a base class for SLK, even @@ -135,8 +108,6 @@ (public :initarg :public :initform nil :accessor cpp-class-public) (protected :initarg :protected :initform nil :reader cpp-class-protected) (private :initarg :private :initform nil :accessor cpp-class-private) - (capnp-opts :type (or null capnp-opts) :initarg :capnp-opts :initform nil - :reader cpp-class-capnp-opts) (slk-opts :type (or null slk-opts) :initarg :slk-opts :initform nil :reader cpp-class-slk-opts) (clone-opts :type (or null clone-opts) :initarg :clone-opts :initform nil @@ -471,26 +442,14 @@ slot-options are keyword arguments. Currently supported options are: * :reader -- if t, generates a public getter for the member. * :scope -- class scope of the member, either :public, :protected or :private (default). * :documentation -- Doxygen documentation of the member. - * :capnp-type -- String or list specifying which Cap'n Proto type to use for - serialization. If a list of (member-symbol \"capnp-type\") then a union - type is specified. - * :capnp-init -- Boolean indicating whether the member needs to be - initialized in Cap'n Proto structure, by calling `builder.init`. - This is T by default, you may need to set it to NIL if the LCP doesn't - correctly recognize a primitive type or you wish to call `init` - yourself. - * :capnp-save -- Custom code for serializing this member. - * :capnp-load -- Custom code for deserializing this member. Currently supported class-options are: * :documentation -- Doxygen documentation of the class. * :public -- additional C++ code in public scope. * :protected -- additional C++ code in protected scope. * :private -- additional C++ code in private scope. - * :serialize -- either (:capnp) or (:slk). Setting :capnp will generate - the Cap'n Proto serialization code for the class members. You may - specifiy additional options after :capnp to fill the `CAPNP-OPTS' slots. - Similarly, you may specify `SLK-OPTS' after :slk. + * :serialize -- only (:slk) is supported for now. You may specify additional + options additional options after :slk to fill the `SLK-OPTS' slots. * :abstractp -- if t, marks that this class cannot be instantiated (currently only useful in serialization code) @@ -499,7 +458,7 @@ Larger example: ;; (lcp:define-class derived (base) ;; ((val :int :reader t :initval 42)) ;; (:public #>cpp void set_val(int new_val) { val_ = new_val; } cpp<#) -;; (:serialize (:capnp))) +;; (:serialize (:slk))) Generates C++: @@ -543,8 +502,6 @@ Generates C++: :public (list ,@(cdr (assoc :public options))) :protected (list ,@(cdr (assoc :protected options))) :private (list ,@(cdr (assoc :private options))) - :capnp-opts ,(when (assoc :capnp serialize) - `(make-capnp-opts ,@(cdr (assoc :capnp serialize)))) :slk-opts ,(when (assoc :slk serialize) `(make-slk-opts ,@(cdr (assoc :slk serialize)))) :clone-opts ,(when (assoc :clone options)