summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGreta Yorsh <45005955+gretay-js@users.noreply.github.com>2020-10-13 14:07:13 +0100
committerGitHub <noreply@github.com>2020-10-13 15:07:13 +0200
commit855c13cd6e42abdc778767adf358cb8a4e4ac0a3 (patch)
tree26ba1ceb4ce5ea985cbe66f1e6f03fc50cded31f
parent246564e8db0e86f10339bc4a4045835590c3e8b9 (diff)
downloadocaml-855c13cd6e42abdc778767adf358cb8a4e4ac0a3.tar.gz
ability to restart compilation from .cmir-linear IR files
-rw-r--r--.depend7
-rw-r--r--Changes3
-rw-r--r--asmcomp/asmgen.ml59
-rw-r--r--asmcomp/asmgen.mli8
-rw-r--r--driver/compenv.ml73
-rw-r--r--driver/compenv.mli3
-rw-r--r--driver/compile.ml7
-rw-r--r--driver/compile.mli1
-rw-r--r--driver/maindriver.ml2
-rw-r--r--driver/optcompile.ml13
-rw-r--r--driver/optcompile.mli1
-rw-r--r--driver/optmaindriver.ml2
-rw-r--r--file_formats/linear_format.ml1
-rw-r--r--file_formats/linear_format.mli1
-rw-r--r--testsuite/tests/tool-ocamlopt-save-ir/check_for_pack.compilers.reference2
-rw-r--r--testsuite/tests/tool-ocamlopt-save-ir/check_for_pack.ml19
-rw-r--r--testsuite/tests/tool-ocamlopt-save-ir/start_from_emit.ml31
-rwxr-xr-xtestsuite/tests/tool-ocamlopt-save-ir/start_from_emit.sh14
-rw-r--r--utils/clflags.ml60
-rw-r--r--utils/clflags.mli12
20 files changed, 250 insertions, 69 deletions
diff --git a/.depend b/.depend
index 6ba99fac29..de33bcee84 100644
--- a/.depend
+++ b/.depend
@@ -5721,7 +5721,8 @@ driver/compenv.cmx : \
utils/clflags.cmx \
utils/ccomp.cmx \
driver/compenv.cmi
-driver/compenv.cmi :
+driver/compenv.cmi : \
+ utils/clflags.cmi
driver/compile.cmo : \
lambda/translmod.cmi \
lambda/simplif.cmi \
@@ -5752,7 +5753,8 @@ driver/compile.cmi : \
typing/typedtree.cmi \
bytecomp/instruct.cmi \
typing/ident.cmi \
- driver/compile_common.cmi
+ driver/compile_common.cmi \
+ utils/clflags.cmi
driver/compile_common.cmo : \
utils/warnings.cmi \
typing/typemod.cmi \
@@ -5945,6 +5947,7 @@ driver/optcompile.cmx : \
driver/optcompile.cmi : \
typing/typedtree.cmi \
driver/compile_common.cmi \
+ utils/clflags.cmi \
middle_end/backend_intf.cmi
driver/opterrors.cmo : \
parsing/location.cmi \
diff --git a/Changes b/Changes
index c20b695253..a8dc05591c 100644
--- a/Changes
+++ b/Changes
@@ -460,6 +460,9 @@ Working version
- #8939: Command-line option to save Linear IR before emit.
(Greta Yorsh, review by Mark Shinwell, Sébastien Hinderer and Frédéric Bour)
+- #9003: Start compilation from Emit when the input file is in Linear IR format.
+ (Greta Yorsh, review by Jérémie Dimino, Gabriel Scherer and Frédéric Bour)
+
### Build system:
- #7121, #9558: Always the autoconf-discovered ld in PACKLD. For
diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml
index de6d5300b9..3bb3a6009e 100644
--- a/asmcomp/asmgen.ml
+++ b/asmcomp/asmgen.ml
@@ -23,7 +23,9 @@ open Clflags
open Misc
open Cmm
-type error = Assembler_error of string
+type error =
+ | Assembler_error of string
+ | Mismatched_for_pack of string option
exception Error of error
@@ -39,18 +41,23 @@ let pass_dump_linear_if ppf flag message phrase =
if !flag then fprintf ppf "*** %s@.%a@." message Printlinear.fundecl phrase;
phrase
+let start_from_emit = ref true
+
let should_save_before_emit () =
- should_save_ir_after Compiler_pass.Scheduling
+ should_save_ir_after Compiler_pass.Scheduling && (not !start_from_emit)
let linear_unit_info =
{ Linear_format.unit_name = "";
items = [];
+ for_pack = None;
}
let reset () =
+ start_from_emit := false;
if should_save_before_emit () then begin
linear_unit_info.unit_name <- Compilenv.current_unit_name ();
linear_unit_info.items <- [];
+ linear_unit_info.for_pack <- !Clflags.for_package;
end
let save_data dl =
@@ -65,9 +72,9 @@ let save_linear f =
end;
f
-let write_linear output_prefix =
+let write_linear prefix =
if should_save_before_emit () then begin
- let filename = output_prefix ^ Clflags.Compiler_ir.(extension Linear) in
+ let filename = Compiler_pass.(to_output_filename Scheduling ~prefix) in
linear_unit_info.items <- List.rev linear_unit_info.items;
Linear_format.save filename linear_unit_info
end
@@ -218,14 +225,15 @@ type middle_end =
-> Lambda.program
-> Clambda.with_constants
-let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end
- ~ppf_dump (program : Lambda.program) =
- let asm_filename =
+let asm_filename output_prefix =
if !keep_asm_file || !Emitaux.binary_backend_available
- then prefixname ^ ext_asm
+ then output_prefix ^ ext_asm
else Filename.temp_file "camlasm" ext_asm
- in
- compile_unit ~output_prefix:prefixname ~asm_filename ~keep_asm:!keep_asm_file
+
+let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end
+ ~ppf_dump (program : Lambda.program) =
+ compile_unit ~output_prefix:prefixname
+ ~asm_filename:(asm_filename prefixname) ~keep_asm:!keep_asm_file
~obj_filename:(prefixname ^ ext_obj)
(fun () ->
Ident.Set.iter Compilenv.require_global program.required_globals;
@@ -234,12 +242,43 @@ let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end
in
end_gen_implementation ?toplevel ~ppf_dump clambda_with_constants)
+let linear_gen_implementation filename =
+ let open Linear_format in
+ let linear_unit_info, _ = restore filename in
+ (match !Clflags.for_package, linear_unit_info.for_pack with
+ | None, None -> ()
+ | Some expected, Some saved when String.equal expected saved -> ()
+ | _, saved -> raise(Error(Mismatched_for_pack saved)));
+ let emit_item = function
+ | Data dl -> emit_data dl
+ | Func f -> emit_fundecl f
+ in
+ start_from_emit := true;
+ emit_begin_assembly ();
+ Profile.record "Emit" (List.iter emit_item) linear_unit_info.items;
+ emit_end_assembly ()
+
+let compile_implementation_linear output_prefix ~progname =
+ compile_unit ~output_prefix
+ ~asm_filename:(asm_filename output_prefix) ~keep_asm:!keep_asm_file
+ ~obj_filename:(output_prefix ^ ext_obj)
+ (fun () ->
+ linear_gen_implementation progname)
+
(* Error report *)
let report_error ppf = function
| Assembler_error file ->
fprintf ppf "Assembler error, input left in file %a"
Location.print_filename file
+ | Mismatched_for_pack saved ->
+ let msg = function
+ | None -> "without -for-pack"
+ | Some s -> "with -for-pack "^s
+ in
+ fprintf ppf
+ "This input file cannot be compiled %s: it was generated %s."
+ (msg !Clflags.for_package) (msg saved)
let () =
Location.register_error_of_exn
diff --git a/asmcomp/asmgen.mli b/asmcomp/asmgen.mli
index 95df2eae45..f86bd67375 100644
--- a/asmcomp/asmgen.mli
+++ b/asmcomp/asmgen.mli
@@ -35,10 +35,16 @@ val compile_implementation
-> Lambda.program
-> unit
+val compile_implementation_linear :
+ string -> progname:string -> unit
+
val compile_phrase :
ppf_dump:Format.formatter -> Cmm.phrase -> unit
-type error = Assembler_error of string
+type error =
+ | Assembler_error of string
+ | Mismatched_for_pack of string option
+
exception Error of error
val report_error: Format.formatter -> error -> unit
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) \
diff --git a/file_formats/linear_format.ml b/file_formats/linear_format.ml
index a12711fc6f..5525a69707 100644
--- a/file_formats/linear_format.ml
+++ b/file_formats/linear_format.ml
@@ -24,6 +24,7 @@ type linear_unit_info =
{
mutable unit_name : string;
mutable items : linear_item_info list;
+ mutable for_pack : string option
}
type error =
diff --git a/file_formats/linear_format.mli b/file_formats/linear_format.mli
index d8856bc7db..766db5db24 100644
--- a/file_formats/linear_format.mli
+++ b/file_formats/linear_format.mli
@@ -27,6 +27,7 @@ type linear_unit_info =
{
mutable unit_name : string;
mutable items : linear_item_info list;
+ mutable for_pack : string option
}
(* Marshal and unmarshal a compilation unit in Linear format.
diff --git a/testsuite/tests/tool-ocamlopt-save-ir/check_for_pack.compilers.reference b/testsuite/tests/tool-ocamlopt-save-ir/check_for_pack.compilers.reference
new file mode 100644
index 0000000000..df07426a41
--- /dev/null
+++ b/testsuite/tests/tool-ocamlopt-save-ir/check_for_pack.compilers.reference
@@ -0,0 +1,2 @@
+File "check_for_pack.cmir-linear", line 1:
+Error: This input file cannot be compiled with -for-pack foo: it was generated without -for-pack.
diff --git a/testsuite/tests/tool-ocamlopt-save-ir/check_for_pack.ml b/testsuite/tests/tool-ocamlopt-save-ir/check_for_pack.ml
new file mode 100644
index 0000000000..610abbdc34
--- /dev/null
+++ b/testsuite/tests/tool-ocamlopt-save-ir/check_for_pack.ml
@@ -0,0 +1,19 @@
+(* TEST
+ * native-compiler
+ ** setup-ocamlopt.byte-build-env
+ *** ocamlopt.byte
+ flags = "-save-ir-after scheduling"
+ ocamlopt_byte_exit_status = "0"
+ **** script
+ script = "touch empty.ml"
+ ***** ocamlopt.byte
+ flags = "-S check_for_pack.cmir-linear -for-pack foo"
+ module = "empty.ml"
+ ocamlopt_byte_exit_status = "2"
+ ****** check-ocamlopt.byte-output
+*)
+
+let foo f x =
+ if x > 0 then x * 7 else f x
+
+let bar x y = x + y
diff --git a/testsuite/tests/tool-ocamlopt-save-ir/start_from_emit.ml b/testsuite/tests/tool-ocamlopt-save-ir/start_from_emit.ml
new file mode 100644
index 0000000000..6f6cdf0f28
--- /dev/null
+++ b/testsuite/tests/tool-ocamlopt-save-ir/start_from_emit.ml
@@ -0,0 +1,31 @@
+(* TEST
+ * native-compiler
+ ** setup-ocamlopt.byte-build-env
+ *** ocamlopt.byte
+ flags = "-save-ir-after scheduling -stop-after scheduling"
+ ocamlopt_byte_exit_status = "0"
+ **** script
+ script = "touch empty.ml"
+ ***** ocamlopt.byte
+ flags = "-S start_from_emit.cmir-linear"
+ module = "empty.ml"
+ ocamlopt_byte_exit_status = "0"
+ ****** check-ocamlopt.byte-output
+ ******* script
+ script = "sh ${test_source_directory}/start_from_emit.sh"
+ ******** ocamlopt.byte
+ flags = "-S start_from_emit.cmir-linear -save-ir-after scheduling"
+ module = "empty.ml"
+ ocamlopt_byte_exit_status = "0"
+ ********* script
+ script = "cp start_from_emit.cmir-linear expected.cmir_linear"
+ ********** check-ocamlopt.byte-output
+ *********** script
+ script = "cmp start_from_emit.cmir-linear expected.cmir_linear"
+
+*)
+
+let foo f x =
+ if x > 0 then x * 7 else f x
+
+let bar x y = x + y
diff --git a/testsuite/tests/tool-ocamlopt-save-ir/start_from_emit.sh b/testsuite/tests/tool-ocamlopt-save-ir/start_from_emit.sh
new file mode 100755
index 0000000000..99eb8136e6
--- /dev/null
+++ b/testsuite/tests/tool-ocamlopt-save-ir/start_from_emit.sh
@@ -0,0 +1,14 @@
+#!/bin/sh
+
+set -e
+
+obj=start_from_emit.${objext}
+
+# Check that obj is generated
+if [ -e "$obj" ] ; then
+ test_result=${TEST_PASS}
+else
+ echo "not found $obj" > ${ocamltest_response}
+ test_result=${TEST_FAIL}
+fi
+exit ${test_result}
diff --git a/utils/clflags.ml b/utils/clflags.ml
index 534551f80f..a193d53d26 100644
--- a/utils/clflags.ml
+++ b/utils/clflags.ml
@@ -417,21 +417,43 @@ let unboxed_types = ref false
(* This is used by the -save-ir-after option. *)
module Compiler_ir = struct
type t = Linear
+
+ let all = [
+ Linear;
+ ]
+
let extension t =
let ext =
match t with
- | Linear -> "linear"
+ | Linear -> "linear"
in
".cmir-" ^ ext
- let magic t =
- let open Config in
- match t with
- | Linear -> linear_magic_number
-
- let all = [
- Linear;
- ]
+ (** [extract_extension_with_pass filename] returns the IR whose extension
+ is a prefix of the extension of [filename], and the suffix,
+ which can be used to distinguish different passes on the same IR.
+ For example, [extract_extension_with_pass "foo.cmir-linear123"]
+ returns [Some (Linear, "123")]. *)
+ let extract_extension_with_pass filename =
+ let ext = Filename.extension filename in
+ let ext_len = String.length ext in
+ if ext_len <= 0 then None
+ else begin
+ let is_prefix ir =
+ let s = extension ir in
+ let s_len = String.length s in
+ s_len <= ext_len && s = String.sub ext 0 s_len
+ in
+ let drop_prefix ir =
+ let s = extension ir in
+ let s_len = String.length s in
+ String.sub ext s_len (ext_len - s_len)
+ in
+ let ir = List.find_opt is_prefix all in
+ match ir with
+ | None -> None
+ | Some ir -> Some (ir, drop_prefix ir)
+ end
end
(* This is used by the -stop-after option. *)
@@ -441,32 +463,37 @@ 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
+ type t = Parsing | Typing | Scheduling | Emit
let to_string = function
| Parsing -> "parsing"
| Typing -> "typing"
| Scheduling -> "scheduling"
+ | Emit -> "emit"
let of_string = function
| "parsing" -> Some Parsing
| "typing" -> Some Typing
| "scheduling" -> Some Scheduling
+ | "emit" -> Some Emit
| _ -> None
let rank = function
| Parsing -> 0
| Typing -> 1
| Scheduling -> 50
+ | Emit -> 60
let passes = [
Parsing;
Typing;
Scheduling;
+ Emit;
]
let is_compilation_pass _ = true
let is_native_only = function
| Scheduling -> true
+ | Emit -> true
| _ -> false
let enabled is_native t = not (is_native_only t) || is_native
@@ -479,6 +506,19 @@ module Compiler_pass = struct
|> List.filter (enabled native)
|> List.filter filter
|> List.map to_string
+
+ let compare a b =
+ compare (rank a) (rank b)
+
+ let to_output_filename t ~prefix =
+ match t with
+ | Scheduling -> prefix ^ Compiler_ir.(extension Linear)
+ | _ -> Misc.fatal_error "Not supported"
+
+ let of_input_filename name =
+ match Compiler_ir.extract_extension_with_pass name with
+ | Some (Linear, _) -> Some Emit
+ | None -> None
end
let stop_after = ref None (* -stop-after *)
diff --git a/utils/clflags.mli b/utils/clflags.mli
index 6fde1fc3e8..645ff4aaa4 100644
--- a/utils/clflags.mli
+++ b/utils/clflags.mli
@@ -235,20 +235,16 @@ val unboxed_types : bool ref
val insn_sched : bool ref
val insn_sched_default : bool
-module Compiler_ir : sig
- type t = Linear
- val extension : t -> string
- val magic : t -> string
- val all : t list
-end
-
module Compiler_pass : sig
- type t = Parsing | Typing | Scheduling
+ type t = Parsing | Typing | Scheduling | Emit
val of_string : string -> t option
val to_string : t -> string
val is_compilation_pass : t -> bool
val available_pass_names : filter:(t -> bool) -> native:bool -> string list
val can_save_ir_after : t -> bool
+ val compare : t -> t -> int
+ val to_output_filename: t -> prefix:string -> string
+ val of_input_filename: string -> t option
end
val stop_after : Compiler_pass.t option ref
val should_stop_after : Compiler_pass.t -> bool