diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/pretty_print_lem.ml | 14 | ||||
| -rw-r--r-- | src/process_file.ml | 1 | ||||
| -rw-r--r-- | src/process_file.mli | 1 | ||||
| -rw-r--r-- | src/rewriter.ml | 2 | ||||
| -rw-r--r-- | src/rewriter.mli | 1 | ||||
| -rw-r--r-- | src/sail.ml | 6 |
6 files changed, 20 insertions, 5 deletions
diff --git a/src/pretty_print_lem.ml b/src/pretty_print_lem.ml index dc51c819..7900e560 100644 --- a/src/pretty_print_lem.ml +++ b/src/pretty_print_lem.ml @@ -285,9 +285,9 @@ let doc_lit_lem sequential mwords in_pat (L_aux(lit,l)) a = | Typ_app (Id_aux (Id "register", _),_) -> utf8string "UndefinedRegister 0" | Typ_id (Id_aux (Id "string", _)) -> utf8string "\"\"" | _ -> + let ta = if contains_t_pp_var typ then empty else doc_tannot_lem sequential mwords false typ in parens - ((utf8string "(failwith \"undefined value of unsupported type\")") ^^ - (doc_tannot_lem sequential mwords false typ))) + ((utf8string "(failwith \"undefined value of unsupported type\")") ^^ ta)) | _ -> utf8string "(failwith \"undefined value of unsupported type\")") | L_string s -> utf8string ("\"" ^ s ^ "\"") | L_real s -> @@ -1031,7 +1031,15 @@ let doc_exp_lem, doc_let_lem = raise (Reporting_basic.err_unreachable l "pretty-printing non-constant sizeof expressions to Lem not supported")) | E_return r -> - align (string "early_return" ^//^ expV true r) + let ret_monad = if sequential then " : MR regstate" else " : MR" in + let ta = + if contains_t_pp_var (typ_of full_exp) || contains_t_pp_var (typ_of r) + then empty + else separate space + [string ret_monad; + parens (doc_typ_lem sequential mwords (typ_of full_exp)); + parens (doc_typ_lem sequential mwords (typ_of r))] in + align (parens (string "early_return" ^//^ expV true r ^//^ ta)) | E_constraint _ | E_comment _ | E_comment_struc _ -> empty | E_internal_cast _ | E_internal_exp _ | E_sizeof_internal _ | E_internal_exp_user _ -> raise (Reporting_basic.err_unreachable l diff --git a/src/process_file.ml b/src/process_file.ml index 8d23fcd2..8fb733d0 100644 --- a/src/process_file.ml +++ b/src/process_file.ml @@ -256,5 +256,6 @@ let rewrite rewriters defs = exit 1 let rewrite_ast = rewrite [("initial", Rewriter.rewrite_defs)] +let rewrite_undefined = rewrite [("undefined", Rewriter.rewrite_undefined)] let rewrite_ast_lem = rewrite Rewriter.rewrite_defs_lem let rewrite_ast_ocaml = rewrite Rewriter.rewrite_defs_ocaml diff --git a/src/process_file.mli b/src/process_file.mli index 53a6f3f2..f00d1e56 100644 --- a/src/process_file.mli +++ b/src/process_file.mli @@ -45,6 +45,7 @@ val convert_ast : Ast.order -> Parse_ast.defs -> unit Ast.defs val check_ast: unit Ast.defs -> Type_check.tannot Ast.defs * Type_check.Env.t val monomorphise_ast : ((string * int) * string) list -> Type_check.tannot Ast.defs -> Type_check.tannot Ast.defs * Type_check.Env.t val rewrite_ast: Type_check.tannot Ast.defs -> Type_check.tannot Ast.defs +val rewrite_undefined: Type_check.tannot Ast.defs -> Type_check.tannot Ast.defs val rewrite_ast_lem : Type_check.tannot Ast.defs -> Type_check.tannot Ast.defs val rewrite_ast_ocaml : Type_check.tannot Ast.defs -> Type_check.tannot Ast.defs diff --git a/src/rewriter.ml b/src/rewriter.ml index 7a25703d..0f05d295 100644 --- a/src/rewriter.ml +++ b/src/rewriter.ml @@ -3516,7 +3516,7 @@ let rewrite_defs_lem = [ let rewrite_defs_ocaml = [ (* ("top_sort_defs", top_sort_defs); *) - ("undefined", rewrite_undefined); + (* ("undefined", rewrite_undefined); *) ("tuple_assignments", rewrite_tuple_assignments); ("simple_assignments", rewrite_simple_assignments); ("remove_vector_concat", rewrite_defs_remove_vector_concat); diff --git a/src/rewriter.mli b/src/rewriter.mli index 1c3e8fae..e42d9b3a 100644 --- a/src/rewriter.mli +++ b/src/rewriter.mli @@ -56,6 +56,7 @@ type 'a rewriters = { rewrite_exp : 'a rewriters -> 'a exp -> 'a exp; val rewrite_exp : tannot rewriters -> tannot exp -> tannot exp val rewrite_defs : tannot defs -> tannot defs +val rewrite_undefined : tannot defs -> tannot defs val rewrite_defs_ocaml : (string * (tannot defs -> tannot defs)) list (*Perform rewrites to exclude AST nodes not supported for ocaml out*) val rewrite_defs_lem : (string * (tannot defs -> tannot defs)) list (*Perform rewrites to exclude AST nodes not supported for lem out*) diff --git a/src/sail.ml b/src/sail.ml index e5a5071f..7b1ee56d 100644 --- a/src/sail.ml +++ b/src/sail.ml @@ -167,7 +167,11 @@ let main() = | locs -> monomorphise_ast locs ast in - let ast = rewrite_ast ast in + let ast = + if !Initial_check.opt_undefined_gen then + rewrite_undefined (rewrite_ast ast) + else rewrite_ast ast in + let out_name = match !opt_file_out with | None -> fst (List.hd parsed) | Some f -> f ^ ".sail" in |