flambda-backend: Attempt to shrink the heap before calling the assembler (ocaml#429)

* Attempt to shrink the heap before calling the assembler

We have a fair amount of global state that's never collected, which is causing
trouble in large parallel builds, particularly when large assembly files are
generated, causing `as` to need a lot of memory itself. This patch simply clears
out some data once it's no longer needed and, when memory use is high, calls
`Gc.compact` to try and release some memory back to the OS. This has been
observed to reduce the heap size by some 640MB (for an unusually large generated
.ml file).

This PR still leaves some relatively low-hanging fruit: after to_cmm, we can
marshal the .cmx eagerly and clear out the exported info. However, it's not
obvious how to handle this cleanly, and anyway one can use `-Oclassic` to avoid
producing a large .cmx to begin with.

Author: lukemaurer

driver/compenv.ml

@@ -621,11 +621,13 @@ let c_object_of_filename name =
   Filename.chop_suffix (Filename.basename name) ".c" ^ Config.ext_obj
 
 let process_action
-    (ppf, implementation, interface, ocaml_mod_ext, ocaml_lib_ext) action =
+    (ppf, implementation, interface, ocaml_mod_ext, ocaml_lib_ext) action
+    ~keep_symbol_tables =
   let impl ~start_from name =
     readenv ppf (Before_compile name);
     let opref = output_prefix name in
-    implementation ~start_from ~source_file:name ~output_prefix:opref;
+    implementation ~start_from ~source_file:name ~output_prefix:opref
+      ~keep_symbol_tables;
     objfiles := (opref ^ ocaml_mod_ext) :: !objfiles
   in
   match action with
@@ -709,7 +711,14 @@ let process_deferred_actions env =
       | ProcessOtherFile name -> Filename.check_suffix name ".cmxa"
       | _ -> false) !deferred_actions then
     fatal "Option -a cannot be used with .cmxa input files.";
-  List.iter (process_action env) (List.rev !deferred_actions);
+  let compiling_multiple_impls =
+    List.length (List.filter (function
+        | ProcessImplementation _ -> true
+        | _ -> false) !deferred_actions) > 1
+  in
+  let keep_symbol_tables = compiling_multiple_impls in
+  List.iter (process_action env ~keep_symbol_tables)
+    (List.rev !deferred_actions);
   output_name := final_output_name;
   stop_early :=
     !compile_only ||

driver/compenv.mli

@@ -82,7 +82,8 @@ val intf : string -> unit
 val process_deferred_actions :
   Format.formatter *
   (start_from:Clflags.Compiler_pass.t ->
-   source_file:string -> output_prefix:string -> unit) *
+   source_file:string -> output_prefix:string ->
+   keep_symbol_tables:bool -> unit) *
   (* compile implementation *)
   (source_file:string -> output_prefix:string -> unit) *
   (* compile interface *)

driver/compile.ml

@@ -57,7 +57,8 @@ let emit_bytecode i (bytecode, required_globals) =
          (Emitcode.to_file oc i.module_name cmofile ~required_globals);
     )
 
-let implementation ~start_from ~source_file ~output_prefix =
+let implementation ~start_from ~source_file ~output_prefix
+    ~keep_symbol_tables:_ =
   let backend info typed =
     let bytecode = to_bytecode info typed in
     emit_bytecode info bytecode

driver/compile.mli

@@ -19,7 +19,7 @@ val interface:
   source_file:string -> output_prefix:string -> unit
 val implementation:
   start_from:Clflags.Compiler_pass.t ->
-  source_file:string -> output_prefix:string -> unit
+  source_file:string -> output_prefix:string -> keep_symbol_tables:bool -> unit
 
 (** {2 Internal functions} **)
 

driver/optcompile.ml

@@ -87,7 +87,8 @@ let emit i =
   Compilenv.reset ?packname:!Clflags.for_package i.module_name;
   Asmgen.compile_implementation_linear i.output_prefix ~progname:i.source_file
 
-let implementation ~backend ~start_from ~source_file ~output_prefix =
+let implementation ~backend ~start_from ~source_file
+    ~output_prefix ~keep_symbol_tables:_ =
   let backend info typed =
     Compilenv.reset ?packname:!Clflags.for_package info.module_name;
     if Config.flambda

driver/optcompile.mli

@@ -20,7 +20,8 @@ val interface: source_file:string -> output_prefix:string -> unit
 val implementation:
    backend:(module Backend_intf.S)
    -> start_from:Clflags.Compiler_pass.t
-   -> source_file:string -> output_prefix:string -> unit
+   -> source_file:string -> output_prefix:string -> keep_symbol_tables:bool
+   -> unit
 
 (** {2 Internal functions} **)
 

typing/typemod.ml

@@ -2943,3 +2943,8 @@ let () =
       | _ ->
         None
     )
+
+let reset () =
+  Env.reset_cache ();
+  Envaux.reset_cache ();
+  Typetexp.reset_type_variables ()

typing/typemod.mli

@@ -136,3 +136,7 @@ exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
 
 val report_error: Env.t -> formatter -> error -> unit
+
+(** Clear several bits of global state that may retain large amounts of memory
+    after typechecking is finished. *)
+val reset : unit -> unit