diff --git a/src/lisp/lcp.lisp b/src/lisp/lcp.lisp index 1ce67caed..85f8d4a13 100644 --- a/src/lisp/lcp.lisp +++ b/src/lisp/lcp.lisp @@ -158,16 +158,25 @@ NIL, returns a string." (in-impl typeinfo-def))))))) (defun cpp-function-declaration (name &key args (returns "void") type-params) - "Generate a C++ top level function declaration named NAME as a string. ARGS -is a list of (variable type) function arguments. RETURNS is the return type of -the function. TYPE-PARAMS is a list of names for template argments" + "Generate, as a string, a top level C++ function declaration for the +function (or function template) named by NAME. + +NAME is a namestring for a function. + +ARGS is a list of (NAME TYPE) pairs representing the function's arguments, where +NAME is a namestring for a variable and TYPE is a CPP-TYPE. + +RETURNS is a typestring for the return type of the function. + +TYPE-PARAMS is a list of strings naming the template type parameters if NAME +names a function template rather than a function." (check-type name string) (check-type returns string) (let ((template (if type-params (cpp-template type-params) "")) (args (format nil "~:{~A ~A~:^, ~}" (mapcar (lambda (name-and-type) - (list (ensure-typestring (second name-and-type)) - (ensure-namestring-for-variable (first name-and-type)))) + (list (cpp-type-decl (second name-and-type)) + (first name-and-type))) args)))) (raw-cpp-string #>cpp @@ -178,11 +187,19 @@ the function. TYPE-PARAMS is a list of names for template argments" (defun cpp-method-declaration (class method-name &key args (returns "void") (inline t) static virtual const override delete) - "Generate a C++ method declaration as a string for the given METHOD-NAME on -CLASS. ARGS is a list of (variable type) arguments to method. RETURNS is the -return type of the function. When INLINE is set to NIL, generates a -declaration to be used outside of class definition. Remaining keys are flags -which generate the corresponding C++ keywords." + "Generate, as a string, a C++ method declaration for the method named by +METHOD-NAME of the C++ class CLASS. + +ARGS is a list of (NAME TYPE) pairs representing the method's arguments, where +NAME is a variable namestring and TYPE is a CPP-TYPE. + +RETURNS is a typestring for the return type of the method. + +If INLINE is T, a declaration appropriate for inclusion into the body of a class +declaration is generated. Otherwise, a top level declaration is generated. + +If VIRTUAL, CONST, OVERRIDE or DELETE is T, the corresponding C++ keyword is +included in the method declaration." (check-type class cpp-class) (check-type method-name string) (let* ((type-params (cpp-type-type-params class)) @@ -196,8 +213,8 @@ which generate the corresponding C++ keywords." class :namespacep nil)))) (args (format nil "~:{~A ~A~:^, ~}" (mapcar (lambda (name-and-type) - (list (ensure-typestring (second name-and-type)) - (ensure-namestring-for-variable (first name-and-type)))) + (list (cpp-type-decl (second name-and-type)) + (first name-and-type))) args))) (const (if const "const" "")) (override (if (and override inline) "override" "")) diff --git a/src/lisp/slk.lisp b/src/lisp/slk.lisp index 216980c31..bd0f1d026 100644 --- a/src/lisp/slk.lisp +++ b/src/lisp/slk.lisp @@ -55,10 +55,10 @@ generation expects the declarations and definitions to be in `slk` namespace." (when (> (length (cpp-class-super-classes-for-slk cpp-class)) 1) (slk-error "Don't know how to save multiple parents of '~A'" (lcp::cpp-type-name cpp-class))) - (let ((self-arg - (list 'self (format nil "const ~A &" - (lcp::cpp-type-decl cpp-class)))) - (builder-arg (list 'builder "slk::Builder *"))) + (let ((self-arg (list (lcp::ensure-namestring-for-variable 'self) + (lcp::cpp-type-wrap cpp-class '("const" "&")))) + (builder-arg (list (lcp::ensure-namestring-for-variable 'builder) + (lcp::ensure-cpp-type "slk::Builder *")))) (lcp::cpp-function-declaration "Save" :args (list* self-arg builder-arg (save-extra-args cpp-class)) :type-params (lcp::cpp-type-type-params cpp-class)))) @@ -75,10 +75,10 @@ namespace." (when (> (length (cpp-class-super-classes-for-slk cpp-class)) 1) (slk-error "Don't know how to load multiple parents of '~A'" (lcp::cpp-type-name cpp-class))) - (let ((self-arg - (list 'self (format nil "std::unique_ptr<~A> *" - (lcp::cpp-type-decl cpp-class)))) - (reader-arg (list 'reader "slk::Reader *"))) + (let ((self-arg (list (lcp::ensure-namestring-for-variable 'self) + (lcp::cpp-type-wrap cpp-class '("std::unique_ptr" "*")))) + (reader-arg (list (lcp::ensure-namestring-for-variable 'reader) + (lcp::ensure-cpp-type "slk::Reader *")))) (lcp::cpp-function-declaration "ConstructAndLoad" :args (list* self-arg reader-arg (load-extra-args cpp-class)) @@ -94,9 +94,10 @@ generation expects the declarations and definitions to be in `slk` namespace." (when (> (length (cpp-class-super-classes-for-slk cpp-class)) 1) (slk-error "Don't know how to load multiple parents of '~A'" (lcp::cpp-type-name cpp-class))) - (let ((self-arg - (list 'self (format nil "~A *" (lcp::cpp-type-decl cpp-class)))) - (reader-arg (list 'reader "slk::Reader *"))) + (let ((self-arg (list (lcp::ensure-namestring-for-variable 'self) + (lcp::cpp-type-wrap cpp-class '("*")))) + (reader-arg (list (lcp::ensure-namestring-for-variable 'reader) + (lcp::ensure-cpp-type "slk::Reader *")))) (lcp::cpp-function-declaration "Load" :args (list* self-arg reader-arg (load-extra-args cpp-class)) :type-params (lcp::cpp-type-type-params cpp-class)))) @@ -217,9 +218,7 @@ CPP-CLASS. Raise `SLK-ERROR' if a derived class has template parameters." (lcp::cpp-type-name subclass))) (let ((derived-class (lcp::cpp-type-decl subclass)) (derived-var (lcp::cpp-name-for-variable (lcp::cpp-type-name subclass))) - (extra-args (mapcar (lambda (name-and-type) - (lcp::cpp-name-for-variable (first name-and-type))) - (save-extra-args cpp-class)))) + (extra-args (mapcar #'first (save-extra-args cpp-class)))) (format s "if (const auto *~A_derived = utils::Downcast(&self)) { return slk::Save(*~A_derived, builder~{, ~A~}); }~%" derived-var derived-class derived-var extra-args)))))) @@ -276,9 +275,7 @@ constructs, mostly related to templates." (dolist (concrete-class concrete-classes) (let ((type-decl (lcp::cpp-type-decl concrete-class)) (var-name (lcp::cpp-name-for-variable (lcp::cpp-type-name concrete-class))) - (extra-args (mapcar (lambda (name-and-type) - (lcp::cpp-name-for-variable (first name-and-type))) - (load-extra-args cpp-class)))) + (extra-args (mapcar #'first (load-extra-args cpp-class)))) (lcp::with-cpp-block-output (s :name (format nil "if (~A::kType.id == type_id)" type-decl)) (format s "auto ~A_instance = std::make_unique<~A>();~%" var-name type-decl) @@ -341,9 +338,10 @@ namespace." "Generate SLK save function declaration for CPP-ENUM. Note that the code generation expects the declarations and definitions to be in `slk` namespace." (check-type cpp-enum lcp::cpp-enum) - (let ((self-arg - (list 'self (format nil "const ~A &" (lcp::cpp-type-decl cpp-enum)))) - (builder-arg (list 'builder "slk::Builder *"))) + (let ((self-arg (list (lcp::ensure-namestring-for-variable 'self) + (lcp::cpp-type-wrap cpp-enum '("const" "&")))) + (builder-arg (list (lcp::ensure-namestring-for-variable 'builder) + (lcp::ensure-cpp-type "slk::Builder *")))) (lcp::cpp-function-declaration "Save" :args (list self-arg builder-arg)))) (defun save-function-code-for-enum (cpp-enum) @@ -371,9 +369,10 @@ declarations and definitions to be in `slk` namespace." "Generate SLK load function declaration for CPP-ENUM. Note that the code generation expects the declarations and definitions to be in `slk` namespace." (check-type cpp-enum lcp::cpp-enum) - (let ((self-arg - (list 'self (format nil "~A *" (lcp::cpp-type-decl cpp-enum)))) - (reader-arg (list 'reader "slk::Reader *"))) + (let ((self-arg (list (lcp::ensure-namestring-for-variable 'self) + (lcp::cpp-type-wrap cpp-enum '("*")))) + (reader-arg (list (lcp::ensure-namestring-for-variable 'reader) + (lcp::ensure-cpp-type "slk::Reader *")))) (lcp::cpp-function-declaration "Load" :args (list self-arg reader-arg)))) (defun load-function-code-for-enum (cpp-enum) diff --git a/src/lisp/types.lisp b/src/lisp/types.lisp index c13b44da8..f53637bf1 100644 --- a/src/lisp/types.lisp +++ b/src/lisp/types.lisp @@ -225,8 +225,8 @@ parse (doesn't support).")) ;; 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) + (save-args nil) + (load-args nil) ;; In case of multiple inheritance, pretend we only inherit the 1st base ;; class. (ignore-other-base-classes nil :type boolean :read-only t)) @@ -234,7 +234,7 @@ parse (doesn't support).")) (defstruct clone-opts "Cloning options for C++ class." ;; Extra arguments to the generated clone function. List of (name cpp-type). - (args nil :read-only t) + (args nil) (return-type nil :type (or null function) :read-only t) (base nil :read-only t) (ignore-other-base-classes nil :read-only t) @@ -277,12 +277,12 @@ parse (doesn't support).")) :type (or null slk-opts) :initarg :slk-opts :initform nil - :reader cpp-class-slk-opts) + :reader %cpp-class-slk-opts) (clone-opts :type (or null clone-opts) :initarg :clone-opts :initform nil - :reader cpp-class-clone-opts) + :reader %cpp-class-clone-opts) (type-info-opts :type type-info-opts :initarg :type-info-opts @@ -320,7 +320,11 @@ arguments." (apply #'cpp-type-decl cpp-type kwargs))) (with-output-to-string (s) (cond - ;; Handle pointers and references specially. + ;; Handle const. + ((cpp-type-const-p cpp-type) + (format s "~A " (cpp-type-name cpp-type)) + (write-string (rec (car (cpp-type-type-args cpp-type))) s)) + ;; Handle pointers and references. ((or (cpp-type-raw-pointer-p cpp-type) (cpp-type-reference-p cpp-type)) (write-string (rec (car (cpp-type-type-args cpp-type))) s) @@ -827,6 +831,11 @@ not an instance of UNSUPPORTED-CPP-TYPE)." (check-type cpp-type cpp-type) (string= (cpp-type-name cpp-type) "&")) +(defun cpp-type-const-p (cpp-type) + "Test whether CPP-TYPE represents a constant type." + (check-type cpp-type cpp-type) + (string= (cpp-type-name cpp-type) "const")) + (defun cpp-type-smart-pointer-p (cpp-type) "Test whether CPP-TYPE represents a smart pointer type." (check-type cpp-type cpp-type) @@ -961,6 +970,37 @@ C++ class CPP-CLASS." (cpp-member-type member) cpp-class))))) (%cpp-class-members cpp-class))) +(defmethod cpp-class-slk-opts (cpp-class) + (alexandria:when-let ((opts (%cpp-class-slk-opts cpp-class))) + (let ((opts (copy-slk-opts opts))) + (prog1 opts + (setf (slk-opts-save-args opts) + (mapcar + (lambda (arg) + (destructuring-bind (namestring typestring) arg + (list namestring (resolve-typestring-for-member + typestring cpp-class)))) + (slk-opts-save-args opts))) + (setf (slk-opts-load-args opts) + (mapcar + (lambda (arg) + (destructuring-bind (namestring typestring) arg + (list namestring (resolve-typestring-for-member + typestring cpp-class)))) + (slk-opts-load-args opts))))))) + +(defmethod cpp-class-clone-opts (cpp-class) + (alexandria:when-let ((opts (%cpp-class-clone-opts cpp-class))) + (let ((opts (copy-clone-opts opts))) + (prog1 opts + (setf (clone-opts-args opts) + (mapcar + (lambda (arg) + (destructuring-bind (namestring typestring) arg + (list namestring (resolve-typestring-for-member + typestring cpp-class)))) + (clone-opts-args opts))))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Type utilities @@ -1018,6 +1058,14 @@ is included." (check-type cpp-class cpp-class) (remove-if #'cpp-member-dont-save (cpp-class-members cpp-class))) +(defun cpp-type-wrap (cpp-type class-templates) + (check-type cpp-type lcp::cpp-type) + (reduce (lambda (cpp-type class-template) + (lcp::make-cpp-type + (lcp::ensure-namestring-for-class class-template) + :type-args (list cpp-type))) + class-templates :initial-value cpp-type)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Macros @@ -1118,6 +1166,34 @@ Each ENUM-OPTION is of the type (KEY VALUE). The possible values of KEY are: :scope ',scope ,@kwargs)))) +(defun ensure-arg-list (args) + (mapcar (lambda (arg) + (destructuring-bind (namestring typestring) arg + (list (ensure-namestring-for-variable namestring) + (process-typestring (ensure-typestring typestring))))) + args)) + +(defun generate-slk-opts (opts) + (destructuring-bind (&rest kwargs &key save-args load-args + &allow-other-keys) + opts + (let ((save-args (and save-args `(:save-args (ensure-arg-list ,save-args)))) + (load-args (and load-args `(:load-args (ensure-arg-list ,load-args))))) + `(make-slk-opts ,@save-args + ,@load-args + ,@(alexandria:remove-from-plist + kwargs + (and save-args :save-args) + (and load-args :load-args)))))) + +(defun generate-clone-opts (opts) + (destructuring-bind (&rest kwargs &key args &allow-other-keys) + opts + (let ((args (and args `(:args (ensure-arg-list ,args))))) + `(make-clone-opts ,@args + ,@(alexandria:remove-from-plist + kwargs (and args :args)))))) + (defun generate-define-class (name super-classes slots options) "Generate the expansion for DEFINE-CLASS." (let* ((name (alexandria:ensure-list name)) @@ -1148,8 +1224,8 @@ Each ENUM-OPTION is of the type (KEY VALUE). The possible values of KEY are: ((public `(list ,@public)) (protected `(list ,@protected)) (private `(list ,@private)) - (slk (and slk `(make-slk-opts ,@(cdr slk)))) - (clone (and clone `(make-clone-opts ,@(cdr clone)))) + (slk (and slk (generate-slk-opts (cdr slk)))) + (clone (and clone (generate-clone-opts (cdr clone)))) (type-info `(make-type-info-opts ,@type-info))) `(make-instance 'cpp-class