Add a constructor to stop after middle-end (#2333)

Author: xclerc

backend/asmgen.ml

@@ -479,6 +479,7 @@ 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 ()
+  ++ (fun x -> if Clflags.should_stop_after Compiler_pass.Middle_end then exit 0 else x)
   ++ Compiler_hooks.execute_and_pipe Compiler_hooks.Cmm
   ++ Profile.record "compile_phrases" (compile_phrases ~ppf_dump)
   ++ (fun () -> ());

driver/optmaindriver.ml

@@ -90,7 +90,7 @@ let main unix argv ppf ~flambda2 =
       | None ->
           Compenv.fatal "Please specify at most one of -pack, -a, -shared, -c, \
                          -output-obj";
-      | Some ((P.Parsing | P.Typing | P.Lambda | P.Scheduling
+      | Some ((P.Parsing | P.Typing | P.Lambda | P.Middle_end | P.Scheduling
               | P.Simplify_cfg | P.Emit | P.Selection) as p) ->
         assert (P.is_compilation_pass p);
         Printf.ksprintf Compenv.fatal

ocaml/driver/maindriver.ml

@@ -67,7 +67,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 | P.Simplify_cfg | P.Emit | P.Selection) ->
+      | Some (P.Middle_end | P.Scheduling | P.Simplify_cfg | P.Emit | P.Selection) ->
         assert false (* native only *)
     end;
     if !make_archive then begin

ocaml/driver/optmaindriver.ml

@@ -72,7 +72,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.Lambda | P.Scheduling
+      | Some ((P.Parsing | P.Typing | P.Lambda | P.Middle_end | P.Scheduling
               | P.Simplify_cfg | P.Emit | P.Selection) as p) ->
         assert (P.is_compilation_pass p);
         Printf.ksprintf Compenv.fatal

ocaml/utils/clflags.ml

@@ -509,13 +509,14 @@ module Compiler_pass = struct
      - the manpages in man/ocaml{c,opt}.m
      - the manual manual/src/cmds/unified-options.etex
   *)
-  type t = Parsing | Typing | Lambda
+  type t = Parsing | Typing | Lambda | Middle_end
          | Scheduling | Emit | Simplify_cfg | Selection
 
   let to_string = function
     | Parsing -> "parsing"
     | Typing -> "typing"
     | Lambda -> "lambda"
+    | Middle_end -> "middle_end"
     | Scheduling -> "scheduling"
     | Emit -> "emit"
     | Simplify_cfg -> "simplify_cfg"
@@ -525,6 +526,7 @@ module Compiler_pass = struct
     | "parsing" -> Some Parsing
     | "typing" -> Some Typing
     | "lambda" -> Some Lambda
+    | "middle_end" -> Some Middle_end
     | "scheduling" -> Some Scheduling
     | "emit" -> Some Emit
     | "simplify_cfg" -> Some Simplify_cfg
@@ -535,6 +537,7 @@ module Compiler_pass = struct
     | Parsing -> 0
     | Typing -> 1
     | Lambda -> 2
+    | Middle_end -> 3
     | Selection -> 20
     | Simplify_cfg -> 49
     | Scheduling -> 50
@@ -544,13 +547,15 @@ module Compiler_pass = struct
     Parsing;
     Typing;
     Lambda;
+    Middle_end;
     Scheduling;
     Emit;
     Simplify_cfg;
     Selection;
   ]
   let is_compilation_pass _ = true
   let is_native_only = function
+    | Middle_end -> true
     | Scheduling -> true
     | Emit -> true
     | Simplify_cfg -> true
@@ -562,7 +567,7 @@ module Compiler_pass = struct
     | Scheduling -> true
     | Simplify_cfg -> true
     | Selection -> true
-    | Parsing | Typing | Lambda | Emit -> false
+    | Parsing | Typing | Lambda | Middle_end | Emit -> false
 
   let available_pass_names ~filter ~native =
     passes
@@ -578,7 +583,7 @@ module Compiler_pass = struct
     | Scheduling -> prefix ^ Compiler_ir.(extension Linear)
     | Simplify_cfg -> prefix ^ Compiler_ir.(extension Cfg)
     | Selection -> prefix ^ Compiler_ir.(extension Cfg) ^ "-sel"
-    | Emit | Parsing | Typing | Lambda -> Misc.fatal_error "Not supported"
+    | Emit | Parsing | Typing | Lambda | Middle_end -> Misc.fatal_error "Not supported"
 
   let of_input_filename name =
     match Compiler_ir.extract_extension_with_pass name with

ocaml/utils/clflags.mli

@@ -256,7 +256,7 @@ module Compiler_ir : sig
 end
 
 module Compiler_pass : sig
-  type t = Parsing | Typing | Lambda
+  type t = Parsing | Typing | Lambda | Middle_end
          | Scheduling | Emit | Simplify_cfg | Selection
   val of_string : string -> t option
   val to_string : t -> string