outcometree: print [@unboxed] attributes

Author: gasche

testsuite/tests/tool-toplevel/printval.ml

@@ -68,7 +68,11 @@ type t =
   | Proxy of t
 ;;
 [%%expect {|
-type t = Int of int | Str of string | Pair of t * t | Proxy of t
+type t =
+    Int of int [@unboxed]
+  | Str of string [@unboxed]
+  | Pair of t * t
+  | Proxy of t
 |}];;
 
 Int 42;;

typing/oprint.ml

@@ -502,6 +502,7 @@ let constructor_of_extension_constructor
     ocstr_name = ext.oext_name;
     ocstr_args = ext.oext_args;
     ocstr_return_type = ext.oext_ret_type;
+    ocstr_unboxed = false;
   }
 
 let split_anon_functor_arguments params =
@@ -716,29 +717,38 @@ and print_out_constr ppf constr =
     ocstr_name = name;
     ocstr_args = tyl;
     ocstr_return_type = return_type;
+    ocstr_unboxed = unboxed;
   } = constr in
   let name =
     match name with
     | "::" -> "(::)"   (* #7200 *)
     | s -> s
   in
+  let pp_unboxed ppf = function
+    | false -> ()
+    | true -> fprintf ppf "@ [@unboxed]"
+  in
   match return_type with
   | None ->
       begin match tyl with
       | [] ->
           pp_print_string ppf name
       | _ ->
-          fprintf ppf "@[<2>%s of@ %a@]" name
+          fprintf ppf "@[<2>%s of@ %a%a@]" name
             (print_typlist print_simple_out_type " *") tyl
+            pp_unboxed unboxed
       end
   | Some ret_type ->
       begin match tyl with
       | [] ->
-          fprintf ppf "@[<2>%s :@ %a@]" name print_simple_out_type  ret_type
+          fprintf ppf "@[<2>%s :@ %a%a@]" name
+            print_simple_out_type ret_type
+            pp_unboxed unboxed
       | _ ->
-          fprintf ppf "@[<2>%s :@ %a -> %a@]" name
+          fprintf ppf "@[<2>%s :@ %a -> %a%a@]" name
             (print_typlist print_simple_out_type " *")
             tyl print_simple_out_type ret_type
+            pp_unboxed unboxed
       end
 
 and print_out_extension_constructor ppf ext =

typing/outcometree.mli

@@ -82,6 +82,7 @@ and out_constructor = {
   ocstr_name: string;
   ocstr_args: out_type list;
   ocstr_return_type: out_type option;
+  ocstr_unboxed: bool;
 }
 
 and out_variant =

typing/printtyp.ml

@@ -1420,11 +1420,13 @@ and tree_of_constructor_arguments = function
 and tree_of_constructor cd =
   let name = Ident.name cd.cd_id in
   let arg () = tree_of_constructor_arguments cd.cd_args in
+  let unboxed = Builtin_attributes.has_unboxed cd.cd_attributes in
   match cd.cd_res with
   | None -> {
       ocstr_name = name;
       ocstr_args = arg ();
       ocstr_return_type = None;
+      ocstr_unboxed = unboxed;
     }
   | Some res ->
       Names.with_local_names (fun () ->
@@ -1434,6 +1436,7 @@ and tree_of_constructor cd =
           ocstr_name = name;
           ocstr_args = args;
           ocstr_return_type = Some ret;
+          ocstr_unboxed = unboxed;
         })
 
 and tree_of_label l =
@@ -1523,6 +1526,7 @@ let extension_only_constructor id ppf ext =
       ocstr_name = name;
       ocstr_args = args;
       ocstr_return_type = ret;
+      ocstr_unboxed = false;
     }
 
 (* Print a value declaration *)