Add support for printing @optional records.

See corresponding PR in syntax:
https://github.com/rescript-lang/syntax/actions/runs/2542072235

Author: cristianoc

jscomp/ml/oprint.ml

@@ -22,11 +22,9 @@ let cautious f ppf arg =
   try f ppf arg with
     Ellipsis -> fprintf ppf "..."
 
-
 let out_ident = ref pp_print_string
 let map_primitive_name = ref (fun x -> x)
 
-
 let print_lident ppf = function
   | "::" -> !out_ident ppf "(::)"
   | s -> !out_ident ppf s
@@ -294,7 +292,7 @@ and print_simple_out_type ppf =
   | Otyp_constr (Oide_dot (Oide_dot (Oide_ident "Js_OO", "Callback" ), _),
                  [tyl])
     -> 
-      fprintf ppf "@[<0>(%a@ [@bs.this])@]" print_out_type_1 tyl
+      fprintf ppf "@[<0>(%a@ [@bs.this])@]" print_out_type_1 tyl  
   | Otyp_constr (id, tyl) ->
       pp_open_box ppf 0;
       print_typargs ppf tyl;
@@ -391,8 +389,8 @@ and print_typargs ppf =
       pp_print_char ppf ')';
       pp_close_box ppf ();
       pp_print_space ppf ()
-and print_out_label ppf (name, mut, arg) =
-  fprintf ppf "@[<2>%s%s :@ %a@];" (if mut then "mutable " else "") name
+and print_out_label ppf (name, mut, opt, arg) =
+  fprintf ppf "@[<2>%s%s%s :@ %a@];" (if opt then "@optional " else "") (if mut then "mutable " else "") name
     print_out_type arg
 
 let out_type = ref print_out_type

jscomp/ml/outcometree.ml

@@ -61,7 +61,7 @@ type out_type =
   | Otyp_constr of out_ident * out_type list
   | Otyp_manifest of out_type * out_type
   | Otyp_object of (string * out_type) list * bool option
-  | Otyp_record of (string * bool * out_type) list
+  | Otyp_record of (string * bool * bool * out_type) list
   | Otyp_stuff of string
   | Otyp_sum of (string * out_type list * out_type option) list
   | Otyp_tuple of out_type list

jscomp/ml/printtyp.ml

@@ -926,7 +926,11 @@ and tree_of_constructor cd =
       (name, args, Some ret)
 
 and tree_of_label l =
-  (Ident.name l.ld_id, l.ld_mutable = Mutable, tree_of_typexp false l.ld_type)
+  let opt = l.ld_attributes |> List.exists (fun ({txt}, _) -> txt = "optional") in
+  let typ = match l.ld_type.desc with
+    | Tconstr (p, [t1], _) when Path.same p Predef.path_option -> t1
+    | _ -> l.ld_type in
+  (Ident.name l.ld_id, l.ld_mutable = Mutable, opt, tree_of_typexp false typ)
 
 let tree_of_type_declaration id decl rs =
   Osig_type (tree_of_type_decl id decl, tree_of_rec rs)

lib/4.06.1/unstable/js_compiler.ml

@@ -5042,7 +5042,7 @@ type out_type =
   | Otyp_constr of out_ident * out_type list
   | Otyp_manifest of out_type * out_type
   | Otyp_object of (string * out_type) list * bool option
-  | Otyp_record of (string * bool * out_type) list
+  | Otyp_record of (string * bool * bool * out_type) list
   | Otyp_stuff of string
   | Otyp_sum of (string * out_type list * out_type option) list
   | Otyp_tuple of out_type list
@@ -31579,11 +31579,9 @@ let cautious f ppf arg =
   try f ppf arg with
     Ellipsis -> fprintf ppf "..."
 
-
 let out_ident = ref pp_print_string
 let map_primitive_name = ref (fun x -> x)
 
-
 let print_lident ppf = function
   | "::" -> !out_ident ppf "(::)"
   | s -> !out_ident ppf s
@@ -31851,7 +31849,7 @@ and print_simple_out_type ppf =
   | Otyp_constr (Oide_dot (Oide_dot (Oide_ident "Js_OO", "Callback" ), _),
                  [tyl])
     -> 
-      fprintf ppf "@[<0>(%a@ [@bs.this])@]" print_out_type_1 tyl
+      fprintf ppf "@[<0>(%a@ [@bs.this])@]" print_out_type_1 tyl  
   | Otyp_constr (id, tyl) ->
       pp_open_box ppf 0;
       print_typargs ppf tyl;
@@ -31948,8 +31946,8 @@ and print_typargs ppf =
       pp_print_char ppf ')';
       pp_close_box ppf ();
       pp_print_space ppf ()
-and print_out_label ppf (name, mut, arg) =
-  fprintf ppf "@[<2>%s%s :@ %a@];" (if mut then "mutable " else "") name
+and print_out_label ppf (name, mut, opt, arg) =
+  fprintf ppf "@[<2>%s%s%s :@ %a@];" (if opt then "@optional " else "") (if mut then "mutable " else "") name
     print_out_type arg
 
 let out_type = ref print_out_type
@@ -33363,7 +33361,11 @@ and tree_of_constructor cd =
       (name, args, Some ret)
 
 and tree_of_label l =
-  (Ident.name l.ld_id, l.ld_mutable = Mutable, tree_of_typexp false l.ld_type)
+  let opt = l.ld_attributes |> List.exists (fun ({txt}, _) -> txt = "optional") in
+  let typ = match l.ld_type.desc with
+    | Tconstr (p, [t1], _) when Path.same p Predef.path_option -> t1
+    | _ -> l.ld_type in
+  (Ident.name l.ld_id, l.ld_mutable = Mutable, opt, tree_of_typexp false typ)
 
 let tree_of_type_declaration id decl rs =
   Osig_type (tree_of_type_decl id decl, tree_of_rec rs)

lib/4.06.1/unstable/js_playground_compiler.ml

@@ -5042,7 +5042,7 @@ type out_type =
   | Otyp_constr of out_ident * out_type list
   | Otyp_manifest of out_type * out_type
   | Otyp_object of (string * out_type) list * bool option
-  | Otyp_record of (string * bool * out_type) list
+  | Otyp_record of (string * bool * bool * out_type) list
   | Otyp_stuff of string
   | Otyp_sum of (string * out_type list * out_type option) list
   | Otyp_tuple of out_type list
@@ -31579,11 +31579,9 @@ let cautious f ppf arg =
   try f ppf arg with
     Ellipsis -> fprintf ppf "..."
 
-
 let out_ident = ref pp_print_string
 let map_primitive_name = ref (fun x -> x)
 
-
 let print_lident ppf = function
   | "::" -> !out_ident ppf "(::)"
   | s -> !out_ident ppf s
@@ -31851,7 +31849,7 @@ and print_simple_out_type ppf =
   | Otyp_constr (Oide_dot (Oide_dot (Oide_ident "Js_OO", "Callback" ), _),
                  [tyl])
     -> 
-      fprintf ppf "@[<0>(%a@ [@bs.this])@]" print_out_type_1 tyl
+      fprintf ppf "@[<0>(%a@ [@bs.this])@]" print_out_type_1 tyl  
   | Otyp_constr (id, tyl) ->
       pp_open_box ppf 0;
       print_typargs ppf tyl;
@@ -31948,8 +31946,8 @@ and print_typargs ppf =
       pp_print_char ppf ')';
       pp_close_box ppf ();
       pp_print_space ppf ()
-and print_out_label ppf (name, mut, arg) =
-  fprintf ppf "@[<2>%s%s :@ %a@];" (if mut then "mutable " else "") name
+and print_out_label ppf (name, mut, opt, arg) =
+  fprintf ppf "@[<2>%s%s%s :@ %a@];" (if opt then "@optional " else "") (if mut then "mutable " else "") name
     print_out_type arg
 
 let out_type = ref print_out_type
@@ -33363,7 +33361,11 @@ and tree_of_constructor cd =
       (name, args, Some ret)
 
 and tree_of_label l =
-  (Ident.name l.ld_id, l.ld_mutable = Mutable, tree_of_typexp false l.ld_type)
+  let opt = l.ld_attributes |> List.exists (fun ({txt}, _) -> txt = "optional") in
+  let typ = match l.ld_type.desc with
+    | Tconstr (p, [t1], _) when Path.same p Predef.path_option -> t1
+    | _ -> l.ld_type in
+  (Ident.name l.ld_id, l.ld_mutable = Mutable, opt, tree_of_typexp false typ)
 
 let tree_of_type_declaration id decl rs =
   Osig_type (tree_of_type_decl id decl, tree_of_rec rs)
@@ -287635,10 +287637,11 @@ and printOutConstructorDoc (name, args, gadt) =
   in
   Doc.group (Doc.concat [Doc.text name; argsDoc; gadtDoc])
 
-and printRecordDeclRowDoc (name, mut, arg) =
+and printRecordDeclRowDoc (name, mut, opt, arg) =
   Doc.group
     (Doc.concat
        [
+         (if opt then Doc.text "@optional " else Doc.nil);
          (if mut then Doc.text "mutable " else Doc.nil);
          printIdentLike ~allowUident:false name;
          Doc.text ": ";

lib/4.06.1/whole_compiler.ml

@@ -151102,7 +151102,7 @@ type out_type =
   | Otyp_constr of out_ident * out_type list
   | Otyp_manifest of out_type * out_type
   | Otyp_object of (string * out_type) list * bool option
-  | Otyp_record of (string * bool * out_type) list
+  | Otyp_record of (string * bool * bool * out_type) list
   | Otyp_stuff of string
   | Otyp_sum of (string * out_type list * out_type option) list
   | Otyp_tuple of out_type list
@@ -206110,11 +206110,9 @@ let cautious f ppf arg =
   try f ppf arg with
     Ellipsis -> fprintf ppf "..."
 
-
 let out_ident = ref pp_print_string
 let map_primitive_name = ref (fun x -> x)
 
-
 let print_lident ppf = function
   | "::" -> !out_ident ppf "(::)"
   | s -> !out_ident ppf s
@@ -206382,7 +206380,7 @@ and print_simple_out_type ppf =
   | Otyp_constr (Oide_dot (Oide_dot (Oide_ident "Js_OO", "Callback" ), _),
                  [tyl])
     -> 
-      fprintf ppf "@[<0>(%a@ [@bs.this])@]" print_out_type_1 tyl
+      fprintf ppf "@[<0>(%a@ [@bs.this])@]" print_out_type_1 tyl  
   | Otyp_constr (id, tyl) ->
       pp_open_box ppf 0;
       print_typargs ppf tyl;
@@ -206479,8 +206477,8 @@ and print_typargs ppf =
       pp_print_char ppf ')';
       pp_close_box ppf ();
       pp_print_space ppf ()
-and print_out_label ppf (name, mut, arg) =
-  fprintf ppf "@[<2>%s%s :@ %a@];" (if mut then "mutable " else "") name
+and print_out_label ppf (name, mut, opt, arg) =
+  fprintf ppf "@[<2>%s%s%s :@ %a@];" (if opt then "@optional " else "") (if mut then "mutable " else "") name
     print_out_type arg
 
 let out_type = ref print_out_type
@@ -207894,7 +207892,11 @@ and tree_of_constructor cd =
       (name, args, Some ret)
 
 and tree_of_label l =
-  (Ident.name l.ld_id, l.ld_mutable = Mutable, tree_of_typexp false l.ld_type)
+  let opt = l.ld_attributes |> List.exists (fun ({txt}, _) -> txt = "optional") in
+  let typ = match l.ld_type.desc with
+    | Tconstr (p, [t1], _) when Path.same p Predef.path_option -> t1
+    | _ -> l.ld_type in
+  (Ident.name l.ld_id, l.ld_mutable = Mutable, opt, tree_of_typexp false typ)
 
 let tree_of_type_declaration id decl rs =
   Osig_type (tree_of_type_decl id decl, tree_of_rec rs)
@@ -294279,10 +294281,11 @@ and printOutConstructorDoc (name, args, gadt) =
   in
   Doc.group (Doc.concat [Doc.text name; argsDoc; gadtDoc])
 
-and printRecordDeclRowDoc (name, mut, arg) =
+and printRecordDeclRowDoc (name, mut, opt, arg) =
   Doc.group
     (Doc.concat
        [
+         (if opt then Doc.text "@optional " else Doc.nil);
          (if mut then Doc.text "mutable " else Doc.nil);
          printIdentLike ~allowUident:false name;
          Doc.text ": ";