flambda-backend: Save cfg to file (#257)

gretay-js · web-flow · commit 07e0918cdd32 · 2021-10-14T08:59:19.000+01:00
diff --git 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 | P.Emit) -> assert false (* native only *)
+      | Some (P.Scheduling | P.Simplify_cfg | P.Emit) -> assert false (* native only *)
     end;
     if !make_archive then begin
       Compmisc.init_path ();
diff --git a/driver/optmaindriver.ml b/driver/optmaindriver.ml
@@ -75,7 +75,8 @@ 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 | P.Emit) as p) ->
+      | Some ((P.Parsing | P.Typing | P.Scheduling
+              | P.Simplify_cfg | P.Emit) as p) ->
         assert (P.is_compilation_pass p);
         Printf.ksprintf Compenv.fatal
           "Options -i and -stop-after (%s) \
diff --git a/testsuite/tests/tool-ocamlopt-save-ir/save_ir_after_typing.compilers.reference b/testsuite/tests/tool-ocamlopt-save-ir/save_ir_after_typing.compilers.reference
@@ -1 +1 @@
-wrong argument 'typing'; option '-save-ir-after' expects one of: scheduling.
+wrong argument 'typing'; option '-save-ir-after' expects one of: scheduling simplify_cfg.
diff --git a/utils/clflags.ml b/utils/clflags.ml
@@ -420,18 +420,17 @@ let unboxed_types = ref false
 
 (* This is used by the -save-ir-after option. *)
 module Compiler_ir = struct
-  type t = Linear
+  type t = Linear | Cfg
 
   let all = [
-    Linear;
+    Linear; Cfg
   ]
 
-  let extension t =
-    let ext =
-    match t with
-      | Linear -> "linear"
-    in
-    ".cmir-" ^ ext
+  let to_string = function
+    | Linear -> "linear"
+    | Cfg -> "cfg"
+
+  let extension t = ".cmir-" ^ (to_string t)
 
   (** [extract_extension_with_pass filename] returns the IR whose extension
       is a prefix of the extension of [filename], and the suffix,
@@ -699,24 +698,27 @@ module Compiler_pass = struct
      - the manpages in man/ocaml{c,opt}.m
      - the manual manual/manual/cmds/unified-options.etex
   *)
-  type t = Parsing | Typing | Scheduling | Emit
+  type t = Parsing | Typing | Scheduling | Emit | Simplify_cfg
 
   let to_string = function
     | Parsing -> "parsing"
     | Typing -> "typing"
     | Scheduling -> "scheduling"
     | Emit -> "emit"
+    | Simplify_cfg -> "simplify_cfg"
 
   let of_string = function
     | "parsing" -> Some Parsing
     | "typing" -> Some Typing
     | "scheduling" -> Some Scheduling
     | "emit" -> Some Emit
+    | "simplify_cfg" -> Some Simplify_cfg
     | _ -> None
 
   let rank = function
     | Parsing -> 0
     | Typing -> 1
+    | Simplify_cfg -> 49
     | Scheduling -> 50
     | Emit -> 60
 
@@ -725,16 +727,19 @@ module Compiler_pass = struct
     Typing;
     Scheduling;
     Emit;
+    Simplify_cfg;
   ]
   let is_compilation_pass _ = true
   let is_native_only = function
     | Scheduling -> true
     | Emit -> true
-    | _ -> false
+    | Simplify_cfg -> true
+    | Parsing | Typing -> false
 
   let enabled is_native t = not (is_native_only t) || is_native
   let can_save_ir_after = function
     | Scheduling -> true
+    | Simplify_cfg -> true
     | _ -> false
 
   let available_pass_names ~filter ~native =
@@ -749,11 +754,13 @@ module Compiler_pass = struct
   let to_output_filename t ~prefix =
     match t with
     | Scheduling -> prefix ^ Compiler_ir.(extension Linear)
-    | _ -> Misc.fatal_error "Not supported"
+    | Simplify_cfg -> prefix ^ Compiler_ir.(extension Cfg)
+    | Emit | Parsing | Typing -> Misc.fatal_error "Not supported"
 
   let of_input_filename name =
     match Compiler_ir.extract_extension_with_pass name with
     | Some (Linear, _) -> Some Emit
+    | Some (Cfg, _) -> None
     | None -> None
 end
 
diff --git a/utils/clflags.mli b/utils/clflags.mli
@@ -311,8 +311,16 @@ val set_oclassic : unit -> unit
 val set_o2 : unit -> unit
 val set_o3 : unit -> unit
 
+module Compiler_ir : sig
+  type t = Linear | Cfg
+  val all : t list
+  val to_string : t -> string
+  val extension : t -> string
+  val extract_extension_with_pass : string -> (t * string) option
+end
+
 module Compiler_pass : sig
-  type t = Parsing | Typing | Scheduling | Emit
+  type t = Parsing | Typing | Scheduling | Emit | Simplify_cfg
   val of_string : string -> t option
   val to_string : t -> string
   val is_compilation_pass : t -> bool
diff --git a/utils/config.mli b/utils/config.mli
@@ -121,6 +121,9 @@ val cmt_magic_number: string
 val linear_magic_number: string
 (** Magic number for Linear internal representation files *)
 
+val cfg_magic_number: string
+(** Magic number for Cfg internal representation files *)
+
 val max_tag: int
 (** Biggest tag that can be stored in the header of a regular block. *)
 
diff --git a/utils/config.mlp b/utils/config.mlp
@@ -111,6 +111,7 @@ and ast_intf_magic_number = "Caml1999N029"
 and cmxs_magic_number = "Caml1999D029"
 and cmt_magic_number = "Caml1999T029"
 and linear_magic_number = "Caml1999L029"
+and cfg_magic_number = "Caml2021G029"
 
 let interface_suffix = ref ".mli"
 

Original file line number	Diff line number	Diff line change
`@@ -1 +1 @@`
`1`		`-wrong argument 'typing'; option '-save-ir-after' expects one of: scheduling.`
	`1`	`+wrong argument 'typing'; option '-save-ir-after' expects one of: scheduling simplify_cfg.`