PR#8908: used as a base for other PRs.pr8908

1 files changed, 22 insertions, 11 deletions

diff --git a/parsing/printast.ml b/parsing/printast.ml
index 085e0d797b..30a0eeb305 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -52,6 +52,10 @@ let fmt_string_loc f (x : string loc) =
   fprintf f "\"%s\" %a" x.txt fmt_location x.loc;
 ;;
 
+let fmt_str_opt_loc f (x : string option loc) =
+  fprintf f "\"%s\" %a" (Option.value x.txt ~default:"_") fmt_location x.loc;
+;;
+
 let fmt_char_option f = function
   | None -> fprintf f "None"
   | Some c -> fprintf f "Some %c" c
@@ -132,6 +136,7 @@ let option i f ppf x =
 let longident_loc i ppf li = line i ppf "%a\n" fmt_longident_loc li;;
 let string i ppf s = line i ppf "\"%s\"\n" s;;
 let string_loc i ppf s = line i ppf "%a\n" fmt_string_loc s;;
+let str_opt_loc i ppf s = line i ppf "%a\n" fmt_str_opt_loc s;;
 let arg_label i ppf = function
   | Nolabel -> line i ppf "Nolabel\n"
   | Optional s -> line i ppf "Optional \"%s\"\n" s
@@ -240,7 +245,7 @@ and pattern i ppf x =
       line i ppf "Ppat_type\n";
       longident_loc i ppf li
   | Ppat_unpack s ->
-      line i ppf "Ppat_unpack %a\n" fmt_string_loc s;
+      line i ppf "Ppat_unpack %a\n" fmt_str_opt_loc s;
   | Ppat_exception p ->
       line i ppf "Ppat_exception\n";
       pattern i ppf p
@@ -347,7 +352,7 @@ and expression i ppf x =
       line i ppf "Pexp_override\n";
       list i string_x_expression ppf l;
   | Pexp_letmodule (s, me, e) ->
-      line i ppf "Pexp_letmodule %a\n" fmt_string_loc s;
+      line i ppf "Pexp_letmodule %a\n" fmt_str_opt_loc s;
       module_expr i ppf me;
       expression i ppf e;
   | Pexp_letexception (cd, e) ->
@@ -662,9 +667,12 @@ and module_type i ppf x =
   | Pmty_signature (s) ->
       line i ppf "Pmty_signature\n";
       signature i ppf s;
-  | Pmty_functor (s, mt1, mt2) ->
-      line i ppf "Pmty_functor %a\n" fmt_string_loc s;
-      Option.iter (module_type i ppf) mt1;
+  | Pmty_functor (Unit, mt2) ->
+      line i ppf "Pmty_functor ()\n";
+      module_type i ppf mt2;
+  | Pmty_functor (Named (s, mt1), mt2) ->
+      line i ppf "Pmty_functor %a\n" fmt_str_opt_loc s;
+      module_type i ppf mt1;
       module_type i ppf mt2;
   | Pmty_with (mt, l) ->
       line i ppf "Pmty_with\n";
@@ -699,7 +707,7 @@ and signature_item i ppf x =
       line i ppf "Psig_exception\n";
       type_exception i ppf te
   | Psig_module pmd ->
-      line i ppf "Psig_module %a\n" fmt_string_loc pmd.pmd_name;
+      line i ppf "Psig_module %a\n" fmt_str_opt_loc pmd.pmd_name;
       attributes i ppf pmd.pmd_attributes;
       module_type i ppf pmd.pmd_type
   | Psig_modsubst pms ->
@@ -765,9 +773,12 @@ and module_expr i ppf x =
   | Pmod_structure (s) ->
       line i ppf "Pmod_structure\n";
       structure i ppf s;
-  | Pmod_functor (s, mt, me) ->
-      line i ppf "Pmod_functor %a\n" fmt_string_loc s;
-      Option.iter (module_type i ppf) mt;
+  | Pmod_functor (Unit, me) ->
+      line i ppf "Pmod_functor ()\n";
+      module_expr i ppf me;
+  | Pmod_functor (Named (s, mt), me) ->
+      line i ppf "Pmod_functor %a\n" fmt_str_opt_loc s;
+      module_type i ppf mt;
       module_expr i ppf me;
   | Pmod_apply (me1, me2) ->
       line i ppf "Pmod_apply\n";
@@ -841,12 +852,12 @@ and structure_item i ppf x =
       attribute i ppf "Pstr_attribute" a
 
 and module_declaration i ppf pmd =
-  string_loc i ppf pmd.pmd_name;
+  str_opt_loc i ppf pmd.pmd_name;
   attributes i ppf pmd.pmd_attributes;
   module_type (i+1) ppf pmd.pmd_type;
 
 and module_binding i ppf x =
-  string_loc i ppf x.pmb_name;
+  str_opt_loc i ppf x.pmb_name;
   attributes i ppf x.pmb_attributes;
   module_expr (i+1) ppf x.pmb_expr