81 lines
2.7 KiB
OCaml
81 lines
2.7 KiB
OCaml
|
(** Options *)
|
||
|
|
|
||
|
|
open ExtStd
|
||
|
|
|
||
|
|
let error msg =
|
||
|
|
Error.global_error
|
||
|
|
"during analysis of options"
|
||
|
|
msg
|
||
|
|
|
||
|
|
let make_string_option what kind =
|
||
|
|
let language = ref "" in
|
||
|
|
let get () =
|
||
|
|
if !language = "" then
|
||
|
|
error (Printf.sprintf "You should specify the %s %s using '--%s'."
|
||
|
|
kind what kind);
|
||
|
|
!language
|
||
|
|
in
|
||
|
|
let set = ( := ) language in
|
||
|
|
let is_set () = !language <> "" in
|
||
|
|
get, set, is_set
|
||
|
|
|
||
|
|
let (get_source_language, set_source_language, is_source_language_set) =
|
||
|
|
make_string_option "language" "source"
|
||
|
|
|
||
|
|
let (get_target_language, set_target_language, is_target_language_set) =
|
||
|
|
make_string_option "language" "target"
|
||
|
|
|
||
|
|
type mode = Interactive | Batch
|
||
|
|
|
||
|
|
let mode = ref Batch
|
||
|
|
|
||
|
|
let set_mode = ( := ) mode
|
||
|
|
|
||
|
|
let get_mode () = !mode
|
||
|
|
|
||
|
|
let (get_input_filename, set_input_filename, is_input_filename_set) =
|
||
|
|
make_string_option "filename" "input"
|
||
|
|
|
||
|
|
let using : string list ref = ref []
|
||
|
|
let insert_using x = using := x :: !using
|
||
|
|
let get_using () = !using
|
||
|
|
|
||
|
|
let set_interactive_mode = function
|
||
|
|
| true -> set_mode Interactive
|
||
|
|
| false -> set_mode Batch
|
||
|
|
|
||
|
|
let set_running_mode, get_running_mode = Ref.as_functions false
|
||
|
|
let set_verbose_mode, get_verbose_mode = Ref.as_functions false
|
||
|
|
let set_dry_mode, get_dry_mode = Ref.as_functions false
|
||
|
|
let set_benchmark, get_benchmark = Ref.as_functions false
|
||
|
|
let set_unsafe, get_unsafe = Ref.as_functions false
|
||
|
|
let set_show_types, get_show_types = Ref.as_functions false
|
||
|
|
let set_infer_types, get_infer_types = Ref.as_functions false
|
||
|
|
let set_check_types, get_check_types = Ref.as_functions true
|
||
|
|
let set_verbose_eval, get_verbose_eval = Ref.as_functions false
|
||
|
|
let set_use_sexp_in, get_use_sexp_in = Ref.as_functions false
|
||
|
|
let set_use_sexp_out, get_use_sexp_out = Ref.as_functions false
|
||
|
|
let set_scripts_dir, get_scripts_dir = Ref.as_functions "/bin"
|
||
|
|
let set_include_dir, get_include_dir = Ref.as_functions "/usr/include"
|
||
|
|
let set_output_file, get_output_file = Ref.as_functions ""
|
||
|
|
let set_fast_match, get_fast_match = Ref.as_functions false
|
||
|
|
let set_backend, get_backend = Ref.as_functions "x86-64"
|
||
|
|
let set_regalloc, get_regalloc = Ref.as_functions "naive"
|
||
|
|
let set_debug_mode, get_debug_mode = Ref.as_functions false
|
||
|
|
let set_print_locs, get_print_locs = Ref.functions_of_ref Error.print_locs
|
||
|
|
|
||
|
|
let get_architecture () : (module Architecture.S) =
|
||
|
|
match get_backend () with
|
||
|
|
| "x86-64" -> (module X86_64_Architecture)
|
||
|
|
| s -> error (Printf.sprintf "`%s' is not a valid architecture." s)
|
||
|
|
|
||
|
|
type regalloc_variant = Naive | Realistic
|
||
|
|
|
||
|
|
let get_regalloc_variant () =
|
||
|
|
match get_regalloc () with
|
||
|
|
| "naive" -> Naive
|
||
|
|
| "realistic" -> Realistic
|
||
|
|
| s -> error (
|
||
|
|
Printf.sprintf "`%s' is not a valid register allocation strategy." s
|
||
|
|
)
|