[WIP] Flambda2 Makefile-based compilation (#36)

* Update Makefile to compile Flambda2

* Update .gitignore

* Disable -O3

* Stop generating allocs of size 0

* Fix dune compilation

* Fix Makefile for Monad and Top_closure

* Add support for ilambdac

Author: lthls

.depend

@@ -92,6 +92,10 @@ _build
 /manual/manual/cmds/warnings-help.etex
 /manual/manual/warnings-help.etex
 
+middle_end/flambda2.0/simplify/simplify.ml
+middle_end/flambda2.0/terms/flambda.ml
+middle_end/flambda2.0/types/flambda_type0.ml
+
 /ocamldoc/ocamldoc
 /ocamldoc/ocamldoc.opt
 /ocamldoc/odoc

.gitignore

@@ -181,12 +181,12 @@ let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end
 type middle_end2 =
      ppf_dump:Format.formatter
   -> prefixname:string
-  -> backend:(module Flambda2.Flambda2_backend_intf.S)
+  -> backend:(module Flambda2_backend_intf.S)
   -> size:int
   -> filename:string
   -> module_ident:Ident.t
   -> module_initializer:Lambda.lambda
-  -> Flambda2.Flambda_static.Program.t
+  -> Flambda_static.Program.t
 
 let compile_implementation2 ?toplevel ~backend ~filename ~prefixname ~size
     ~module_ident ~module_initializer ~middle_end ~ppf_dump required_globals =
@@ -202,7 +202,7 @@ let compile_implementation2 ?toplevel ~backend ~filename ~prefixname ~size
         (middle_end : middle_end2) ~backend ~size ~filename ~prefixname
           ~ppf_dump ~module_ident ~module_initializer
       in
-      end_gen_implementation ?toplevel ~ppf_dump Flambda2_to_cmm.Un_cps.program
+      end_gen_implementation ?toplevel ~ppf_dump Un_cps.program
         translated_program)
 
 let compile_implementation_flambda ?toplevel ~prefixname
@@ -216,7 +216,7 @@ let compile_implementation_flambda ?toplevel ~prefixname
     (fun () ->
       Ident.Set.iter Compilenv.require_global required_globals;
       end_gen_implementation ?toplevel ~ppf_dump
-        Flambda2_to_cmm.Un_cps.program program)
+        Un_cps.program program)
 
 (* Error report *)
 

Makefile

@@ -39,17 +39,17 @@ val compile_implementation
 type middle_end2 =
      ppf_dump:Format.formatter
   -> prefixname:string
-  -> backend:(module Flambda2.Flambda2_backend_intf.S)
+  -> backend:(module Flambda2_backend_intf.S)
   -> size:int
   -> filename:string
   -> module_ident:Ident.t
   -> module_initializer:Lambda.lambda
-  -> Flambda2.Flambda_static.Program.t
+  -> Flambda_static.Program.t
 
 (** Compile an implementation from Lambda using the given middle end. *)
 val compile_implementation2
    : ?toplevel:(string -> bool)
-  -> backend:(module Flambda2.Flambda2_backend_intf.S)
+  -> backend:(module Flambda2_backend_intf.S)
   -> filename:string
   -> prefixname:string
   -> size:int
@@ -66,7 +66,7 @@ val compile_implementation_flambda
   -> prefixname:string
   -> ppf_dump:Format.formatter
   -> required_globals:Ident.Set.t
-  -> Flambda2.Flambda_static.Program.t
+  -> Flambda_static.Program.t
   -> unit
 
 val compile_phrase :

asmcomp/asmgen.ml

@@ -26,10 +26,7 @@ type error =
 exception Error of error
 
 let default_ui_export_info =
-  if Config.flambda then
-    Cmx_format.Flambda Export_info.empty
-  else
-    Cmx_format.Clambda Clambda.Value_unknown
+  Cmx_format.Clambda Clambda.Value_unknown
 
 let read_info name =
   let filename =

asmcomp/asmgen.mli

@@ -101,35 +101,20 @@ let make_package_object ~ppf_dump members targetobj targetname coercion
     let prefixname = Filename.remove_extension objtemp in
     let required_globals = Ident.Set.empty in
     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;
-            module_ident;
-            required_globals;
-          }
-        in
-        program, Flambda_middle_end.lambda_to_clambda
-      else
-        let main_module_block_size, code =
-          Translmod.transl_store_package components
-            (Ident.create_persistent targetname) coercion
-        in
-        let code = Simplif.simplify_lambda code in
-        let program =
-          { Lambda.
-            code;
-            main_module_block_size;
-            module_ident;
-            required_globals;
-          }
-        in
-        program, Closure_middle_end.lambda_to_clambda
+      let main_module_block_size, code =
+        Translmod.transl_store_package components
+          (Ident.create_persistent targetname) coercion
+      in
+      let code = Simplif.simplify_lambda code in
+      let program =
+        { Lambda.
+          code;
+          main_module_block_size;
+          module_ident;
+          required_globals;
+        }
+      in
+      program, Closure_middle_end.lambda_to_clambda
     in
     Asmgen.compile_implementation ~backend
       ~filename:targetname
@@ -150,16 +135,9 @@ let make_package_object ~ppf_dump members targetobj targetname coercion
 
 (* Make the .cmx file for the package *)
 
-let get_export_info ui =
-  assert(Config.flambda);
-  match ui.ui_export_info with
-  | Clambda _ -> assert false
-  | Flambda info -> info
-
 let get_approx ui =
   assert(not Config.flambda);
   match ui.ui_export_info with
-  | Flambda _ -> assert false
   | Clambda info -> info
 
 let build_package_cmx members cmxfile =
@@ -177,42 +155,10 @@ let build_package_cmx members cmxfile =
       (fun m accu ->
         match m.pm_kind with PM_intf -> accu | PM_impl info -> info :: accu)
       members [] in
-  let pack_units =
-    List.fold_left
-      (fun set info ->
-         let unit_id = Compilenv.unit_id_from_name info.ui_name in
-         Compilation_unit.Set.add
-           (Compilenv.unit_for_global unit_id) set)
-      Compilation_unit.Set.empty units in
-  let units =
-    if Config.flambda then
-      List.map (fun info ->
-          { info with
-            ui_export_info =
-              Flambda
-                (Export_info_for_pack.import_for_pack ~pack_units
-                   ~pack:(Compilenv.current_unit ())
-                   (get_export_info info)) })
-        units
-    else
-      units
-  in
   let ui = Compilenv.current_unit_infos() in
   let ui_export_info =
-    if Config.flambda then
-      let ui_export_info =
-        List.fold_left (fun acc info ->
-            Export_info.merge acc (get_export_info info))
-          (Export_info_for_pack.import_for_pack ~pack_units
-             ~pack:(Compilenv.current_unit ())
-             (get_export_info ui))
-          units
-      in
-      Flambda ui_export_info
-    else
-      Clambda (get_approx ui)
+    Clambda (get_approx ui)
   in
-  Export_info_for_pack.clear_import_state ();
   let pkg_infos =
     { ui_name = ui.ui_name;
       ui_symbol = ui.ui_symbol;

asmcomp/asmlibrarian.ml

@@ -1,8 +1,8 @@
 module Flambda2_backend = struct
   let symbol_for_global' id =
-    Flambda2.Symbol.unsafe_create
-      (Flambda2.Compilation_unit.get_current_exn ())
-      (Flambda2.Linkage_name.create (Compilenv.symbol_for_global id))
+    Symbol.unsafe_create
+      (Compilation_unit.get_current_exn ())
+      (Linkage_name.create (Compilenv.symbol_for_global id))
 
   let division_by_zero =
     symbol_for_global' Predef.ident_division_by_zero
@@ -14,7 +14,7 @@ module Flambda2_backend = struct
   let really_import_approx _ = failwith "Not yet implemented"
   let import_symbol _ = failwith "Not yet implemented"
 
-  let all_predefined_exception_symbols = Flambda2.Symbol.Set.empty (* XXX *)
+  let all_predefined_exception_symbols = Symbol.Set.empty (* XXX *)
 
   let size_int = Arch.size_int
   let big_endian = Arch.big_endian
@@ -23,12 +23,12 @@ module Flambda2_backend = struct
     Proc.max_arguments_for_tailcalls - 1
 end
 let flambda2_backend =
-  (module Flambda2_backend : Flambda2.Flambda2_backend_intf.S)
+  (module Flambda2_backend : Flambda2_backend_intf.S)
 
 let () =
   Clflags.dump_cmm := true;
   Clflags.keep_asm_file := true;
-  let fl = Flambda2.Parse_ilambda.go ~backend:flambda2_backend () in
+  let fl = Parse_ilambda.go ~backend:flambda2_backend () in
   Asmgen.compile_implementation_flambda
     ?toplevel:None
     ~prefixname:"test"

asmcomp/asmpackager.ml

@@ -36,32 +36,32 @@ module Flambda2_backend = struct
   let symbol_for_global' ?comp_unit id =
     let comp_unit =
       match comp_unit with
-      | None -> Flambda2.Compilation_unit.get_current_exn ()
+      | None -> Compilation_unit.get_current_exn ()
       | Some comp_unit -> comp_unit
     in
-    Flambda2.Symbol.unsafe_create
+    Symbol.unsafe_create
       comp_unit
-      (Flambda2.Linkage_name.create (Compilenv.symbol_for_global id))
+      (Linkage_name.create (Compilenv.symbol_for_global id))
 
   let closure_symbol _ = failwith "Not yet implemented"
 
   let division_by_zero =
     symbol_for_global'
-      ~comp_unit:(Flambda2.Compilation_unit.predefined_exception ())
+      ~comp_unit:(Compilation_unit.predefined_exception ())
       Predef.ident_division_by_zero
 
   let invalid_argument =
     symbol_for_global'
-      ~comp_unit:(Flambda2.Compilation_unit.predefined_exception ())
+      ~comp_unit:(Compilation_unit.predefined_exception ())
       Predef.ident_invalid_argument
 
   let all_predefined_exception_symbols =
-    Flambda2.Symbol.Set.of_list [
+    Symbol.Set.of_list [
       division_by_zero;
       invalid_argument;
     ] (* CR mshinwell: and the rest... *)
 
-  let symbol_for_global' id : Flambda2.Symbol.t = symbol_for_global' id
+  let symbol_for_global' id : Symbol.t = symbol_for_global' id
 
   let size_int = Arch.size_int
   let big_endian = Arch.big_endian
@@ -70,42 +70,7 @@ module Flambda2_backend = struct
     Proc.max_arguments_for_tailcalls - 1
 end
 let flambda2_backend =
-  (module Flambda2_backend : Flambda2.Flambda2_backend_intf.S)
-
-let flambda i backend typed =
-  if !Clflags.classic_inlining then begin
-    Clflags.default_simplify_rounds := 1;
-    Clflags.use_inlining_arguments_set Clflags.classic_arguments;
-    Clflags.unbox_free_vars_of_closures := false;
-    Clflags.unbox_specialised_args := false
-  end;
-  typed
-  |> Profile.(record transl)
-      (Translmod.transl_implementation_flambda i.module_name)
-  |> Profile.(record generate)
-    (fun {Lambda.module_ident; main_module_block_size;
-          required_globals; code } ->
-    ((module_ident, main_module_block_size), code)
-    |>> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.lambda
-    |>> Simplif.simplify_lambda
-    |>> print_if i.ppf_dump Clflags.dump_lambda Printlambda.lambda
-    |> (fun ((module_ident, main_module_block_size), code) ->
-      let program : Lambda.program =
-        { Lambda.
-          module_ident;
-          main_module_block_size;
-          required_globals;
-          code;
-        }
-      in
-      Asmgen.compile_implementation
-        ~backend
-        ~filename:i.source_file
-        ~prefixname:i.output_prefix
-        ~middle_end:Flambda_middle_end.lambda_to_clambda
-        ~ppf_dump:i.ppf_dump
-        program);
-    Compilenv.save_unit_info (cmx i))
+  (module Flambda2_backend : Flambda2_backend_intf.S)
 
 let flambda2 i typed =
   if !Clflags.classic_inlining then begin
@@ -133,7 +98,7 @@ let flambda2 i typed =
           ~module_ident
           ~module_initializer:code
           ~ppf_dump:i.ppf_dump
-          ~middle_end:Flambda2.Flambda2_middle_end.middle_end);
+          ~middle_end:Flambda2_middle_end.middle_end);
     Compilenv.save_unit_info (cmx i)
     )
 
@@ -156,16 +121,11 @@ let clambda i backend typed =
             ~ppf_dump:i.ppf_dump;
        Compilenv.save_unit_info (cmx i))
 
-let config_flambda2 () =
-  try ignore (Sys.getenv "FLAMBDA2"); true
-  with Not_found -> false
-
 let implementation ~backend ~source_file ~output_prefix =
   let backend info typed =
     Compilenv.reset ?packname:!Clflags.for_package info.module_name;
     if Config.flambda then
-      if config_flambda2 () then flambda2 info typed
-      else flambda info backend typed
+      flambda2 info typed
     else clambda info backend typed
   in
   with_info ~source_file ~output_prefix ~dump_ext:"cmx" @@ fun info ->

driver/ilambdac.ml

@@ -30,11 +30,3 @@ val clambda :
 (** [clambda info typed] applies the regular compilation pipeline to the
     given typechecked implementation and outputs the resulting files.
 *)
-
-val flambda :
-  Compile_common.info ->
-  (module Backend_intf.S) ->
-  Typedtree.structure * Typedtree.module_coercion -> unit
-(** [flambda info backend typed] applies the Flambda compilation pipeline to the
-    given typechecked implementation and outputs the resulting files.
-*)