diff options
Diffstat (limited to 'src/sail.ml')
| -rw-r--r-- | src/sail.ml | 126 |
1 files changed, 81 insertions, 45 deletions
diff --git a/src/sail.ml b/src/sail.ml index 920542bc..06bd618e 100644 --- a/src/sail.ml +++ b/src/sail.ml @@ -54,7 +54,6 @@ module Big_int = Nat_big_num let lib = ref ([] : string list) let opt_file_out : string option ref = ref None -let opt_interactive = ref false let opt_interactive_script : string option ref = ref None let opt_print_version = ref false let opt_print_initial_env = ref false @@ -65,7 +64,7 @@ let opt_print_c = ref false let opt_print_latex = ref false let opt_print_coq = ref false let opt_print_cgen = ref false -let opt_memo_z3 = ref false +let opt_memo_z3 = ref true let opt_sanity = ref false let opt_includes_c = ref ([]:string list) let opt_libs_lem = ref ([]:string list) @@ -73,21 +72,25 @@ let opt_libs_coq = ref ([]:string list) let opt_file_arguments = ref ([]:string list) let opt_process_elf : string option ref = ref None let opt_ocaml_generators = ref ([]:string list) +let opt_slice = ref ([]:string list) let options = Arg.align ([ ( "-o", Arg.String (fun f -> opt_file_out := Some f), "<prefix> select output filename prefix"); ( "-i", - Arg.Tuple [Arg.Set opt_interactive; Arg.Set Initial_check.opt_undefined_gen], + Arg.Tuple [Arg.Set Interactive.opt_interactive; Arg.Set Initial_check.opt_undefined_gen], " start interactive interpreter"); ( "-is", - Arg.Tuple [Arg.Set opt_interactive; Arg.Set Initial_check.opt_undefined_gen; + Arg.Tuple [Arg.Set Interactive.opt_interactive; Arg.Set Initial_check.opt_undefined_gen; Arg.String (fun s -> opt_interactive_script := Some s)], "<filename> start interactive interpreter and execute commands in script"); ( "-iout", Arg.String (fun file -> Value.output_redirect (open_out file)), "<filename> print interpreter output to file"); + ( "-emacs", + Arg.Set Interactive.opt_emacs_mode, + " run sail interactively as an emacs mode child process"); ( "-no_warn", Arg.Clear Util.opt_warnings, " do not print warnings"); @@ -96,7 +99,7 @@ let options = Arg.align ([ " output an OCaml translated version of the input"); ( "-ocaml-nobuild", Arg.Set Ocaml_backend.opt_ocaml_nobuild, - " do not build generated ocaml"); + " do not build generated OCaml"); ( "-ocaml_trace", Arg.Tuple [Arg.Set opt_print_ocaml; Arg.Set Initial_check.opt_undefined_gen; Arg.Set Ocaml_backend.opt_trace_ocaml], " output an OCaml translated version of the input with tracing instrumentation, implies -ocaml"); @@ -105,28 +108,31 @@ let options = Arg.align ([ " set a custom directory to build generated OCaml"); ( "-ocaml-coverage", Arg.Set Ocaml_backend.opt_ocaml_coverage, - " Build ocaml with bisect_ppx coverage reporting (requires opam packages bisect_ppx-ocamlbuild and bisect_ppx)."); + " build OCaml with bisect_ppx coverage reporting (requires opam packages bisect_ppx-ocamlbuild and bisect_ppx)."); ( "-ocaml_generators", Arg.String (fun s -> opt_ocaml_generators := s::!opt_ocaml_generators), "<types> produce random generators for the given types"); ( "-latex", Arg.Tuple [Arg.Set opt_print_latex; Arg.Clear Type_check.opt_expand_valspec ], - " pretty print the input to latex"); + " pretty print the input to LaTeX"); + ( "-latex_prefix", + Arg.String (fun prefix -> Latex.opt_prefix := prefix), + " set a custom prefix for generated LaTeX macro command (default sail)"); ( "-latex_full_valspecs", Arg.Clear Latex.opt_simple_val, - " print full valspecs in latex output latex"); + " print full valspecs in LaTeX output"); ( "-c", Arg.Tuple [Arg.Set opt_print_c; Arg.Set Initial_check.opt_undefined_gen], " output a C translated version of the input"); ( "-c_include", Arg.String (fun i -> opt_includes_c := i::!opt_includes_c), - " <filename> provide additional include for C output"); + "<filename> provide additional include for C output"); ( "-c_no_main", Arg.Set C_backend.opt_no_main, " do not generate the main() function" ); ( "-elf", Arg.String (fun elf -> opt_process_elf := Some elf), - " process an elf file so that it can be executed by compiled C code"); + " process an ELF file so that it can be executed by compiled C code"); ( "-O", Arg.Tuple [Arg.Set C_backend.optimize_primops; Arg.Set C_backend.optimize_hoist_allocations; @@ -137,19 +143,22 @@ let options = Arg.align ([ " turn on optimizations for C compilation"); ( "-Oconstant_fold", Arg.Set Constant_fold.optimize_constant_fold, - " Apply constant folding optimizations"); + " apply constant folding optimizations"); ( "-Oexperimental", Arg.Set C_backend.optimize_experimental, " turn on additional, experimental optimisations"); ( "-static", Arg.Set C_backend.opt_static, - " Make generated C functions static"); + " make generated C functions static"); ( "-trace", Arg.Tuple [Arg.Set C_backend.opt_trace; Arg.Set Ocaml_backend.opt_trace_ocaml], - " Instrument ouput with tracing"); + " instrument output with tracing"); + ( "-smt_trace", + Arg.Tuple [Arg.Set C_backend.opt_smt_trace], + " instrument output with tracing for SMT"); ( "-cgen", Arg.Set opt_print_cgen, - " Generate CGEN source"); + " generate CGEN source"); ( "-lem", Arg.Set opt_print_lem, " output a Lem translated version of the input"); @@ -186,9 +195,6 @@ let options = Arg.align ([ ( "-dcoq_debug_on", Arg.String (fun f -> Pretty_print_coq.opt_debug_on := f::!Pretty_print_coq.opt_debug_on), "<function> produce debug messages for Coq output on given function"); - ( "-latex_prefix", - Arg.String (fun prefix -> Latex.opt_prefix := prefix), - " set a custom prefix for generated latex command (default sail)"); ( "-mono_split", Arg.String (fun s -> let l = Util.split_on_char ':' s in @@ -199,7 +205,13 @@ let options = Arg.align ([ "<filename>:<line>:<variable> to case split for monomorphisation"); ( "-memo_z3", Arg.Set opt_memo_z3, - " memoize calls to z3, improving performance when typechecking repeatedly"); + " memoize calls to z3, improving performance when typechecking repeatedly (default)"); + ( "-no_memo_z3", + Arg.Clear opt_memo_z3, + " do not memoize calls to z3"); + ( "-memo", + Arg.Tuple [Arg.Set opt_memo_z3; Arg.Set C_backend.opt_memo_cache], + " memoize calls to z3, and intermediate compilation results"); ( "-undefined_gen", Arg.Set Initial_check.opt_undefined_gen, " generate undefined_type functions for types in the specification"); @@ -237,8 +249,11 @@ let options = Arg.align ([ Arg.Set Rewrites.opt_dmono_continue, " continue despite monomorphisation errors"); ( "-verbose", + Arg.Int (fun verbosity -> Util.opt_verbosity := verbosity), + " produce verbose output"); + ( "-output_sail", Arg.Set opt_print_verbose, - " (debug) pretty-print the input to standard output"); + " print Sail code after type checking and initial rewriting"); ( "-ddump_tc_ast", Arg.Set opt_ddump_tc_ast, " (debug) dump the typechecked ast to stdout"); @@ -251,6 +266,9 @@ let options = Arg.align ([ ( "-dtc_verbose", Arg.Int (fun verbosity -> Type_check.opt_tc_debug := verbosity), "<verbosity> (debug) verbose typechecker output: 0 is silent"); + ( "-dsmt_verbose", + Arg.Set Constraint.opt_smt_verbose, + " (debug) print SMTLIB constraints sent to Z3"); ( "-dno_cast", Arg.Set opt_dno_cast, " (debug) typecheck without any implicit casting"); @@ -265,16 +283,27 @@ let options = Arg.align ([ " (debug) print debugging output for a single function"); ( "-dprofile", Arg.Set Profile.opt_profile, - " (debug) provides basic profiling information for rewriting passes within Sail"); + " (debug) provide basic profiling information for rewriting passes within Sail"); + ( "-slice", + Arg.String (fun s -> opt_slice := s::!opt_slice), + "<id> produce version of input restricted to the given function"); ( "-v", Arg.Set opt_print_version, " print version"); ] ) +let version = + let open Manifest in + let default = Printf.sprintf "Sail %s @ %s" branch commit in + (* version is parsed from the output of git describe *) + match String.split_on_char '-' version with + | (vnum :: _) -> + Printf.sprintf "Sail %s (%s @ %s)" vnum branch commit + | _ -> default + let usage_msg = - ("Sail 2.0\n" - ^ "usage: sail <options> <file1.sail> ... <fileN.sail>\n" - ) + version + ^ "\nusage: sail <options> <file1.sail> ... <fileN.sail>\n" let _ = Arg.parse options @@ -282,10 +311,7 @@ let _ = opt_file_arguments := (!opt_file_arguments) @ [s]) usage_msg -let interactive_ast = ref (Ast.Defs []) -let interactive_env = ref Type_check.initial_env - -let load_files type_envs files = +let load_files ?generate:(generate=true) type_envs files = if !opt_memo_z3 then Constraint.load_digests () else (); let t = Profile.start () in @@ -294,7 +320,7 @@ let load_files type_envs files = List.fold_right (fun (_, Parse_ast.Defs ast_nodes) (Parse_ast.Defs later_nodes) -> Parse_ast.Defs (ast_nodes@later_nodes)) parsed (Parse_ast.Defs []) in let ast = Process_file.preprocess_ast options ast in - let ast = convert_ast Ast_util.inc_ord ast in + let ast = Initial_check.process_ast ~generate:generate ast in Profile.finish "parsing" t; let t = Profile.start () in @@ -302,7 +328,7 @@ let load_files type_envs files = Profile.finish "type checking" t; let ast = Scattered.descatter ast in - let ast = rewrite_ast ast in + let ast = rewrite_ast type_envs ast in let out_name = match !opt_file_out with | None when parsed = [] -> "out.sail" @@ -314,8 +340,8 @@ let load_files type_envs files = (out_name, ast, type_envs) let main() = - if !opt_print_version - then Printf.printf "Sail 2.0\n" + if !opt_print_version then + print_endline version else let out_name, ast, type_envs = load_files Type_check.initial_env !opt_file_arguments in Util.opt_warnings := false; (* Don't show warnings during re-writing for now *) @@ -343,31 +369,36 @@ let main() = | _ -> Some (Ocaml_backend.orig_types_for_ocaml_generator ast, !opt_ocaml_generators) in - (*let _ = Printf.eprintf "Type checked, next to pretty print" in*) begin - (if !(opt_interactive) + (if !(Interactive.opt_interactive) then - (interactive_ast := Process_file.rewrite_ast_interpreter ast; interactive_env := type_envs) + (Interactive.ast := Process_file.rewrite_ast_interpreter type_envs ast; Interactive.env := type_envs) else ()); (if !(opt_sanity) then - let _ = rewrite_ast_check ast in + let _ = rewrite_ast_check type_envs ast in () else ()); (if !(opt_print_verbose) then ((Pretty_print_sail.pp_defs stdout) ast) else ()); + (match !opt_slice with + | [] -> () + | ids -> + let ids = List.map Ast_util.mk_id ids in + let ids = Ast_util.IdSet.of_list ids in + Pretty_print_sail.pp_defs stdout (Specialize.slice_defs type_envs ast ids)); (if !(opt_print_ocaml) then - let ast_ocaml = rewrite_ast_ocaml ast in + let ast_ocaml = rewrite_ast_ocaml type_envs ast in let out = match !opt_file_out with None -> "out" | Some s -> s in Ocaml_backend.ocaml_compile out ast_ocaml ocaml_generator_info else ()); (if !(opt_print_c) then - let ast_c = rewrite_ast_c ast in + let ast_c = rewrite_ast_c type_envs ast in let ast_c, type_envs = Specialize.specialize ast_c type_envs in - let ast_c = Spec_analysis.top_sort_defs ast_c in + (* let ast_c = Spec_analysis.top_sort_defs ast_c in *) Util.opt_warnings := true; C_backend.compile_ast (C_backend.initial_ctx type_envs) (!opt_includes_c) ast_c else ()); @@ -378,14 +409,14 @@ let main() = then let mwords = !Pretty_print_lem.opt_mwords in let type_envs, ast_lem = State.add_regstate_defs mwords type_envs ast in - let ast_lem = rewrite_ast_lem ast_lem in - output "" (Lem_out (!opt_libs_lem)) [out_name,ast_lem] + let ast_lem = rewrite_ast_lem type_envs ast_lem in + output "" (Lem_out (!opt_libs_lem)) [out_name,type_envs,ast_lem] else ()); (if !(opt_print_coq) then let type_envs, ast_coq = State.add_regstate_defs true type_envs ast in - let ast_coq = rewrite_ast_coq ast_coq in - output "" (Coq_out (!opt_libs_coq)) [out_name,ast_coq] + let ast_coq = rewrite_ast_coq type_envs ast_coq in + output "" (Coq_out (!opt_libs_coq)) [out_name,type_envs,ast_coq] else ()); (if !(opt_print_latex) then @@ -406,11 +437,16 @@ let main() = close_out chan end else ()); + + if !opt_memo_z3 then Constraint.save_digests () else () end let _ = try begin - try ignore(main ()) - with Failure(s) -> raise (Reporting.err_general Parse_ast.Unknown ("Failure "^s)) + try ignore (main ()) + with Failure s -> raise (Reporting.err_general Parse_ast.Unknown ("Failure " ^ s)) end - with Reporting.Fatal_error e -> Reporting.report_error e + with Reporting.Fatal_error e -> + Reporting.print_error e; + Interactive.opt_suppress_banner := true; + if !Interactive.opt_interactive then () else exit 1 |
