fix: outcome printer migration 5.2 -> 5.1 for labeled args

reasonml · Jul 8, 2024 · 83d330b · 83d330b
1 parent 2b610ac
commit 83d330b
Show file tree

Hide file tree

Showing 3 changed files with 31 additions and 26 deletions.
diff --git a/src/reason-parser/reason_oprint.ml b/src/reason-parser/reason_oprint.ml
@@ -85,7 +85,8 @@
 *)
 
 open Format
-module Outcometree = Reason_omp.Ast_414.Outcometree
+module Reason_ast = Reason_omp.Ast_414
+module Outcometree = Reason_ast.Outcometree
 open Outcometree
 
 exception Ellipsis
@@ -241,16 +242,26 @@ let pr_present =
 let pr_vars =
   print_list (fun ppf s -> fprintf ppf "'%s" s) (fun ppf -> fprintf ppf "@ ")
 
-type label =
-  | Nonlabeled
-  | Labeled of string
-  | Optional of string
-
 let get_label lbl =
-  if lbl = "" then Nonlabeled
+  if lbl = "" then Reason_ast.Asttypes.Nolabel
   else if String.get lbl 0 = '?' then
     Optional (String.sub lbl 1 @@ String.length lbl - 1)
-  else Labeled lbl
+  else Labelled lbl
+
+let get_arg_suffix ppf lab =
+  match get_label lab with
+    | Nolabel -> ""
+    | Labelled lab ->
+        pp_print_string ppf "~";
+        pp_print_string ppf lab;
+        pp_print_string ppf ": ";
+        ""
+    | Optional lab ->
+        pp_print_string ppf "~";
+        pp_print_string ppf lab;
+        pp_print_string ppf ": ";
+        "=?"
+
 
 let rec print_out_type ppf =
   function
@@ -264,20 +275,7 @@ let rec print_out_type ppf =
       print_out_type_1 ~uncurried:false ppf ty
 
 and print_arg ppf (lab, typ) =
-  let suffix =
-    match get_label lab with
-    | Nonlabeled -> ""
-    | Labeled lab ->
-        pp_print_string ppf "~";
-        pp_print_string ppf lab;
-        pp_print_string ppf ": ";
-        ""
-    | Optional lab ->
-        pp_print_string ppf "~";
-        pp_print_string ppf lab;
-        pp_print_string ppf ": ";
-        "=?"
-  in
+  let suffix = get_arg_suffix ppf lab in
   print_out_type_2 ppf typ;
   pp_print_string ppf suffix;
 

diff --git a/src/vendored-omp/src/migrate_parsetree_51_52_migrate.ml b/src/vendored-omp/src/migrate_parsetree_51_52_migrate.ml
@@ -1,6 +1,13 @@
 open Stdlib0
 module From = Ast_51
 module To = Ast_52
+
+let get_label lbl =
+  if lbl = "" then Ast_52.Asttypes.Nolabel
+  else if String.get lbl 0 = '?' then
+    Optional (String.sub lbl 1 @@ String.length lbl - 1)
+  else Labelled lbl
+
 let rec copy_out_type_extension :
   Ast_51.Outcometree.out_type_extension ->
     Ast_52.Outcometree.out_type_extension
@@ -170,7 +177,7 @@ and copy_out_class_type :
         ((copy_out_ident x0), (List.map copy_out_type x1))
   | Ast_51.Outcometree.Octy_arrow (x0, x1, x2) ->
       Ast_52.Outcometree.Octy_arrow
-        ((if x0 = "" then Nolabel else Labelled x0), (copy_out_type x1), (copy_out_class_type x2))
+        (get_label x0, (copy_out_type x1), (copy_out_class_type x2))
   | Ast_51.Outcometree.Octy_signature (x0, x1) ->
       Ast_52.Outcometree.Octy_signature
         ((Option.map copy_out_type x0),
@@ -218,7 +225,7 @@ and copy_out_type :
   | Ast_51.Outcometree.Otyp_open -> Ast_52.Outcometree.Otyp_open
   | Ast_51.Outcometree.Otyp_arrow (x0, x1, x2) ->
       Ast_52.Outcometree.Otyp_arrow
-        ((if x0 = "" then Nolabel else Labelled x0), (copy_out_type x1), (copy_out_type x2))
+        (get_label x0, (copy_out_type x1), (copy_out_type x2))
   | Ast_51.Outcometree.Otyp_class (x0, x1) ->
       Ast_52.Outcometree.Otyp_class
         ((copy_out_ident x0), (List.map copy_out_type x1))

diff --git a/src/vendored-omp/src/migrate_parsetree_52_51_migrate.ml b/src/vendored-omp/src/migrate_parsetree_52_51_migrate.ml
@@ -170,7 +170,7 @@ and copy_out_class_type :
         ((copy_out_ident x0), (List.map copy_out_type x1))
   | Ast_52.Outcometree.Octy_arrow (x0, x1, x2) ->
       Ast_51.Outcometree.Octy_arrow
-        ((match x0 with Nolabel -> "" | Labelled s | Optional s -> s), (copy_out_type x1), (copy_out_class_type x2))
+        ((match x0 with Nolabel -> "" | Labelled s  -> s | Optional s -> "?" ^ s), (copy_out_type x1), (copy_out_class_type x2))
   | Ast_52.Outcometree.Octy_signature (x0, x1) ->
       Ast_51.Outcometree.Octy_signature
         ((Option.map copy_out_type x0),
@@ -216,7 +216,7 @@ and copy_out_type :
       Ast_51.Outcometree.Otyp_alias {non_gen; aliased=(copy_out_type x0); alias=x1}
   | Ast_52.Outcometree.Otyp_arrow (x0, x1, x2) ->
       Ast_51.Outcometree.Otyp_arrow
-        ((match x0 with Nolabel -> "" | Labelled s | Optional s -> s), (copy_out_type x1), (copy_out_type x2))
+        ((match x0 with Nolabel -> "" | Labelled s -> s | Optional s -> "?" ^ s), (copy_out_type x1), (copy_out_type x2))
   | Ast_52.Outcometree.Otyp_class (x0, x1) ->
       Ast_51.Outcometree.Otyp_class
         ((copy_out_ident x0), (List.map copy_out_type x1))