feat typereg: store whether a typedef is unboxed

src/typereg/ppx/imandrakit_typereg_ppx.ml

@@ -16,6 +16,9 @@ let attr_name =
     Ast_pattern.(single_expr_payload (estring __))
     (fun x -> x)
 
+let has_attr_unboxed (ty : type_declaration) : bool =
+  List.exists (fun a -> a.attr_name.txt = "unboxed") ty.ptype_attributes
+
 let rec lid_to_str (lid : Longident.t) : string =
   match lid with
   | Longident.Lident s -> s
@@ -155,6 +158,7 @@ let tyreg_of_tydecl (d : type_declaration) : expression =
     | None -> d.ptype_name.txt
     | Some s -> s
   in
+  let unboxed = has_attr_unboxed d in
 
   [%expr
     let open Imandrakit_typereg in
@@ -163,6 +167,12 @@ let tyreg_of_tydecl (d : type_declaration) : expression =
       params = [%e params];
       name = [%e A.Exp.constant @@ A.Const.string name];
       decl = [%e decl];
+      unboxed =
+        [%e
+          if unboxed then
+            [%expr true]
+          else
+            [%expr false]];
     }]
 
 let generate_impl_ (_rec_flag, type_declarations) : structure_item list =

src/typereg/ty_def.ml

@@ -45,6 +45,7 @@ type t = {
   name: string;  (** Name of the type *)
   params: string list;  (** Type parameters *)
   decl: decl;
+  unboxed: bool;
 }
 [@@deriving show { with_path = false }, eq, yojson]
 

test/typereg/t1.expected

@@ -3,14 +3,14 @@ t1:
    decl =
    (Alias
       (Cstor ("array",
-         [(Cstor ("list", [(Cstor ("option", [(Cstor ("float", []))]))]))])))
-   }]
+         [(Cstor ("list", [(Cstor ("option", [(Cstor ("float", []))]))]))])));
+   unboxed = false }]
 [{ path = "Dune__exe__T1"; name = "bar"; params = [];
    decl =
    (Alias
       (Tuple
          [(Cstor ("foo", []));
-           (Cstor ("option", [(Cstor ("list", [(Cstor ("int", []))]))]))]))
-   }]
+           (Cstor ("option", [(Cstor ("list", [(Cstor ("int", []))]))]))]));
+   unboxed = false }]
 [{ path = "Dune__exe__T1"; name = "foo"; params = [];
-   decl = (Alias (Cstor ("int", []))) }]
+   decl = (Alias (Cstor ("int", []))); unboxed = false }]

test/typereg/t2.expected

@@ -13,13 +13,13 @@ t2:
                [(Tuple [(Cstor ("string", [])); (Cstor ("foo", []))])]))
             ];
           labels = (Some ["x"; "y"]) }
-        ])
-   }]
+        ]);
+   unboxed = false }]
 [{ path = "Dune__exe__T2"; name = "foo"; params = [];
    decl =
    (Record
       { fields =
         [("x", (Cstor ("int", [])));
           ("y", (Cstor ("option", [(Cstor ("float", []))])))]
-        })
-   }]
+        });
+   unboxed = false }]

test/typereg/t3.expected

@@ -1,5 +1,8 @@
 t3:
 [{ path = "Dune__exe__T3"; name = "A.t"; params = [];
-   decl = (Alias (Cstor ("int", []))) }]
+   decl = (Alias (Cstor ("int", []))); unboxed = false }]
 [{ path = "Dune__exe__T3"; name = "B.t"; params = [];
-   decl = (Alias (Cstor ("bool", []))) }]
+   decl = (Alias (Cstor ("bool", []))); unboxed = false }]
+[{ path = "Dune__exe__T3"; name = "u"; params = [];
+   decl = (Record { fields = [("x", (Cstor ("float", [])))] });
+   unboxed = true }]

test/typereg/t3.ml

@@ -10,6 +10,8 @@ module B = struct
   type t = bool [@@deriving typereg] [@@typereg.name "B.t"]
 end
 
+type u = { x: float } [@@unboxed] [@@deriving typereg]
+
 let () =
   print_endline "t3:";
   dump ()