ability to restart compilation from .cmir-linear IR files

8 files changed, 64 insertions, 38 deletions

diff --git a/driver/compenv.ml b/driver/compenv.ml
index 9f6fa692b4..8efe79e6be 100644
--- a/driver/compenv.ml
+++ b/driver/compenv.ml
@@ -193,6 +193,30 @@ let check_bool ppf name s =
       "bad value %s for %s" s name;
     false
 
+let decode_compiler_pass ppf v ~name ~filter =
+  let module P = Clflags.Compiler_pass in
+  let passes = P.available_pass_names ~filter ~native:!native_code in
+  begin match List.find_opt (String.equal v) passes with
+  | None ->
+    Printf.ksprintf (print_error ppf)
+      "bad value %s for option \"%s\" (expected one of: %s)"
+      v name (String.concat ", " passes);
+    None
+  | Some v -> P.of_string v
+  end
+
+let set_compiler_pass ppf ~name v flag ~filter =
+  match decode_compiler_pass ppf v ~name ~filter with
+  | None -> ()
+  | Some pass ->
+    match !flag with
+    | None -> flag := Some pass
+    | Some p ->
+      if not (p = pass) then begin
+        Printf.ksprintf (print_error ppf)
+          "Please specify at most one %s <pass>." name
+      end
+
 (* 'can-discard=' specifies which arguments can be discarded without warning
    because they are not understood by some versions of OCaml. *)
 let can_discard = ref []
@@ -436,35 +460,14 @@ let read_one_param ppf position name v =
      profile_columns := if check_bool ppf name v then if_on else []
 
   | "stop-after" ->
-    let module P = Clflags.Compiler_pass in
-    let passes = P.available_pass_names
-                   ~filter:(fun _ -> true)
-                   ~native:!native_code in
-    begin match List.find_opt (String.equal v) passes with
-    | None ->
-        Printf.ksprintf (print_error ppf)
-          "bad value %s for option \"stop-after\" (expected one of: %s)"
-          v (String.concat ", " passes)
-    | Some v ->
-        let pass = Option.get (P.of_string v)  in
-        Clflags.stop_after := Some pass
-    end
+    set_compiler_pass ppf v ~name Clflags.stop_after ~filter:(fun _ -> true)
 
   | "save-ir-after" ->
     if !native_code then begin
-      let module P = Clflags.Compiler_pass in
-      let passes = P.available_pass_names
-                     ~filter:P.can_save_ir_after
-                     ~native:!native_code in
-      begin match List.find_opt (String.equal v) passes with
-      | None ->
-          Printf.ksprintf (print_error ppf)
-            "bad value %s for option \"save-ir-after\" (expected one of: %s)"
-            v (String.concat ", " passes)
-      | Some v ->
-          let pass = Option.get (P.of_string v)  in
-          set_save_ir_after pass true
-      end
+      let filter = Clflags.Compiler_pass.can_save_ir_after in
+      match decode_compiler_pass ppf v ~name ~filter with
+      | None -> ()
+      | Some pass -> set_save_ir_after pass true
     end
 
   | _ ->
@@ -475,6 +478,7 @@ let read_one_param ppf position name v =
         name
     end
 
+
 let read_OCAMLPARAM ppf position =
   try
     let s = Sys.getenv "OCAMLPARAM" in
@@ -614,12 +618,15 @@ let c_object_of_filename name =
 
 let process_action
     (ppf, implementation, interface, ocaml_mod_ext, ocaml_lib_ext) action =
+  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;
+    objfiles := (opref ^ ocaml_mod_ext) :: !objfiles
+  in
   match action with
   | ProcessImplementation name ->
-      readenv ppf (Before_compile name);
-      let opref = output_prefix name in
-      implementation ~source_file:name ~output_prefix:opref;
-      objfiles := (opref ^ ocaml_mod_ext) :: !objfiles
+      impl ~start_from:Compiler_pass.Parsing name
   | ProcessInterface name ->
       readenv ppf (Before_compile name);
       let opref = output_prefix name in
@@ -646,7 +653,11 @@ let process_action
       else if not !native_code && Filename.check_suffix name Config.ext_dll then
         dllibs := name :: !dllibs
       else
-        raise(Arg.Bad("don't know what to do with " ^ name))
+        match Compiler_pass.of_input_filename name with
+        | Some start_from ->
+          Location.input_name := name;
+          impl ~start_from name
+        | None -> raise(Arg.Bad("don't know what to do with " ^ name))
 
 
 let action_of_file name =
diff --git a/driver/compenv.mli b/driver/compenv.mli
index a8c22f3081..93a585dc78 100644
--- a/driver/compenv.mli
+++ b/driver/compenv.mli
@@ -71,7 +71,8 @@ val intf : string -> unit
 
 val process_deferred_actions :
   Format.formatter *
-  (source_file:string -> output_prefix:string -> unit) *
+  (start_from:Clflags.Compiler_pass.t ->
+   source_file:string -> output_prefix:string -> unit) *
   (* compile implementation *)
   (source_file:string -> output_prefix:string -> unit) *
   (* compile interface *)
diff --git a/driver/compile.ml b/driver/compile.ml
index c41a877ff4..ead460368c 100644
--- a/driver/compile.ml
+++ b/driver/compile.ml
@@ -54,10 +54,13 @@ let emit_bytecode i (bytecode, required_globals) =
          (Emitcode.to_file oc i.module_name cmofile ~required_globals);
     )
 
-let implementation ~source_file ~output_prefix =
+let implementation ~start_from ~source_file ~output_prefix =
   let backend info typed =
     let bytecode = to_bytecode info typed in
     emit_bytecode info bytecode
   in
   with_info ~source_file ~output_prefix ~dump_ext:"cmo" @@ fun info ->
-  Compile_common.implementation info ~backend
+  match (start_from : Clflags.Compiler_pass.t) with
+  | Parsing -> Compile_common.implementation info ~backend
+  | _ -> Misc.fatal_errorf "Cannot start from %s"
+           (Clflags.Compiler_pass.to_string start_from)
diff --git a/driver/compile.mli b/driver/compile.mli
index 7c564c3e3d..968955762a 100644
--- a/driver/compile.mli
+++ b/driver/compile.mli
@@ -18,6 +18,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
 
 (** {2 Internal functions} **)
diff --git a/driver/maindriver.ml b/driver/maindriver.ml
index be9a8e5e62..81d7edfd29 100644
--- a/driver/maindriver.ml
+++ b/driver/maindriver.ml
@@ -63,7 +63,7 @@ let main argv ppf =
            are  incompatible with -pack, -a, -output-obj"
           (String.concat "|"
              (P.available_pass_names ~filter:(fun _ -> true) ~native:false))
-      | Some P.Scheduling -> assert false (* native only *)
+      | Some (P.Scheduling | P.Emit) -> assert false (* native only *)
     end;
     if !make_archive then begin
       Compmisc.init_path ();
diff --git a/driver/optcompile.ml b/driver/optcompile.ml
index 9ca93c33b0..693a35f489 100644
--- a/driver/optcompile.ml
+++ b/driver/optcompile.ml
@@ -85,7 +85,12 @@ let clambda i backend typed =
             ~ppf_dump:i.ppf_dump;
        Compilenv.save_unit_info (cmx i))
 
-let implementation ~backend ~source_file ~output_prefix =
+(* Emit assembly directly from Linear IR *)
+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 backend info typed =
     Compilenv.reset ?packname:!Clflags.for_package info.module_name;
     if Config.flambda
@@ -93,4 +98,8 @@ let implementation ~backend ~source_file ~output_prefix =
     else clambda info backend typed
   in
   with_info ~source_file ~output_prefix ~dump_ext:"cmx" @@ fun info ->
-  Compile_common.implementation info ~backend
+  match (start_from:Clflags.Compiler_pass.t) with
+  | Parsing -> Compile_common.implementation info ~backend
+  | Emit -> emit info
+  | _ -> Misc.fatal_errorf "Cannot start from %s"
+           (Clflags.Compiler_pass.to_string start_from)
diff --git a/driver/optcompile.mli b/driver/optcompile.mli
index 9a23b8b239..f04e75e626 100644
--- a/driver/optcompile.mli
+++ b/driver/optcompile.mli
@@ -19,6 +19,7 @@ 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
 
 (** {2 Internal functions} **)
diff --git a/driver/optmaindriver.ml b/driver/optmaindriver.ml
index 0c9626f2b0..9986a5a5b8 100644
--- a/driver/optmaindriver.ml
+++ b/driver/optmaindriver.ml
@@ -75,7 +75,7 @@ let main argv ppf =
       | None ->
           Compenv.fatal "Please specify at most one of -pack, -a, -shared, -c, \
                          -output-obj";
-      | Some ((P.Parsing | P.Typing | P.Scheduling) as p) ->
+      | Some ((P.Parsing | P.Typing | P.Scheduling | P.Emit) as p) ->
         assert (P.is_compilation_pass p);
         Printf.ksprintf Compenv.fatal
           "Options -i and -stop-after (%s) \