Support looking for nested enums in LCP

Reviewers: mtomic, llugovic

Reviewed By: mtomic

Subscribers: pullbot

Differential Revision: https://phabricator.memgraph.io/D1686

src/lisp/lcp-test.lisp

@@ -69,7 +69,12 @@
                          :namespace '("std")
                          :type-args '("void(int, bool)"))
                        :double))
-                   :char))))
+                    :char)))
+
+    (parse-test "::my_namespace::EnclosingClass::Thing"
+                (lcp::make-cpp-type "Thing"
+                                    :namespace '("" "my_namespace")
+                                    :enclosing-class "EnclosingClass")))
 
   (subtest "printing"
     (decl-test "pair<T1, T2>"
@@ -90,7 +95,37 @@
     (decl-test "pair"
                (lcp::make-cpp-type
                 "pair" :type-params '("TIntegral1 TIntegral2"))
-               :type-params nil)))
+               :type-params nil))
+
+  (subtest "finding defined enums"
+    (let ((lcp::*cpp-classes* nil)
+          (lcp::*cpp-enums* nil))
+      (lcp:define-enum action (val1 val2))
+      (lcp:define-class enclosing-class ()
+        ()
+        (:public
+         (lcp:define-enum action (other-val1 other-val2))
+         (lcp:define-class another-enclosing ()
+           ()
+           (:public
+            (lcp:define-enum action (deep-val1 deep-val2))))))
+      (lcp:namespace my-namespace)
+      (lcp:define-enum action (third-val1 third-val2))
+      (lcp:pop-namespace)
+
+      (decl-test "Action" (lcp::find-cpp-enum "::Action"))
+      (decl-test "EnclosingClass::Action" (lcp::find-cpp-enum "EnclosingClass::Action"))
+      (decl-test "EnclosingClass::Action" (lcp::find-cpp-enum "::EnclosingClass::Action"))
+      (decl-test "EnclosingClass::AnotherEnclosing::Action"
+                 (lcp::find-cpp-enum "EnclosingClass::AnotherEnclosing::Action"))
+      (decl-test "my_namespace::Action" (lcp::find-cpp-enum "my_namespace::Action"))
+      (decl-test "my_namespace::Action" (lcp::find-cpp-enum "::my_namespace::Action"))
+      (ok (lcp::find-cpp-enum "Action"))
+      (ok (lcp::find-cpp-enum 'action))
+      (ok (not (lcp::find-cpp-enum "NonExistent")))
+      (ok (not (lcp::find-cpp-enum "")))
+      (ok (not (lcp::find-cpp-enum "my_namespace::NonExistent")))
+      (ok (not (lcp::find-cpp-enum "::NonExistent"))))))
 
 (deftest "unsupported"
   (subtest "cv-qualifiers"

src/lisp/lcp.lisp

@@ -75,7 +75,7 @@
               :documentation "A list of symbols or strings defining the full
               namespace. A single symbol may refer to a `CPP-CLASS' which
               encloses this type.")
-   (enclosing-class :type (or null symbol) :initarg :enclosing-class
+   (enclosing-class :type (or null symbol string) :initarg :enclosing-class
                     :initform nil :accessor cpp-type-enclosing-class
                     :documentation "A symbol that is a designator for the type
                     of the enclosing class of this type, or NIL if the type has
@@ -97,12 +97,20 @@
 
 (defun make-cpp-type (name &key namespace enclosing-class type-params type-args)
   "Create an instance of CPP-TYPE given the arguments."
+  (let ((namespace (if (and namespace
+                            (string= (string-trim +whitespace-chars+ (car namespace)) ""))
+                       (cdr namespace)
+                       namespace)))
+    (loop for ns in namespace
+       when (or (find-if (lambda (c) (member c +whitespace-chars+ :test #'char=)) ns)
+                (string= ns ""))
+       do (error "Invalid namespace name ~S in ~S" ns namespace))
     (make-instance 'cpp-type
                    :name name
                    :namespace namespace
                    :enclosing-class enclosing-class
                    :type-params type-params
-                 :type-args (mapcar #'cpp-type type-args)))
+                   :type-args (mapcar #'cpp-type type-args))))
 
 (defun cpp-type= (a b)
   (let ((a (cpp-type a))
@@ -113,8 +121,9 @@
              (equalp (cpp-type-name a) (cpp-type-name b))
              (and (= (length args1) (length args2))
                   (every #'cpp-type= args1 args2))
-             (eq (cpp-type-enclosing-class a)
+             (string=
-                 (cpp-type-enclosing-class b)))))))
+              (cpp-type-name (cpp-type-enclosing-class a))
+              (cpp-type-name (cpp-type-enclosing-class b))))))))
 
 (defmethod print-object ((cpp-type cpp-type) stream)
   (print-unreadable-object (cpp-type stream :type t)
@@ -208,8 +217,7 @@ produces:
   (let ((ptr-pos (position #\* type-decl :from-end t)))
     (when (and ptr-pos (not (cl-ppcre:scan "[()<>]" type-decl :start ptr-pos)))
       (return-from parse-cpp-type-declaration
-        (make-instance 'cpp-type
+        (make-cpp-type (subseq type-decl ptr-pos)
-                       :name (subseq type-decl ptr-pos)
                        :type-args (list (parse-cpp-type-declaration
                                          (subseq type-decl 0 ptr-pos)))))))
   ;; Other cases
@@ -235,11 +243,24 @@ produces:
                        (subseq template arg-start (1- match-end)))
                       type-args)
                 (setf arg-start (1+ match-end)))))))
-      (make-instance 'cpp-type
+      (let (namespace enclosing-class namespace-done-p)
-                     :ns (when (cdr namespace-split)
+        (when (cdr namespace-split)
-                           (butlast namespace-split))
+          (dolist (ns (butlast namespace-split))
-                     :name name
+            ;; Treat capitalized namespace as designating an enclosing class.
-                     :type-args (reverse type-args)))))
+            ;; Only the final enclosing class is taken, because we assume that
+            ;; we can get enclosing classes recursively via `FIND-CPP-CLASS'.
+            ;; This won't work if the classes are not defined in LCP.
+            (cond
+              ((and (string/= "" ns) (upper-case-p (aref ns 0)))
+               (setf namespace-done-p t)
+               (setf enclosing-class ns))
+              ((not namespace-done-p)
+               (push ns namespace))))
+          (setf namespace (reverse namespace)))
+        (make-cpp-type name
+                       :namespace namespace
+                       :enclosing-class enclosing-class
+                       :type-args (reverse type-args))))))
 
 (defun cpp-type-decl (cpp-type &key (type-params t) (namespace t))
   "Return the fully qualified name of given CPP-TYPE."
@@ -335,20 +356,20 @@ produces:
 ;; TODO: use CPP-TYPE, CPP-TYPE= and CPP-PRIMITIVE-TYPE-P in the rest of the
 ;; code
 (defun cpp-type (type-designator)
-  "Coerce the CPP-TYPE designator TYPE-DESIGNATOR into a CPP-TYPE instace.
+  "Coerce the CPP-TYPE designator TYPE-DESIGNATOR into a CPP-TYPE instance.
 
-- if TYPE-DESIGNATOR is an instance of CPP-TYPE, CPP-PRIMITIVE-TYPE or
+- If TYPE-DESIGNATOR is an instance of CPP-TYPE, CPP-PRIMITIVE-TYPE or
-  CPP-CLASS, just return it
+  CPP-CLASS, just return it.
 
-- if TYPE-DESIGNATOR is one of the keywords in +CPP-PRIMITIVE-TYPE-KEYOWRDS+,
+- If TYPE-DESIGNATOR is one of the keywords in +CPP-PRIMITIVE-TYPE-KEYWORDS+,
   return an instance of CPP-PRIMITIVE-TYPE with the name being the result
-  of (string-downcase type-designator)
+  of (string-downcase type-designator).
 
-- if TYPE-DESIGNATOR is any other symbol, return an instance of CPP-TYPE with
+- If TYPE-DESIGNATOR is any other symbol, return an instance of CPP-TYPE with
-  the name being the result of (remove #\- (string-capitalize type-designator))
+  the name being the result of (remove #\- (string-capitalize type-designator)).
 
-- if TYPE-DESIGNATOR is a string, return an instance of CPP-TYPE with the name
+- If TYPE-DESIGNATOR is a string, return an instance of CPP-TYPE with the name
-  being that string"
+  being that string."
   (etypecase type-designator
     ((or cpp-type cpp-primitive-type cpp-class)
      type-designator)
@@ -377,7 +398,8 @@ produces:
   "Find CPP-ENUM in *CPP-ENUMS* by CPP-ENUM-NAME"
   (declare (type (or symbol string) cpp-enum-name))
   (if (stringp cpp-enum-name)
-      (find cpp-enum-name *cpp-enums* :key #'cpp-type-name :test #'string=)
+      (or (find (parse-cpp-type-declaration cpp-enum-name) *cpp-enums* :test #'cpp-type=)
+          (find cpp-enum-name *cpp-enums* :key #'cpp-type-name :test #'string=))
       (find cpp-enum-name *cpp-enums* :key #'cpp-type-base-name)))
 
 (defun direct-subclasses-of (cpp-class)
@@ -953,19 +975,23 @@ encoded as union inheritance in Cap'n Proto."
              namespace '("capnp")))
       (t ;; Just append capnp as final namespace
        (setf namespace (append namespace '("capnp")))))
-    (make-instance 'cpp-type
+    (make-cpp-type name :namespace namespace
-                   :name name :namespace namespace
                    :enclosing-class (cpp-type-enclosing-class cpp-type))))
 
-(defun capnp-save-default (member-name member-type member-builder capnp-name)
+(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 (find-cpp-enum member-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
        (funcall
@@ -1041,7 +1067,8 @@ Proto schema."
                            (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)
+                                                   member-builder capnp-name
+                                                   :cpp-class cpp-class)
                                s))))))))))
 
 (defun capnp-save-function-code (cpp-class)
@@ -1191,14 +1218,18 @@ Proto schema."
      :returns "void"
      :type-params (cpp-type-type-params cpp-class))))
 
-(defun capnp-load-default (member-name member-type member-reader capnp-name)
+(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 (find-cpp-enum member-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
        (funcall
@@ -1268,7 +1299,8 @@ example, INSTANCE-ACCESS could be `my_struct->`"
                                               member-reader member-access capnp-name)))
                    (write-line (capnp-load-default member-access
                                                    (cpp-member-type member)
-                                                   member-reader capnp-name) s))))))))))
+                                                   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."