From 58260e3d11d566168e75fa1dd192882165181dc7 Mon Sep 17 00:00:00 2001
From: Gabriel Scherer <gabriel.scherer@gmail.com>
Date: Tue, 14 Sep 2021 21:37:33 +0200
Subject: [PATCH] outcometree: print [@unboxed] attributes

---
 testsuite/tests/tool-toplevel/printval.ml |  6 +++++-
 typing/oprint.ml                          | 16 +++++++++++++---
 typing/outcometree.mli                    |  1 +
 typing/printtyp.ml                        |  4 ++++
 4 files changed, 23 insertions(+), 4 deletions(-)

diff --git a/testsuite/tests/tool-toplevel/printval.ml b/testsuite/tests/tool-toplevel/printval.ml
index 4b660c20389a..b7f220dd3ba6 100644
--- a/testsuite/tests/tool-toplevel/printval.ml
+++ b/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;;
diff --git a/typing/oprint.ml b/typing/oprint.ml
index eb4c7b173565..eba942d11b56 100644
--- a/typing/oprint.ml
+++ b/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 =
diff --git a/typing/outcometree.mli b/typing/outcometree.mli
index 8e8dfcac3e89..bd6e7e0bcf7a 100644
--- a/typing/outcometree.mli
+++ b/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 =
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index 719979e90563..16c43c5056c7 100644
--- a/typing/printtyp.ml
+++ b/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 *)