Avoid needless dependency on parameter .cmi by introducing Parameter_name.t (#3708)

* Introduce `Global_module.Parameter_name.t`

Takes the place of any `Global_module.t` or `Global_module.Name.t` that is known
to be the name of a parameter. Can't have parameters. (Notably, even the current
half-worked-out plans for parameterized parameters would actually keep this type
in many places, so this isn't as much in the way as one might think.)

* Don't call `global_of_global_name` on parameter names

This has the benefit of not loading the .cmi file for something whose signature
we don't need (say because the parameter is only used as part of an instance
name).

* Code review

Author: lukemaurer

driver/compile.ml

@@ -108,10 +108,7 @@ let implementation_aux ~start_from ~source_file ~output_prefix
     let backend info typed =
       let as_arg_for =
         !Clflags.as_argument_for
-        |> Option.map (fun param ->
-          (* Currently, parameters don't have parameters, so we assume the argument
-             list is empty *)
-          Global_module.Name.create_no_args param)
+        |> Option.map Global_module.Parameter_name.of_string
       in
       let bytecode = to_bytecode info typed ~as_arg_for in
       emit_bytecode info bytecode

driver/compile.mli

@@ -33,7 +33,7 @@ val instance:
 val to_bytecode :
   Compile_common.info ->
   Typedtree.implementation ->
-  as_arg_for:Global_module.Name.t option ->
+  as_arg_for:Global_module.Parameter_name.t option ->
   Instruct.instruction list * Compilation_unit.Set.t *
     Lambda.main_module_block_format *
     Lambda.arg_descr option

driver/compile_common.ml

@@ -99,9 +99,8 @@ let emit_signature info alerts tsg =
         Parameter
       else begin
         let cmi_arg_for =
-          match !Clflags.as_argument_for with
-          | Some arg_type -> Some (Global_module.Name.create_no_args arg_type)
-          | None -> None
+          !Clflags.as_argument_for
+          |> Option.map Global_module.Parameter_name.of_string
         in
         Normal { cmi_impl = info.module_name; cmi_arg_for }
       end

driver/compmisc.ml

@@ -61,8 +61,7 @@ let init_parameters () =
   let param_names = !Clflags.parameters in
   List.iter
     (fun param_name ->
-        (* We don't (yet!) support parameterised parameters *)
-        let param = Global_module.Name.create_no_args param_name in
+        let param = Global_module.Parameter_name.of_string param_name in
         Env.register_parameter param
     )
     param_names

driver/instantiator.ml

@@ -42,15 +42,15 @@ type error =
       compilation_unit : CU.t;
       filename : Misc.filepath;
     }
-  | Missing_argument of { param : Global_module.Name.t }
+  | Missing_argument of { param : Global_module.Parameter_name.t }
   | No_such_parameter of {
       base_unit : CU.t;
-      available_params : Global_module.Name.t list;
-      param : Global_module.Name.t;
+      available_params : Global_module.Parameter_name.t list;
+      param : Global_module.Parameter_name.t;
       arg : Global_module.Name.t;
     }
   | Repeated_parameter of {
-      param : Global_module.Name.t;
+      param : Global_module.Parameter_name.t;
       arg1 : CU.t;
       arg2 : CU.t;
     }
@@ -85,11 +85,11 @@ let instantiate
   let arg_pairs : CU.argument list =
     List.map
       (fun (param, (value, _)) : CU.argument ->
-         { param = CU.of_global_name param; value })
+         { param = CU.Name.of_parameter_name param; value })
       arg_infos
   in
-  let arg_map : (CU.t * int) Global_module.Name.Map.t =
-    match Global_module.Name.Map.of_list_checked arg_infos with
+  let arg_map : (CU.t * int) Global_module.Parameter_name.Map.t =
+    match Global_module.Parameter_name.Map.of_list_checked arg_infos with
     | Ok map -> map
     | Error (Duplicate { key; value1 = (arg1, _); value2 = (arg2, _) }) ->
       error (Repeated_parameter { param = key; arg1; arg2 })
@@ -138,7 +138,7 @@ let instantiate
   let arg_subst : Global_module.subst =
     global.visible_args
     |> List.map (fun ({ param; value } : Global_module.argument) -> param, value)
-    |> Global_module.Name.Map.of_list
+    |> Global_module.Parameter_name.Map.of_list
   in
   let runtime_params, main_module_block_size =
     match base_unit_info.ui_format with
@@ -154,18 +154,17 @@ let instantiate
     |> List.map (fun runtime_param : Translmod.runtime_arg ->
          match (runtime_param : Lambda.runtime_param) with
            | Rp_argument_block global ->
-             let global_name = Global_module.to_name global in
              begin
                match
-                 Global_module.Name.Map.find_opt global_name arg_map
+                 Global_module.find_in_parameter_map global arg_map
                with
                | Some (ra_unit, ra_field_idx) ->
                  Argument_block { ra_unit; ra_field_idx }
                | None ->
                  (* This should have been caught by
                     [Env.global_of_instance_compilation_unit] earlier *)
                  Misc.fatal_errorf "Can't find value for %a"
-                   Global_module.Name.print global_name
+                   Global_module.print global
              end
            | Rp_main_module_block global ->
              (* Substitute away any references to parameters in [global] *)
@@ -192,7 +191,7 @@ module Style = Misc.Style
 let pp_parameters ppf params =
   fprintf ppf "@[<hov>%a@]"
     (pp_print_list ~pp_sep:pp_print_space
-       (Style.as_inline_code Global_module.Name.print))
+       (Style.as_inline_code Global_module.Parameter_name.print))
     params
 
 let report_error ppf = function
@@ -231,18 +230,19 @@ let report_error ppf = function
       (Style.as_inline_code Location.print_filename) filename
   | Missing_argument { param } ->
     fprintf ppf "No argument given for parameter %a"
-      (Style.as_inline_code Global_module.Name.print) param
+      (Style.as_inline_code Global_module.Parameter_name.print) param
   | No_such_parameter { base_unit; available_params; param; arg } ->
     fprintf ppf
       "@[<hov>Module %a@ is an argument for parameter %a,@ \
          which is not a parameter of %a.@]@.\
        @[<hov>@{<hint>Hint@}: @[<hov>%a@ was compiled with %a.@]@]@.\
        @[<hov>@{<hint>Hint@}: @[<hov>Parameters of %a:@ %a@]@]"
       (Style.as_inline_code Global_module.Name.print) arg
-      (Style.as_inline_code Global_module.Name.print) param
+      (Style.as_inline_code Global_module.Parameter_name.print) param
       (Style.as_inline_code CU.print) base_unit
       (Style.as_inline_code Global_module.Name.print) arg
-      (Style.as_clflag "-as-argument-for" Global_module.Name.print) param
+      (Style.as_clflag "-as-argument-for" Global_module.Parameter_name.print)
+        param
       (Style.as_inline_code CU.print) base_unit
       pp_parameters available_params
   | Repeated_parameter { param; arg1; arg2 } ->
@@ -254,10 +254,11 @@ let report_error ppf = function
          with %a.@]@]"
       (Style.as_inline_code CU.print) arg1
       (Style.as_inline_code CU.print) arg2
-      (Style.as_inline_code Global_module.Name.print) param
+      (Style.as_inline_code Global_module.Parameter_name.print) param
       (Style.as_inline_code CU.print) arg1
       (Style.as_inline_code CU.print) arg2
-      (Style.as_clflag "-as-argument-for" Global_module.Name.print) param
+      (Style.as_clflag "-as-argument-for" Global_module.Parameter_name.print)
+        param
 let () =
   Location.register_error_of_exn
     (function

driver/instantiator.mli

@@ -63,15 +63,15 @@ type error =
       compilation_unit : CU.t;
       filename : Misc.filepath;
     }
-  | Missing_argument of { param : Global_module.Name.t }
+  | Missing_argument of { param : Global_module.Parameter_name.t }
   | No_such_parameter of {
       base_unit : CU.t;
-      available_params : Global_module.Name.t list;
-      param : Global_module.Name.t;
+      available_params : Global_module.Parameter_name.t list;
+      param : Global_module.Parameter_name.t;
       arg : Global_module.Name.t
     }
   | Repeated_parameter of {
-      param : Global_module.Name.t;
+      param : Global_module.Parameter_name.t;
       arg1 : CU.t;
       arg2 : CU.t;
     }

driver/optcompile.ml

@@ -133,10 +133,7 @@ let implementation_aux unix ~(flambda2 : flambda2) ~start_from
       let typed = structure, coercion, argument_coercion in
       let as_arg_for =
         !Clflags.as_argument_for
-        |> Option.map (fun param ->
-          (* Currently, parameters don't have parameters, so we assume the argument
-             list is empty *)
-          Global_module.Name.create_no_args param)
+        |> Option.map Global_module.Parameter_name.of_string
       in
       if not (Config.flambda || Config.flambda2) then Clflags.set_oclassic ();
       compile_from_typed info typed ~unix ~transl_style ~pipeline ~as_arg_for

file_formats/cmi_format.ml

@@ -23,7 +23,7 @@ type pers_flags =
 type kind =
   | Normal of {
       cmi_impl : Compilation_unit.t;
-      cmi_arg_for : Global_module.Name.t option;
+      cmi_arg_for : Global_module.Parameter_name.t option;
     }
   | Parameter
 
@@ -65,15 +65,15 @@ type header = {
     header_kind : kind;
     header_globals : Global_module.With_precision.t array;
     header_sign : Serialized.signature;
-    header_params : Global_module.t list;
+    header_params : Global_module.Parameter_name.t list;
 }
 
 type 'sg cmi_infos_generic = {
     cmi_name : Compilation_unit.Name.t;
     cmi_kind : kind;
     cmi_globals : Global_module.With_precision.t array;
     cmi_sign : 'sg;
-    cmi_params : Global_module.t list;
+    cmi_params : Global_module.Parameter_name.t list;
     cmi_crcs : crcs;
     cmi_flags : flags;
 }

file_formats/cmi_format.mli

@@ -25,7 +25,7 @@ type kind =
       cmi_impl : Compilation_unit.t;
         (* If this module takes parameters, [cmi_impl] will be the functor that
            generates instances *)
-      cmi_arg_for : Global_module.Name.t option;
+      cmi_arg_for : Global_module.Parameter_name.t option;
     }
   | Parameter
 
@@ -34,7 +34,7 @@ type 'sg cmi_infos_generic = {
     cmi_kind : kind;
     cmi_globals : Global_module.With_precision.t array;
     cmi_sign : 'sg;
-    cmi_params : Global_module.t list; (* CR lmaurer: Should be [Parameter_name.t list] *)
+    cmi_params : Global_module.Parameter_name.t list;
     cmi_crcs : Import_info.t array;
     cmi_flags : pers_flags list;
 }

flambda-backend/tests/typing/global_module_test.expected

@@ -2,17 +2,18 @@
 Tests of subst:
 
 X { (X Unit) } = Unit
-Y{X} { (X Unit) } = Y[X:Unit]
-Y[X:Unit] { (X String) } = Y[X:Unit]
-Y[X:Unit] { (Y[X:Unit] String) } = String
-M{X}{Y:Y{X}} { (X A) } = M[X:A]{Y:Y[X:A]}
-M{X}{Y:Y{X}} { (X A) (Y B) } = M[X:A][Y:B]
+Y { (X Unit) } = Y
+Y { (X String) } = Y
+M{X}{Y} { (X A) } = M[X:A]{Y}
+M{X}{Y} { (X A) (Y B) } = M[X:A][Y:B]
 X { (I Unit) } = X
-Y{X} { (I Unit) } = Y{X}
-Print{Conv[O:String]:Conv[O:String]{I}}{I}
-  { (I Unit) }
+Y { (I Unit) } = Y
+Print{Conv}{I} { (I Unit) } = Print[I:Unit]{Conv}
+Print{Conv}{I}
+  { (Conv Opaque{I}) (I Option{I}) }
   =
-  Print[I:Unit]{Conv[O:String]:Conv[I:Unit][O:String]}
+  Print[Conv:Opaque{I}][I:Option{I}]
+Print[Conv:Opaque{I}]{I} { (I Unit) } = Print[Conv:Opaque[I:Unit]][I:Unit]
 
 Tests of check:
 
@@ -22,7 +23,6 @@ check { (X String) } [] = false
 check { (X String) } [ X ] = true
 check { (I Unit) } [ I ] = true
 check { (I Unit) } [ O ] = false
-check { (I Unit) } [ Conv{I}{O}; I ] = true
-check { (Conv Opaque{I}) (O String) } [ Conv{I}{O}; I; O ] = true
-check { (Conv[O:String] Opaque{I}) } [ Conv{I}{O}; I; O ] = false
-check { (Conv[O:String] Opaque{I}) } [ Conv[O:String]{I}; I ] = true
+check { (I Unit) } [ Conv; I ] = true
+check { (I Option{I}) } [ Conv; I ] = true
+check { (I Option[I:Unit]) } [ Conv; I ] = true