Compile refactor (#1096)

Author: lukemaurer

backend/asmgen.ml

@@ -431,7 +431,7 @@ let compile_unit ~output_prefix ~asm_filename ~keep_asm ~obj_filename ~may_reduc
        if create_asm && not keep_asm then remove_file asm_filename
     )
 
-let end_gen_implementation0 unix ?toplevel ~ppf_dump ~sourcefile make_cmm =
+let end_gen_implementation unix ?toplevel ~ppf_dump ~sourcefile make_cmm =
   Emitaux.Dwarf_helpers.init ~disable_dwarf:false sourcefile;
   emit_begin_assembly unix;
   make_cmm ()
@@ -452,10 +452,6 @@ let end_gen_implementation0 unix ?toplevel ~ppf_dump ~sourcefile make_cmm =
           !Translmod.primitive_declarations));
   emit_end_assembly sourcefile ()
 
-let end_gen_implementation unix ?toplevel ~ppf_dump ~sourcefile clambda =
-  end_gen_implementation0 unix ?toplevel ~ppf_dump ~sourcefile (fun () ->
-    Profile.record "cmm" Cmmgen.compunit clambda)
-
 type middle_end =
      backend:(module Backend_intf.S)
   -> filename:string
@@ -464,43 +460,47 @@ type middle_end =
   -> Lambda.program
   -> Clambda.with_constants
 
+type direct_to_cmm =
+     ppf_dump:Format.formatter
+  -> prefixname:string
+  -> filename:string
+  -> Lambda.program
+  -> Cmm.phrase list
+
+type pipeline =
+  | Via_clambda of {
+      backend : (module Backend_intf.S);
+      middle_end : middle_end;
+    }
+  | Direct_to_cmm of direct_to_cmm
+
 let asm_filename output_prefix =
     if !keep_asm_file || !Emitaux.binary_backend_available
     then output_prefix ^ ext_asm
     else Filename.temp_file "camlasm" ext_asm
 
-let compile_implementation unix ?toplevel ~backend ~filename ~prefixname
-      ~middle_end ~ppf_dump (program : Lambda.program) =
+let compile_implementation unix ?toplevel ~pipeline
+      ~filename ~prefixname ~ppf_dump (program : Lambda.program) =
   compile_unit ~ppf_dump ~output_prefix:prefixname
     ~asm_filename:(asm_filename prefixname) ~keep_asm:!keep_asm_file
     ~obj_filename:(prefixname ^ ext_obj)
     ~may_reduce_heap:(Option.is_none toplevel)
     (fun () ->
       Compilation_unit.Set.iter Compilenv.require_global
         program.required_globals;
-      let clambda_with_constants =
-        middle_end ~backend ~filename ~prefixname ~ppf_dump program
-      in
-      end_gen_implementation unix ?toplevel ~ppf_dump ~sourcefile:filename
-        clambda_with_constants)
-
-let compile_implementation_flambda2 unix ?toplevel ?(keep_symbol_tables=true)
-    ~filename ~prefixname ~size:module_block_size_in_words ~compilation_unit
-    ~module_initializer ~flambda2 ~ppf_dump ~required_globals () =
-  compile_unit ~ppf_dump ~output_prefix:prefixname
-    ~asm_filename:(asm_filename prefixname) ~keep_asm:!keep_asm_file
-    ~obj_filename:(prefixname ^ ext_obj)
-    ~may_reduce_heap:(Option.is_none toplevel)
-    (fun () ->
-      Compilation_unit.Set.iter Compilenv.require_global
-        required_globals;
-      let cmm_phrases =
-        flambda2 ~ppf_dump ~prefixname ~filename ~compilation_unit
-          ~module_block_size_in_words ~module_initializer
-          ~keep_symbol_tables
-      in
-      end_gen_implementation0 unix ?toplevel ~ppf_dump ~sourcefile:filename
-        (fun () -> cmm_phrases))
+      match pipeline with
+      | Via_clambda { middle_end; backend; } ->
+        let clambda_with_constants =
+          middle_end ~backend ~filename ~prefixname ~ppf_dump program
+        in
+        end_gen_implementation unix ?toplevel ~ppf_dump ~sourcefile:filename
+          (fun () -> Profile.record "cmm" Cmmgen.compunit clambda_with_constants)
+      | Direct_to_cmm direct_to_cmm ->
+        let cmm_phrases =
+          direct_to_cmm ~ppf_dump ~prefixname ~filename program
+        in
+        end_gen_implementation unix ?toplevel ~ppf_dump ~sourcefile:filename
+          (fun () -> cmm_phrases))
 
 let linear_gen_implementation unix filename =
   let open Linear_format in

backend/asmgen.mli

@@ -24,42 +24,32 @@ type middle_end =
   -> Lambda.program
   -> Clambda.with_constants
 
-(** Compile an implementation from Lambda using the given middle end. *)
-val compile_implementation
-   : (module Compiler_owee.Unix_intf.S)
-  -> ?toplevel:(string -> bool)
-  -> backend:(module Backend_intf.S)
-  -> filename:string
+(** The type of converters straight from Lambda to Cmm. This is how Flambda 2
+    operates. *)
+type direct_to_cmm =
+  ppf_dump:Format.formatter
   -> prefixname:string
-  -> middle_end:middle_end
-  -> ppf_dump:Format.formatter
+  -> filename:string
   -> Lambda.program
-  -> unit
+  -> Cmm.phrase list
+
+(** The ways to get from Lambda to Cmm. *)
+type pipeline =
+  | Via_clambda of {
+      backend : (module Backend_intf.S);
+      middle_end : middle_end;
+    }
+  | Direct_to_cmm of direct_to_cmm
 
-(** Compile an implementation from Lambda using Flambda 2.
-    The Flambda 2 middle end neither uses the Clambda language nor the
-    Cmmgen pass.  Instead it emits Cmm directly. *)
-val compile_implementation_flambda2
+(** Compile an implementation from Lambda using the given middle end. *)
+val compile_implementation
    : (module Compiler_owee.Unix_intf.S)
   -> ?toplevel:(string -> bool)
-  -> ?keep_symbol_tables:bool
+  -> pipeline:pipeline
   -> filename:string
   -> prefixname:string
-  -> size:int
-  -> compilation_unit:Compilation_unit.t
-  -> module_initializer:Lambda.lambda
-  -> flambda2:(
-    ppf_dump:Format.formatter ->
-    prefixname:string ->
-    filename:string ->
-    compilation_unit:Compilation_unit.t ->
-    module_block_size_in_words:int ->
-    module_initializer:Lambda.lambda ->
-    keep_symbol_tables:bool ->
-    Cmm.phrase list)
   -> ppf_dump:Format.formatter
-  -> required_globals:Compilation_unit.Set.t
-  -> unit
+  -> Lambda.program
   -> unit
 
 val compile_implementation_linear

backend/asmpackager.ml

@@ -83,8 +83,16 @@ let check_units members =
 
 (* Make the .o file for the package *)
 
+type flambda2 =
+  ppf_dump:Format.formatter ->
+  prefixname:string ->
+  filename:string ->
+  keep_symbol_tables:bool ->
+  Lambda.program ->
+  Cmm.phrase list
+
 let make_package_object unix ~ppf_dump members targetobj targetname coercion
-      ~backend ~flambda2 =
+      ~backend ~(flambda2 : flambda2) =
   Profile.record_call (Printf.sprintf "pack(%s)" targetname) (fun () ->
     let objtemp =
       if !Clflags.keep_asm_file
@@ -111,61 +119,38 @@ let make_package_object unix ~ppf_dump members targetobj targetname coercion
     let compilation_unit = CU.create for_pack_prefix modname in
     let prefixname = Filename.remove_extension objtemp in
     let required_globals = Compilation_unit.Set.empty in
-    if Config.flambda2 then begin
-      let main_module_block_size, module_initializer =
-        Translmod.transl_package_flambda components coercion
-      in
-      let module_initializer = Simplif.simplify_lambda module_initializer in
-      Asmgen.compile_implementation_flambda2 unix
-        ~filename:targetname
-        ~prefixname
-        ~size:main_module_block_size
-        ~compilation_unit
-        ~module_initializer
-        ~flambda2
-        ~ppf_dump
-        ~required_globals:required_globals
-        ~keep_symbol_tables:true
-        ()
-    end else begin
-      let program, middle_end =
-        if Config.flambda then
-          let main_module_block_size, code =
-            Translmod.transl_package_flambda components coercion
-          in
-          let code = Simplif.simplify_lambda code in
-          let program =
-            { Lambda.
-              code;
-              main_module_block_size;
-              compilation_unit;
-              required_globals;
-            }
-          in
-          program, Flambda_middle_end.lambda_to_clambda
-        else
-          let main_module_block_size, code =
-            Translmod.transl_store_package components
-              compilation_unit coercion
-          in
-          let code = Simplif.simplify_lambda code in
-          let program =
-            { Lambda.
-              code;
-              main_module_block_size;
-              compilation_unit;
-              required_globals;
-            }
-          in
-          program, Closure_middle_end.lambda_to_clambda
-      in
-      Asmgen.compile_implementation ~backend unix
-        ~filename:targetname
-        ~prefixname
-        ~middle_end
-        ~ppf_dump
-        program
-    end;
+    let transl_style : Translmod.compilation_unit_style =
+      if Config.flambda || Config.flambda2 then Plain_block
+      else Set_individual_fields
+    in
+    let main_module_block_size, code =
+      Translmod.transl_package components compilation_unit coercion
+        ~style:transl_style
+    in
+    let code = Simplif.simplify_lambda code in
+    let program =
+      { Lambda.
+        code;
+        main_module_block_size;
+        compilation_unit;
+        required_globals;
+      }
+    in
+    let pipeline : Asmgen.pipeline =
+      if Config.flambda2 then
+        Direct_to_cmm (flambda2 ~keep_symbol_tables:true)
+      else
+        let middle_end =
+          if Config.flambda then Flambda_middle_end.lambda_to_clambda
+          else Closure_middle_end.lambda_to_clambda
+        in
+        Via_clambda { middle_end; backend }
+    in
+    Asmgen.compile_implementation ~pipeline unix
+      ~filename:targetname
+      ~prefixname
+      ~ppf_dump
+      program;
     let objfiles =
       List.map
         (fun m -> Filename.remove_extension m.pm_file ^ Config.ext_obj)

backend/asmpackager.mli

@@ -27,10 +27,8 @@ val package_files
     ppf_dump:Format.formatter ->
     prefixname:string ->
     filename:string ->
-    compilation_unit:Compilation_unit.t ->
-    module_block_size_in_words:int ->
-    module_initializer:Lambda.lambda ->
     keep_symbol_tables:bool ->
+    Lambda.program ->
     Cmm.phrase list)
   -> unit