diff --git a/src/lisp/code-gen.lisp b/src/lisp/code-gen.lisp index abf955484..07931c909 100644 --- a/src/lisp/code-gen.lisp +++ b/src/lisp/code-gen.lisp @@ -17,3 +17,28 @@ prepend the starting block with a name, for example \"class MyClass\"." see `CALL-WITH-CPP-BLOCK-OUTPUT' documentation." (declare (ignorable semicolonp name)) `(call-with-cpp-block-output ,out (lambda () ,@body) ,@rest)) + +(defun cpp-documentation (documentation) + "Convert DOCUMENTATION to Doxygen style string." + (declare (type string documentation)) + (format nil "/// ~A" + (cl-ppcre:regex-replace-all + (string #\Newline) documentation (format nil "~%/// ")))) + +(defun cpp-variable-name (symbol) + "Get C++ style name of SYMBOL as a string." + (declare (type (or string symbol) symbol)) + (cl-ppcre:regex-replace-all "-" (string-downcase symbol) "_")) + +(defun cpp-enumerator-name (symbol) + "Get C++ style enumerator name of SYMBOL as a string. This is like +`CPP-VARIABLE-NAME' but upcased." + (declare (type (or string symbol) symbol)) + (cl-ppcre:regex-replace-all "-" (string-upcase symbol) "_")) + +(defun cpp-member-name (cpp-member &key struct) + "Get C++ style name of the `CPP-MEMBER' as a string." + (declare (type cpp-member cpp-member) + (type boolean struct)) + (let ((cpp-name (cpp-variable-name (cpp-member-symbol cpp-member)))) + (if struct cpp-name (format nil "~A_" cpp-name)))) diff --git a/src/lisp/lcp-test.lisp b/src/lisp/lcp-test.lisp index ffa182f35..8f591ce88 100644 --- a/src/lisp/lcp-test.lisp +++ b/src/lisp/lcp-test.lisp @@ -171,6 +171,13 @@ ())) "void Save(const Derived &self, slk::Builder *builder)") (undefine-cpp-types) + (let ((my-enum (lcp:define-enum my-enum + (first-value second-value)))) + (is-generated (lcp.slk:save-function-declaration-for-enum my-enum) + "void Save(const MyEnum &self, slk::Builder *builder)") + (is-generated (lcp.slk:load-function-declaration-for-enum my-enum) + "void Load(MyEnum *self, slk::Reader *reader)")) + (undefine-cpp-types) (is-error (lcp.slk:save-function-declaration-for-class (lcp:define-class derived (fst-base snd-base) ())) @@ -212,6 +219,19 @@ "void Save(const TestStruct &self, slk::Builder *builder) { self.custom_member.CustomSave(builder); }") + (undefine-cpp-types) + (is-generated (lcp.slk:save-function-definition-for-enum + (lcp:define-enum test-enum + (first-value second-value))) + "void Save(const TestEnum &self, slk::Builder *builder) { + uint8_t enum_value; + switch (self) { + case TestEnum::FIRST_VALUE: enum_value = 0; break; + case TestEnum::SECOND_VALUE: enum_value = 1; break; + } + slk::Save(enum_value, builder); + }") + (undefine-cpp-types) (subtest "inheritance" (undefine-cpp-types) @@ -273,18 +293,33 @@ (is-error (lcp.slk:save-function-definition-for-class base-class) 'lcp.slk:slk-error) (is-error (lcp.slk:save-function-definition-for-class derived-templated-class) - 'lcp.slk:slk-error))) + 'lcp.slk:slk-error)))) - (subtest "non-public members" - (undefine-cpp-types) - (is-error (lcp.slk:save-function-definition-for-class - (lcp:define-class test-class () - ((public-member :bool :scope :public) - (private-member :int64_t)))) - 'lcp.slk:slk-error) - (undefine-cpp-types) - (is-error (lcp.slk:save-function-definition-for-class - (lcp:define-struct test-struct () - ((protected-member :int64_t :scope :protected) - (public-member :char)))) - 'lcp.slk:slk-error)))) + (subtest "load definitions" + (undefine-cpp-types) + (is-generated (lcp.slk:load-function-definition-for-enum + (lcp:define-enum my-enum + (first-value second-value))) + "void Load(MyEnum *self, slk::Reader *reader) { + uint8_t enum_value; + slk::Load(&enum_value, reader); + switch (enum_value) { + case static_cast(0): *self = MyEnum::FIRST_VALUE; break; + case static_cast(1): *self = MyEnum::SECOND_VALUE; break; + default: LOG(FATAL) << \"Trying to load unknown enum value!\"; + } + }")) + + (subtest "non-public members" + (undefine-cpp-types) + (is-error (lcp.slk:save-function-definition-for-class + (lcp:define-class test-class () + ((public-member :bool :scope :public) + (private-member :int64_t)))) + 'lcp.slk:slk-error) + (undefine-cpp-types) + (is-error (lcp.slk:save-function-definition-for-class + (lcp:define-struct test-struct () + ((protected-member :int64_t :scope :protected) + (public-member :char)))) + 'lcp.slk:slk-error))) diff --git a/src/lisp/lcp.lisp b/src/lisp/lcp.lisp index 63473f502..236920ec9 100644 --- a/src/lisp/lcp.lisp +++ b/src/lisp/lcp.lisp @@ -25,31 +25,6 @@ See https://en.wikipedia.org/wiki/Fowler_Noll_Vo_hash." ))) hash)) -(defun cpp-documentation (documentation) - "Convert DOCUMENTATION to Doxygen style string." - (declare (type string documentation)) - (format nil "/// ~A" - (cl-ppcre:regex-replace-all - (string #\Newline) documentation (format nil "~%/// ")))) - -(defun cpp-variable-name (symbol) - "Get C++ style name of SYMBOL as a string." - (declare (type (or string symbol) symbol)) - (cl-ppcre:regex-replace-all "-" (string-downcase symbol) "_")) - -(defun cpp-constant-name (symbol) - "Get C++ style constant name of SYMBOL as a string. This is like -`CPP-VARIABLE-NAME' but upcased." - (declare (type (or string symbol) symbol)) - (cl-ppcre:regex-replace-all "-" (string-upcase symbol) "_")) - -(defun cpp-member-name (cpp-member &key struct) - "Get C++ style name of the `CPP-MEMBER' as a string." - (declare (type cpp-member cpp-member) - (type boolean struct)) - (let ((cpp-name (cpp-variable-name (cpp-member-symbol cpp-member)))) - (if struct cpp-name (format nil "~A_" cpp-name)))) - (defun cpp-enum-definition (cpp-enum) "Get C++ style `CPP-ENUM' definition as a string." (declare (type cpp-enum cpp-enum)) @@ -58,7 +33,7 @@ See https://en.wikipedia.org/wiki/Fowler_Noll_Vo_hash." (write-line (cpp-documentation (cpp-type-documentation cpp-enum)) s)) (with-cpp-block-output (s :name (format nil "enum class ~A" (cpp-type-name cpp-enum)) :semicolonp t) - (format s "~{ ~A~^,~%~}~%" (mapcar #'cpp-constant-name (cpp-enum-values cpp-enum)))))) + (format s "~{ ~A~^,~%~}~%" (mapcar #'cpp-enumerator-name (cpp-enum-values cpp-enum)))))) (defun cpp-member-declaration (cpp-member &key struct) "Get C++ style `CPP-MEMBER' declaration as a string." @@ -1116,7 +1091,7 @@ example, INSTANCE-ACCESS could be `my_struct->`" (dolist (subclass (capnp-union-subclasses cpp-class)) (format s " case capnp::~A::~A: " (cpp-type-name cpp-class) - (cpp-constant-name (cpp-type-base-name subclass))) + (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) @@ -1132,7 +1107,7 @@ example, INSTANCE-ACCESS could be `my_struct->`" (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-constant-name type-arg)) + (cpp-type-name subclass) (cpp-enumerator-name type-arg)) (load-derived (format nil "~A<~A>" (cpp-type-name subclass) (cpp-type-name type-arg)))))) @@ -1143,7 +1118,7 @@ example, INSTANCE-ACCESS could be `my_struct->`" ;; 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-constant-name (cpp-type-base-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))))) @@ -1262,7 +1237,7 @@ which aren't defined in LCP." (check-type enum-values list) (lambda (builder member capnp-name) (let ((cases (mapcar (lambda (value-symbol) - (let ((value (cl-ppcre:regex-replace-all "-" (string value-symbol) "_"))) + (let ((value (cpp-enumerator-name value-symbol))) #>cpp case ${cpp-type}::${value}: ${builder}->set${capnp-name}(${capnp-type}::${value}); @@ -1280,7 +1255,7 @@ enums which aren't defined in LCP." (check-type enum-values list) (lambda (reader member capnp-name) (let ((cases (mapcar (lambda (value-symbol) - (let ((value (cl-ppcre:regex-replace-all "-" (string value-symbol) "_"))) + (let ((value (cpp-enumerator-name value-symbol))) #>cpp case ${capnp-type}::${value}: ${member} = ${cpp-type}::${value}; diff --git a/src/lisp/package.lisp b/src/lisp/package.lisp index 39e5896bb..935fce0d8 100644 --- a/src/lisp/package.lisp +++ b/src/lisp/package.lisp @@ -21,6 +21,10 @@ (defpackage #:lcp.slk (:use #:cl) - (:export #:save-function-declaration-for-class + (:export #:slk-error + #:save-function-declaration-for-class #:save-function-definition-for-class - #:slk-error)) + #:save-function-declaration-for-enum + #:save-function-definition-for-enum + #:load-function-declaration-for-enum + #:load-function-definition-for-enum)) diff --git a/src/lisp/slk.lisp b/src/lisp/slk.lisp index f60cb327d..6969b8bac 100644 --- a/src/lisp/slk.lisp +++ b/src/lisp/slk.lisp @@ -121,3 +121,64 @@ generation expects the declarations and definitions to be in `slk` namespace." (lcp::with-cpp-block-output (cpp-out :name (save-function-declaration-for-class cpp-class)) (write-line (save-function-code-for-class cpp-class) cpp-out)))) + +(defun save-function-declaration-for-enum (cpp-enum) + "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 *"))) + (lcp::cpp-function-declaration "Save" :args (list self-arg builder-arg)))) + +(defun save-function-code-for-enum (cpp-enum) + (with-output-to-string (s) + (write-line "uint8_t enum_value;" s) + (lcp::with-cpp-block-output (s :name "switch (self)") + (loop for enum-value in (lcp::cpp-enum-values cpp-enum) + and enum-ix from 0 do + (format s "case ~A::~A: enum_value = ~A; break;" + (lcp::cpp-type-decl cpp-enum) + (lcp::cpp-enumerator-name enum-value) + enum-ix))) + (write-line "slk::Save(enum_value, builder);" s))) + +(defun save-function-definition-for-enum (cpp-enum) + "Generate SLK save function. Note that the code generation expects the +declarations and definitions to be in `slk` namespace." + (check-type cpp-enum lcp::cpp-enum) + (with-output-to-string (cpp-out) + (lcp::with-cpp-block-output + (cpp-out :name (save-function-declaration-for-enum cpp-enum)) + (write-line (save-function-code-for-enum cpp-enum) cpp-out)))) + +(defun load-function-declaration-for-enum (cpp-enum) + "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 *"))) + (lcp::cpp-function-declaration "Load" :args (list self-arg reader-arg)))) + +(defun load-function-code-for-enum (cpp-enum) + (with-output-to-string (s) + (write-line "uint8_t enum_value;" s) + (write-line "slk::Load(&enum_value, reader);" s) + (lcp::with-cpp-block-output (s :name "switch (enum_value)") + (loop for enum-value in (lcp::cpp-enum-values cpp-enum) + and enum-ix from 0 do + (format s "case static_cast(~A): *self = ~A::~A; break;" + enum-ix + (lcp::cpp-type-decl cpp-enum) + (lcp::cpp-enumerator-name enum-value))) + (write-line "default: LOG(FATAL) << \"Trying to load unknown enum value!\";" s)))) + +(defun load-function-definition-for-enum (cpp-enum) + "Generate SLK save function. Note that the code generation expects the +declarations and definitions to be in `slk` namespace." + (check-type cpp-enum lcp::cpp-enum) + (with-output-to-string (cpp-out) + (lcp::with-cpp-block-output + (cpp-out :name (load-function-declaration-for-enum cpp-enum)) + (write-line (load-function-code-for-enum cpp-enum) cpp-out))))