Code review

asmcomp/asmpackager.ml

@@ -127,7 +127,7 @@ let make_package_object unix ~ppf_dump members target coercion
         ~style:transl_style
     in
     let code = Simplif.simplify_lambda code in
-    let module_block_format : Lambda.module_block_format =
+    let main_module_block_format : Lambda.main_module_block_format =
       Mb_record { mb_size = main_module_block_size }
     in
     let arg_block_field =
@@ -137,7 +137,7 @@ let make_package_object unix ~ppf_dump members target coercion
     let program =
       { Lambda.
         code;
-        module_block_format;
+        main_module_block_format;
         arg_block_field;
         compilation_unit;
         required_globals;
@@ -193,7 +193,7 @@ let build_package_cmx members cmxfile ~main_module_block_size =
   List.iter (fun info -> Zero_alloc_info.merge info.ui_zero_alloc_info
                            ~into:ui_zero_alloc_info) units;
   let modname = Compilation_unit.name ui.ui_unit in
-  let format : Lambda.module_block_format =
+  let format : Lambda.main_module_block_format =
     (* Open modules not supported with packs, so always just a record *)
     Mb_record { mb_size = main_module_block_size }
   in

bytecomp/bytepackager.ml

@@ -318,7 +318,7 @@ let package_object_files ~ppf_dump files target coercion =
       Import_info.create packed_compilation_unit_name
         ~crc_with_unit:(Some (packed_compilation_unit, crc))
     in
-    let format : Lambda.module_block_format =
+    let format : Lambda.main_module_block_format =
       (* Open modules not supported with packs, so always just a record *)
       Mb_record { mb_size = main_module_block_size }
     in

bytecomp/emitcode.ml

@@ -415,7 +415,7 @@ let rec emit = function
 
 (* Emission to a file *)
 
-let to_file outchan cu artifact_info ~required_globals ~module_block_format
+let to_file outchan cu artifact_info ~required_globals ~main_module_block_format
           ~arg_descr code =
   init();
   Fun.protect ~finally:clear (fun () ->
@@ -452,7 +452,7 @@ let to_file outchan cu artifact_info ~required_globals ~module_block_format
       cu_reloc = List.rev !reloc_info;
       cu_arg_descr = arg_descr;
       cu_imports = Env.imports() |> Array.of_list;
-      cu_format = module_block_format;
+      cu_format = main_module_block_format;
       cu_primitives = List.map Primitive.byte_name
                                !Translmod.primitive_declarations;
       cu_required_compunits = Compilation_unit.Set.elements required_globals;

bytecomp/emitcode.mli

@@ -20,7 +20,7 @@ open Instruct
 
 val to_file: out_channel -> Compilation_unit.t -> Unit_info.Artifact.t ->
   required_globals:Compilation_unit.Set.t ->
-  module_block_format:Lambda.module_block_format ->
+  main_module_block_format:Lambda.main_module_block_format ->
   arg_descr:Lambda.arg_descr option -> instruction list -> unit
         (* Arguments:
              channel on output file

driver/compile.ml

@@ -42,7 +42,7 @@ let make_arg_descr ~param ~arg_block_field : Lambda.arg_descr option =
 let raw_lambda_to_bytecode i raw_lambda ~as_arg_for =
   raw_lambda
   |> Profile.(record ~accumulate:true generate)
-    (fun { Lambda.code = lambda; required_globals; module_block_format;
+    (fun { Lambda.code = lambda; required_globals; main_module_block_format;
            arg_block_field } ->
        Builtin_attributes.warn_unused ();
        lambda
@@ -53,7 +53,7 @@ let raw_lambda_to_bytecode i raw_lambda ~as_arg_for =
        |> print_if i.ppf_dump Clflags.dump_instr Printinstr.instrlist
        |> fun bytecode ->
           let arg_descr = make_arg_descr ~param:as_arg_for ~arg_block_field in
-          bytecode, required_globals, module_block_format, arg_descr
+          bytecode, required_globals, main_module_block_format, arg_descr
     )
 
 let to_bytecode i Typedtree.{structure; coercion; argument_interface; _} =
@@ -69,7 +69,7 @@ let to_bytecode i Typedtree.{structure; coercion; argument_interface; _} =
   |> raw_lambda_to_bytecode i
 
 let emit_bytecode i
-      (bytecode, required_globals, module_block_format, arg_descr) =
+      (bytecode, required_globals, main_module_block_format, arg_descr) =
   let cmo = Unit_info.cmo i.target in
   let oc = open_out_bin (Unit_info.Artifact.filename cmo) in
   Misc.try_finally
@@ -81,7 +81,7 @@ let emit_bytecode i
        bytecode
        |> Profile.(record ~accumulate:true generate)
          (Emitcode.to_file oc i.module_name cmo ~required_globals
-            ~module_block_format ~arg_descr);
+            ~main_module_block_format ~arg_descr);
     )
 
 type starting_point =
@@ -121,16 +121,6 @@ let implementation0 ~start_from ~source_file ~output_prefix
       ~hook_typed_tree:(fun _ -> ())
       info ~backend
   | Instantiation { runtime_args; main_module_block_size; arg_descr } ->
-    (* FIXME delete; should not be necessary {[
-    (* Consider the names of arguments to be parameters for the purposes of the
-       subset rule - that is, a module we import can refer to our arguments as
-       parameters. *)
-    List.iter
-      (fun (param, _value) ->
-         let import = Compilation_unit.Name.of_head_of_global_name param in
-         Env.register_parameter_import import)
-      global_name.args;
-    ]} *)
     let as_arg_for, arg_block_field =
       match (arg_descr : Lambda.arg_descr option) with
       | Some { arg_param; arg_block_field } ->

driver/compile.mli

@@ -35,7 +35,7 @@ val to_bytecode :
   Typedtree.implementation ->
   as_arg_for:Global_module.Name.t option ->
   Instruct.instruction list * Compilation_unit.Set.t *
-    Lambda.module_block_format *
+    Lambda.main_module_block_format *
     Lambda.arg_descr option
 (** [to_bytecode info typed] takes a typechecked implementation
     and returns its bytecode.
@@ -44,7 +44,7 @@ val to_bytecode :
 val emit_bytecode :
   Compile_common.info ->
   Instruct.instruction list * Compilation_unit.Set.t *
-    Lambda.module_block_format *
+    Lambda.main_module_block_format *
     Lambda.arg_descr option ->
     unit
 (** [emit_bytecode bytecode] output the bytecode executable. *)

driver/instantiator.ml

@@ -29,7 +29,7 @@ let error e = raise (Error e)
 type unit_info = {
   ui_unit : CU.t;
   ui_arg_descr : Lambda.arg_descr option;
-  ui_format : Lambda.module_block_format;
+  ui_format : Lambda.main_module_block_format;
 }
 
 let instantiate
@@ -104,7 +104,7 @@ let instantiate
   let runtime_args =
     runtime_params
     |> List.map (fun runtime_param : Translmod.runtime_arg ->
-         match (runtime_param : Lambda.runtime_param_descr) with
+         match (runtime_param : Lambda.runtime_param) with
            | Rp_argument_block global ->
              let global_name = Global_module.to_name global in
              begin

driver/instantiator.mli

@@ -3,7 +3,7 @@ module CU := Compilation_unit
 type unit_info = {
   ui_unit : CU.t;
   ui_arg_descr : Lambda.arg_descr option;
-  ui_format : Lambda.module_block_format;
+  ui_format : Lambda.main_module_block_format;
 }
 
 val instantiate

driver/maindriver.ml

@@ -66,7 +66,7 @@ let main argv ppf =
         assert (P.is_compilation_pass p);
         Printf.ksprintf Compenv.fatal
           "Options -i and -stop-after (%s) \
-           are  incompatible with -pack, -a, -output-obj, -instantiate"
+           are  incompatible with -pack, -a, -output-obj"
           (String.concat "|"
              (P.available_pass_names ~filter:(fun _ -> true) ~native:false))
       | Some (P.Middle_end | P.Scheduling | P.Simplify_cfg | P.Emit | P.Selection) ->

driver/optcompile.ml

@@ -66,7 +66,7 @@ let compile_from_raw_lambda i raw_lambda ~unix ~pipeline ~as_arg_for =
            in
            Compilenv.save_unit_info
              (Unit_info.Artifact.filename (Unit_info.cmx i.target))
-             ~module_block_format:program.module_block_format
+             ~main_module_block_format:program.main_module_block_format
              ~arg_descr)
 
 let compile_from_typed i typed ~transl_style ~unix ~pipeline ~as_arg_for =
@@ -130,7 +130,7 @@ let implementation0 unix ~(flambda2 : flambda2) ~start_from
       |> Option.map (fun param ->
            (* Currently, parameters don't have parameters, so we assume the argument
               list is empty *)
-           Global_module.Name.create_exn param [])
+           Global_module.Name.create_no_args param)
     in
     if not (Config.flambda || Config.flambda2) then Clflags.set_oclassic ();
     compile_from_typed info typed ~unix ~transl_style ~pipeline ~as_arg_for
@@ -149,19 +149,6 @@ let implementation0 unix ~(flambda2 : flambda2) ~start_from
   | Emit -> emit unix info ~ppf_dump:info.ppf_dump
   | Instantiation { runtime_args; main_module_block_size; arg_descr } ->
     Compilenv.reset info.module_name;
-    (* FIXME delete {[
-    let global_name =
-      Compilation_unit.to_global_name_exn info.module_name
-    in
-    (* Consider the names of arguments to be parameters for the purposes of the
-       subset rule - that is, a module we import can refer to our arguments as
-       parameters. *)
-    List.iter
-      (fun (param, _value) ->
-        let import = Compilation_unit.Name.of_head_of_global_name param in
-        Env.register_parameter_import import)
-      global_name.args;
-    ]} *)
     let as_arg_for, arg_block_field =
       match (arg_descr : Lambda.arg_descr option) with
       | Some { arg_param; arg_block_field } ->

driver/optmaindriver.ml

@@ -95,7 +95,7 @@ let main unix argv ppf ~flambda2 =
         assert (P.is_compilation_pass p);
         Printf.ksprintf Compenv.fatal
           "Options -i and -stop-after (%s) \
-           are  incompatible with -pack, -a, -shared, -output-obj, -instantiate"
+           are  incompatible with -pack, -a, -shared, -output-obj"
           (String.concat "|"
              (P.available_pass_names ~filter:(fun _ -> true) ~native:true))
     end;

file_formats/cmo_format.mli

@@ -40,7 +40,7 @@ type compilation_unit_descr =
                                         (* If this is an argument unit, the
                                            parameter it implements *)
     cu_imports: Import_info.t array;    (* Names and CRC of intfs imported *)
-    cu_format: Lambda.module_block_format;
+    cu_format: Lambda.main_module_block_format;
     cu_required_compunits: Compilation_unit.t list;
                                         (* Compilation units whose
                                            initialization side effects

file_formats/cmx_format.mli

@@ -62,12 +62,8 @@ type unit_infos =
                                           (* Interfaces imported *)
     mutable ui_imports_cmx: Import_info.t list;
                                           (* Infos imported *)
-    mutable ui_format: Lambda.module_block_format;
-                                          (* Implementation imports which are
-                                             bound as parameters at runtime,
-                                             including source-level parameters
-                                             as well as implementation imports
-                                             with unbound parameters *)
+    mutable ui_format: Lambda.main_module_block_format;
+                                          (* Structure of the main module block *)
     mutable ui_generic_fns: generic_fns;  (* Generic functions needed *)
     mutable ui_export_info: Flambda2_cmx.Flambda_cmx_format.t option;
     mutable ui_zero_alloc_info: Zero_alloc_info.t;
@@ -81,7 +77,7 @@ type unit_infos_raw =
     uir_arg_descr: Lambda.arg_descr option;
     uir_imports_cmi: Import_info.t array;
     uir_imports_cmx: Import_info.t array;
-    uir_format: Lambda.module_block_format;
+    uir_format: Lambda.main_module_block_format;
     uir_generic_fns: generic_fns;
     uir_export_info: Flambda2_cmx.Flambda_cmx_format.raw option;
     uir_zero_alloc_info: Zero_alloc_info.Raw.t;

lambda/lambda.ml

@@ -786,28 +786,25 @@ and lambda_event_kind =
   | Lev_function
   | Lev_pseudo
 
-type runtime_param_descr =
-  | Rp_argument_block of Global_module.t  (* The argument block of a module
-                                             compiled with [-as-argument-for] *)
-  | Rp_dependency of Global_module.t      (* A parameterised module (not itself a
-                                             parameter) that this module depends
-                                             on *)
-  | Rp_unit                               (* The unit value (only used when
-                                             there are no other parameters) *)
-
-type module_block_format =
-  | Mb_record of { mb_size : int }      (* A block with [mb_size] fields *)
-  | Mb_wrapped_function of { mb_runtime_params : runtime_param_descr list;
+type runtime_param =
+  | Rp_argument_block of Global_module.t
+  | Rp_dependency of Global_module.t
+  | Rp_unit
+
+type main_module_block_format =
+  | Mb_record of { mb_size : int }
+  | Mb_wrapped_function of { mb_runtime_params : runtime_param list;
                              mb_returned_size : int;
                            }
-                                        (* A block with exactly one field:
-                                           a function taking [mb_runtime_params] and
-                                           returning a block with
-                                           [mb_returned_size] fields *)
+
+let main_module_block_size format =
+  match format with
+  | Mb_record { mb_size } -> mb_size
+  | Mb_wrapped_function _ -> 1
 
 type program =
   { compilation_unit : Compilation_unit.t;
-    module_block_format : module_block_format;
+    main_module_block_format : main_module_block_format;
     arg_block_field : int option;
     required_globals : Compilation_unit.Set.t;
     code : lambda }

lambda/lambda.mli

@@ -762,47 +762,63 @@ and lambda_event_kind =
   | Lev_function
   | Lev_pseudo
 
-(* Descriptor for a parameter that this module takes at runtime. *)
-type runtime_param_descr =
+type runtime_param =
   | Rp_argument_block of Global_module.t  (* The argument block of a module
                                              compiled with [-as-argument-for] *)
   | Rp_dependency of Global_module.t      (* A parameterised module (not itself a
                                              parameter) that this module depends
-                                             on *)
+                                             on. Must not be complete (see
+                                             [Global_module.is_complete]) *)
   | Rp_unit                               (* The unit value (only used when
                                              there are no other parameters) *)
 
-type module_block_format =
+(* The structure of the main module block. A module with no parameters will be an
+   [Mb_record] and a module with parameters will be an [Mb_wrapped_function]. *)
+type main_module_block_format =
   | Mb_record of { mb_size : int }      (* A block with [mb_size] fields *)
-  | Mb_wrapped_function of { mb_runtime_params : runtime_param_descr list;
+  | Mb_wrapped_function of { mb_runtime_params : runtime_param list;
                              mb_returned_size : int;
                            }
                                         (* A block with exactly one field:
                                            a function taking [mb_runtime_params] and
                                            returning a block with
                                            [mb_returned_size] fields *)
 
+(* The number of words in the main module block. *)
+val main_module_block_size : main_module_block_format -> int
+
 type program =
   { compilation_unit : Compilation_unit.t;
-    module_block_format : module_block_format;
+    main_module_block_format : main_module_block_format;
     arg_block_field : int option;       (* Unnamed field with argument block
                                            (see [arg_descr]) *)
     required_globals : Compilation_unit.Set.t;
                                         (* Modules whose initializer side effects
                                            must occur before [code]. *)
     code : lambda }
-(* Lambda code for the middle-end.
+(* Lambda code for the middle-end. Here [mbf] is the value of the
+   [main_module_block_format] field.
    * In the closure case the code is a sequence of assignments to a
-     preallocated block of size [main_module_block_size] using
+     preallocated block of size [main_module_block_size mbf] using
      (Setfield(Getpredef(compilation_unit))). The size is used to preallocate
      the block.
    * In the flambda case the code is an expression returning a block
-     value of size [main_module_block_size]. The size is used to build
+     value of size [main_module_block_size mbf]. The size is used to build
      the module root as an initialize_symbol
      Initialize_symbol(module_name, 0,
-       [getfield 0; ...; getfield (main_module_block_size - 1)])
+       [getfield 0; ...; getfield (main_module_block_size mbf - 1)])
 *)
 
+(* Info for a compilation unit that implements a parameter (i.e., is an argument
+   for that parameter) *)
+
+type arg_descr =
+  { arg_param: Global_module.Name.t;    (* The parameter implemented *)
+    arg_block_field: int; }             (* The index of an unnamed field
+                                           containing the block to use as an
+                                           argument value (may be a supertype of
+                                           the whole compilation unit's type) *)
+
 (* Sharing key *)
 val make_key: lambda -> lambda option
 
@@ -1064,13 +1080,3 @@ val simple_prim_on_values
 -> arity:int
 -> alloc:bool
 -> external_call_description
-
-(* Info for a compilation unit that implements a parameter (i.e., is an argument
-   for that parameter) *)
-
-type arg_descr =
-  { arg_param: Global_module.Name.t;    (* The parameter implemented *)
-    arg_block_field: int; }             (* The index of an unnamed field
-                                           containing the block to use as the
-                                           argument value (may be a supertype of
-                                           the whole compilation unit's type) *)