diff options
| author | Escherichia | 2024-03-29 13:21:08 +0100 |
|---|---|---|
| committer | Escherichia | 2024-03-29 13:48:15 +0100 |
| commit | 786c54c01ea98580374638c0ed92d19dfae19b1f (patch) | |
| tree | 4ad9010c76553797420bcaa2976ed02c216a2757 | |
| parent | bd89156cbdcb047ed9a6c557e9873dd5724c391f (diff) | |
added file and line arg to craise and cassert
Diffstat (limited to '')
36 files changed, 929 insertions, 928 deletions
diff --git a/compiler/AssociatedTypes.ml b/compiler/AssociatedTypes.ml index 5d5f53a4..8faaf62b 100644 --- a/compiler/AssociatedTypes.ml +++ b/compiler/AssociatedTypes.ml @@ -51,7 +51,7 @@ let compute_norm_trait_types_from_preds (meta : Meta.meta option) (* Sanity check: the type constraint can't make use of regions - Remark that it would be enough to only visit the field [ty] of the trait type constraint, but for safety we visit all the fields *) - sanity_check_opt_meta (trait_type_constraint_no_regions c) meta; + sanity_check_opt_meta __FILE__ __LINE__ (trait_type_constraint_no_regions c) meta; let { trait_ref; type_name; ty } : trait_type_constraint = c in let trait_ty = TTraitType (trait_ref, type_name) in let trait_ty_ref = get_ref trait_ty in @@ -239,7 +239,7 @@ let rec norm_ctx_normalize_ty (ctx : norm_ctx) (ty : ty) : ty = match trait_ref.trait_id with | TraitRef { trait_id = TraitImpl impl_id; generics = ref_generics; _ } -> - cassert_opt_meta + cassert_opt_meta __FILE__ __LINE__ (ref_generics = empty_generic_args) ctx.meta "Higher order trait types are not supported yet"; log#ldebug @@ -281,7 +281,7 @@ let rec norm_ctx_normalize_ty (ctx : norm_ctx) (ty : ty) : ty = ^ trait_ref_to_string ctx trait_ref ^ "\n- raw trait ref:\n" ^ show_trait_ref trait_ref)); (* We can't project *) - sanity_check_opt_meta + sanity_check_opt_meta __FILE__ __LINE__ (trait_instance_id_is_local_clause trait_ref.trait_id) ctx.meta; TTraitType (trait_ref, type_name) @@ -351,7 +351,7 @@ and norm_ctx_normalize_trait_instance_id (ctx : norm_ctx) match impl with | None -> (* This is actually a local clause *) - sanity_check_opt_meta + sanity_check_opt_meta __FILE__ __LINE__ (trait_instance_id_is_local_clause inst_id) ctx.meta; (ParentClause (inst_id, decl_id, clause_id), None) @@ -384,7 +384,7 @@ and norm_ctx_normalize_trait_instance_id (ctx : norm_ctx) match impl with | None -> (* This is actually a local clause *) - sanity_check_opt_meta + sanity_check_opt_meta __FILE__ __LINE__ (trait_instance_id_is_local_clause inst_id) ctx.meta; (ItemClause (inst_id, decl_id, item_name, clause_id), None) @@ -426,10 +426,10 @@ and norm_ctx_normalize_trait_instance_id (ctx : norm_ctx) | TraitRef trait_ref -> (* The trait instance id necessarily refers to a local sub-clause. We can't project over it and can only peel off the [TraitRef] wrapper *) - cassert_opt_meta + cassert_opt_meta __FILE__ __LINE__ (trait_instance_id_is_local_clause trait_ref.trait_id) ctx.meta "Trait instance id is not a local sub-clause"; - cassert_opt_meta + cassert_opt_meta __FILE__ __LINE__ (trait_ref.generics = empty_generic_args) ctx.meta "TODO: error message"; (trait_ref.trait_id, None) @@ -480,7 +480,7 @@ and norm_ctx_normalize_trait_ref (ctx : norm_ctx) (trait_ref : trait_ref) : (lazy ("norm_ctx_normalize_trait_ref: normalized to: " ^ trait_ref_to_string ctx trait_ref)); - cassert_opt_meta + cassert_opt_meta __FILE__ __LINE__ (generics = empty_generic_args) ctx.meta "TODO: error message"; trait_ref diff --git a/compiler/Contexts.ml b/compiler/Contexts.ml index c2d6999a..edda4260 100644 --- a/compiler/Contexts.ml +++ b/compiler/Contexts.ml @@ -298,7 +298,7 @@ let env_lookup_var (meta : Meta.meta) (env : env) (vid : VarId.id) : | EBinding (BVar var, v) :: env' -> if var.index = vid then (var, v) else lookup env' | (EBinding (BDummy _, _) | EAbs _) :: env' -> lookup env' - | EFrame :: _ -> craise meta "End of frame" + | EFrame :: _ -> craise __FILE__ __LINE__ meta "End of frame" in lookup env @@ -349,12 +349,12 @@ let env_update_var_value (meta : Meta.meta) (env : env) (vid : VarId.id) *) let rec update env = match env with - | [] -> craise meta "Unexpected" + | [] -> craise __FILE__ __LINE__ meta "Unexpected" | EBinding ((BVar b as var), v) :: env' -> if b.index = vid then EBinding (var, nv) :: env' else EBinding (var, v) :: update env' | ((EBinding (BDummy _, _) | EAbs _) as ee) :: env' -> ee :: update env' - | EFrame :: _ -> craise meta "End of frame" + | EFrame :: _ -> craise __FILE__ __LINE__ meta "End of frame" in update env @@ -377,7 +377,7 @@ let ctx_update_var_value (meta : Meta.meta) (ctx : eval_ctx) (vid : VarId.id) *) let ctx_push_var (meta : Meta.meta) (ctx : eval_ctx) (var : var) (v : typed_value) : eval_ctx = - cassert + cassert __FILE__ __LINE__ (TypesUtils.ty_is_ety var.var_ty && var.var_ty = v.ty) meta "The pushed variables and their values do not have the same type"; let bv = var_to_binder var in @@ -399,7 +399,7 @@ let ctx_push_vars (meta : Meta.meta) (ctx : eval_ctx) (* We can unfortunately not use Print because it depends on Contexts... *) show_var var ^ " -> " ^ show_typed_value value) vars))); - cassert + cassert __FILE__ __LINE__ (List.for_all (fun (var, (value : typed_value)) -> TypesUtils.ty_is_ety var.var_ty && var.var_ty = value.ty) @@ -432,7 +432,7 @@ let ctx_remove_dummy_var meta (ctx : eval_ctx) (vid : DummyVarId.id) : eval_ctx * typed_value = let rec remove_var (env : env) : env * typed_value = match env with - | [] -> craise meta "Could not lookup a dummy variable" + | [] -> craise __FILE__ __LINE__ meta "Could not lookup a dummy variable" | EBinding (BDummy vid', v) :: env when vid' = vid -> (env, v) | ee :: env -> let env, v = remove_var env in @@ -446,7 +446,7 @@ let ctx_lookup_dummy_var (meta : Meta.meta) (ctx : eval_ctx) (vid : DummyVarId.id) : typed_value = let rec lookup_var (env : env) : typed_value = match env with - | [] -> craise meta "Could not lookup a dummy variable" + | [] -> craise __FILE__ __LINE__ meta "Could not lookup a dummy variable" | EBinding (BDummy vid', v) :: _env when vid' = vid -> v | _ :: env -> lookup_var env in @@ -495,7 +495,7 @@ let env_remove_abs (meta : Meta.meta) (env : env) (abs_id : AbstractionId.id) : env * abs option = let rec remove (env : env) : env * abs option = match env with - | [] -> craise meta "Unreachable" + | [] -> craise __FILE__ __LINE__ meta "Unreachable" | EFrame :: _ -> (env, None) | EBinding (bv, v) :: env -> let env, abs_opt = remove env in @@ -521,7 +521,7 @@ let env_subst_abs (meta : Meta.meta) (env : env) (abs_id : AbstractionId.id) (nabs : abs) : env * abs option = let rec update (env : env) : env * abs option = match env with - | [] -> craise meta "Unreachable" + | [] -> craise __FILE__ __LINE__ meta "Unreachable" | EFrame :: _ -> (* We're done *) (env, None) | EBinding (bv, v) :: env -> let env, opt_abs = update env in diff --git a/compiler/Errors.ml b/compiler/Errors.ml index 68073ef7..bfdf5796 100644 --- a/compiler/Errors.ml +++ b/compiler/Errors.ml @@ -13,43 +13,43 @@ exception CFailure of string let error_list : (Meta.meta option * string) list ref = ref [] -let push_error (meta : Meta.meta option) (msg : string) = - error_list := (meta, msg) :: !error_list +let push_error (file : string) (line : int) (meta : Meta.meta option) (msg : string) = + error_list := (meta, msg ^ "\n In file:" ^ file ^ "\n Line:" ^ string_of_int line) :: !error_list -let save_error ?(b : bool = true) (meta : Meta.meta option) (msg : string) = - push_error meta msg; +let save_error (file : string) (line : int) ?(b : bool = true) (meta : Meta.meta option) (msg : string) = + push_error file line meta msg; match meta with | Some m -> if !Config.fail_hard && b then - raise (Failure (format_error_message m msg)) + raise (Failure (format_error_message m (msg ^ "\n In file:" ^ file ^ "\n Line:" ^ string_of_int line))) | None -> if !Config.fail_hard && b then raise (Failure msg) -let craise_opt_meta (meta : Meta.meta option) (msg : string) = +let craise_opt_meta (file : string) (line : int) (meta : Meta.meta option) (msg : string) = match meta with | Some m -> - if !Config.fail_hard then raise (Failure (format_error_message m msg)) + if !Config.fail_hard then raise (Failure (format_error_message m (msg ^ "\n In file:" ^ file ^ "\n Line:" ^ string_of_int line))) else - let () = push_error (Some m) msg in + let () = push_error file line (Some m) msg in raise (CFailure msg) | None -> - if !Config.fail_hard then raise (Failure msg) + if !Config.fail_hard then raise (Failure (msg ^ "\n In file:" ^ file ^ "\n Line:" ^ string_of_int line)) else - let () = push_error None msg in + let () = push_error file line None msg in raise (CFailure msg) -let craise (meta : Meta.meta) (msg : string) = craise_opt_meta (Some meta) msg +let craise (file : string) (line : int) (meta : Meta.meta) (msg : string) = craise_opt_meta file line (Some meta) msg -let cassert_opt_meta (b : bool) (meta : Meta.meta option) (msg : string) = - if not b then craise_opt_meta meta msg +let cassert_opt_meta (file : string) (line : int) (b : bool) (meta : Meta.meta option) (msg : string) = + if not b then craise_opt_meta file line meta msg -let cassert (b : bool) (meta : Meta.meta) (msg : string) = - cassert_opt_meta b (Some meta) msg +let cassert (file : string) (line : int) (b : bool) (meta : Meta.meta) (msg : string) = + cassert_opt_meta file line b (Some meta) msg -let sanity_check b meta = cassert b meta "Internal error, please file an issue" +let sanity_check (file : string) (line : int) b meta = cassert file line b meta "Internal error, please file an issue" -let sanity_check_opt_meta b meta = - cassert_opt_meta b meta "Internal error, please file an issue" +let sanity_check_opt_meta (file : string) (line : int) b meta = + cassert_opt_meta file line b meta "Internal error, please file an issue" -let internal_error meta = craise meta "Internal error, please report an issue" +let internal_error (file : string) (line : int) meta = craise file line meta "Internal error, please report an issue" let exec_raise = craise let exec_assert = cassert diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 72cd91e5..4fb0e3c8 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -60,7 +60,7 @@ let extract_fun_decl_register_names (ctx : extraction_ctx) (* Add the decreases proof for Lean only *) match !Config.backend with | Coq | FStar -> ctx - | HOL4 -> craise def.meta "Unexpected" + | HOL4 -> craise __FILE__ __LINE__ def.meta "Unexpected" | Lean -> ctx_add_decreases_proof def ctx else ctx in @@ -128,10 +128,10 @@ let extract_adt_g_value (meta : Meta.meta) | TAdt (TTuple, generics) -> (* Tuple *) (* For now, we only support fully applied tuple constructors *) - cassert + cassert __FILE__ __LINE__ (List.length generics.types = List.length field_values) meta "Only fully applied tuple constructors are currently supported"; - cassert + cassert __FILE__ __LINE__ (generics.const_generics = [] && generics.trait_refs = []) meta "Only fully applied tuple constructors are currently supported"; extract_as_tuple () @@ -187,7 +187,7 @@ let extract_adt_g_value (meta : Meta.meta) in if use_parentheses then F.pp_print_string fmt ")"; ctx - | _ -> craise meta "Inconsistent typed value" + | _ -> craise __FILE__ __LINE__ meta "Inconsistent typed value" (* Extract globals in the same way as variables *) let extract_global (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) @@ -281,7 +281,7 @@ let lets_require_wrap_in_do (meta : Meta.meta) (* HOL4 is similar to HOL4, but we add a sanity check *) let wrap_in_do = List.exists (fun (m, _, _) -> m) lets in if wrap_in_do then - sanity_check (List.for_all (fun (m, _, _) -> m) lets) meta; + sanity_check __FILE__ __LINE__ (List.for_all (fun (m, _, _) -> m) lets) meta; wrap_in_do | FStar | Coq -> false @@ -320,7 +320,7 @@ let rec extract_texpression (meta : Meta.meta) (ctx : extraction_ctx) | StructUpdate supd -> extract_StructUpdate meta ctx fmt inside e.ty supd | Loop _ -> (* The loop nodes should have been eliminated in {!PureMicroPasses} *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" (* Extract an application *or* a top-level qualif (function extraction has * to handle top-level qualifiers, so it seemed more natural to merge the @@ -454,7 +454,7 @@ and extract_function_call (meta : Meta.meta) (ctx : extraction_ctx) if not method_id.is_provided then ( (* Required method *) - sanity_check (lp_id = None) trait_decl.meta; + sanity_check __FILE__ __LINE__ (lp_id = None) trait_decl.meta; extract_trait_ref trait_decl.meta ctx fmt TypeDeclId.Set.empty true trait_ref; let fun_name = @@ -485,7 +485,7 @@ and extract_function_call (meta : Meta.meta) (ctx : extraction_ctx) F.pp_print_string fmt fun_name); (* Sanity check: HOL4 doesn't support const generics *) - sanity_check (generics.const_generics = [] || !backend <> HOL4) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = [] || !backend <> HOL4) meta; (* Print the generics. We might need to filter some of the type arguments, if the type @@ -505,9 +505,9 @@ and extract_function_call (meta : Meta.meta) (ctx : extraction_ctx) | Error (types, err) -> extract_generic_args meta ctx fmt TypeDeclId.Set.empty { generics with types }; - (* if !Config.fail_hard then craise meta err + (* if !Config.fail_hard then craise __FILE__ __LINE__ meta err else *) - save_error (Some meta) err; + save_error __FILE__ __LINE__ (Some meta) err; F.pp_print_string fmt "(\"ERROR: ill-formed builtin: invalid number of filtering \ arguments\")"); @@ -522,7 +522,7 @@ and extract_function_call (meta : Meta.meta) (ctx : extraction_ctx) (* Return *) if inside then F.pp_print_string fmt ")" | (Unop _ | Binop _), _ -> - craise meta + craise __FILE__ __LINE__ meta ("Unreachable:\n" ^ "Function: " ^ show_fun_or_op_id fid ^ ",\nNumber of arguments: " ^ string_of_int (List.length args) @@ -644,7 +644,7 @@ and extract_field_projector (meta : Meta.meta) (ctx : extraction_ctx) extract_App meta ctx fmt inside (mk_app meta original_app arg) args | [] -> (* No argument: shouldn't happen *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" and extract_Lambda (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (xl : typed_pattern list) (e : texpression) : unit = @@ -653,7 +653,7 @@ and extract_Lambda (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (* Open parentheses *) if inside then F.pp_print_string fmt "("; (* Print the lambda - note that there should always be at least one variable *) - sanity_check (xl <> []) meta; + sanity_check __FILE__ __LINE__ (xl <> []) meta; F.pp_print_string fmt "fun"; let with_type = !backend = Coq in let ctx = @@ -726,7 +726,7 @@ and extract_lets (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) let arrow = match !backend with | Coq | HOL4 -> "<-" - | FStar | Lean -> craise meta "impossible" + | FStar | Lean -> craise __FILE__ __LINE__ meta "impossible" in F.pp_print_string fmt arrow; F.pp_print_space fmt (); @@ -959,7 +959,7 @@ and extract_StructUpdate (meta : Meta.meta) (ctx : extraction_ctx) unit = (* We can't update a subset of the fields in Coq (i.e., we can do [{| x:= 3; y := 4 |}], but there is no syntax for [{| s with x := 3 |}]) *) - sanity_check (!backend <> Coq || supd.init = None) meta; + sanity_check __FILE__ __LINE__ (!backend <> Coq || supd.init = None) meta; (* In the case of HOL4, records with no fields are not supported and are thus extracted to unit. We need to check that by looking up the definition *) let extract_as_unit = @@ -1099,7 +1099,7 @@ and extract_StructUpdate (meta : Meta.meta) (ctx : extraction_ctx) F.pp_print_string fmt "]"; if need_paren then F.pp_print_string fmt ")"; F.pp_close_box fmt () - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" (** A small utility to print the parameters of a function signature. @@ -1202,7 +1202,7 @@ let assert_backend_supports_decreases_clauses (meta : Meta.meta) = match !backend with | FStar | Lean -> () | _ -> - craise meta + craise __FILE__ __LINE__ meta "Decreases clauses are only supported for the Lean and F* backends" (** Extract a decreases clause function template body. @@ -1223,7 +1223,7 @@ let assert_backend_supports_decreases_clauses (meta : Meta.meta) = *) let extract_template_fstar_decreases_clause (ctx : extraction_ctx) (fmt : F.formatter) (def : fun_decl) : unit = - cassert (!backend = FStar) def.meta + cassert __FILE__ __LINE__ (!backend = FStar) def.meta "The generation of template decrease clauses is only supported for the F* \ backend"; @@ -1292,7 +1292,7 @@ let extract_template_fstar_decreases_clause (ctx : extraction_ctx) *) let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) (fmt : F.formatter) (def : fun_decl) : unit = - cassert (!backend = Lean) def.meta + cassert __FILE__ __LINE__ (!backend = Lean) def.meta "The generation of template termination and decreasing clauses is only \ supported for the Lean backend"; (* @@ -1419,7 +1419,7 @@ let extract_fun_comment (ctx : extraction_ctx) (fmt : F.formatter) *) let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) (kind : decl_kind) (has_decreases_clause : bool) (def : fun_decl) : unit = - sanity_check (not def.is_global_decl_body) def.meta; + sanity_check __FILE__ __LINE__ (not def.is_global_decl_body) def.meta; (* Retrieve the function name *) let def_name = ctx_get_local_function def.meta def.def_id def.loop_id ctx in (* Add a break before *) @@ -1672,7 +1672,7 @@ let extract_fun_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) (def : fun_decl) : unit = (* Retrieve the definition name *) let def_name = ctx_get_local_function def.meta def.def_id def.loop_id ctx in - cassert + cassert __FILE__ __LINE__ (def.signature.generics.const_generics = []) def.meta "Constant generics are not supported yet when generating code for HOL4"; @@ -1721,7 +1721,7 @@ let extract_fun_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) *) let extract_fun_decl (ctx : extraction_ctx) (fmt : F.formatter) (kind : decl_kind) (has_decreases_clause : bool) (def : fun_decl) : unit = - sanity_check (not def.is_global_decl_body) def.meta; + sanity_check __FILE__ __LINE__ (not def.is_global_decl_body) def.meta; (* We treat HOL4 opaque functions in a specific manner *) if !backend = HOL4 && Option.is_none def.body then extract_fun_decl_hol4_opaque ctx fmt def @@ -1872,8 +1872,8 @@ let extract_global_decl_hol4_opaque (meta : Meta.meta) (ctx : extraction_ctx) let extract_global_decl (ctx : extraction_ctx) (fmt : F.formatter) (global : global_decl) (body : fun_decl) (interface : bool) : unit = let meta = body.meta in - cassert body.is_global_decl_body body.meta "TODO: Error message"; - cassert (body.signature.inputs = []) body.meta "TODO: Error message"; + cassert __FILE__ __LINE__ body.is_global_decl_body body.meta "TODO: Error message"; + cassert __FILE__ __LINE__ (body.signature.inputs = []) body.meta "TODO: Error message"; (* Add a break then the name of the corresponding LLBC declaration *) F.pp_print_break fmt 0 0; @@ -2225,7 +2225,7 @@ let extract_trait_impl_register_names (ctx : extraction_ctx) in (* For now we do not support overriding provided methods *) - cassert + cassert __FILE__ __LINE__ (trait_impl.provided_methods = []) trait_impl.meta "Overriding provided methods is not supported yet"; (* Everything is taken care of by {!extract_trait_decl_register_names} *but* diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 99167ae4..eb37a726 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -253,8 +253,8 @@ let empty_names_map : names_map = } (** Small helper to report name collision *) -let report_name_collision (id_to_string : id -> string) (id1 : id) (id2 : id) - (name : string) : unit = +let report_name_collision (id_to_string : id -> string) + ((id1, meta) : id * Meta.meta option) (id2 : id) (name : string) : unit = let id1 = "\n- " ^ id_to_string id1 in let id2 = "\n- " ^ id_to_string id2 in let err = @@ -263,9 +263,10 @@ let report_name_collision (id_to_string : id -> string) (id1 : id) (id2 : id) ^ "\nYou may want to rename some of your definitions, or report an issue." in (* If we fail hard on errors, raise an exception *) - save_error None err + save_error meta err -let names_map_get_id_from_name (name : string) (nm : names_map) : id option = +let names_map_get_id_from_name (name : string) (nm : names_map) : + (id * meta option) option = StringMap.find_opt name nm.name_to_id let names_map_check_collision (id_to_string : id -> string) (id : id) @@ -296,7 +297,7 @@ let names_map_add (id_to_string : id -> string) (id : id) (name : string) ^ ":\nThe chosen name is already in the names set: " ^ name in (* If we fail hard on errors, raise an exception *) - save_error None err); + save_error __FILE__ __LINE__ None err); (* Insert *) names_map_add_unchecked id name nm @@ -443,7 +444,7 @@ let names_maps_get (meta : Meta.meta option) (id_to_string : id -> string) "Could not find: " ^ id_to_string id ^ "\nNames map:\n" ^ map_to_string m in - save_error meta err; + save_error __FILE__ __LINE__ meta err; "(%%%ERROR: unknown identifier\": " ^ id_to_string id ^ "\"%%%)") else let m = nm.names_map.id_to_name in @@ -454,7 +455,7 @@ let names_maps_get (meta : Meta.meta option) (id_to_string : id -> string) "Could not find: " ^ id_to_string id ^ "\nNames map:\n" ^ map_to_string m in - save_error meta err; + save_error __FILE__ __LINE__ meta err; "(ERROR: \"" ^ id_to_string id ^ "\")" type names_map_init = { @@ -681,7 +682,7 @@ let ctx_get_local_function (meta : Meta.meta) (id : A.FunDeclId.id) let ctx_get_type (meta : Meta.meta option) (id : type_id) (ctx : extraction_ctx) : string = - sanity_check_opt_meta (id <> TTuple) meta; + sanity_check_opt_meta __FILE__ __LINE__ (id <> TTuple) meta; ctx_get meta (TypeId id) ctx let ctx_get_local_type (meta : Meta.meta) (id : TypeDeclId.id) @@ -1201,7 +1202,7 @@ let type_decl_kind_to_qualif (meta : Meta.meta) (kind : decl_kind) (* This is for traits *) Some "Record" | _ -> - craise meta + craise __FILE__ __LINE__ meta ("Unexpected: (" ^ show_decl_kind kind ^ ", " ^ Print.option_to_string show_type_decl_kind type_kind ^ ")")) @@ -1262,13 +1263,13 @@ let type_keyword (meta : Meta.meta) = match !backend with | FStar -> "Type0" | Coq | Lean -> "Type" - | HOL4 -> craise meta "Unexpected" + | HOL4 -> craise __FILE__ __LINE__ meta "Unexpected" (** Helper *) let name_last_elem_as_ident (meta : Meta.meta) (n : llbc_name) : string = match Collections.List.last n with | PeIdent (s, _) -> s - | PeImpl _ -> craise meta "Unexpected" + | PeImpl _ -> craise __FILE__ __LINE__ meta "Unexpected" (** Helper @@ -1284,7 +1285,7 @@ let ctx_prepare_name (meta : Meta.meta) (ctx : extraction_ctx) | (PeIdent (crate, _) as id) :: name -> if crate = ctx.crate.name then name else id :: name | _ -> - craise meta + craise __FILE__ __LINE__ meta ("Unexpected name shape: " ^ TranslateCore.name_to_string ctx.trans_ctx name) @@ -1597,7 +1598,7 @@ let ctx_compute_termination_measure_name (meta : Meta.meta) match !Config.backend with | FStar -> "_decreases" | Lean -> "_terminates" - | Coq | HOL4 -> craise meta "Unexpected" + | Coq | HOL4 -> craise __FILE__ __LINE__ meta "Unexpected" in (* Concatenate *) fname ^ lp_suffix ^ suffix @@ -1625,7 +1626,7 @@ let ctx_compute_decreases_proof_name (meta : Meta.meta) (ctx : extraction_ctx) let suffix = match !Config.backend with | Lean -> "_decreases" - | FStar | Coq | HOL4 -> craise meta "Unexpected" + | FStar | Coq | HOL4 -> craise __FILE__ __LINE__ meta "Unexpected" in (* Concatenate *) fname ^ lp_suffix ^ suffix @@ -1656,7 +1657,7 @@ let ctx_compute_var_basename (meta : Meta.meta) (ctx : extraction_ctx) let cl = to_snake_case name in let cl = String.split_on_char '_' cl in let cl = List.filter (fun s -> String.length s > 0) cl in - sanity_check (List.length cl > 0) meta; + sanity_check __FILE__ __LINE__ (List.length cl > 0) meta; let cl = List.map (fun s -> s.[0]) cl in StringUtils.string_of_chars cl in @@ -1936,7 +1937,7 @@ let ctx_compute_fun_name (def : fun_decl) (ctx : extraction_ctx) : string = let ctx_add_fun_decl (def : fun_decl) (ctx : extraction_ctx) : extraction_ctx = (* Sanity check: the function should not be a global body - those are handled * separately *) - sanity_check (not def.is_global_decl_body) def.meta; + sanity_check __FILE__ __LINE__ (not def.is_global_decl_body) def.meta; (* Lookup the LLBC def to compute the region group information *) let def_id = def.def_id in (* Add the function name *) diff --git a/compiler/ExtractName.ml b/compiler/ExtractName.ml index e9d6116f..0573512d 100644 --- a/compiler/ExtractName.ml +++ b/compiler/ExtractName.ml @@ -73,7 +73,7 @@ let pattern_to_extract_name (meta : Meta.meta option) (name : pattern) : let id = Collections.List.last id in match id with | PIdent (_, _) -> super#visit_PImpl () (EComp [ id ]) - | PImpl _ -> craise_opt_meta meta "Unreachable") + | PImpl _ -> craise_opt_meta __FILE__ __LINE__ meta "Unreachable") | _ -> super#visit_PImpl () ty method! visit_EPrimAdt _ adt g = diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml index d785e299..f737f73b 100644 --- a/compiler/ExtractTypes.ml +++ b/compiler/ExtractTypes.ml @@ -29,7 +29,7 @@ let extract_literal (meta : Meta.meta) (fmt : F.formatter) (inside : bool) | HOL4 -> F.pp_print_string fmt ("int_to_" ^ int_name sv.int_ty); F.pp_print_space fmt () - | _ -> craise meta "Unreachable"); + | _ -> craise __FILE__ __LINE__ meta "Unreachable"); (* We need to add parentheses if the value is negative *) if sv.value >= Z.of_int 0 then F.pp_print_string fmt (Z.to_string sv.value) @@ -42,7 +42,7 @@ let extract_literal (meta : Meta.meta) (fmt : F.formatter) (inside : bool) let iname = String.lowercase_ascii (int_name sv.int_ty) in F.pp_print_string fmt ("#" ^ iname) | HOL4 -> () - | _ -> craise meta "Unreachable"); + | _ -> craise __FILE__ __LINE__ meta "Unreachable"); if print_brackets then F.pp_print_string fmt ")") | VBool b -> let b = @@ -129,7 +129,7 @@ let extract_unop (meta : Meta.meta) (extract_expr : bool -> texpression -> unit) match !backend with | Coq | FStar -> "scalar_cast" | Lean -> "Scalar.cast" - | HOL4 -> craise meta "Unreachable" + | HOL4 -> craise __FILE__ __LINE__ meta "Unreachable" in let src = if !backend <> Lean then Some (integer_type_to_string src) @@ -142,20 +142,20 @@ let extract_unop (meta : Meta.meta) (extract_expr : bool -> texpression -> unit) match !backend with | Coq | FStar -> "scalar_cast_bool" | Lean -> "Scalar.cast_bool" - | HOL4 -> craise meta "Unreachable" + | HOL4 -> craise __FILE__ __LINE__ meta "Unreachable" in let tgt = integer_type_to_string tgt in (cast_str, None, Some tgt) | TInteger _, TBool -> (* This is not allowed by rustc: the way of doing it in Rust is: [x != 0] *) - craise meta "Unexpected cast: integer to bool" + craise __FILE__ __LINE__ meta "Unexpected cast: integer to bool" | TBool, TBool -> (* There shouldn't be any cast here. Note that if one writes [b as bool] in Rust (where [b] is a boolean), it gets compiled to [b] (i.e., no cast is introduced). *) - craise meta "Unexpected cast: bool to bool" - | _ -> craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unexpected cast: bool to bool" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in (* Print the name of the function *) F.pp_print_string fmt cast_str; @@ -289,7 +289,7 @@ let start_fun_decl_group (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_string fmt ("val [" ^ String.concat ", " names ^ "] = DefineDiv ‘") else ( - sanity_check_opt_meta (List.length names = 1) None; + sanity_check_opt_meta __FILE__ __LINE__ (List.length names = 1) None; let name = List.hd names in F.pp_print_string fmt ("val " ^ name ^ " = Define ‘")); F.pp_print_cut fmt () @@ -498,14 +498,14 @@ let rec extract_ty (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) | HOL4 -> let { types; const_generics; trait_refs } = generics in (* Const generics are not supported in HOL4 *) - cassert (const_generics = []) meta + cassert __FILE__ __LINE__ (const_generics = []) meta "Constant generics are not supported yet when generating code \ for HOL4"; let print_tys = match type_id with | TAdtId id -> not (TypeDeclId.Set.mem id no_params_tys) | TAssumed _ -> true - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in if types <> [] && print_tys then ( let print_paren = List.length types > 1 in @@ -534,7 +534,7 @@ let rec extract_ty (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) extract_rec false ret_ty; if inside then F.pp_print_string fmt ")" | TTraitType (trait_ref, type_name) -> ( - if !parameterize_trait_types then craise meta "Unimplemented" + if !parameterize_trait_types then craise __FILE__ __LINE__ meta "Unimplemented" else let type_name = ctx_get_trait_type meta trait_ref.trait_decl_ref.trait_decl_id @@ -552,7 +552,7 @@ let rec extract_ty (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) *) match trait_ref.trait_id with | Self -> - cassert + cassert __FILE__ __LINE__ (trait_ref.generics = empty_generic_args) meta "TODO: Error message"; extract_trait_instance_id_with_dot meta ctx fmt no_params_tys false @@ -560,7 +560,7 @@ let rec extract_ty (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_string fmt type_name | _ -> (* HOL4 doesn't have 1st class types *) - cassert (!backend <> HOL4) meta + cassert __FILE__ __LINE__ (!backend <> HOL4) meta "Trait types are not supported yet when generating code for HOL4"; extract_trait_ref meta ctx fmt no_params_tys false trait_ref; F.pp_print_string fmt ("." ^ add_brackets type_name)) @@ -615,7 +615,7 @@ and extract_generic_args (meta : Meta.meta) (ctx : extraction_ctx) (extract_ty meta ctx fmt no_params_tys true) types); if const_generics <> [] then ( - cassert (!backend <> HOL4) meta + cassert __FILE__ __LINE__ (!backend <> HOL4) meta "Constant generics are not supported yet when generating code for HOL4"; F.pp_print_space fmt (); Collections.List.iter_link (F.pp_print_space fmt) @@ -671,7 +671,7 @@ and extract_trait_instance_id (meta : Meta.meta) (ctx : extraction_ctx) | Self -> (* This has a specific treatment depending on the item we're extracting (associated type, etc.). We should have caught this elsewhere. *) - save_error (Some meta) "Unexpected occurrence of `Self`"; + save_error __FILE__ __LINE__ (Some meta) "Unexpected occurrence of `Self`"; F.pp_print_string fmt "ERROR(\"Unexpected Self\")" | TraitImpl id -> let name = ctx_get_trait_impl meta id ctx in @@ -695,7 +695,7 @@ and extract_trait_instance_id (meta : Meta.meta) (ctx : extraction_ctx) extract_trait_ref meta ctx fmt no_params_tys inside trait_ref | UnknownTrait _ -> (* This is an error case *) - craise meta "Unexpected" + craise __FILE__ __LINE__ meta "Unexpected" (** Compute the names for all the top-level identifiers used in a type definition (type name, variant names, field names, etc. but not type @@ -772,7 +772,7 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : in (field_names, cons_name) | Some info -> - craise def.meta + craise __FILE__ __LINE__ def.meta ("Invalid builtin information: " ^ show_builtin_type_info info) in (* Add the fields *) @@ -818,7 +818,7 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : (fun variant_id (variant : variant) -> (variant_id, StringMap.find variant.variant_name variant_map)) variants - | _ -> craise def.meta "Invalid builtin information" + | _ -> craise __FILE__ __LINE__ def.meta "Invalid builtin information" in List.fold_left (fun ctx (vid, vname) -> @@ -887,7 +887,7 @@ let extract_type_decl_variant (meta : Meta.meta) (ctx : extraction_ctx) List.fold_left (fun ctx (fid, f) -> print_field fid f ctx) ctx fields in (* Sanity check: HOL4 doesn't support const generics *) - sanity_check (cg_params = [] || !backend <> HOL4) meta; + sanity_check __FILE__ __LINE__ (cg_params = [] || !backend <> HOL4) meta; (* Print the final type *) if !backend <> HOL4 then ( F.pp_print_space fmt (); @@ -1089,7 +1089,7 @@ let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) else ( (* We extract for Coq or Lean, and we have a recursive record, or a record in a group of mutually recursive types: we extract it as an inductive type *) - cassert + cassert __FILE__ __LINE__ (is_rec && (!backend = Coq || !backend = Lean)) def.meta "Constant generics are not supported yet when generating code for HOL4"; @@ -1196,7 +1196,7 @@ let extract_generic_params (meta : Meta.meta) (ctx : extraction_ctx) (trait_clauses : string list) : unit = let all_params = List.concat [ type_params; cg_params; trait_clauses ] in (* HOL4 doesn't support const generics *) - cassert + cassert __FILE__ __LINE__ (cg_params = [] || !backend <> HOL4) meta "Constant generics are not supported yet when generating code for HOL4"; let left_bracket (implicit : bool) = @@ -1346,7 +1346,7 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl) (extract_body : bool) : unit = (* Sanity check *) - sanity_check (extract_body || !backend <> HOL4) def.meta; + sanity_check __FILE__ __LINE__ (extract_body || !backend <> HOL4) def.meta; let is_tuple_struct = TypesUtils.type_decl_from_decl_id_is_tuple_struct ctx.trans_ctx.type_ctx.type_infos def.def_id @@ -1418,7 +1418,7 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) | None -> F.pp_print_string fmt def_name); (* HOL4 doesn't support const generics, and type definitions in HOL4 don't support trait clauses *) - cassert + cassert __FILE__ __LINE__ ((cg_params = [] && trait_clauses = []) || !backend <> HOL4) def.meta "Constant generics and type definitions with trait clauses are not \ @@ -1465,7 +1465,7 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) | Enum variants -> extract_type_decl_enum_body ctx_body fmt type_decl_group def def_name type_params cg_params variants - | Opaque -> craise def.meta "Unreachable"); + | Opaque -> craise __FILE__ __LINE__ def.meta "Unreachable"); (* Add the definition end delimiter *) if !backend = HOL4 && decl_is_not_last_from_group kind then ( F.pp_print_space fmt (); @@ -1491,12 +1491,12 @@ let extract_type_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) (* Retrieve the definition name *) let def_name = ctx_get_local_type def.meta def.def_id ctx in (* Generic parameters are unsupported *) - cassert + cassert __FILE__ __LINE__ (def.generics.const_generics = []) def.meta "Constant generics are not supported yet when generating code for HOL4"; (* Trait clauses on type definitions are unsupported *) - cassert + cassert __FILE__ __LINE__ (def.generics.trait_clauses = []) def.meta "Types with trait clauses are not supported yet when generating code for \ @@ -1523,7 +1523,7 @@ let extract_type_decl_hol4_empty_record (ctx : extraction_ctx) (* Retrieve the definition name *) let def_name = ctx_get_local_type def.meta def.def_id ctx in (* Sanity check *) - sanity_check (def.generics = empty_generic_params) def.meta; + sanity_check __FILE__ __LINE__ (def.generics = empty_generic_params) def.meta; (* Generate the declaration *) F.pp_print_space fmt (); F.pp_print_string fmt ("Type " ^ def_name ^ " = “: unit”"); @@ -1599,7 +1599,7 @@ let extract_coq_arguments_instruction (ctx : extraction_ctx) (fmt : F.formatter) *) let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) (kind : decl_kind) (decl : type_decl) : unit = - sanity_check (!backend = Coq) decl.meta; + sanity_check __FILE__ __LINE__ (!backend = Coq) decl.meta; (* Generating the [Arguments] instructions is useful only if there are parameters *) let num_params = List.length decl.generics.types @@ -1647,7 +1647,7 @@ let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) *) let extract_type_decl_record_field_projectors (ctx : extraction_ctx) (fmt : F.formatter) (kind : decl_kind) (decl : type_decl) : unit = - sanity_check (!backend = Coq) decl.meta; + sanity_check __FILE__ __LINE__ (!backend = Coq) decl.meta; match decl.kind with | Opaque | Enum _ -> () | Struct fields -> diff --git a/compiler/FunsAnalysis.ml b/compiler/FunsAnalysis.ml index f85f9d1e..df2a010d 100644 --- a/compiler/FunsAnalysis.ml +++ b/compiler/FunsAnalysis.ml @@ -145,7 +145,7 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t) end in (* Sanity check: global bodies don't contain stateful calls *) - sanity_check ((not f.is_global_decl_body) || not !stateful) f.meta; + sanity_check __FILE__ __LINE__ ((not f.is_global_decl_body) || not !stateful) f.meta; let builtin_info = get_builtin_info f in let has_builtin_info = builtin_info <> None in group_has_builtin_info := !group_has_builtin_info || has_builtin_info; @@ -167,11 +167,11 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t) (* We need to know if the declaration group contains a global - note that * groups containing globals contain exactly one declaration *) let is_global_decl_body = List.exists (fun f -> f.is_global_decl_body) d in - cassert + cassert __FILE__ __LINE__ ((not is_global_decl_body) || List.length d = 1) (List.hd d).meta "This global definition is in a group of mutually recursive definitions"; - cassert + cassert __FILE__ __LINE__ ((not !group_has_builtin_info) || List.length d = 1) (List.hd d).meta "This builtin function belongs to a group of mutually recursive \ diff --git a/compiler/Interpreter.ml b/compiler/Interpreter.ml index 453ad088..ea1d5633 100644 --- a/compiler/Interpreter.ml +++ b/compiler/Interpreter.ml @@ -85,7 +85,7 @@ let symbolic_instantiate_fun_sig (meta : Meta.meta) (ctx : eval_ctx) List.map (fun (v : const_generic_var) -> CgVar v.index) const_generics in (* Annoying that we have to generate this substitution here *) - let r_subst _ = craise meta "Unexpected region" in + let r_subst _ = craise __FILE__ __LINE__ meta "Unexpected region" in let ty_subst = Substitute.make_type_subst_from_vars sg.generics.types types in @@ -123,7 +123,7 @@ let symbolic_instantiate_fun_sig (meta : Meta.meta) (ctx : eval_ctx) trait_instance_id = match TraitClauseId.Map.find_opt clause_id tr_map with | Some tr -> tr - | None -> craise meta "Local trait clause not found" + | None -> craise __FILE__ __LINE__ meta "Local trait clause not found" in let mk_subst tr_map = let tr_subst = mk_tr_subst tr_map in @@ -215,7 +215,7 @@ let initialize_symbolic_context_for_fun (ctx : decls_ctx) (fdef : fun_decl) : in (* Initialize the abstractions as empty (i.e., with no avalues) abstractions *) let call_id = fresh_fun_call_id () in - sanity_check (call_id = FunCallId.zero) fdef.meta; + sanity_check __FILE__ __LINE__ (call_id = FunCallId.zero) fdef.meta; let compute_abs_avalues (abs : abs) (ctx : eval_ctx) : eval_ctx * typed_avalue list = (* Project over the values - we use *loan* projectors, as explained above *) @@ -337,7 +337,7 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) let region_can_end rid = RegionGroupId.Set.mem rid parent_and_current_rgs in - sanity_check (region_can_end back_id) fdef.meta; + sanity_check __FILE__ __LINE__ (region_can_end back_id) fdef.meta; let ctx = create_push_abstractions_from_abs_region_groups (fun rg_id -> SynthRet rg_id) @@ -424,7 +424,7 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) | Loop (loop_id', rg_id', LoopSynthInput) -> (* We only allow to end the loop synth input abs for the region group [rg_id] *) - sanity_check + sanity_check __FILE__ __LINE__ (if Option.is_some loop_id then loop_id = Some loop_id' else true) fdef.meta; @@ -435,7 +435,7 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) else abs | Loop (loop_id', _, LoopCall) -> (* We can end all the loop call abstractions *) - sanity_check (loop_id = Some loop_id') fdef.meta; + sanity_check __FILE__ __LINE__ (loop_id = Some loop_id') fdef.meta; { abs with can_end = true } | SynthInput rg_id' -> if rg_id' = back_id && end_fun_synth_input then @@ -538,7 +538,7 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) match res with | Return -> None | LoopReturn loop_id -> Some loop_id - | _ -> craise fdef.meta "Unreachable" + | _ -> craise __FILE__ __LINE__ fdef.meta "Unreachable" in let is_regular_return = true in let inside_loop = Option.is_some loop_id in @@ -564,7 +564,7 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) match res with | EndEnterLoop _ -> false | EndContinue _ -> true - | _ -> craise fdef.meta "Unreachable" + | _ -> craise __FILE__ __LINE__ fdef.meta "Unreachable" in (* Forward translation *) let fwd_e = @@ -605,7 +605,7 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) * the executions can lead to a panic *) if synthesize then Some SA.Panic else None | Unit | Break _ | Continue _ -> - craise fdef.meta + craise __FILE__ __LINE__ fdef.meta ("evaluate_function_symbolic failed on: " ^ name_to_string ()) in @@ -636,8 +636,8 @@ module Test = struct fdef.name)); (* Sanity check - *) - sanity_check (fdef.signature.generics = empty_generic_params) fdef.meta; - sanity_check (body.arg_count = 0) fdef.meta; + sanity_check __FILE__ __LINE__ (fdef.signature.generics = empty_generic_params) fdef.meta; + sanity_check __FILE__ __LINE__ (body.arg_count = 0) fdef.meta; (* Create the evaluation context *) let ctx = initialize_eval_ctx fdef.meta decls_ctx [] [] [] in @@ -654,7 +654,7 @@ module Test = struct let pop_return_value = true in pop_frame config fdef.meta pop_return_value (fun _ _ -> None) ctx | _ -> - craise fdef.meta + craise __FILE__ __LINE__ fdef.meta ("Unit test failed (concrete execution) on: " ^ Print.Types.name_to_string (Print.Contexts.decls_ctx_to_fmt_env decls_ctx) diff --git a/compiler/InterpreterBorrows.ml b/compiler/InterpreterBorrows.ml index 2ccf2d5d..cc34020a 100644 --- a/compiler/InterpreterBorrows.ml +++ b/compiler/InterpreterBorrows.ml @@ -43,7 +43,7 @@ let end_borrow_get_borrow (meta : Meta.meta) in let set_replaced_bc (abs_id : AbstractionId.id option) (bc : g_borrow_content) = - sanity_check (Option.is_none !replaced_bc) meta; + sanity_check __FILE__ __LINE__ (Option.is_none !replaced_bc) meta; replaced_bc := Some (abs_id, bc) in (* Raise an exception if: @@ -182,7 +182,7 @@ let end_borrow_get_borrow (meta : Meta.meta) * Also note that, as we are moving the borrowed value inside the * abstraction (and not really giving the value back to the context) * we do not insert {!AEndedMutBorrow} but rather {!ABottom} *) - craise meta "Unimplemented" + craise __FILE__ __LINE__ meta "Unimplemented" (* ABottom *)) else (* Update the outer borrows before diving into the child avalue *) @@ -225,8 +225,8 @@ let end_borrow_get_borrow (meta : Meta.meta) method! visit_abs outer abs = (* Update the outer abs *) let outer_abs, outer_borrows = outer in - sanity_check (Option.is_none outer_abs) meta; - sanity_check (Option.is_none outer_borrows) meta; + sanity_check __FILE__ __LINE__ (Option.is_none outer_abs) meta; + sanity_check __FILE__ __LINE__ (Option.is_none outer_borrows) meta; let outer = (Some abs.abs_id, None) in super#visit_abs outer abs end @@ -249,10 +249,10 @@ let end_borrow_get_borrow (meta : Meta.meta) let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) (nv : typed_value) (ctx : eval_ctx) : eval_ctx = (* Sanity check *) - exec_assert + exec_assert __FILE__ __LINE__ (not (loans_in_value nv)) meta "Can not end a borrow because the value to give back contains bottom"; - exec_assert + exec_assert __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions nv)) meta "Can not end a borrow because the value to give back contains bottom"; (* Debug *) @@ -266,7 +266,7 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) (* We use a reference to check that we updated exactly one loan *) let replaced : bool ref = ref false in let set_replaced () = - sanity_check (not !replaced) meta; + sanity_check __FILE__ __LINE__ (not !replaced) meta; replaced := true in (* Whenever giving back symbolic values, they shouldn't contain already ended regions *) @@ -308,7 +308,7 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) ("give_back_value: improper type:\n- expected: " ^ ty_to_string ctx ty ^ "\n- received: " ^ ty_to_string ctx nv.ty); - craise meta "Value given back doesn't have the proper type"); + craise __FILE__ __LINE__ meta "Value given back doesn't have the proper type"); (* Replace *) set_replaced (); nv.value) @@ -353,7 +353,7 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) ABorrow (AEndedIgnoredMutBorrow { given_back; child; given_back_meta }) - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" else (* Continue exploring *) ABorrow (super#visit_AIgnoredMutBorrow opt_abs bid' child) @@ -368,7 +368,7 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) (* Preparing a bit *) let regions, ancestors_regions = match opt_abs with - | None -> craise meta "Unreachable" + | None -> craise __FILE__ __LINE__ meta "Unreachable" | Some abs -> (abs.regions, abs.ancestors_regions) in (* Rk.: there is a small issue with the types of the aloan values. @@ -434,7 +434,7 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) (* We remember in which abstraction we are before diving - * this is necessary for projecting values: we need to know * over which regions to project *) - sanity_check (Option.is_none opt_abs) meta; + sanity_check __FILE__ __LINE__ (Option.is_none opt_abs) meta; super#visit_EAbs (Some abs) abs end in @@ -442,7 +442,7 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) (* Explore the environment *) let ctx = obj#visit_eval_ctx None ctx in (* Check we gave back to exactly one loan *) - cassert !replaced meta "Only one loan should have been given back"; + cassert __FILE__ __LINE__ !replaced meta "Only one loan should have been given back"; (* Apply the reborrows *) apply_registered_reborrows ctx @@ -451,7 +451,7 @@ let give_back_symbolic_value (_config : config) (meta : Meta.meta) (proj_regions : RegionId.Set.t) (proj_ty : rty) (sv : symbolic_value) (nsv : symbolic_value) (ctx : eval_ctx) : eval_ctx = (* Sanity checks *) - sanity_check (sv.sv_id <> nsv.sv_id && ty_is_rty proj_ty) meta; + sanity_check __FILE__ __LINE__ (sv.sv_id <> nsv.sv_id && ty_is_rty proj_ty) meta; (* Store the given-back value as a meta-value for synthesis purposes *) let mv = nsv in (* Substitution function, to replace the borrow projectors over symbolic values *) @@ -473,7 +473,7 @@ let give_back_symbolic_value (_config : config) (meta : Meta.meta) type [T]! We thus *mustn't* introduce a projector here. *) (* AProjBorrows (nsv, sv.sv_ty) *) - internal_error meta + internal_error __FILE__ __LINE__ meta in AProjLoans (sv, (mv, child_proj) :: local_given_back) in @@ -498,7 +498,7 @@ let give_back_avalue_to_same_abstraction (_config : config) (meta : Meta.meta) (* We use a reference to check that we updated exactly one loan *) let replaced : bool ref = ref false in let set_replaced () = - cassert (not !replaced) meta "Only one loan should have been updated"; + cassert __FILE__ __LINE__ (not !replaced) meta "Only one loan should have been updated"; replaced := true in let obj = @@ -541,7 +541,7 @@ let give_back_avalue_to_same_abstraction (_config : config) (meta : Meta.meta) ("give_back_avalue_to_same_abstraction: improper type:\n\ - expected: " ^ ty_to_string ctx ty ^ "\n- received: " ^ ty_to_string ctx nv.ty); - craise meta "Value given back doesn't have the proper type"); + craise __FILE__ __LINE__ meta "Value given back doesn't have the proper type"); (* This is the loan we are looking for: apply the projection to * the value we give back and replaced this mutable loan with * an ended loan *) @@ -567,7 +567,7 @@ let give_back_avalue_to_same_abstraction (_config : config) (meta : Meta.meta) * we don't register the fact that we inserted the value somewhere * (i.e., we don't call {!set_replaced}) *) (* Sanity check *) - sanity_check (nv.ty = ty) meta; + sanity_check __FILE__ __LINE__ (nv.ty = ty) meta; ALoan (AEndedIgnoredMutLoan { given_back = nv; child; given_back_meta = nsv })) @@ -583,7 +583,7 @@ let give_back_avalue_to_same_abstraction (_config : config) (meta : Meta.meta) (* Explore the environment *) let ctx = obj#visit_eval_ctx None ctx in (* Check we gave back to exactly one loan *) - cassert !replaced meta "Only one loan should be given back"; + cassert __FILE__ __LINE__ !replaced meta "Only one loan should be given back"; (* Return *) ctx @@ -601,7 +601,7 @@ let give_back_shared _config (meta : Meta.meta) (bid : BorrowId.id) (* We use a reference to check that we updated exactly one loan *) let replaced : bool ref = ref false in let set_replaced () = - cassert (not !replaced) meta "Only one loan should be updated"; + cassert __FILE__ __LINE__ (not !replaced) meta "Only one loan should be updated"; replaced := true in let obj = @@ -666,7 +666,7 @@ let give_back_shared _config (meta : Meta.meta) (bid : BorrowId.id) (* Explore the environment *) let ctx = obj#visit_eval_ctx None ctx in (* Check we gave back to exactly one loan *) - cassert !replaced meta "Exactly one loan should be given back"; + cassert __FILE__ __LINE__ !replaced meta "Exactly one loan should be given back"; (* Return *) ctx @@ -680,7 +680,7 @@ let reborrow_shared (meta : Meta.meta) (original_bid : BorrowId.id) (* Keep track of changes *) let r = ref false in let set_ref () = - sanity_check (not !r) meta; + sanity_check __FILE__ __LINE__ (not !r) meta; r := true in @@ -710,7 +710,7 @@ let reborrow_shared (meta : Meta.meta) (original_bid : BorrowId.id) let env = obj#visit_env () ctx.env in (* Check that we reborrowed once *) - sanity_check !r meta; + sanity_check __FILE__ __LINE__ !r meta; { ctx with env } (** Convert an {!type:avalue} to a {!type:value}. @@ -770,24 +770,24 @@ let give_back (config : config) (meta : Meta.meta) (l : BorrowId.id) match bc with | Concrete (VMutBorrow (l', tv)) -> (* Sanity check *) - sanity_check (l' = l) meta; - sanity_check (not (loans_in_value tv)) meta; + sanity_check __FILE__ __LINE__ (l' = l) meta; + sanity_check __FILE__ __LINE__ (not (loans_in_value tv)) meta; (* Check that the corresponding loan is somewhere - purely a sanity check *) - sanity_check (Option.is_some (lookup_loan_opt meta sanity_ek l ctx)) meta; + sanity_check __FILE__ __LINE__ (Option.is_some (lookup_loan_opt meta sanity_ek l ctx)) meta; (* Update the context *) give_back_value config meta l tv ctx | Concrete (VSharedBorrow l' | VReservedMutBorrow l') -> (* Sanity check *) - sanity_check (l' = l) meta; + sanity_check __FILE__ __LINE__ (l' = l) meta; (* Check that the borrow is somewhere - purely a sanity check *) - sanity_check (Option.is_some (lookup_loan_opt meta sanity_ek l ctx)) meta; + sanity_check __FILE__ __LINE__ (Option.is_some (lookup_loan_opt meta sanity_ek l ctx)) meta; (* Update the context *) give_back_shared config meta l ctx | Abstract (AMutBorrow (l', av)) -> (* Sanity check *) - sanity_check (l' = l) meta; + sanity_check __FILE__ __LINE__ (l' = l) meta; (* Check that the corresponding loan is somewhere - purely a sanity check *) - sanity_check (Option.is_some (lookup_loan_opt meta sanity_ek l ctx)) meta; + sanity_check __FILE__ __LINE__ (Option.is_some (lookup_loan_opt meta sanity_ek l ctx)) meta; (* Convert the avalue to a (fresh symbolic) value. Rem.: we shouldn't do this here. We should do this in a function @@ -800,20 +800,20 @@ let give_back (config : config) (meta : Meta.meta) (l : BorrowId.id) ctx | Abstract (ASharedBorrow l') -> (* Sanity check *) - sanity_check (l' = l) meta; + sanity_check __FILE__ __LINE__ (l' = l) meta; (* Check that the borrow is somewhere - purely a sanity check *) - sanity_check (Option.is_some (lookup_loan_opt meta sanity_ek l ctx)) meta; + sanity_check __FILE__ __LINE__ (Option.is_some (lookup_loan_opt meta sanity_ek l ctx)) meta; (* Update the context *) give_back_shared config meta l ctx | Abstract (AProjSharedBorrow asb) -> (* Sanity check *) - sanity_check (borrow_in_asb l asb) meta; + sanity_check __FILE__ __LINE__ (borrow_in_asb l asb) meta; (* Update the context *) give_back_shared config meta l ctx | Abstract ( AEndedMutBorrow _ | AIgnoredMutBorrow _ | AEndedIgnoredMutBorrow _ | AEndedSharedBorrow ) -> - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" let check_borrow_disappeared (meta : Meta.meta) (fun_name : string) (l : BorrowId.id) (ctx0 : eval_ctx) : cm_fun = @@ -829,7 +829,7 @@ let check_borrow_disappeared (meta : Meta.meta) (fun_name : string) ^ eval_ctx_to_string ~meta:(Some meta) ctx0 ^ "\n\n- new context:\n" ^ eval_ctx_to_string ~meta:(Some meta) ctx)); - craise meta "Borrow not eliminated" + craise __FILE__ __LINE__ meta "Borrow not eliminated" in match lookup_loan_opt meta ek_all l ctx with | None -> () (* Ok *) @@ -841,7 +841,7 @@ let check_borrow_disappeared (meta : Meta.meta) (fun_name : string) ^ eval_ctx_to_string ~meta:(Some meta) ctx0 ^ "\n\n- new context:\n" ^ eval_ctx_to_string ~meta:(Some meta) ctx)); - craise meta "Loan not eliminated" + craise __FILE__ __LINE__ meta "Loan not eliminated" in unit_to_cm_fun check_disappeared @@ -937,7 +937,7 @@ let rec end_borrow_aux (config : config) (meta : Meta.meta) log#ldebug (lazy "End borrow: borrow not found"); (* It is possible that we can't find a borrow in symbolic mode (ending * an abstraction may end several borrows at once *) - sanity_check (config.mode = SymbolicMode) meta; + sanity_check __FILE__ __LINE__ (config.mode = SymbolicMode) meta; (* Do a sanity check and continue *) cf_check cf ctx (* We found a borrow and replaced it with [Bottom]: give it back (i.e., update @@ -946,7 +946,7 @@ let rec end_borrow_aux (config : config) (meta : Meta.meta) (* Sanity check: the borrowed value shouldn't contain loans *) (match bc with | Concrete (VMutBorrow (_, bv)) -> - sanity_check (Option.is_none (get_first_loan_in_value bv)) meta + sanity_check __FILE__ __LINE__ (Option.is_none (get_first_loan_in_value bv)) meta | _ -> ()); (* Give back the value *) let ctx = give_back config meta l bc ctx in @@ -1002,7 +1002,7 @@ and end_abstraction_aux (config : config) (meta : Meta.meta) (* Check that we can end the abstraction *) if abs.can_end then () else - craise meta + craise __FILE__ __LINE__ meta ("Can't end abstraction " ^ AbstractionId.to_string abs.abs_id ^ " as it is set as non-endable"); @@ -1172,7 +1172,7 @@ and end_abstraction_borrows (config : config) (meta : Meta.meta) method! visit_aproj env sproj = (match sproj with - | AProjLoans _ -> craise meta "Unexpected" + | AProjLoans _ -> craise __FILE__ __LINE__ meta "Unexpected" | AProjBorrows (sv, proj_ty) -> raise (FoundAProjBorrows (sv, proj_ty)) | AEndedProjLoans _ | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()); super#visit_aproj env sproj @@ -1181,7 +1181,7 @@ and end_abstraction_borrows (config : config) (meta : Meta.meta) method! visit_borrow_content _ bc = match bc with | VSharedBorrow _ | VMutBorrow (_, _) -> raise (FoundBorrowContent bc) - | VReservedMutBorrow _ -> craise meta "Unreachable" + | VReservedMutBorrow _ -> craise __FILE__ __LINE__ meta "Unreachable" end in (* Lookup the abstraction *) @@ -1241,7 +1241,7 @@ and end_abstraction_borrows (config : config) (meta : Meta.meta) ctx | AEndedMutBorrow _ | AIgnoredMutBorrow _ | AEndedIgnoredMutBorrow _ | AEndedSharedBorrow -> - craise meta "Unexpected" + craise __FILE__ __LINE__ meta "Unexpected" in (* Reexplore *) end_abstraction_borrows config meta chain abs_id cf ctx @@ -1276,7 +1276,7 @@ and end_abstraction_borrows (config : config) (meta : Meta.meta) match end_borrow_get_borrow meta (Some abs_id) allow_inner_loans bid ctx with - | Error _ -> craise meta "Unreachable" + | Error _ -> craise __FILE__ __LINE__ meta "Unreachable" | Ok (ctx, _) -> (* Give back *) give_back_shared config meta bid ctx) @@ -1286,12 +1286,12 @@ and end_abstraction_borrows (config : config) (meta : Meta.meta) match end_borrow_get_borrow meta (Some abs_id) allow_inner_loans bid ctx with - | Error _ -> craise meta "Unreachable" + | Error _ -> craise __FILE__ __LINE__ meta "Unreachable" | Ok (ctx, _) -> (* Give the value back - note that the mut borrow was below a * shared borrow: the value is thus unchanged *) give_back_value config meta bid v ctx) - | VReservedMutBorrow _ -> craise meta "Unreachable" + | VReservedMutBorrow _ -> craise __FILE__ __LINE__ meta "Unreachable" in (* Reexplore *) end_abstraction_borrows config meta chain abs_id cf ctx @@ -1430,7 +1430,7 @@ and end_proj_loans_symbolic (config : config) (meta : Meta.meta) * replace it with... Maybe we should introduce an ABottomProj? *) let ctx = update_aproj_borrows meta abs_id sv AIgnoredProjBorrows ctx in (* Sanity check: no other occurrence of an intersecting projector of borrows *) - sanity_check + sanity_check __FILE__ __LINE__ (Option.is_none (lookup_intersecting_aproj_borrows_opt meta explore_shared regions sv ctx)) @@ -1509,22 +1509,22 @@ let promote_shared_loan_to_mut_loan (meta : Meta.meta) (l : BorrowId.id) in match lookup_loan meta ek l ctx with | _, Concrete (VMutLoan _) -> - craise meta "Expected a shared loan, found a mut loan" + craise __FILE__ __LINE__ meta "Expected a shared loan, found a mut loan" | _, Concrete (VSharedLoan (bids, sv)) -> (* Check that there is only one borrow id (l) and update the loan *) - cassert + cassert __FILE__ __LINE__ (BorrowId.Set.mem l bids && BorrowId.Set.cardinal bids = 1) meta "There should only be one borrow id"; (* We need to check that there aren't any loans in the value: we should have gotten rid of those already, but it is better to do a sanity check. *) - sanity_check (not (loans_in_value sv)) meta; + sanity_check __FILE__ __LINE__ (not (loans_in_value sv)) meta; (* Check there isn't {!Bottom} (this is actually an invariant *) - cassert + cassert __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions sv)) meta "There shouldn't be a bottom"; (* Check there aren't reserved borrows *) - cassert + cassert __FILE__ __LINE__ (not (reserved_in_value sv)) meta "There shouldn't be reserved borrows"; (* Update the loan content *) @@ -1534,7 +1534,7 @@ let promote_shared_loan_to_mut_loan (meta : Meta.meta) (l : BorrowId.id) | _, Abstract _ -> (* I don't think it is possible to have two-phase borrows involving borrows * returned by abstractions. I'm not sure how we could handle that anyway. *) - craise meta + craise __FILE__ __LINE__ meta "Can't promote a shared loan to a mutable loan if the loan is inside \ an abstraction" @@ -1555,13 +1555,13 @@ let replace_reserved_borrow_with_mut_borrow (meta : Meta.meta) (l : BorrowId.id) let ctx = match lookup_borrow meta ek l ctx with | Concrete (VSharedBorrow _ | VMutBorrow (_, _)) -> - craise meta "Expected a reserved mutable borrow" + craise __FILE__ __LINE__ meta "Expected a reserved mutable borrow" | Concrete (VReservedMutBorrow _) -> (* Update it *) update_borrow meta ek l (VMutBorrow (l, borrowed_value)) ctx | Abstract _ -> (* This can't happen for sure *) - craise meta + craise __FILE__ __LINE__ meta "Can't promote a shared borrow to a mutable borrow if the borrow is \ inside an abstraction" in @@ -1577,7 +1577,7 @@ let rec promote_reserved_mut_borrow (config : config) (meta : Meta.meta) { enter_shared_loans = false; enter_mut_borrows = true; enter_abs = false } in match lookup_loan meta ek l ctx with - | _, Concrete (VMutLoan _) -> craise meta "Unreachable" + | _, Concrete (VMutLoan _) -> craise __FILE__ __LINE__ meta "Unreachable" | _, Concrete (VSharedLoan (bids, sv)) -> ( (* If there are loans inside the value, end them. Note that there can't be reserved borrows inside the value. @@ -1601,9 +1601,9 @@ let rec promote_reserved_mut_borrow (config : config) (meta : Meta.meta) (lazy ("activate_reserved_mut_borrow: resulting value:\n" ^ typed_value_to_string ~meta:(Some meta) ctx sv)); - sanity_check (not (loans_in_value sv)) meta; - sanity_check (not (bottom_in_value ctx.ended_regions sv)) meta; - sanity_check (not (reserved_in_value sv)) meta; + sanity_check __FILE__ __LINE__ (not (loans_in_value sv)) meta; + sanity_check __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions sv)) meta; + sanity_check __FILE__ __LINE__ (not (reserved_in_value sv)) meta; (* End the borrows which borrow from the value, at the exception of the borrow we want to promote *) let bids = BorrowId.Set.remove l bids in @@ -1625,7 +1625,7 @@ let rec promote_reserved_mut_borrow (config : config) (meta : Meta.meta) | _, Abstract _ -> (* I don't think it is possible to have two-phase borrows involving borrows * returned by abstractions. I'm not sure how we could handle that anyway. *) - craise meta + craise __FILE__ __LINE__ meta "Can't activate a reserved mutable borrow referencing a loan inside\n\ \ an abstraction" @@ -1642,7 +1642,7 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) ignore the children altogether. Instead, we explore them and make sure we don't register values while doing so. *) - let push_fail _ = craise meta "Unreachable" in + let push_fail _ = craise __FILE__ __LINE__ meta "Unreachable" in (* Function to explore an avalue and destructure it *) let rec list_avalues (allow_borrows : bool) (push : typed_avalue -> unit) (av : typed_avalue) : unit = @@ -1657,7 +1657,7 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) match lc with | ASharedLoan (bids, sv, child_av) -> (* We don't support nested borrows for now *) - cassert + cassert __FILE__ __LINE__ (not (value_has_borrows ctx sv.value)) meta "Nested borrows are not supported yet"; (* Destructure the shared value *) @@ -1686,10 +1686,10 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) push { value; ty } | AIgnoredMutLoan (opt_bid, child_av) -> (* We don't support nested borrows for now *) - cassert + cassert __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos child_av.ty)) meta "Nested borrows are not supported yet"; - sanity_check (opt_bid = None) meta; + sanity_check __FILE__ __LINE__ (opt_bid = None) meta; (* Simply explore the child *) list_avalues false push_fail child_av | AEndedMutLoan @@ -1699,14 +1699,14 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) { child = child_av; given_back = _; given_back_meta = _ } | AIgnoredSharedLoan child_av -> (* We don't support nested borrows for now *) - cassert + cassert __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos child_av.ty)) meta "Nested borrows are not supported yet"; (* Simply explore the child *) list_avalues false push_fail child_av) | ABorrow bc -> ( (* Sanity check - rem.: may be redundant with [push_fail] *) - sanity_check allow_borrows meta; + sanity_check __FILE__ __LINE__ allow_borrows meta; (* Explore the borrow content *) match bc with | AMutBorrow (bid, child_av) -> @@ -1721,23 +1721,23 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) push av | AIgnoredMutBorrow (opt_bid, child_av) -> (* We don't support nested borrows for now *) - cassert + cassert __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos child_av.ty)) meta "Nested borrows are not supported yet"; - sanity_check (opt_bid = None) meta; + sanity_check __FILE__ __LINE__ (opt_bid = None) meta; (* Just explore the child *) list_avalues false push_fail child_av | AEndedIgnoredMutBorrow { child = child_av; given_back = _; given_back_meta = _ } -> (* We don't support nested borrows for now *) - cassert + cassert __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos child_av.ty)) meta "Nested borrows are not supported yet"; (* Just explore the child *) list_avalues false push_fail child_av | AProjSharedBorrow asb -> (* We don't support nested borrows *) - cassert (asb = []) meta "Nested borrows are not supported yet"; + cassert __FILE__ __LINE__ (asb = []) meta "Nested borrows are not supported yet"; (* Nothing specific to do *) () | AEndedMutBorrow _ | AEndedSharedBorrow -> @@ -1745,11 +1745,11 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) be in the context anymore (if we end *one* borrow in an abstraction, we have to end them all and remove the abstraction from the context) *) - craise meta "Unreachable") + craise __FILE__ __LINE__ meta "Unreachable") | ASymbolic _ -> (* For now, we fore all symbolic values containing borrows to be eagerly expanded *) - sanity_check (not (ty_has_borrows ctx.type_ctx.type_infos ty)) meta + sanity_check __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos ty)) meta and list_values (v : typed_value) : typed_avalue list * typed_value = let ty = v.ty in match v.value with @@ -1761,20 +1761,20 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) let avl = List.concat avll in let adt = { adt with field_values } in (avl, { v with value = VAdt adt }) - | VBottom -> craise meta "Unreachable" + | VBottom -> craise __FILE__ __LINE__ meta "Unreachable" | VBorrow _ -> (* We don't support nested borrows for now *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | VLoan lc -> ( match lc with | VSharedLoan (bids, sv) -> let avl, sv = list_values sv in if destructure_shared_values then ( (* Rem.: the shared value can't contain loans nor borrows *) - cassert (ty_no_regions ty) meta + cassert __FILE__ __LINE__ (ty_no_regions ty) meta "Nested borrows are not supported yet"; let av : typed_avalue = - sanity_check + sanity_check __FILE__ __LINE__ (not (value_has_loans_or_borrows ctx sv.value)) meta; (* We introduce fresh ids for the symbolic values *) @@ -1799,11 +1799,11 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) let avl = List.append [ av ] avl in (avl, sv)) else (avl, { v with value = VLoan (VSharedLoan (bids, sv)) }) - | VMutLoan _ -> craise meta "Unreachable") + | VMutLoan _ -> craise __FILE__ __LINE__ meta "Unreachable") | VSymbolic _ -> (* For now, we fore all symbolic values containing borrows to be eagerly expanded *) - sanity_check (not (ty_has_borrows ctx.type_ctx.type_infos ty)) meta; + sanity_check __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos ty)) meta; ([], v) in @@ -1903,14 +1903,14 @@ let convert_value_to_abstractions (meta : Meta.meta) (abs_kind : abs_kind) (avl, { v with value = VAdt adt }) | VBorrow bc -> ( let _, ref_ty, kind = ty_as_ref ty in - cassert (ty_no_regions ref_ty) meta + cassert __FILE__ __LINE__ (ty_no_regions ref_ty) meta "Nested borrows are not supported yet"; (* Sanity check *) - sanity_check allow_borrows meta; + sanity_check __FILE__ __LINE__ allow_borrows meta; (* Convert the borrow content *) match bc with | VSharedBorrow bid -> - cassert (ty_no_regions ref_ty) meta + cassert __FILE__ __LINE__ (ty_no_regions ref_ty) meta "Nested borrows are not supported yet"; let ty = TRef (RFVar r_id, ref_ty, kind) in let value = ABorrow (ASharedBorrow bid) in @@ -1918,7 +1918,7 @@ let convert_value_to_abstractions (meta : Meta.meta) (abs_kind : abs_kind) | VMutBorrow (bid, bv) -> let r_id = if group then r_id else fresh_region_id () in (* We don't support nested borrows for now *) - cassert + cassert __FILE__ __LINE__ (not (value_has_borrows ctx bv.value)) meta "Nested borrows are not supported yet"; (* Create an avalue to push - note that we use [AIgnore] for the inner avalue *) @@ -1933,18 +1933,18 @@ let convert_value_to_abstractions (meta : Meta.meta) (abs_kind : abs_kind) (av :: avl, value) | VReservedMutBorrow _ -> (* This borrow should have been activated *) - craise meta "Unexpected") + craise __FILE__ __LINE__ meta "Unexpected") | VLoan lc -> ( match lc with | VSharedLoan (bids, sv) -> let r_id = if group then r_id else fresh_region_id () in (* We don't support nested borrows for now *) - cassert + cassert __FILE__ __LINE__ (not (value_has_borrows ctx sv.value)) meta "Nested borrows are not supported yet"; (* Push the avalue - note that we use [AIgnore] for the inner avalue *) (* For avalues, a loan has the borrow type *) - cassert (ty_no_regions ty) meta + cassert __FILE__ __LINE__ (ty_no_regions ty) meta "Nested borrows are not supported yet"; let ty = mk_ref_ty (RFVar r_id) ty RShared in let ignored = mk_aignored meta ty in @@ -1963,7 +1963,7 @@ let convert_value_to_abstractions (meta : Meta.meta) (abs_kind : abs_kind) | VMutLoan bid -> (* Push the avalue - note that we use [AIgnore] for the inner avalue *) (* For avalues, a loan has the borrow type *) - cassert (ty_no_regions ty) meta + cassert __FILE__ __LINE__ (ty_no_regions ty) meta "Nested borrows are not supported yet"; let ty = mk_ref_ty (RFVar r_id) ty RMut in let ignored = mk_aignored meta ty in @@ -1973,7 +1973,7 @@ let convert_value_to_abstractions (meta : Meta.meta) (abs_kind : abs_kind) | VSymbolic _ -> (* For now, we force all the symbolic values containing borrows to be eagerly expanded, and we don't support nested borrows *) - cassert + cassert __FILE__ __LINE__ (not (value_has_borrows ctx v.value)) meta "Nested borrows are not supported yet"; (* Return nothing *) @@ -2029,26 +2029,26 @@ let compute_merge_abstraction_info (meta : Meta.meta) (ctx : eval_ctx) in let push_loans ids (lc : g_loan_content_with_ty) : unit = - sanity_check (BorrowId.Set.disjoint !loans ids) meta; + sanity_check __FILE__ __LINE__ (BorrowId.Set.disjoint !loans ids) meta; loans := BorrowId.Set.union !loans ids; BorrowId.Set.iter (fun id -> - sanity_check (not (BorrowId.Map.mem id !loan_to_content)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem id !loan_to_content)) meta; loan_to_content := BorrowId.Map.add id lc !loan_to_content; borrows_loans := LoanId id :: !borrows_loans) ids in let push_loan id (lc : g_loan_content_with_ty) : unit = - sanity_check (not (BorrowId.Set.mem id !loans)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Set.mem id !loans)) meta; loans := BorrowId.Set.add id !loans; - sanity_check (not (BorrowId.Map.mem id !loan_to_content)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem id !loan_to_content)) meta; loan_to_content := BorrowId.Map.add id lc !loan_to_content; borrows_loans := LoanId id :: !borrows_loans in let push_borrow id (bc : g_borrow_content_with_ty) : unit = - sanity_check (not (BorrowId.Set.mem id !borrows)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Set.mem id !borrows)) meta; borrows := BorrowId.Set.add id !borrows; - sanity_check (not (BorrowId.Map.mem id !borrow_to_content)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem id !borrow_to_content)) meta; borrow_to_content := BorrowId.Map.add id bc !borrow_to_content; borrows_loans := BorrowId id :: !borrows_loans in @@ -2071,23 +2071,23 @@ let compute_merge_abstraction_info (meta : Meta.meta) (ctx : eval_ctx) let ty = match Option.get env with | Concrete ty -> ty - | Abstract _ -> craise meta "Unreachable" + | Abstract _ -> craise __FILE__ __LINE__ meta "Unreachable" in (match lc with | VSharedLoan (bids, _) -> push_loans bids (Concrete (ty, lc)) - | VMutLoan _ -> craise meta "Unreachable"); + | VMutLoan _ -> craise __FILE__ __LINE__ meta "Unreachable"); (* Continue *) super#visit_loan_content env lc method! visit_borrow_content _ _ = (* Can happen if we explore shared values which contain borrows - i.e., if we have nested borrows (we forbid this for now) *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" method! visit_aloan_content env lc = let ty = match Option.get env with - | Concrete _ -> craise meta "Unreachable" + | Concrete _ -> craise __FILE__ __LINE__ meta "Unreachable" | Abstract ty -> ty in (* Register the loans *) @@ -2097,14 +2097,14 @@ let compute_merge_abstraction_info (meta : Meta.meta) (ctx : eval_ctx) | AEndedMutLoan _ | AEndedSharedLoan _ | AIgnoredMutLoan _ | AEndedIgnoredMutLoan _ | AIgnoredSharedLoan _ -> (* The abstraction has been destructured, so those shouldn't appear *) - craise meta "Unreachable"); + craise __FILE__ __LINE__ meta "Unreachable"); (* Continue *) super#visit_aloan_content env lc method! visit_aborrow_content env bc = let ty = match Option.get env with - | Concrete _ -> craise meta "Unreachable" + | Concrete _ -> craise __FILE__ __LINE__ meta "Unreachable" | Abstract ty -> ty in (* Explore the borrow content *) @@ -2118,18 +2118,18 @@ let compute_merge_abstraction_info (meta : Meta.meta) (ctx : eval_ctx) | AsbProjReborrows _ -> (* Can only happen if the symbolic value (potentially) contains borrows - i.e., we have nested borrows *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in List.iter register asb | AIgnoredMutBorrow _ | AEndedIgnoredMutBorrow _ | AEndedMutBorrow _ | AEndedSharedBorrow -> (* The abstraction has been destructured, so those shouldn't appear *) - craise meta "Unreachable"); + craise __FILE__ __LINE__ meta "Unreachable"); super#visit_aborrow_content env bc method! visit_symbolic_value _ sv = (* Sanity check: no borrows *) - sanity_check (not (symbolic_value_has_borrows ctx sv)) meta + sanity_check __FILE__ __LINE__ (not (symbolic_value_has_borrows ctx sv)) meta end in @@ -2209,10 +2209,10 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) (* Check that the abstractions are destructured *) if !Config.sanity_checks then ( let destructure_shared_values = true in - sanity_check + sanity_check __FILE__ __LINE__ (abs_is_destructured meta destructure_shared_values ctx abs0) meta; - sanity_check + sanity_check __FILE__ __LINE__ (abs_is_destructured meta destructure_shared_values ctx abs1) meta); @@ -2240,8 +2240,8 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) (* Sanity check: there is no loan/borrows which appears in both abstractions, unless we allow to merge duplicates *) if merge_funs = None then - (sanity_check (BorrowId.Set.disjoint borrows0 borrows1) meta; - sanity_check (BorrowId.Set.disjoint loans0 loans1)) + (sanity_check __FILE__ __LINE__ (BorrowId.Set.disjoint borrows0 borrows1) meta; + sanity_check __FILE__ __LINE__ (BorrowId.Set.disjoint loans0 loans1)) meta; (* Merge. @@ -2283,7 +2283,7 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) in let filter_bids (bids : BorrowId.Set.t) : BorrowId.Set.t = let bids = BorrowId.Set.diff bids intersect in - sanity_check (not (BorrowId.Set.is_empty bids)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Set.is_empty bids)) meta; bids in let filter_bid (bid : BorrowId.id) : BorrowId.id option = @@ -2311,11 +2311,11 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) (Option.get merge_funs).merge_ashared_borrows id ty0 ty1 | AProjSharedBorrow _, AProjSharedBorrow _ -> (* Unreachable because requires nested borrows *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | _ -> (* Unreachable because those cases are ignored (ended/ignored borrows) or inconsistent *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in let merge_g_borrow_contents (bc0 : g_borrow_content_with_ty) @@ -2323,12 +2323,12 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) match (bc0, bc1) with | Concrete _, Concrete _ -> (* This can happen only in case of nested borrows *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | Abstract (ty0, bc0), Abstract (ty1, bc1) -> merge_aborrow_contents ty0 bc0 ty1 bc1 | Concrete _, Abstract _ | Abstract _, Concrete _ -> (* TODO: is it really unreachable? *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in let merge_aloan_contents (ty0 : rty) (lc0 : aloan_content) (ty1 : rty) @@ -2346,7 +2346,7 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) (* Check that the sets of ids are the same - if it is not the case, it means we actually need to merge more than 2 avalues: we ignore this case for now *) - sanity_check (BorrowId.Set.equal ids0 ids1) meta; + sanity_check __FILE__ __LINE__ (BorrowId.Set.equal ids0 ids1) meta; let ids = ids0 in if BorrowId.Set.is_empty ids then ( (* If the set of ids is empty, we can eliminate this shared loan. @@ -2358,10 +2358,10 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) to preserve (in practice it works because we destructure the shared values in the abstractions, and forbid nested borrows). *) - sanity_check (not (value_has_loans_or_borrows ctx sv0.value)) meta; - sanity_check (not (value_has_loans_or_borrows ctx sv0.value)) meta; - sanity_check (is_aignored child0.value) meta; - sanity_check (is_aignored child1.value) meta; + sanity_check __FILE__ __LINE__ (not (value_has_loans_or_borrows ctx sv0.value)) meta; + sanity_check __FILE__ __LINE__ (not (value_has_loans_or_borrows ctx sv0.value)) meta; + sanity_check __FILE__ __LINE__ (is_aignored child0.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child1.value) meta; None) else ( (* Register the loan ids *) @@ -2373,7 +2373,7 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) | _ -> (* Unreachable because those cases are ignored (ended/ignored borrows) or inconsistent *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in (* Note that because we may filter ids from a set of id, this function has @@ -2384,12 +2384,12 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) match (lc0, lc1) with | Concrete _, Concrete _ -> (* This can not happen: the values should have been destructured *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | Abstract (ty0, lc0), Abstract (ty1, lc1) -> merge_aloan_contents ty0 lc0 ty1 lc1 | Concrete _, Abstract _ | Abstract _, Concrete _ -> (* TODO: is it really unreachable? *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in (* Note that we first explore the borrows/loans of [abs1], because we @@ -2430,12 +2430,12 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) a concrete borrow can only happen inside a shared loan *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | Abstract (ty, bc) -> { value = ABorrow bc; ty }) | Some bc0, Some bc1 -> - sanity_check (merge_funs <> None) meta; + sanity_check __FILE__ __LINE__ (merge_funs <> None) meta; merge_g_borrow_contents bc0 bc1 - | None, None -> craise meta "Unreachable" + | None, None -> craise __FILE__ __LINE__ meta "Unreachable" in push_avalue av) | LoanId bid -> @@ -2468,16 +2468,16 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) | Concrete _ -> (* This shouldn't happen because the avalues should have been destructured. *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | Abstract (ty, lc) -> ( match lc with | ASharedLoan (bids, sv, child) -> let bids = filter_bids bids in - sanity_check + sanity_check __FILE__ __LINE__ (not (BorrowId.Set.is_empty bids)) meta; - sanity_check (is_aignored child.value) meta; - sanity_check + sanity_check __FILE__ __LINE__ (is_aignored child.value) meta; + sanity_check __FILE__ __LINE__ (not (value_has_loans_or_borrows ctx sv.value)) meta; let lc = ASharedLoan (bids, sv, child) in @@ -2490,11 +2490,11 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) | AIgnoredMutLoan _ | AEndedIgnoredMutLoan _ | AIgnoredSharedLoan _ -> (* The abstraction has been destructured, so those shouldn't appear *) - craise meta "Unreachable")) + craise __FILE__ __LINE__ meta "Unreachable")) | Some lc0, Some lc1 -> - sanity_check (merge_funs <> None) meta; + sanity_check __FILE__ __LINE__ (merge_funs <> None) meta; merge_g_loan_contents lc0 lc1 - | None, None -> craise meta "Unreachable" + | None, None -> craise __FILE__ __LINE__ meta "Unreachable" in push_opt_avalue av)) borrows_loans; @@ -2512,7 +2512,7 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) match av.value with | ABorrow _ -> true | ALoan _ -> false - | _ -> craise meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Unexpected" in let aborrows, aloans = List.partition is_borrow avalues in List.append aborrows aloans @@ -2547,7 +2547,7 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) in (* Sanity check *) - sanity_check (abs_is_destructured meta true ctx abs) meta; + sanity_check __FILE__ __LINE__ (abs_is_destructured meta true ctx abs) meta; (* Return *) abs diff --git a/compiler/InterpreterBorrowsCore.ml b/compiler/InterpreterBorrowsCore.ml index 02ceffb4..fd656063 100644 --- a/compiler/InterpreterBorrowsCore.ml +++ b/compiler/InterpreterBorrowsCore.ml @@ -75,7 +75,7 @@ let borrow_or_abs_ids_chain_to_string (ids : borrow_or_abs_ids) : string = let add_borrow_or_abs_id_to_chain (meta : Meta.meta) (msg : string) (id : borrow_or_abs_id) (ids : borrow_or_abs_ids) : borrow_or_abs_ids = if List.mem id ids then - craise meta + craise __FILE__ __LINE__ meta (msg ^ "detected a loop in the chain of ids: " ^ borrow_or_abs_ids_chain_to_string (id :: ids)) else id :: ids @@ -100,17 +100,17 @@ let rec compare_rtys (meta : Meta.meta) (default : bool) = let compare = compare_rtys meta default combine compare_regions in (* Sanity check - TODO: don't do this at every recursive call *) - sanity_check (ty_is_rty ty1 && ty_is_rty ty2) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty ty1 && ty_is_rty ty2) meta; (* Normalize the associated types *) match (ty1, ty2) with | TLiteral lit1, TLiteral lit2 -> - sanity_check (lit1 = lit2) meta; + sanity_check __FILE__ __LINE__ (lit1 = lit2) meta; default | TAdt (id1, generics1), TAdt (id2, generics2) -> - sanity_check (id1 = id2) meta; + sanity_check __FILE__ __LINE__ (id1 = id2) meta; (* There are no regions in the const generics, so we ignore them, but we still check they are the same, for sanity *) - sanity_check (generics1.const_generics = generics2.const_generics) meta; + sanity_check __FILE__ __LINE__ (generics1.const_generics = generics2.const_generics) meta; (* We also ignore the trait refs *) @@ -144,7 +144,7 @@ let rec compare_rtys (meta : Meta.meta) (default : bool) combine params_b tys_b | TRef (r1, ty1, kind1), TRef (r2, ty2, kind2) -> (* Sanity check *) - sanity_check (kind1 = kind2) meta; + sanity_check __FILE__ __LINE__ (kind1 = kind2) meta; (* Explanation for the case where we check if projections intersect: * the projections intersect if the borrows intersect or their contents * intersect. *) @@ -152,19 +152,19 @@ let rec compare_rtys (meta : Meta.meta) (default : bool) let tys_b = compare ty1 ty2 in combine regions_b tys_b | TVar id1, TVar id2 -> - sanity_check (id1 = id2) meta; + sanity_check __FILE__ __LINE__ (id1 = id2) meta; default | TTraitType _, TTraitType _ -> (* The types should have been normalized. If after normalization we get trait types, we can consider them as variables *) - sanity_check (ty1 = ty2) meta; + sanity_check __FILE__ __LINE__ (ty1 = ty2) meta; default | _ -> log#lerror (lazy ("compare_rtys: unexpected inputs:" ^ "\n- ty1: " ^ show_ty ty1 ^ "\n- ty2: " ^ show_ty ty2)); - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" (** Check if two different projections intersect. This is necessary when giving a symbolic value to an abstraction: we need to check that @@ -269,7 +269,7 @@ let lookup_loan_opt (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) super#visit_aloan_content env lc method! visit_EBinding env bv v = - sanity_check (Option.is_none !abs_or_var) meta; + sanity_check __FILE__ __LINE__ (Option.is_none !abs_or_var) meta; abs_or_var := Some (match bv with @@ -279,7 +279,7 @@ let lookup_loan_opt (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) abs_or_var := None method! visit_EAbs env abs = - sanity_check (Option.is_none !abs_or_var) meta; + sanity_check __FILE__ __LINE__ (Option.is_none !abs_or_var) meta; if ek.enter_abs then ( abs_or_var := Some (AbsId abs.abs_id); super#visit_EAbs env abs; @@ -294,7 +294,7 @@ let lookup_loan_opt (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) with FoundGLoanContent lc -> ( match !abs_or_var with | Some abs_or_var -> Some (abs_or_var, lc) - | None -> craise meta "Inconsistent state") + | None -> craise __FILE__ __LINE__ meta "Inconsistent state") (** Lookup a loan content. @@ -304,7 +304,7 @@ let lookup_loan_opt (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) let lookup_loan (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) (ctx : eval_ctx) : abs_or_var_id * g_loan_content = match lookup_loan_opt meta ek l ctx with - | None -> craise meta "Unreachable" + | None -> craise __FILE__ __LINE__ meta "Unreachable" | Some res -> res (** Update a loan content. @@ -320,7 +320,7 @@ let update_loan (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) * returning we check that we updated at least once. *) let r = ref false in let update () : loan_content = - sanity_check (not !r) meta; + sanity_check __FILE__ __LINE__ (not !r) meta; r := true; nlc in @@ -367,7 +367,7 @@ let update_loan (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) let ctx = obj#visit_eval_ctx () ctx in (* Check that we updated at least one loan *) - sanity_check !r meta; + sanity_check __FILE__ __LINE__ !r meta; ctx (** Update a abstraction loan content. @@ -383,7 +383,7 @@ let update_aloan (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) * returning we check that we updated at least once. *) let r = ref false in let update () : aloan_content = - sanity_check (not !r) meta; + sanity_check __FILE__ __LINE__ (not !r) meta; r := true; nlc in @@ -416,7 +416,7 @@ let update_aloan (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) let ctx = obj#visit_eval_ctx () ctx in (* Check that we updated at least one loan *) - sanity_check !r meta; + sanity_check __FILE__ __LINE__ !r meta; ctx (** Lookup a borrow content from a borrow id. *) @@ -485,7 +485,7 @@ let lookup_borrow_opt (ek : exploration_kind) (l : BorrowId.id) (ctx : eval_ctx) let lookup_borrow (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) (ctx : eval_ctx) : g_borrow_content = match lookup_borrow_opt ek l ctx with - | None -> craise meta "Unreachable" + | None -> craise __FILE__ __LINE__ meta "Unreachable" | Some lc -> lc (** Update a borrow content. @@ -501,7 +501,7 @@ let update_borrow (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) * returning we check that we updated at least once. *) let r = ref false in let update () : borrow_content = - sanity_check (not !r) meta; + sanity_check __FILE__ __LINE__ (not !r) meta; r := true; nbc in @@ -542,7 +542,7 @@ let update_borrow (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) let ctx = obj#visit_eval_ctx () ctx in (* Check that we updated at least one borrow *) - sanity_check !r meta; + sanity_check __FILE__ __LINE__ !r meta; ctx (** Update an abstraction borrow content. @@ -558,7 +558,7 @@ let update_aborrow (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) * returning we check that we updated at least once. *) let r = ref false in let update () : avalue = - sanity_check (not !r) meta; + sanity_check __FILE__ __LINE__ (not !r) meta; r := true; nv in @@ -589,7 +589,7 @@ let update_aborrow (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) let ctx = obj#visit_eval_ctx () ctx in (* Check that we updated at least one borrow *) - cassert !r meta "No borrow was updated"; + cassert __FILE__ __LINE__ !r meta "No borrow was updated"; ctx (** Auxiliary function: see its usage in [end_borrow_get_borrow_in_value] *) @@ -708,13 +708,13 @@ let lookup_intersecting_aproj_borrows_opt (meta : Meta.meta) let set_non_shared ((id, ty) : AbstractionId.id * rty) : unit = match !found with | None -> found := Some (NonSharedProj (id, ty)) - | Some _ -> craise meta "Unreachable" + | Some _ -> craise __FILE__ __LINE__ meta "Unreachable" in let add_shared (x : AbstractionId.id * rty) : unit = match !found with | None -> found := Some (SharedProjs [ x ]) | Some (SharedProjs pl) -> found := Some (SharedProjs (x :: pl)) - | Some (NonSharedProj _) -> craise meta "Unreachable" + | Some (NonSharedProj _) -> craise __FILE__ __LINE__ meta "Unreachable" in let check_add_proj_borrows (is_shared : bool) abs sv' proj_ty = if @@ -734,7 +734,7 @@ let lookup_intersecting_aproj_borrows_opt (meta : Meta.meta) method! visit_abstract_shared_borrow abs asb = (* Sanity check *) (match !found with - | Some (NonSharedProj _) -> craise meta "Unreachable" + | Some (NonSharedProj _) -> craise __FILE__ __LINE__ meta "Unreachable" | _ -> ()); (* Explore *) if lookup_shared then @@ -782,7 +782,7 @@ let lookup_intersecting_aproj_borrows_not_shared_opt (meta : Meta.meta) with | None -> None | Some (NonSharedProj (abs_id, rty)) -> Some (abs_id, rty) - | _ -> craise meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Unexpected" (** Similar to {!lookup_intersecting_aproj_borrows_opt}, but updates the values. @@ -800,12 +800,12 @@ let update_intersecting_aproj_borrows (meta : Meta.meta) let add_shared () = match !shared with | None -> shared := Some true - | Some b -> sanity_check b meta + | Some b -> sanity_check __FILE__ __LINE__ b meta in let set_non_shared () = match !shared with | None -> shared := Some false - | Some _ -> craise meta "Found unexpected intersecting proj_borrows" + | Some _ -> craise __FILE__ __LINE__ meta "Found unexpected intersecting proj_borrows" in let check_proj_borrows is_shared abs sv' proj_ty = if @@ -825,7 +825,7 @@ let update_intersecting_aproj_borrows (meta : Meta.meta) method! visit_abstract_shared_borrows abs asb = (* Sanity check *) - (match !shared with Some b -> sanity_check b meta | _ -> ()); + (match !shared with Some b -> sanity_check __FILE__ __LINE__ b meta | _ -> ()); (* Explore *) if can_update_shared then let abs = Option.get abs in @@ -857,7 +857,7 @@ let update_intersecting_aproj_borrows (meta : Meta.meta) (* Apply *) let ctx = obj#visit_eval_ctx None ctx in (* Check that we updated the context at least once *) - cassert (Option.is_some !shared) meta "Context was not updated at least once"; + cassert __FILE__ __LINE__ (Option.is_some !shared) meta "Context was not updated at least once"; (* Return *) ctx @@ -873,7 +873,7 @@ let update_intersecting_aproj_borrows_non_shared (meta : Meta.meta) (ctx : eval_ctx) : eval_ctx = (* Small helpers *) let can_update_shared = false in - let update_shared _ _ = craise meta "Unexpected" in + let update_shared _ _ = craise __FILE__ __LINE__ meta "Unexpected" in let updated = ref false in let update_non_shared _ _ = (* We can update more than one borrow! *) @@ -886,7 +886,7 @@ let update_intersecting_aproj_borrows_non_shared (meta : Meta.meta) update_non_shared regions sv ctx in (* Check that we updated at least once *) - sanity_check !updated meta; + sanity_check __FILE__ __LINE__ !updated meta; (* Return *) ctx @@ -901,7 +901,7 @@ let remove_intersecting_aproj_borrows_shared (meta : Meta.meta) (* Small helpers *) let can_update_shared = true in let update_shared _ _ = [] in - let update_non_shared _ _ = craise meta "Unexpected" in + let update_non_shared _ _ = craise __FILE__ __LINE__ meta "Unexpected" in (* Update *) update_intersecting_aproj_borrows meta can_update_shared update_shared update_non_shared regions sv ctx @@ -942,7 +942,7 @@ let update_intersecting_aproj_loans (meta : Meta.meta) (subst : abs -> (msymbolic_value * aproj) list -> aproj) (ctx : eval_ctx) : eval_ctx = (* *) - sanity_check (ty_is_rty proj_ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty proj_ty) meta; (* Small helpers for sanity checks *) let updated = ref false in let update abs local_given_back : aproj = @@ -964,7 +964,7 @@ let update_intersecting_aproj_loans (meta : Meta.meta) | AProjLoans (sv', given_back) -> let abs = Option.get abs in if same_symbolic_id sv sv' then ( - sanity_check (sv.sv_ty = sv'.sv_ty) meta; + sanity_check __FILE__ __LINE__ (sv.sv_ty = sv'.sv_ty) meta; if projections_intersect meta proj_ty proj_regions sv'.sv_ty abs.regions @@ -976,7 +976,7 @@ let update_intersecting_aproj_loans (meta : Meta.meta) (* Apply *) let ctx = obj#visit_eval_ctx None ctx in (* Check that we updated the context at least once *) - sanity_check !updated meta; + sanity_check __FILE__ __LINE__ !updated meta; (* Return *) ctx @@ -996,7 +996,7 @@ let lookup_aproj_loans (meta : Meta.meta) (abs_id : AbstractionId.id) let found = ref None in let set_found x = (* There is at most one projector which corresponds to the description *) - sanity_check (Option.is_none !found) meta; + sanity_check __FILE__ __LINE__ (Option.is_none !found) meta; found := Some x in (* The visitor *) @@ -1014,9 +1014,9 @@ let lookup_aproj_loans (meta : Meta.meta) (abs_id : AbstractionId.id) super#visit_aproj abs sproj | AProjLoans (sv', given_back) -> let abs = Option.get abs in - sanity_check (abs.abs_id = abs_id) meta; + sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) meta; if sv'.sv_id = sv.sv_id then ( - sanity_check (sv' = sv) meta; + sanity_check __FILE__ __LINE__ (sv' = sv) meta; set_found given_back) else ()); super#visit_aproj abs sproj @@ -1041,7 +1041,7 @@ let update_aproj_loans (meta : Meta.meta) (abs_id : AbstractionId.id) let found = ref false in let update () = (* We update at most once *) - sanity_check (not !found) meta; + sanity_check __FILE__ __LINE__ (not !found) meta; found := true; nproj in @@ -1060,9 +1060,9 @@ let update_aproj_loans (meta : Meta.meta) (abs_id : AbstractionId.id) super#visit_aproj abs sproj | AProjLoans (sv', _) -> let abs = Option.get abs in - sanity_check (abs.abs_id = abs_id) meta; + sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) meta; if sv'.sv_id = sv.sv_id then ( - sanity_check (sv' = sv) meta; + sanity_check __FILE__ __LINE__ (sv' = sv) meta; update ()) else super#visit_aproj (Some abs) sproj end @@ -1070,7 +1070,7 @@ let update_aproj_loans (meta : Meta.meta) (abs_id : AbstractionId.id) (* Apply *) let ctx = obj#visit_eval_ctx None ctx in (* Sanity check *) - sanity_check !found meta; + sanity_check __FILE__ __LINE__ !found meta; (* Return *) ctx @@ -1090,7 +1090,7 @@ let update_aproj_borrows (meta : Meta.meta) (abs_id : AbstractionId.id) let found = ref false in let update () = (* We update at most once *) - sanity_check (not !found) meta; + sanity_check __FILE__ __LINE__ (not !found) meta; found := true; nproj in @@ -1109,9 +1109,9 @@ let update_aproj_borrows (meta : Meta.meta) (abs_id : AbstractionId.id) super#visit_aproj abs sproj | AProjBorrows (sv', _proj_ty) -> let abs = Option.get abs in - sanity_check (abs.abs_id = abs_id) meta; + sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) meta; if sv'.sv_id = sv.sv_id then ( - sanity_check (sv' = sv) meta; + sanity_check __FILE__ __LINE__ (sv' = sv) meta; update ()) else super#visit_aproj (Some abs) sproj end @@ -1119,7 +1119,7 @@ let update_aproj_borrows (meta : Meta.meta) (abs_id : AbstractionId.id) (* Apply *) let ctx = obj#visit_eval_ctx None ctx in (* Sanity check *) - sanity_check !found meta; + sanity_check __FILE__ __LINE__ !found meta; (* Return *) ctx @@ -1156,7 +1156,7 @@ let no_aproj_over_symbolic_in_context (meta : Meta.meta) (sv : symbolic_value) in (* Apply *) try obj#visit_eval_ctx () ctx - with Found -> craise meta "update_aproj_loans_to_ended: failed" + with Found -> craise __FILE__ __LINE__ meta "update_aproj_loans_to_ended: failed" (** Helper function @@ -1194,7 +1194,7 @@ let get_first_non_ignored_aloan_in_abstraction (meta : Meta.meta) (abs : abs) : | VMutLoan _ -> (* The mut loan linked to the mutable borrow present in a shared * value in an abstraction should be in an AProjBorrows *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | VSharedLoan (bids, _) -> raise (FoundBorrowIds (Borrows bids)) method! visit_aproj env sproj = diff --git a/compiler/InterpreterExpansion.ml b/compiler/InterpreterExpansion.ml index 3e1aeef2..0b7c071e 100644 --- a/compiler/InterpreterExpansion.ml +++ b/compiler/InterpreterExpansion.ml @@ -66,7 +66,7 @@ let apply_symbolic_expansion_to_target_avalues (config : config) (** When visiting an abstraction, we remember the regions it owns to be able to properly reduce projectors when expanding symbolic values *) method! visit_abs current_abs abs = - sanity_check (Option.is_none current_abs) meta; + sanity_check __FILE__ __LINE__ (Option.is_none current_abs) meta; let current_abs = Some abs in super#visit_abs current_abs abs @@ -78,7 +78,7 @@ let apply_symbolic_expansion_to_target_avalues (config : config) method! visit_aproj current_abs aproj = (match aproj with | AProjLoans (sv, _) | AProjBorrows (sv, _) -> - sanity_check (not (same_symbolic_id sv original_sv)) meta + sanity_check __FILE__ __LINE__ (not (same_symbolic_id sv original_sv)) meta | AEndedProjLoans _ | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()); super#visit_aproj current_abs aproj @@ -98,7 +98,7 @@ let apply_symbolic_expansion_to_target_avalues (config : config) (* Check if this is the symbolic value we are looking for *) if same_symbolic_id sv original_sv then ( (* There mustn't be any given back values *) - sanity_check (given_back = []) meta; + sanity_check __FILE__ __LINE__ (given_back = []) meta; (* Apply the projector *) let projected_value = apply_proj_loans_on_symbolic_expansion meta proj_regions @@ -169,7 +169,7 @@ let replace_symbolic_values (meta : Meta.meta) (at_most_once : bool) (* Count *) let replaced = ref false in let replace () = - if at_most_once then sanity_check (not !replaced) meta; + if at_most_once then sanity_check __FILE__ __LINE__ (not !replaced) meta; replaced := true; nv in @@ -218,7 +218,7 @@ let compute_expanded_symbolic_non_assumed_adt_value (meta : Meta.meta) (* Lookup the definition and check if it is an enumeration with several * variants *) let def = ctx_lookup_type_decl ctx def_id in - sanity_check + sanity_check __FILE__ __LINE__ (List.length generics.regions = List.length def.generics.regions) meta; (* Retrieve, for every variant, the list of its instantiated field types *) @@ -228,7 +228,7 @@ let compute_expanded_symbolic_non_assumed_adt_value (meta : Meta.meta) in (* Check if there is strictly more than one variant *) if List.length variants_fields_types > 1 && not expand_enumerations then - craise meta "Not allowed to expand enumerations with several variants"; + craise __FILE__ __LINE__ meta "Not allowed to expand enumerations with several variants"; (* Initialize the expanded value for a given variant *) let initialize ((variant_id, field_types) : VariantId.id option * rty list) : symbolic_expansion = @@ -279,7 +279,7 @@ let compute_expanded_symbolic_adt_value (meta : Meta.meta) | TAssumed TBox, [], [ boxed_ty ] -> [ compute_expanded_symbolic_box_value meta boxed_ty ] | _ -> - craise meta "compute_expanded_symbolic_adt_value: unexpected combination" + craise __FILE__ __LINE__ meta "compute_expanded_symbolic_adt_value: unexpected combination" let expand_symbolic_value_shared_borrow (config : config) (meta : Meta.meta) (original_sv : symbolic_value) (original_sv_place : SA.mplace option) @@ -314,7 +314,7 @@ let expand_symbolic_value_shared_borrow (config : config) (meta : Meta.meta) Some [ AsbBorrow bid; shared_asb ] else (* Not in the set: ignore *) Some [ shared_asb ] - | _ -> craise meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Unexpected" else None in (* The fresh symbolic value for the shared value *) @@ -331,7 +331,7 @@ let expand_symbolic_value_shared_borrow (config : config) (meta : Meta.meta) else super#visit_VSymbolic env sv method! visit_EAbs proj_regions abs = - sanity_check (Option.is_none proj_regions) meta; + sanity_check __FILE__ __LINE__ (Option.is_none proj_regions) meta; let proj_regions = Some abs.regions in super#visit_EAbs proj_regions abs @@ -356,7 +356,7 @@ let expand_symbolic_value_shared_borrow (config : config) (meta : Meta.meta) method! visit_aproj proj_regions aproj = (match aproj with | AProjLoans (sv, _) | AProjBorrows (sv, _) -> - sanity_check (not (same_symbolic_id sv original_sv)) meta + sanity_check __FILE__ __LINE__ (not (same_symbolic_id sv original_sv)) meta | AEndedProjLoans _ | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()); super#visit_aproj proj_regions aproj @@ -382,7 +382,7 @@ let expand_symbolic_value_shared_borrow (config : config) (meta : Meta.meta) let ctx = obj#visit_eval_ctx None ctx in (* Finally, replace the projectors on loans *) let bids = !borrows in - sanity_check (not (BorrowId.Set.is_empty bids)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Set.is_empty bids)) meta; let see = SeSharedRef (bids, shared_sv) in let allow_reborrows = true in let ctx = @@ -400,9 +400,9 @@ let expand_symbolic_value_borrow (config : config) (meta : Meta.meta) (original_sv : symbolic_value) (original_sv_place : SA.mplace option) (region : region) (ref_ty : rty) (rkind : ref_kind) : cm_fun = fun cf ctx -> - sanity_check (region <> RErased) meta; + sanity_check __FILE__ __LINE__ (region <> RErased) meta; (* Check that we are allowed to expand the reference *) - sanity_check (not (region_in_set region ctx.ended_regions)) meta; + sanity_check __FILE__ __LINE__ (not (region_in_set region ctx.ended_regions)) meta; (* Match on the reference kind *) match rkind with | RMut -> @@ -456,7 +456,7 @@ let apply_branching_symbolic_expansions_non_borrow (config : config) (see_cf_l : (symbolic_expansion option * st_cm_fun) list) (cf_after_join : st_m_fun) : m_fun = fun ctx -> - sanity_check (see_cf_l <> []) meta; + sanity_check __FILE__ __LINE__ (see_cf_l <> []) meta; (* Apply the symbolic expansion in the context and call the continuation *) let resl = List.map @@ -490,9 +490,9 @@ let apply_branching_symbolic_expansions_non_borrow (config : config) match resl with | Some _ :: _ -> Some (List.map Option.get resl) | None :: _ -> - List.iter (fun res -> sanity_check (res = None) meta) resl; + List.iter (fun res -> sanity_check __FILE__ __LINE__ (res = None) meta) resl; None - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in (* Synthesize and return *) let seel = List.map fst see_cf_l in @@ -506,7 +506,7 @@ let expand_symbolic_bool (config : config) (meta : Meta.meta) let original_sv = sv in let original_sv_place = sv_place in let rty = original_sv.sv_ty in - sanity_check (rty = TLiteral TBool) meta; + sanity_check __FILE__ __LINE__ (rty = TLiteral TBool) meta; (* Expand the symbolic value to true or false and continue execution *) let see_true = SeLiteral (VBool true) in let see_false = SeLiteral (VBool false) in @@ -556,7 +556,7 @@ let expand_symbolic_value_no_branching (config : config) (meta : Meta.meta) expand_symbolic_value_borrow config meta original_sv original_sv_place region ref_ty rkind cf ctx | _ -> - craise meta + craise __FILE__ __LINE__ meta ("expand_symbolic_value_no_branching: unexpected type: " ^ show_rty rty) in @@ -573,7 +573,7 @@ let expand_symbolic_value_no_branching (config : config) (meta : Meta.meta) ^ eval_ctx_to_string ~meta:(Some meta) ctx ^ "\n")); (* Sanity check: the symbolic value has disappeared *) - sanity_check (not (symbolic_value_id_in_ctx original_sv.sv_id ctx)) meta) + sanity_check __FILE__ __LINE__ (not (symbolic_value_id_in_ctx original_sv.sv_id ctx)) meta) in (* Continue *) cc cf ctx @@ -603,14 +603,14 @@ let expand_symbolic_adt (config : config) (meta : Meta.meta) let seel = List.map (fun see -> (Some see, cf_branches)) seel in apply_branching_symbolic_expansions_non_borrow config meta original_sv original_sv_place seel cf_after_join ctx - | _ -> craise meta ("expand_symbolic_adt: unexpected type: " ^ show_rty rty) + | _ -> craise __FILE__ __LINE__ meta ("expand_symbolic_adt: unexpected type: " ^ show_rty rty) let expand_symbolic_int (config : config) (meta : Meta.meta) (sv : symbolic_value) (sv_place : SA.mplace option) (int_type : integer_type) (tgts : (scalar_value * st_cm_fun) list) (otherwise : st_cm_fun) (cf_after_join : st_m_fun) : m_fun = (* Sanity check *) - sanity_check (sv.sv_ty = TLiteral (TInteger int_type)) meta; + sanity_check __FILE__ __LINE__ (sv.sv_ty = TLiteral (TInteger int_type)) meta; (* For all the branches of the switch, we expand the symbolic value * to the value given by the branch and execute the branch statement. * For the otherwise branch, we leave the symbolic value as it is @@ -678,16 +678,16 @@ let greedy_expand_symbolics_with_borrows (config : config) (meta : Meta.meta) : (match def.kind with | Struct _ | Enum ([] | [ _ ]) -> () | Enum (_ :: _) -> - craise meta + craise __FILE__ __LINE__ meta ("Attempted to greedily expand a symbolic enumeration with > \ 1 variants (option [greedy_expand_symbolics_with_borrows] \ of [config]): " ^ name_to_string ctx def.name) | Opaque -> - craise meta "Attempted to greedily expand an opaque type"); + craise __FILE__ __LINE__ meta "Attempted to greedily expand an opaque type"); (* Also, we need to check if the definition is recursive *) if ctx_type_decl_is_rec ctx def_id then - craise meta + craise __FILE__ __LINE__ meta ("Attempted to greedily expand a recursive definition (option \ [greedy_expand_symbolics_with_borrows] of [config]): " ^ name_to_string ctx def.name) @@ -697,10 +697,10 @@ let greedy_expand_symbolics_with_borrows (config : config) (meta : Meta.meta) : expand_symbolic_value_no_branching config meta sv None | TAdt (TAssumed (TArray | TSlice | TStr), _) -> (* We can't expand those *) - craise meta + craise __FILE__ __LINE__ meta "Attempted to greedily expand an ADT which can't be expanded " | TVar _ | TLiteral _ | TNever | TTraitType _ | TArrow _ | TRawPtr _ -> - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in (* Compose and continue *) comp cc expand cf ctx diff --git a/compiler/InterpreterExpressions.ml b/compiler/InterpreterExpressions.ml index 3d01024b..59f74ad8 100644 --- a/compiler/InterpreterExpressions.ml +++ b/compiler/InterpreterExpressions.ml @@ -55,11 +55,11 @@ let read_place (meta : Meta.meta) (access : access_kind) (p : place) fun ctx -> let v = read_place meta access p ctx in (* Check that there are no bottoms in the value *) - cassert + cassert __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions v)) meta "There should be no bottoms in the value"; (* Check that there are no reserved borrows in the value *) - cassert + cassert __FILE__ __LINE__ (not (reserved_in_value v)) meta "There should be no reserved borrows in the value"; (* Call the continuation *) @@ -107,11 +107,11 @@ let literal_to_typed_value (meta : Meta.meta) (ty : literal_type) (cv : literal) | TChar, VChar v -> { value = VLiteral (VChar v); ty = TLiteral ty } | TInteger int_ty, VScalar v -> (* Check the type and the ranges *) - sanity_check (int_ty = v.int_ty) meta; - sanity_check (check_scalar_value_in_range v) meta; + sanity_check __FILE__ __LINE__ (int_ty = v.int_ty) meta; + sanity_check __FILE__ __LINE__ (check_scalar_value_in_range v) meta; { value = VLiteral (VScalar v); ty = TLiteral ty } (* Remaining cases (invalid) *) - | _, _ -> craise meta "Improperly typed constant value" + | _, _ -> craise __FILE__ __LINE__ meta "Improperly typed constant value" (** Copy a value, and return the resulting value. @@ -142,9 +142,9 @@ let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) (* Sanity check *) (match v.ty with | TAdt (TAssumed TBox, _) -> - exec_raise meta "Can't copy an assumed value other than Option" + exec_raise __FILE__ __LINE__ meta "Can't copy an assumed value other than Option" | TAdt (TAdtId _, _) as ty -> - sanity_check (allow_adt_copy || ty_is_primitively_copyable ty) meta + sanity_check __FILE__ __LINE__ (allow_adt_copy || ty_is_primitively_copyable ty) meta | TAdt (TTuple, _) -> () (* Ok *) | TAdt ( TAssumed (TSlice | TArray), @@ -154,17 +154,17 @@ let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) const_generics = []; trait_refs = []; } ) -> - exec_assert + exec_assert __FILE__ __LINE__ (ty_is_primitively_copyable ty) meta "The type is not primitively copyable" - | _ -> exec_raise meta "Unreachable"); + | _ -> exec_raise __FILE__ __LINE__ meta "Unreachable"); let ctx, fields = List.fold_left_map (copy_value meta allow_adt_copy config) ctx av.field_values in (ctx, { v with value = VAdt { av with field_values = fields } }) - | VBottom -> exec_raise meta "Can't copy ⊥" + | VBottom -> exec_raise __FILE__ __LINE__ meta "Can't copy ⊥" | VBorrow bc -> ( (* We can only copy shared borrows *) match bc with @@ -174,13 +174,13 @@ let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) let bid' = fresh_borrow_id () in let ctx = InterpreterBorrows.reborrow_shared meta bid bid' ctx in (ctx, { v with value = VBorrow (VSharedBorrow bid') }) - | VMutBorrow (_, _) -> exec_raise meta "Can't copy a mutable borrow" + | VMutBorrow (_, _) -> exec_raise __FILE__ __LINE__ meta "Can't copy a mutable borrow" | VReservedMutBorrow _ -> - exec_raise meta "Can't copy a reserved mut borrow") + exec_raise __FILE__ __LINE__ meta "Can't copy a reserved mut borrow") | VLoan lc -> ( (* We can only copy shared loans *) match lc with - | VMutLoan _ -> exec_raise meta "Can't copy a mutable loan" + | VMutLoan _ -> exec_raise __FILE__ __LINE__ meta "Can't copy a mutable loan" | VSharedLoan (_, sv) -> (* We don't copy the shared loan: only the shared value inside *) copy_value meta allow_adt_copy config ctx sv) @@ -189,7 +189,7 @@ let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) * Note that in the general case, copy is a trait: copying values * thus requires calling the proper function. Here, we copy values * for very simple types such as integers, shared borrows, etc. *) - cassert + cassert __FILE__ __LINE__ (ty_is_primitively_copyable (Substitute.erase_regions sp.sv_ty)) meta "Not primitively copyable"; (* If the type is copyable, we simply return the current value. Side @@ -319,14 +319,14 @@ let eval_operand_no_reorganize (config : config) (meta : Meta.meta) let e = cf cv ctx in (* If we are synthesizing a symbolic AST, it means that we are in symbolic mode: the value of the const generic is necessarily symbolic. *) - sanity_check (e = None || is_symbolic cv.value) meta; + sanity_check __FILE__ __LINE__ (e = None || is_symbolic cv.value) meta; (* We have to wrap the generated expression *) match e with | None -> None | Some e -> (* If we are synthesizing a symbolic AST, it means that we are in symbolic mode: the value of the const generic is necessarily symbolic. *) - sanity_check (is_symbolic cv.value) meta; + sanity_check __FILE__ __LINE__ (is_symbolic cv.value) meta; (* *) Some (SymbolicAst.IntroSymbolic @@ -335,7 +335,7 @@ let eval_operand_no_reorganize (config : config) (meta : Meta.meta) value_as_symbolic meta cv.value, SymbolicAst.VaCgValue vid, e ))) - | CFnPtr _ -> craise meta "TODO: error message") + | CFnPtr _ -> craise __FILE__ __LINE__ meta "TODO: error message") | Copy p -> (* Access the value *) let access = Read in @@ -344,10 +344,10 @@ let eval_operand_no_reorganize (config : config) (meta : Meta.meta) let copy cf v : m_fun = fun ctx -> (* Sanity checks *) - exec_assert + exec_assert __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions v)) meta "Can not copy a value containing bottom"; - sanity_check + sanity_check __FILE__ __LINE__ (Option.is_none (find_first_primitively_copyable_sv_with_borrows ctx.type_ctx.type_infos v)) @@ -368,7 +368,7 @@ let eval_operand_no_reorganize (config : config) (meta : Meta.meta) let move cf v : m_fun = fun ctx -> (* Check that there are no bottoms in the value we are about to move *) - exec_assert + exec_assert __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions v)) meta "There should be no bottoms in the value we are about to move"; let bottom : typed_value = { value = VBottom; ty = v.ty } in @@ -420,7 +420,7 @@ let eval_two_operands (config : config) (meta : Meta.meta) (op1 : operand) (op2 : operand) (cf : typed_value * typed_value -> m_fun) : m_fun = let eval_op = eval_operands config meta [ op1; op2 ] in let use_res cf res = - match res with [ v1; v2 ] -> cf (v1, v2) | _ -> craise meta "Unreachable" + match res with [ v1; v2 ] -> cf (v1, v2) | _ -> craise __FILE__ __LINE__ meta "Unreachable" in comp eval_op use_res cf @@ -441,7 +441,7 @@ let eval_unary_op_concrete (config : config) (meta : Meta.meta) (unop : unop) | ( Cast (CastScalar (TInteger src_ty, TInteger tgt_ty)), VLiteral (VScalar sv) ) -> ( (* Cast between integers *) - sanity_check (src_ty = sv.int_ty) meta; + sanity_check __FILE__ __LINE__ (src_ty = sv.int_ty) meta; let i = sv.value in match mk_scalar tgt_ty i with | Error _ -> cf (Error EPanic) @@ -463,12 +463,12 @@ let eval_unary_op_concrete (config : config) (meta : Meta.meta) (unop : unop) let b = if Z.of_int 0 = sv.value then false else if Z.of_int 1 = sv.value then true - else exec_raise meta "Conversion from int to bool: out of range" + else exec_raise __FILE__ __LINE__ meta "Conversion from int to bool: out of range" in let value = VLiteral (VBool b) in let ty = TLiteral TBool in cf (Ok { ty; value }) - | _ -> exec_raise meta "Invalid input for unop" + | _ -> exec_raise __FILE__ __LINE__ meta "Invalid input for unop" in comp eval_op apply cf @@ -486,7 +486,7 @@ let eval_unary_op_symbolic (config : config) (meta : Meta.meta) (unop : unop) | Not, (TLiteral TBool as lty) -> lty | Neg, (TLiteral (TInteger _) as lty) -> lty | Cast (CastScalar (_, tgt_ty)), _ -> TLiteral tgt_ty - | _ -> exec_raise meta "Invalid input for unop" + | _ -> exec_raise __FILE__ __LINE__ meta "Invalid input for unop" in let res_sv = { sv_id = res_sv_id; sv_ty = res_sv_ty } in (* Call the continuation *) @@ -514,9 +514,9 @@ let eval_binary_op_concrete_compute (meta : Meta.meta) (binop : binop) * The remaining binops only operate on scalars. *) if binop = Eq || binop = Ne then ( (* Equality operations *) - exec_assert (v1.ty = v2.ty) meta "TODO: error message"; + exec_assert __FILE__ __LINE__ (v1.ty = v2.ty) meta "TODO: error message"; (* Equality/inequality check is primitive only for a subset of types *) - exec_assert + exec_assert __FILE__ __LINE__ (ty_is_primitively_copyable v1.ty) meta "Type is not primitively copyable"; let b = v1 = v2 in @@ -533,7 +533,7 @@ let eval_binary_op_concrete_compute (meta : Meta.meta) (binop : binop) match binop with | Lt | Le | Ge | Gt -> (* The two operands must have the same type and the result is a boolean *) - sanity_check (sv1.int_ty = sv2.int_ty) meta; + sanity_check __FILE__ __LINE__ (sv1.int_ty = sv2.int_ty) meta; let b = match binop with | Lt -> Z.lt sv1.value sv2.value @@ -542,14 +542,14 @@ let eval_binary_op_concrete_compute (meta : Meta.meta) (binop : binop) | Gt -> Z.gt sv1.value sv2.value | Div | Rem | Add | Sub | Mul | BitXor | BitAnd | BitOr | Shl | Shr | Ne | Eq -> - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in Ok ({ value = VLiteral (VBool b); ty = TLiteral TBool } : typed_value) | Div | Rem | Add | Sub | Mul | BitXor | BitAnd | BitOr -> ( (* The two operands must have the same type and the result is an integer *) - sanity_check (sv1.int_ty = sv2.int_ty) meta; + sanity_check __FILE__ __LINE__ (sv1.int_ty = sv2.int_ty) meta; let res = match binop with | Div -> @@ -566,7 +566,7 @@ let eval_binary_op_concrete_compute (meta : Meta.meta) (binop : binop) | BitAnd -> raise Unimplemented | BitOr -> raise Unimplemented | Lt | Le | Ge | Gt | Shl | Shr | Ne | Eq -> - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in match res with | Error _ -> Error EPanic @@ -577,8 +577,8 @@ let eval_binary_op_concrete_compute (meta : Meta.meta) (binop : binop) ty = TLiteral (TInteger sv1.int_ty); }) | Shl | Shr -> raise Unimplemented - | Ne | Eq -> craise meta "Unreachable") - | _ -> craise meta "Invalid inputs for binop" + | Ne | Eq -> craise __FILE__ __LINE__ meta "Unreachable") + | _ -> craise __FILE__ __LINE__ meta "Invalid inputs for binop" let eval_binary_op_concrete (config : config) (meta : Meta.meta) (binop : binop) (op1 : operand) (op2 : operand) @@ -607,9 +607,9 @@ let eval_binary_op_symbolic (config : config) (meta : Meta.meta) (binop : binop) let res_sv_ty = if binop = Eq || binop = Ne then ( (* Equality operations *) - sanity_check (v1.ty = v2.ty) meta; + sanity_check __FILE__ __LINE__ (v1.ty = v2.ty) meta; (* Equality/inequality check is primitive only for a subset of types *) - exec_assert + exec_assert __FILE__ __LINE__ (ty_is_primitively_copyable v1.ty) meta "The type is not primitively copyable"; TLiteral TBool) @@ -619,17 +619,17 @@ let eval_binary_op_symbolic (config : config) (meta : Meta.meta) (binop : binop) | TLiteral (TInteger int_ty1), TLiteral (TInteger int_ty2) -> ( match binop with | Lt | Le | Ge | Gt -> - sanity_check (int_ty1 = int_ty2) meta; + sanity_check __FILE__ __LINE__ (int_ty1 = int_ty2) meta; TLiteral TBool | Div | Rem | Add | Sub | Mul | BitXor | BitAnd | BitOr -> - sanity_check (int_ty1 = int_ty2) meta; + sanity_check __FILE__ __LINE__ (int_ty1 = int_ty2) meta; TLiteral (TInteger int_ty1) | Shl | Shr -> (* The number of bits can be of a different integer type than the operand *) TLiteral (TInteger int_ty1) - | Ne | Eq -> craise meta "Unreachable") - | _ -> craise meta "Invalid inputs for binop" + | Ne | Eq -> craise __FILE__ __LINE__ meta "Unreachable") + | _ -> craise __FILE__ __LINE__ meta "Invalid inputs for binop" in let res_sv = { sv_id = res_sv_id; sv_ty = res_sv_ty } in (* Call the continuattion *) @@ -659,14 +659,14 @@ let eval_rvalue_ref (config : config) (meta : Meta.meta) (p : place) In practice this restricted the behaviour too much, so for now we forbid them. *) - sanity_check (bkind <> BShallow) meta; + sanity_check __FILE__ __LINE__ (bkind <> BShallow) meta; (* Access the value *) let access = match bkind with | BShared | BShallow -> Read | BTwoPhaseMut -> Write - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in let expand_prim_copy = false in @@ -698,7 +698,7 @@ let eval_rvalue_ref (config : config) (meta : Meta.meta) (p : place) match bkind with | BShared | BShallow -> RShared | BTwoPhaseMut -> RMut - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in let rv_ty = TRef (RErased, v.ty, ref_kind) in let bc = @@ -708,7 +708,7 @@ let eval_rvalue_ref (config : config) (meta : Meta.meta) (p : place) handle shallow borrows like shared borrows *) VSharedBorrow bid | BTwoPhaseMut -> VReservedMutBorrow bid - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in let rv : typed_value = { value = VBorrow bc; ty = rv_ty } in (* Continue *) @@ -765,7 +765,7 @@ let eval_rvalue_aggregate (config : config) (meta : Meta.meta) | TAdtId def_id -> (* Sanity checks *) let type_decl = ctx_lookup_type_decl ctx def_id in - sanity_check + sanity_check __FILE__ __LINE__ (List.length type_decl.generics.regions = List.length generics.regions) meta; @@ -773,7 +773,7 @@ let eval_rvalue_aggregate (config : config) (meta : Meta.meta) AssociatedTypes.ctx_adt_get_inst_norm_field_etypes meta ctx def_id opt_variant_id generics in - sanity_check + sanity_check __FILE__ __LINE__ (expected_field_types = List.map (fun (v : typed_value) -> v.ty) values) meta; @@ -785,15 +785,15 @@ let eval_rvalue_aggregate (config : config) (meta : Meta.meta) let aggregated : typed_value = { value = VAdt av; ty = aty } in (* Call the continuation *) cf aggregated ctx - | TAssumed _ -> craise meta "Unreachable") + | TAssumed _ -> craise __FILE__ __LINE__ meta "Unreachable") | AggregatedArray (ety, cg) -> ( (* Sanity check: all the values have the proper type *) - sanity_check + sanity_check __FILE__ __LINE__ (List.for_all (fun (v : typed_value) -> v.ty = ety) values) meta; (* Sanity check: the number of values is consistent with the length *) let len = (literal_as_scalar (const_generic_as_literal cg)).value in - sanity_check (len = Z.of_int (List.length values)) meta; + sanity_check __FILE__ __LINE__ (len = Z.of_int (List.length values)) meta; let generics = TypesUtils.mk_generic_args [] [ ety ] [ cg ] [] in let ty = TAdt (TAssumed TArray, generics) in (* In order to generate a better AST, we introduce a symbolic @@ -809,7 +809,7 @@ let eval_rvalue_aggregate (config : config) (meta : Meta.meta) (* Introduce the symbolic value in the AST *) let sv = ValuesUtils.value_as_symbolic meta saggregated.value in Some (SymbolicAst.IntroSymbolic (ctx, None, sv, VaArray values, e))) - | AggregatedClosure _ -> craise meta "Closures are not supported yet" + | AggregatedClosure _ -> craise __FILE__ __LINE__ meta "Closures are not supported yet" in (* Compose and apply *) comp eval_ops compute cf @@ -834,10 +834,10 @@ let eval_rvalue_not_global (config : config) (meta : Meta.meta) | Aggregate (aggregate_kind, ops) -> comp_wrap (eval_rvalue_aggregate config meta aggregate_kind ops) ctx | Discriminant _ -> - craise meta + craise __FILE__ __LINE__ meta "Unreachable: discriminant reads should have been eliminated from the \ AST" - | Global _ -> craise meta "Unreachable" + | Global _ -> craise __FILE__ __LINE__ meta "Unreachable" let eval_fake_read (config : config) (meta : Meta.meta) (p : place) : cm_fun = fun cf ctx -> @@ -847,7 +847,7 @@ let eval_fake_read (config : config) (meta : Meta.meta) (p : place) : cm_fun = in let cf_continue cf v : m_fun = fun ctx -> - cassert + cassert __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions v)) meta "Fake read: the value contains bottom"; cf ctx diff --git a/compiler/InterpreterLoops.ml b/compiler/InterpreterLoops.ml index d369aef9..17487401 100644 --- a/compiler/InterpreterLoops.ml +++ b/compiler/InterpreterLoops.ml @@ -54,10 +54,10 @@ let eval_loop_concrete (meta : Meta.meta) (eval_loop_body : st_cm_fun) : * {!Unit} would account for the first iteration of the loop. * We prefer to write it this way for consistency and sanity, * though. *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | LoopReturn _ | EndEnterLoop _ | EndContinue _ -> (* We can't get there: this is only used in symbolic mode *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in (* Apply *) @@ -160,7 +160,7 @@ let eval_loop_symbolic (config : config) (meta : meta) cf res ctx | Continue i -> (* We don't support nested loops for now *) - cassert (i = 0) meta "Nested loops are not supported yet"; + cassert __FILE__ __LINE__ (i = 0) meta "Nested loops are not supported yet"; log#ldebug (lazy ("eval_loop_symbolic: about to match the fixed-point context \ @@ -178,7 +178,7 @@ let eval_loop_symbolic (config : config) (meta : meta) (* For why we can't get [Unit], see the comments inside {!eval_loop_concrete}. For [EndEnterLoop] and [EndContinue]: we don't support nested loops for now. *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in let loop_expr = eval_loop_body cf_loop fp_ctx in @@ -212,7 +212,7 @@ let eval_loop_symbolic (config : config) (meta : meta) match av.value with | ABorrow _ -> true | ALoan _ -> false - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in let borrows, loans = List.partition is_borrow abs.avalues in @@ -221,10 +221,10 @@ let eval_loop_symbolic (config : config) (meta : meta) (fun (av : typed_avalue) -> match av.value with | ABorrow (AMutBorrow (bid, child_av)) -> - sanity_check (is_aignored child_av.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child_av.value) meta; Some (bid, child_av.ty) | ABorrow (ASharedBorrow _) -> None - | _ -> craise meta "Unreachable") + | _ -> craise __FILE__ __LINE__ meta "Unreachable") borrows in let borrows = ref (BorrowId.Map.of_list borrows) in @@ -234,10 +234,10 @@ let eval_loop_symbolic (config : config) (meta : meta) (fun (av : typed_avalue) -> match av.value with | ALoan (AMutLoan (bid, child_av)) -> - sanity_check (is_aignored child_av.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child_av.value) meta; Some bid | ALoan (ASharedLoan _) -> None - | _ -> craise meta "Unreachable") + | _ -> craise __FILE__ __LINE__ meta "Unreachable") loans in @@ -253,7 +253,7 @@ let eval_loop_symbolic (config : config) (meta : meta) ty) loan_ids in - sanity_check (BorrowId.Map.is_empty !borrows) meta; + sanity_check __FILE__ __LINE__ (BorrowId.Map.is_empty !borrows) meta; given_back_tys in diff --git a/compiler/InterpreterLoopsCore.ml b/compiler/InterpreterLoopsCore.ml index 660e542d..a8a64264 100644 --- a/compiler/InterpreterLoopsCore.ml +++ b/compiler/InterpreterLoopsCore.ml @@ -380,7 +380,7 @@ let ctx_split_fixed_new (meta : Meta.meta) (fixed_ids : ids_sets) let new_absl = List.map (fun ee -> - match ee with EAbs abs -> abs | _ -> craise meta "Unreachable") + match ee with EAbs abs -> abs | _ -> craise __FILE__ __LINE__ meta "Unreachable") new_absl in let new_dummyl = @@ -388,7 +388,7 @@ let ctx_split_fixed_new (meta : Meta.meta) (fixed_ids : ids_sets) (fun ee -> match ee with | EBinding (BDummy _, v) -> v - | _ -> craise meta "Unreachable") + | _ -> craise __FILE__ __LINE__ meta "Unreachable") new_dummyl in (filt_env, new_absl, new_dummyl) diff --git a/compiler/InterpreterLoopsFixedPoint.ml b/compiler/InterpreterLoopsFixedPoint.ml index 7ddf55c1..39add08e 100644 --- a/compiler/InterpreterLoopsFixedPoint.ml +++ b/compiler/InterpreterLoopsFixedPoint.ml @@ -144,7 +144,7 @@ let reorder_loans_borrows_in_fresh_abs (meta : Meta.meta) match av.value with | ABorrow _ -> true | ALoan _ -> false - | _ -> craise meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Unexpected" in let aborrows, aloans = List.partition is_borrow abs.avalues in @@ -157,13 +157,13 @@ let reorder_loans_borrows_in_fresh_abs (meta : Meta.meta) let get_borrow_id (av : typed_avalue) : BorrowId.id = match av.value with | ABorrow (AMutBorrow (bid, _) | ASharedBorrow bid) -> bid - | _ -> craise meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Unexpected" in let get_loan_id (av : typed_avalue) : BorrowId.id = match av.value with | ALoan (AMutLoan (lid, _)) -> lid | ALoan (ASharedLoan (lids, _, _)) -> BorrowId.Set.min_elt lids - | _ -> craise meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Unexpected" in (* We use ordered maps to reorder the borrows and loans *) let reorder (get_bid : typed_avalue -> BorrowId.id) @@ -268,12 +268,12 @@ let prepare_ashared_loans (meta : Meta.meta) (loop_id : LoopId.id option) : borrow_substs := (lid, nlid) :: !borrow_substs; (* Rem.: the below sanity checks are not really necessary *) - sanity_check (AbstractionId.Set.is_empty abs.parents) meta; - sanity_check (abs.original_parents = []) meta; - sanity_check (RegionId.Set.is_empty abs.ancestors_regions) meta; + sanity_check __FILE__ __LINE__ (AbstractionId.Set.is_empty abs.parents) meta; + sanity_check __FILE__ __LINE__ (abs.original_parents = []) meta; + sanity_check __FILE__ __LINE__ (RegionId.Set.is_empty abs.ancestors_regions) meta; (* Introduce the new abstraction for the shared values *) - cassert (ty_no_regions sv.ty) meta "Nested borrows are not supported yet"; + cassert __FILE__ __LINE__ (ty_no_regions sv.ty) meta "Nested borrows are not supported yet"; let rty = sv.ty in (* Create the shared loan child *) @@ -324,7 +324,7 @@ let prepare_ashared_loans (meta : Meta.meta) (loop_id : LoopId.id option) : let collect_shared_values_in_abs (abs : abs) : unit = let collect_shared_value lids (sv : typed_value) = (* Sanity check: we don't support nested borrows for now *) - sanity_check (not (value_has_borrows ctx sv.value)) meta; + sanity_check __FILE__ __LINE__ (not (value_has_borrows ctx sv.value)) meta; (* Filter the loan ids whose corresponding borrows appear in abstractions (see the documentation of the function) *) @@ -358,7 +358,7 @@ let prepare_ashared_loans (meta : Meta.meta) (loop_id : LoopId.id option) : TODO: implement this more general behavior. *) method! visit_symbolic_value env sv = - cassert + cassert __FILE__ __LINE__ (not (symbolic_value_has_borrows ctx sv)) meta "There should be no symbolic values with borrows inside the \ @@ -478,15 +478,15 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) | Return | Panic | Break _ -> None | Unit -> (* See the comment in {!eval_loop} *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | Continue i -> (* For now we don't support continues to outer loops *) - cassert (i = 0) meta "Continues to outer loops not supported yet"; + cassert __FILE__ __LINE__ (i = 0) meta "Continues to outer loops not supported yet"; register_ctx ctx; None | LoopReturn _ | EndEnterLoop _ | EndContinue _ -> (* We don't support nested loops for now *) - craise meta "Nested loops are not supported for now" + craise __FILE__ __LINE__ meta "Nested loops are not supported for now" in (* The fixed ids. They are the ids of the original ctx, after we ended @@ -580,7 +580,7 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) log#ldebug (lazy "compute_fixed_point: equiv_ctx:"); let fixed_ids = compute_fixed_ids [ ctx1; ctx2 ] in let check_equivalent = true in - let lookup_shared_value _ = craise meta "Unreachable" in + let lookup_shared_value _ = craise __FILE__ __LINE__ meta "Unreachable" in Option.is_some (match_ctxs meta check_equivalent fixed_ids lookup_shared_value lookup_shared_value ctx1 ctx2) @@ -588,7 +588,7 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) let max_num_iter = Config.loop_fixed_point_max_num_iters in let rec compute_fixed_point (ctx : eval_ctx) (i0 : int) (i : int) : eval_ctx = if i = 0 then - craise meta + craise __FILE__ __LINE__ meta ("Could not compute a loop fixed point in " ^ string_of_int i0 ^ " iterations") else @@ -639,10 +639,10 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) method! visit_abs _ abs = match abs.kind with | Loop (loop_id', _, kind) -> - sanity_check (loop_id' = loop_id) meta; - sanity_check (kind = LoopSynthInput) meta; + sanity_check __FILE__ __LINE__ (loop_id' = loop_id) meta; + sanity_check __FILE__ __LINE__ (kind = LoopSynthInput) meta; (* The abstractions introduced so far should be endable *) - sanity_check (abs.can_end = true) meta; + sanity_check __FILE__ __LINE__ (abs.can_end = true) meta; add_aid abs.abs_id; abs | _ -> abs @@ -675,12 +675,12 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) None | Break _ -> (* We enforce that we can't get there: see {!PrePasses.remove_loop_breaks} *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | Unit | LoopReturn _ | EndEnterLoop _ | EndContinue _ -> (* For why we can't get [Unit], see the comments inside {!eval_loop_concrete}. For [EndEnterLoop] and [EndContinue]: we don't support nested loops for now. *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | Return -> log#ldebug (lazy "compute_loop_entry_fixed_point: cf_loop: Return"); (* Should we consume the return value and pop the frame? @@ -699,7 +699,7 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) in (* By default, the [SynthInput] abs can't end *) let ctx = ctx_set_abs_can_end meta ctx abs_id true in - sanity_check + sanity_check __FILE__ __LINE__ (let abs = ctx_lookup_abs ctx abs_id in abs.kind = SynthInput rg_id) meta; @@ -725,7 +725,7 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) let _ = RegionGroupId.Map.iter (fun _ ids -> - cassert + cassert __FILE__ __LINE__ (AbstractionId.Set.disjoint !aids_union ids) meta "The sets of abstractions we need to end per region group are not \ @@ -736,7 +736,7 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) (* We also check that all the regions need to end - this is not necessary per se, but if it doesn't happen it is bizarre and worth investigating... *) - sanity_check (AbstractionId.Set.equal !aids_union !fp_aids) meta; + sanity_check __FILE__ __LINE__ (AbstractionId.Set.equal !aids_union !fp_aids) meta; (* Merge the abstractions which need to be merged, and compute the map from region id to abstraction id *) @@ -794,7 +794,7 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) fp := fp'; id0 := id0'; () - with ValueMatchFailure _ -> craise meta "Unexpected") + with ValueMatchFailure _ -> craise __FILE__ __LINE__ meta "Unexpected") ids; (* Register the mapping *) let abs = ctx_lookup_abs !fp !id0 in @@ -827,8 +827,8 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) method! visit_abs _ abs = match abs.kind with | Loop (loop_id', _, kind) -> - sanity_check (loop_id' = loop_id) meta; - sanity_check (kind = LoopSynthInput) meta; + sanity_check __FILE__ __LINE__ (loop_id' = loop_id) meta; + sanity_check __FILE__ __LINE__ (kind = LoopSynthInput) meta; let kind : abs_kind = if remove_rg_id then Loop (loop_id, None, LoopSynthInput) else abs.kind @@ -897,7 +897,7 @@ let compute_fixed_point_id_correspondance (meta : Meta.meta) match snd (lookup_loan meta ek_all lid ctx) with | Concrete (VSharedLoan (_, v)) -> v | Abstract (ASharedLoan (_, v, _)) -> v - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in let lookup_in_tgt id = lookup_shared_loan id tgt_ctx in let lookup_in_src id = lookup_shared_loan id src_ctx in @@ -957,7 +957,7 @@ let compute_fixed_point_id_correspondance (meta : Meta.meta) ids.loan_ids in (* Check that the loan and borrows are related *) - sanity_check (BorrowId.Set.equal ids.borrow_ids loan_ids) meta) + sanity_check __FILE__ __LINE__ (BorrowId.Set.equal ids.borrow_ids loan_ids) meta) new_absl; (* For every target abstraction (going back to the [list_nth_mut] example, @@ -1084,7 +1084,7 @@ let compute_fp_ctx_symbolic_values (meta : Meta.meta) (ctx : eval_ctx) match snd (lookup_loan meta ek_all bid fp_ctx) with | Concrete (VSharedLoan (_, v)) -> v | Abstract (ASharedLoan (_, v, _)) -> v - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in self#visit_typed_value env v diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml index 020e812a..3b1767e8 100644 --- a/compiler/InterpreterLoopsJoinCtxs.ml +++ b/compiler/InterpreterLoopsJoinCtxs.ml @@ -27,7 +27,7 @@ let reorder_loans_borrows_in_fresh_abs (meta : Meta.meta) match av.value with | ABorrow _ -> true | ALoan _ -> false - | _ -> craise meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Unexpected" in let aborrows, aloans = List.partition is_borrow abs.avalues in @@ -40,13 +40,13 @@ let reorder_loans_borrows_in_fresh_abs (meta : Meta.meta) let get_borrow_id (av : typed_avalue) : BorrowId.id = match av.value with | ABorrow (AMutBorrow (bid, _) | ASharedBorrow bid) -> bid - | _ -> craise meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Unexpected" in let get_loan_id (av : typed_avalue) : BorrowId.id = match av.value with | ALoan (AMutLoan (lid, _)) -> lid | ALoan (ASharedLoan (lids, _, _)) -> BorrowId.Set.min_elt lids - | _ -> craise meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Unexpected" in (* We use ordered maps to reorder the borrows and loans *) let reorder (get_bid : typed_avalue -> BorrowId.id) @@ -316,8 +316,8 @@ let mk_collapse_ctx_merge_duplicate_funs (meta : Meta.meta) *) let merge_amut_borrows id ty0 child0 _ty1 child1 = (* Sanity checks *) - sanity_check (is_aignored child0.value) meta; - sanity_check (is_aignored child1.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child0.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child1.value) meta; (* We need to pick a type for the avalue. The types on the left and on the right may use different regions: it doesn't really matter (here, we pick @@ -335,8 +335,8 @@ let mk_collapse_ctx_merge_duplicate_funs (meta : Meta.meta) let _ = let _, ty0, _ = ty_as_ref ty0 in let _, ty1, _ = ty_as_ref ty1 in - sanity_check (not (ty_has_borrows ctx.type_ctx.type_infos ty0)) meta; - sanity_check (not (ty_has_borrows ctx.type_ctx.type_infos ty1)) meta + sanity_check __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos ty0)) meta; + sanity_check __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos ty1)) meta in (* Same remarks as for [merge_amut_borrows] *) @@ -347,8 +347,8 @@ let mk_collapse_ctx_merge_duplicate_funs (meta : Meta.meta) let merge_amut_loans id ty0 child0 _ty1 child1 = (* Sanity checks *) - sanity_check (is_aignored child0.value) meta; - sanity_check (is_aignored child1.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child0.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child1.value) meta; (* Same remarks as for [merge_amut_borrows] *) let ty = ty0 in let child = child0 in @@ -358,15 +358,15 @@ let mk_collapse_ctx_merge_duplicate_funs (meta : Meta.meta) let merge_ashared_loans ids ty0 (sv0 : typed_value) child0 _ty1 (sv1 : typed_value) child1 = (* Sanity checks *) - sanity_check (is_aignored child0.value) meta; - sanity_check (is_aignored child1.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child0.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child1.value) meta; (* Same remarks as for [merge_amut_borrows]. This time we need to also merge the shared values. We rely on the join matcher [JM] to do so. *) - sanity_check (not (value_has_loans_or_borrows ctx sv0.value)) meta; - sanity_check (not (value_has_loans_or_borrows ctx sv1.value)) meta; + sanity_check __FILE__ __LINE__ (not (value_has_loans_or_borrows ctx sv0.value)) meta; + sanity_check __FILE__ __LINE__ (not (value_has_loans_or_borrows ctx sv1.value)) meta; let ty = ty0 in let child = child0 in let sv = M.match_typed_values ctx ctx sv0 sv1 in @@ -398,7 +398,7 @@ let collapse_ctx_with_merge (meta : Meta.meta) (loop_id : LoopId.id) (old_ids : ids_sets) (ctx : eval_ctx) : eval_ctx = let merge_funs = mk_collapse_ctx_merge_duplicate_funs meta loop_id ctx in try collapse_ctx meta loop_id (Some merge_funs) old_ids ctx - with ValueMatchFailure _ -> craise meta "Unexpected" + with ValueMatchFailure _ -> craise __FILE__ __LINE__ meta "Unexpected" let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) (ctx0 : eval_ctx) (ctx1 : eval_ctx) : ctx_or_update = @@ -435,16 +435,16 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) match ee with | EBinding (BVar _, _) -> (* Variables are necessarily in the prefix *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | EBinding (BDummy did, _) -> - sanity_check (not (DummyVarId.Set.mem did fixed_ids.dids)) meta + sanity_check __FILE__ __LINE__ (not (DummyVarId.Set.mem did fixed_ids.dids)) meta | EAbs abs -> - sanity_check + sanity_check __FILE__ __LINE__ (not (AbstractionId.Set.mem abs.abs_id fixed_ids.aids)) meta | EFrame -> (* This should have been eliminated *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in List.iter check_valid env0; List.iter check_valid env1; @@ -481,7 +481,7 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) are not in the prefix anymore *) if DummyVarId.Set.mem b0 fixed_ids.dids then ( (* Still in the prefix: match the values *) - cassert (b0 = b1) meta + cassert __FILE__ __LINE__ (b0 = b1) meta "Bindings are not the same. We are not in the prefix anymore"; let b = b0 in let v = M.match_typed_values ctx0 ctx1 v0 v1 in @@ -504,7 +504,7 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) (* Variable bindings *must* be in the prefix and consequently their ids must be the same *) - cassert (b0 = b1) meta + cassert __FILE__ __LINE__ (b0 = b1) meta "Variable bindings *must* be in the prefix and consequently their\n\ \ ids must be the same"; (* Match the values *) @@ -527,7 +527,7 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) (* Same as for the dummy values: there are two cases *) if AbstractionId.Set.mem abs0.abs_id fixed_ids.aids then ( (* Still in the prefix: the abstractions must be the same *) - cassert (abs0 = abs1) meta "The abstractions are not the same"; + cassert __FILE__ __LINE__ (abs0 = abs1) meta "The abstractions are not the same"; (* Continue *) abs :: join_prefixes env0' env1') else (* Not in the prefix anymore *) @@ -542,7 +542,7 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) let env0, env1 = match (env0, env1) with | EFrame :: env0, EFrame :: env1 -> (env0, env1) - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in log#ldebug @@ -682,7 +682,7 @@ let loop_join_origin_with_continue_ctxs (config : config) (meta : Meta.meta) | LoansInRight bids -> InterpreterBorrows.end_borrows_no_synth config meta bids ctx | AbsInRight _ | AbsInLeft _ | LoanInLeft _ | LoansInLeft _ -> - craise meta "Unexpected" + craise __FILE__ __LINE__ meta "Unexpected" in join_one_aux ctx in diff --git a/compiler/InterpreterLoopsMatchCtxs.ml b/compiler/InterpreterLoopsMatchCtxs.ml index 1a6e6926..9c017f19 100644 --- a/compiler/InterpreterLoopsMatchCtxs.ml +++ b/compiler/InterpreterLoopsMatchCtxs.ml @@ -43,7 +43,7 @@ let compute_abs_borrows_loans_maps (meta : Meta.meta) (no_duplicates : bool) match Id0.Map.find_opt id0 !map with | None -> () | Some set -> - sanity_check + sanity_check __FILE__ __LINE__ ((not check_not_already_registered) || not (Id1.Set.mem id1 set)) meta); (* Update the mapping *) @@ -54,8 +54,8 @@ let compute_abs_borrows_loans_maps (meta : Meta.meta) (no_duplicates : bool) | None -> Some (Id1.Set.singleton id1) | Some ids -> (* Sanity check *) - sanity_check (not check_singleton_sets) meta; - sanity_check + sanity_check __FILE__ __LINE__ (not check_singleton_sets) meta; + sanity_check __FILE__ __LINE__ ((not check_not_already_registered) || not (Id1.Set.mem id1 ids)) meta; @@ -96,7 +96,7 @@ let compute_abs_borrows_loans_maps (meta : Meta.meta) (no_duplicates : bool) | AIgnoredSharedLoan child -> (* Ignore the id of the loan, if there is *) self#visit_typed_avalue abs_id child - | AEndedMutLoan _ | AEndedSharedLoan _ -> craise meta "Unreachable" + | AEndedMutLoan _ | AEndedSharedLoan _ -> craise __FILE__ __LINE__ meta "Unreachable" (** Make sure we don't register the ignored ids *) method! visit_aborrow_content abs_id bc = @@ -109,7 +109,7 @@ let compute_abs_borrows_loans_maps (meta : Meta.meta) (no_duplicates : bool) -> (* Ignore the id of the borrow, if there is *) self#visit_typed_avalue abs_id child - | AEndedMutBorrow _ | AEndedSharedBorrow -> craise meta "Unreachable" + | AEndedMutBorrow _ | AEndedSharedBorrow -> craise __FILE__ __LINE__ meta "Unreachable" method! visit_borrow_id abs_id bid = register_borrow_id abs_id bid method! visit_loan_id abs_id lid = register_loan_id abs_id lid @@ -150,9 +150,9 @@ let rec match_types (meta : Meta.meta) (match_distinct_types : ty -> ty -> ty) let match_rec = match_types meta match_distinct_types match_regions in match (ty0, ty1) with | TAdt (id0, generics0), TAdt (id1, generics1) -> - sanity_check (id0 = id1) meta; - sanity_check (generics0.const_generics = generics1.const_generics) meta; - sanity_check (generics0.trait_refs = generics1.trait_refs) meta; + sanity_check __FILE__ __LINE__ (id0 = id1) meta; + sanity_check __FILE__ __LINE__ (generics0.const_generics = generics1.const_generics) meta; + sanity_check __FILE__ __LINE__ (generics0.trait_refs = generics1.trait_refs) meta; let id = id0 in let const_generics = generics1.const_generics in let trait_refs = generics1.trait_refs in @@ -169,17 +169,17 @@ let rec match_types (meta : Meta.meta) (match_distinct_types : ty -> ty -> ty) let generics = { regions; types; const_generics; trait_refs } in TAdt (id, generics) | TVar vid0, TVar vid1 -> - sanity_check (vid0 = vid1) meta; + sanity_check __FILE__ __LINE__ (vid0 = vid1) meta; let vid = vid0 in TVar vid | TLiteral lty0, TLiteral lty1 -> - sanity_check (lty0 = lty1) meta; + sanity_check __FILE__ __LINE__ (lty0 = lty1) meta; ty0 | TNever, TNever -> ty0 | TRef (r0, ty0, k0), TRef (r1, ty1, k1) -> let r = match_regions r0 r1 in let ty = match_rec ty0 ty1 in - sanity_check (k0 = k1) meta; + sanity_check __FILE__ __LINE__ (k0 = k1) meta; let k = k0 in TRef (r, ty, k) | _ -> match_distinct_types ty0 ty1 @@ -213,8 +213,8 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct { value; ty = v1.ty } else ( (* For now, we don't merge ADTs which contain borrows *) - sanity_check (not (value_has_borrows v0.value)) M.meta; - sanity_check (not (value_has_borrows v1.value)) M.meta; + sanity_check __FILE__ __LINE__ (not (value_has_borrows v0.value)) M.meta; + sanity_check __FILE__ __LINE__ (not (value_has_borrows v1.value)) M.meta; (* Merge *) M.match_distinct_adts ctx0 ctx1 ty av0 av1) | VBottom, VBottom -> v0 @@ -229,7 +229,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct | VMutBorrow (bid0, bv0), VMutBorrow (bid1, bv1) -> let bv = match_rec bv0 bv1 in - cassert + cassert __FILE__ __LINE__ (not (ValuesUtils.value_has_borrows ctx0.type_ctx.type_infos bv.value)) @@ -246,7 +246,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct trying to match a reserved borrow, which shouldn't happen because reserved borrow should be eliminated very quickly - they are introduced just before function calls which activate them *) - craise M.meta "Unexpected" + craise __FILE__ __LINE__ M.meta "Unexpected" in { value = VBorrow bc; ty } | VLoan lc0, VLoan lc1 -> @@ -256,7 +256,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct match (lc0, lc1) with | VSharedLoan (ids0, sv0), VSharedLoan (ids1, sv1) -> let sv = match_rec sv0 sv1 in - cassert + cassert __FILE__ __LINE__ (not (value_has_borrows sv.value)) M.meta "TODO: error message"; let ids, sv = M.match_shared_loans ctx0 ctx1 ty ids0 ids1 sv in @@ -265,18 +265,18 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct let id = M.match_mut_loans ctx0 ctx1 ty id0 id1 in VMutLoan id | VSharedLoan _, VMutLoan _ | VMutLoan _, VSharedLoan _ -> - craise M.meta "Unreachable" + craise __FILE__ __LINE__ M.meta "Unreachable" in { value = VLoan lc; ty = v1.ty } | VSymbolic sv0, VSymbolic sv1 -> (* For now, we force all the symbolic values containing borrows to be eagerly expanded, and we don't support nested borrows *) - cassert + cassert __FILE__ __LINE__ (not (value_has_borrows v0.value)) M.meta "Nested borrows are not supported yet and all the symbolic values \ containing borrows are currently forced to be eagerly expanded"; - cassert + cassert __FILE__ __LINE__ (not (value_has_borrows v1.value)) M.meta "Nested borrows are not supported yet and all the symbolic values \ @@ -303,7 +303,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct ^ typed_value_to_string ~meta:(Some M.meta) ctx0 v0 ^ "\n- value1: " ^ typed_value_to_string ~meta:(Some M.meta) ctx1 v1)); - craise M.meta "Unexpected match case" + craise __FILE__ __LINE__ M.meta "Unexpected match case" and match_typed_avalues (ctx0 : eval_ctx) (ctx1 : eval_ctx) (v0 : typed_avalue) (v1 : typed_avalue) : typed_avalue = @@ -357,7 +357,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct M.match_amut_borrows ctx0 ctx1 v0.ty bid0 av0 v1.ty bid1 av1 ty av | AIgnoredMutBorrow _, AIgnoredMutBorrow _ -> (* The abstractions are destructured: we shouldn't get there *) - craise M.meta "Unexpected" + craise __FILE__ __LINE__ M.meta "Unexpected" | AProjSharedBorrow asb0, AProjSharedBorrow asb1 -> ( match (asb0, asb1) with | [], [] -> @@ -366,7 +366,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct v0 | _ -> (* We should get there only if there are nested borrows *) - craise M.meta "Unexpected") + craise __FILE__ __LINE__ M.meta "Unexpected") | _ -> (* TODO: getting there is not necessarily inconsistent (it may just be because the environments don't match) so we may want @@ -377,7 +377,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct we are *currently* ending it, in which case we need to completely end it before continuing. *) - craise M.meta "Unexpected") + craise __FILE__ __LINE__ M.meta "Unexpected") | ALoan lc0, ALoan lc1 -> ( log#ldebug (lazy "match_typed_avalues: loans"); (* TODO: maybe we should enforce that the ids are always exactly the same - @@ -387,7 +387,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct log#ldebug (lazy "match_typed_avalues: shared loans"); let sv = match_rec sv0 sv1 in let av = match_arec av0 av1 in - sanity_check (not (value_has_borrows sv.value)) M.meta; + sanity_check __FILE__ __LINE__ (not (value_has_borrows sv.value)) M.meta; M.match_ashared_loans ctx0 ctx1 v0.ty ids0 sv0 av0 v1.ty ids1 sv1 av1 ty sv av | AMutLoan (id0, av0), AMutLoan (id1, av1) -> @@ -402,12 +402,12 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct | AIgnoredSharedLoan _, AIgnoredSharedLoan _ -> (* Those should have been filtered when destructuring the abstractions - they are necessary only when there are nested borrows *) - craise M.meta "Unreachable" - | _ -> craise M.meta "Unreachable") + craise __FILE__ __LINE__ M.meta "Unreachable" + | _ -> craise __FILE__ __LINE__ M.meta "Unreachable") | ASymbolic _, ASymbolic _ -> (* For now, we force all the symbolic values containing borrows to be eagerly expanded, and we don't support nested borrows *) - craise M.meta "Unreachable" + craise __FILE__ __LINE__ M.meta "Unreachable" | _ -> M.match_avalues ctx0 ctx1 v0 v1 end @@ -419,13 +419,13 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct let push_absl (absl : abs list) : unit = List.iter push_abs absl let match_etys _ _ ty0 ty1 = - sanity_check (ty0 = ty1) meta; + sanity_check __FILE__ __LINE__ (ty0 = ty1) meta; ty0 let match_rtys _ _ ty0 ty1 = (* The types must be equal - in effect, this forbids to match symbolic values containing borrows *) - sanity_check (ty0 = ty1) meta; + sanity_check __FILE__ __LINE__ (ty0 = ty1) meta; ty0 let match_distinct_literals (_ : eval_ctx) (_ : eval_ctx) (ty : ety) @@ -439,7 +439,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct updates *) let check_no_borrows ctx (v : typed_value) = - sanity_check (not (value_has_borrows ctx v.value)) meta + sanity_check __FILE__ __LINE__ (not (value_has_borrows ctx v.value)) meta in List.iter (check_no_borrows ctx0) adt0.field_values; List.iter (check_no_borrows ctx1) adt1.field_values; @@ -574,12 +574,12 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct do so, we won't introduce reborrows like above: the forward loop function will update [v], while the backward loop function will return nothing. *) - cassert + cassert __FILE__ __LINE__ (not (ValuesUtils.value_has_borrows ctx0.type_ctx.type_infos bv.value)) meta "Nested borrows are not supported yet"; if bv0 = bv1 then ( - sanity_check (bv0 = bv) meta; + sanity_check __FILE__ __LINE__ (bv0 = bv) meta; (bid0, bv)) else let rid = fresh_region_id () in @@ -587,7 +587,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct let kind = RMut in let bv_ty = bv.ty in - sanity_check (ty_no_regions bv_ty) meta; + sanity_check __FILE__ __LINE__ (ty_no_regions bv_ty) meta; let borrow_ty = mk_ref_ty (RFVar rid) bv_ty kind in let borrow_av = @@ -640,7 +640,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct (* Generate the avalues for the abstraction *) let mk_aborrow (bid : borrow_id) (bv : typed_value) : typed_avalue = let bv_ty = bv.ty in - cassert (ty_no_regions bv_ty) meta + cassert __FILE__ __LINE__ (ty_no_regions bv_ty) meta "Nested borrows are not supported yet"; let value = ABorrow (AMutBorrow (bid, mk_aignored meta bv_ty)) in { value; ty = borrow_ty } @@ -688,7 +688,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct raise (ValueMatchFailure (LoansInRight extra_ids_right)); (* This should always be true if we get here *) - sanity_check (ids0 = ids1) meta; + sanity_check __FILE__ __LINE__ (ids0 = ids1) meta; let ids = ids0 in (* Return *) @@ -708,13 +708,13 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct let id1 = sv1.sv_id in if id0 = id1 then ( (* Sanity check *) - sanity_check (sv0 = sv1) meta; + sanity_check __FILE__ __LINE__ (sv0 = sv1) meta; (* Return *) sv0) else ( (* The caller should have checked that the symbolic values don't contain borrows *) - sanity_check + sanity_check __FILE__ __LINE__ (not (ty_has_borrows ctx0.type_ctx.type_infos sv0.sv_ty)) meta; (* We simply introduce a fresh symbolic value *) @@ -728,14 +728,14 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct If there are loans in the regular value, raise an exception. *) let type_infos = ctx0.type_ctx.type_infos in - cassert + cassert __FILE__ __LINE__ (not (ty_has_borrows type_infos sv.sv_ty)) meta "Check that:\n\ \ - there are no borrows in the symbolic value\n\ \ - there are no borrows in the \"regular\" value\n\ \ If there are loans in the regular value, raise an exception."; - cassert + cassert __FILE__ __LINE__ (not (ValuesUtils.value_has_borrows type_infos v.value)) meta "Check that:\n\ @@ -767,7 +767,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct with | Some (BorrowContent _) -> (* Can't get there: we only ask for outer *loans* *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | Some (LoanContent lc) -> ( match lc with | VSharedLoan (ids, _) -> @@ -795,12 +795,12 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct (* As explained in comments: we don't use the join matcher to join avalues, only concrete values *) - let match_distinct_aadts _ _ _ _ _ _ _ = craise meta "Unreachable" - let match_ashared_borrows _ _ _ _ _ _ = craise meta "Unreachable" - let match_amut_borrows _ _ _ _ _ _ _ _ _ _ = craise meta "Unreachable" - let match_ashared_loans _ _ _ _ _ _ _ _ _ _ _ _ _ = craise meta "Unreachable" - let match_amut_loans _ _ _ _ _ _ _ _ _ _ = craise meta "Unreachable" - let match_avalues _ _ _ _ = craise meta "Unreachable" + let match_distinct_aadts _ _ _ _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" + let match_ashared_borrows _ _ _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" + let match_amut_borrows _ _ _ _ _ _ _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" + let match_ashared_loans _ _ _ _ _ _ _ _ _ _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" + let match_amut_loans _ _ _ _ _ _ _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" + let match_avalues _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" end (* Very annoying: functors only take modules as inputs... *) @@ -837,13 +837,13 @@ module MakeMoveMatcher (S : MatchMoveState) : PrimMatcher = struct let push_moved_value (v : typed_value) : unit = S.nvalues := v :: !S.nvalues let match_etys _ _ ty0 ty1 = - sanity_check (ty0 = ty1) meta; + sanity_check __FILE__ __LINE__ (ty0 = ty1) meta; ty0 let match_rtys _ _ ty0 ty1 = (* The types must be equal - in effect, this forbids to match symbolic values containing borrows *) - sanity_check (ty0 = ty1) meta; + sanity_check __FILE__ __LINE__ (ty0 = ty1) meta; ty0 let match_distinct_literals (_ : eval_ctx) (_ : eval_ctx) (ty : ety) @@ -897,10 +897,10 @@ module MakeMoveMatcher (S : MatchMoveState) : PrimMatcher = struct with | Some (BorrowContent _) -> (* Can't get there: we only ask for outer *loans* *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | Some (LoanContent _) -> (* We should have ended all the outer loans *) - craise meta "Unexpected outer loan" + craise __FILE__ __LINE__ meta "Unexpected outer loan" | None -> (* Move the value - note that we shouldn't get there if we were not allowed to move the value in the first place. *) @@ -912,17 +912,17 @@ module MakeMoveMatcher (S : MatchMoveState) : PrimMatcher = struct fixed-point) has a non-bottom value, while the target environment (e.g., the environment we have when we reach the continue) has bottom: we shouldn't get there. *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" (* As explained in comments: we don't use the join matcher to join avalues, only concrete values *) - let match_distinct_aadts _ _ _ _ _ _ _ = craise meta "Unreachable" - let match_ashared_borrows _ _ _ _ _ _ = craise meta "Unreachable" - let match_amut_borrows _ _ _ _ _ _ _ _ _ = craise meta "Unreachable" - let match_ashared_loans _ _ _ _ _ _ _ _ _ _ _ _ _ = craise meta "Unreachable" - let match_amut_loans _ _ _ _ _ _ _ _ _ _ = craise meta "Unreachable" - let match_avalues _ _ _ _ = craise meta "Unreachable" + let match_distinct_aadts _ _ _ _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" + let match_ashared_borrows _ _ _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" + let match_amut_borrows _ _ _ _ _ _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" + let match_ashared_loans _ _ _ _ _ _ _ _ _ _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" + let match_amut_loans _ _ _ _ _ _ _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" + let match_avalues _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" end module MakeCheckEquivMatcher (S : MatchCheckEquivState) : CheckEquivMatcher = @@ -1107,7 +1107,7 @@ struct sv else ( (* Check: fixed values are fixed *) - sanity_check + sanity_check __FILE__ __LINE__ (id0 = id1 || not (SymbolicValueId.InjSubst.mem id0 !S.sid_map)) meta; @@ -1126,10 +1126,10 @@ struct (sv : symbolic_value) (v : typed_value) : typed_value = if S.check_equiv then raise (Distinct "match_symbolic_with_other") else ( - sanity_check left meta; + sanity_check __FILE__ __LINE__ left meta; let id = sv.sv_id in (* Check: fixed values are fixed *) - sanity_check (not (SymbolicValueId.InjSubst.mem id !S.sid_map)) meta; + sanity_check __FILE__ __LINE__ (not (SymbolicValueId.InjSubst.mem id !S.sid_map)) meta; (* Update the binding for the target symbolic value *) S.sid_to_value_map := SymbolicValueId.Map.add_strict id v !S.sid_to_value_map; @@ -1351,18 +1351,18 @@ let match_ctxs (meta : Meta.meta) (check_equiv : bool) (fixed_ids : ids_sets) be the same and their values equal (and the borrows/loans/symbolic *) if DummyVarId.Set.mem b0 fixed_ids.dids then ((* Fixed values: the values must be equal *) - sanity_check (b0 = b1) meta; - sanity_check (v0 = v1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) meta; + sanity_check __FILE__ __LINE__ (v0 = v1) meta; (* The ids present in the left value must be fixed *) let ids, _ = compute_typed_value_ids v0 in - sanity_check ((not S.check_equiv) || ids_are_fixed ids)) + sanity_check __FILE__ __LINE__ ((not S.check_equiv) || ids_are_fixed ids)) meta; (* We still match the values - allows to compute mappings (which are the identity actually) *) let _ = M.match_typed_values ctx0 ctx1 v0 v1 in match_envs env0' env1' | EBinding (BVar b0, v0) :: env0', EBinding (BVar b1, v1) :: env1' -> - sanity_check (b0 = b1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) meta; (* Match the values *) let _ = M.match_typed_values ctx0 ctx1 v0 v1 in (* Continue *) @@ -1373,10 +1373,10 @@ let match_ctxs (meta : Meta.meta) (check_equiv : bool) (fixed_ids : ids_sets) if AbstractionId.Set.mem abs0.abs_id fixed_ids.aids then ( log#ldebug (lazy "match_ctxs: match_envs: matching abs: fixed abs"); (* Still in the prefix: the abstractions must be the same *) - sanity_check (abs0 = abs1) meta; + sanity_check __FILE__ __LINE__ (abs0 = abs1) meta; (* Their ids must be fixed *) let ids, _ = compute_abs_ids abs0 in - sanity_check ((not S.check_equiv) || ids_are_fixed ids) meta; + sanity_check __FILE__ __LINE__ ((not S.check_equiv) || ids_are_fixed ids) meta; (* Continue *) match_envs env0' env1') else ( @@ -1404,7 +1404,7 @@ let match_ctxs (meta : Meta.meta) (check_equiv : bool) (fixed_ids : ids_sets) let env0, env1 = match (env0, env1) with | EFrame :: env0, EFrame :: env1 -> (env0, env1) - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in match_envs env0 env1; @@ -1427,7 +1427,7 @@ let match_ctxs (meta : Meta.meta) (check_equiv : bool) (fixed_ids : ids_sets) let ctxs_are_equivalent (meta : Meta.meta) (fixed_ids : ids_sets) (ctx0 : eval_ctx) (ctx1 : eval_ctx) : bool = let check_equivalent = true in - let lookup_shared_value _ = craise meta "Unreachable" in + let lookup_shared_value _ = craise __FILE__ __LINE__ meta "Unreachable" in Option.is_some (match_ctxs meta check_equivalent fixed_ids lookup_shared_value lookup_shared_value ctx0 ctx1) @@ -1482,14 +1482,14 @@ let prepare_match_ctx_with_target (config : config) (meta : Meta.meta) (fun (var0, var1) -> match (var0, var1) with | EBinding (BDummy b0, v0), EBinding (BDummy b1, v1) -> - sanity_check (b0 = b1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) meta; let _ = M.match_typed_values src_ctx tgt_ctx v0 v1 in () | EBinding (BVar b0, v0), EBinding (BVar b1, v1) -> - sanity_check (b0 = b1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) meta; let _ = M.match_typed_values src_ctx tgt_ctx v0 v1 in () - | _ -> craise meta "Unexpected") + | _ -> craise __FILE__ __LINE__ meta "Unexpected") (List.combine filt_src_env filt_tgt_env) in (* No exception was thrown: continue *) @@ -1520,14 +1520,14 @@ let prepare_match_ctx_with_target (config : config) (meta : Meta.meta) (fun (var0, var1) -> match (var0, var1) with | EBinding (BDummy b0, v0), EBinding ((BDummy b1 as var1), v1) -> - sanity_check (b0 = b1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) meta; let v = M.match_typed_values src_ctx tgt_ctx v0 v1 in (var1, v) | EBinding (BVar b0, v0), EBinding ((BVar b1 as var1), v1) -> - sanity_check (b0 = b1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) meta; let v = M.match_typed_values src_ctx tgt_ctx v0 v1 in (var1, v) - | _ -> craise meta "Unexpected") + | _ -> craise __FILE__ __LINE__ meta "Unexpected") (List.combine filt_src_env filt_tgt_env) in let var_to_new_val = BinderMap.of_list var_to_new_val in @@ -1567,7 +1567,7 @@ let prepare_match_ctx_with_target (config : config) (meta : Meta.meta) | LoanInRight bid -> InterpreterBorrows.end_borrow config meta bid | LoansInRight bids -> InterpreterBorrows.end_borrows config meta bids | AbsInRight _ | AbsInLeft _ | LoanInLeft _ | LoansInLeft _ -> - craise meta "Unexpected" + craise __FILE__ __LINE__ meta "Unexpected" in comp cc cf_reorganize_join_tgt cf tgt_ctx in @@ -1627,7 +1627,7 @@ let match_ctx_with_target (config : config) (meta : Meta.meta) let filt_src_env, new_absl, new_dummyl = ctx_split_fixed_new meta fixed_ids src_ctx in - sanity_check (new_dummyl = []) meta; + sanity_check __FILE__ __LINE__ (new_dummyl = []) meta; let filt_tgt_ctx = { tgt_ctx with env = filt_tgt_env } in let filt_src_ctx = { src_ctx with env = filt_src_env } in @@ -1639,7 +1639,7 @@ let match_ctx_with_target (config : config) (meta : Meta.meta) match snd (lookup_loan meta ek_all lid ctx) with | Concrete (VSharedLoan (_, v)) -> v | Abstract (ASharedLoan (_, v, _)) -> v - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in let lookup_in_src id = lookup_shared_loan id src_ctx in let lookup_in_tgt id = lookup_shared_loan id tgt_ctx in @@ -1765,7 +1765,7 @@ let match_ctx_with_target (config : config) (meta : Meta.meta) abstractions and in the *variable bindings* once we allow symbolic values containing borrows to not be eagerly expanded. *) - sanity_check Config.greedy_expand_symbolics_with_borrows meta; + sanity_check __FILE__ __LINE__ Config.greedy_expand_symbolics_with_borrows meta; (* Update the borrows and loans in the abstractions of the target context. @@ -1834,7 +1834,7 @@ let match_ctx_with_target (config : config) (meta : Meta.meta) (* No mapping: this means that the borrow was mapped when we matched values (it doesn't come from a fresh abstraction) and because of this, it should actually be mapped to itself *) - sanity_check + sanity_check __FILE__ __LINE__ (BorrowId.InjSubst.find id src_to_tgt_maps.borrow_id_map = id) meta; id @@ -1848,8 +1848,8 @@ let match_ctx_with_target (config : config) (meta : Meta.meta) method! visit_abs env abs = match abs.kind with | Loop (loop_id', rg_id, kind) -> - sanity_check (loop_id' = loop_id) meta; - sanity_check (kind = LoopSynthInput) meta; + sanity_check __FILE__ __LINE__ (loop_id' = loop_id) meta; + sanity_check __FILE__ __LINE__ (kind = LoopSynthInput) meta; let can_end = false in let kind : abs_kind = Loop (loop_id, rg_id, LoopCall) in let abs = { abs with kind; can_end } in diff --git a/compiler/InterpreterPaths.ml b/compiler/InterpreterPaths.ml index c386c2db..26456acf 100644 --- a/compiler/InterpreterPaths.ml +++ b/compiler/InterpreterPaths.ml @@ -87,7 +87,7 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) (lazy ("Not the same type:\n- nv.ty: " ^ show_ety nv.ty ^ "\n- v.ty: " ^ show_ety v.ty)); - craise meta + craise __FILE__ __LINE__ meta "Assertion failed: new value doesn't have the same type as its \ destination"); Ok (ctx, { read = v; updated = nv }) @@ -100,9 +100,9 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) (* Check consistency *) (match (proj_kind, type_id) with | ProjAdt (def_id, opt_variant_id), TAdtId def_id' -> - sanity_check (def_id = def_id') meta; - sanity_check (opt_variant_id = adt.variant_id) meta - | _ -> craise meta "Unreachable"); + sanity_check __FILE__ __LINE__ (def_id = def_id') meta; + sanity_check __FILE__ __LINE__ (opt_variant_id = adt.variant_id) meta + | _ -> craise __FILE__ __LINE__ meta "Unreachable"); (* Actually project *) let fv = FieldId.nth adt.field_values field_id in match access_projection meta access ctx update p' fv with @@ -117,7 +117,7 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) Ok (ctx, { res with updated })) (* Tuples *) | Field (ProjTuple arity, field_id), VAdt adt, TAdt (TTuple, _) -> ( - sanity_check (arity = List.length adt.field_values) meta; + sanity_check __FILE__ __LINE__ (arity = List.length adt.field_values) meta; let fv = FieldId.nth adt.field_values field_id in (* Project *) match access_projection meta access ctx update p' fv with @@ -166,7 +166,7 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) if access.lookup_shared_borrows then match lookup_loan meta ek bid ctx with | _, Concrete (VMutLoan _) -> - craise meta "Expected a shared loan" + craise __FILE__ __LINE__ meta "Expected a shared loan" | _, Concrete (VSharedLoan (bids, sv)) -> ( (* Explore the shared value *) match access_projection meta access ctx update p' sv with @@ -191,7 +191,7 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) | AEndedIgnoredMutLoan { given_back = _; child = _; given_back_meta = _ } | AIgnoredSharedLoan _ ) ) -> - craise meta "Expected a shared (abstraction) loan" + craise __FILE__ __LINE__ meta "Expected a shared (abstraction) loan" | _, Abstract (ASharedLoan (bids, sv, _av)) -> ( (* Explore the shared value *) match access_projection meta access ctx update p' sv with @@ -201,7 +201,7 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) let av = match lookup_loan meta ek bid ctx with | _, Abstract (ASharedLoan (_, _, av)) -> av - | _ -> craise meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Unexpected" in (* Update the shared loan with the new value returned by {!access_projection} *) @@ -248,7 +248,7 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) let v = "- v:\n" ^ show_value v in let ty = "- ty:\n" ^ show_ety ty in log#serror ("Inconsistent projection:\n" ^ pe ^ "\n" ^ v ^ "\n" ^ ty); - craise meta "Inconsistent projection") + craise __FILE__ __LINE__ meta "Inconsistent projection") (** Generic function to access (read/write) the value at a given place. @@ -321,13 +321,13 @@ let try_read_place (meta : Meta.meta) (access : access_kind) (p : place) ^ show_env ctx1.env ^ "\n\nOld environment:\n" ^ show_env ctx.env in log#serror msg; - craise meta "Unexpected environment update"); + craise __FILE__ __LINE__ meta "Unexpected environment update"); Ok read_value let read_place (meta : Meta.meta) (access : access_kind) (p : place) (ctx : eval_ctx) : typed_value = match try_read_place meta access p ctx with - | Error e -> craise meta ("Unreachable: " ^ show_path_fail_kind e) + | Error e -> craise __FILE__ __LINE__ meta ("Unreachable: " ^ show_path_fail_kind e) | Ok v -> v (** Attempt to update the value at a given place *) @@ -345,19 +345,19 @@ let try_write_place (meta : Meta.meta) (access : access_kind) (p : place) let write_place (meta : Meta.meta) (access : access_kind) (p : place) (nv : typed_value) (ctx : eval_ctx) : eval_ctx = match try_write_place meta access p nv ctx with - | Error e -> craise meta ("Unreachable: " ^ show_path_fail_kind e) + | Error e -> craise __FILE__ __LINE__ meta ("Unreachable: " ^ show_path_fail_kind e) | Ok ctx -> ctx let compute_expanded_bottom_adt_value (meta : Meta.meta) (ctx : eval_ctx) (def_id : TypeDeclId.id) (opt_variant_id : VariantId.id option) (generics : generic_args) : typed_value = - sanity_check (TypesUtils.generic_args_only_erased_regions generics) meta; + sanity_check __FILE__ __LINE__ (TypesUtils.generic_args_only_erased_regions generics) meta; (* Lookup the definition and check if it is an enumeration - it should be an enumeration if and only if the projection element is a field projection with *some* variant id. Retrieve the list of fields at the same time. *) let def = ctx_lookup_type_decl ctx def_id in - sanity_check + sanity_check __FILE__ __LINE__ (List.length generics.regions = List.length def.generics.regions) meta; (* Compute the field types *) @@ -430,7 +430,7 @@ let expand_bottom_value_from_projection (meta : Meta.meta) (* "Regular" ADTs *) | ( Field (ProjAdt (def_id, opt_variant_id), _), TAdt (TAdtId def_id', generics) ) -> - sanity_check (def_id = def_id') meta; + sanity_check __FILE__ __LINE__ (def_id = def_id') meta; compute_expanded_bottom_adt_value meta ctx def_id opt_variant_id generics (* Tuples *) @@ -438,17 +438,17 @@ let expand_bottom_value_from_projection (meta : Meta.meta) TAdt (TTuple, { regions = []; types; const_generics = []; trait_refs = [] }) ) -> - sanity_check (arity = List.length types) meta; + sanity_check __FILE__ __LINE__ (arity = List.length types) meta; (* Generate the field values *) compute_expanded_bottom_tuple_value meta types | _ -> - craise meta + craise __FILE__ __LINE__ meta ("Unreachable: " ^ show_projection_elem pe ^ ", " ^ show_ety ty) in (* Update the context by inserting the expanded value at the proper place *) match try_write_place meta access p' nv ctx with | Ok ctx -> ctx - | Error _ -> craise meta "Unreachable" + | Error _ -> craise __FILE__ __LINE__ meta "Unreachable" let rec update_ctx_along_read_place (config : config) (meta : Meta.meta) (access : access_kind) (p : place) : cm_fun = @@ -474,8 +474,8 @@ let rec update_ctx_along_read_place (config : config) (meta : Meta.meta) (Some (Synth.mk_mplace meta prefix ctx)) | FailBottom (_, _, _) -> (* We can't expand {!Bottom} values while reading them *) - craise meta "Found [Bottom] while reading a place" - | FailBorrow _ -> craise meta "Could not read a borrow" + craise __FILE__ __LINE__ meta "Found [Bottom] while reading a place" + | FailBorrow _ -> craise __FILE__ __LINE__ meta "Could not read a borrow" in comp cc (update_ctx_along_read_place config meta access p) cf ctx @@ -506,7 +506,7 @@ let rec update_ctx_along_write_place (config : config) (meta : Meta.meta) pe ty ctx in cf ctx - | FailBorrow _ -> craise meta "Could not write to a borrow" + | FailBorrow _ -> craise __FILE__ __LINE__ meta "Could not write to a borrow" in (* Retry *) comp cc (update_ctx_along_write_place config meta access p) cf ctx @@ -596,7 +596,7 @@ let drop_outer_loans_at_lplace (config : config) (meta : Meta.meta) (p : place) match c with | LoanContent (VSharedLoan (bids, _)) -> end_borrows config meta bids | LoanContent (VMutLoan bid) -> end_borrow config meta bid - | BorrowContent _ -> craise meta "Unreachable" + | BorrowContent _ -> craise __FILE__ __LINE__ meta "Unreachable" in (* Retry *) comp cc drop cf ctx @@ -611,7 +611,7 @@ let drop_outer_loans_at_lplace (config : config) (meta : Meta.meta) (p : place) (* Reinsert *) let ctx = write_place meta access p v ctx in (* Sanity check *) - sanity_check (not (outer_loans_in_value v)) meta; + sanity_check __FILE__ __LINE__ (not (outer_loans_in_value v)) meta; (* Continue *) cf ctx) in @@ -636,7 +636,7 @@ let prepare_lplace (config : config) (meta : Meta.meta) (p : place) fun ctx -> let v = read_place meta access p ctx in (* Sanity checks *) - sanity_check (not (outer_loans_in_value v)) meta; + sanity_check __FILE__ __LINE__ (not (outer_loans_in_value v)) meta; (* Continue *) cf v ctx in diff --git a/compiler/InterpreterProjectors.ml b/compiler/InterpreterProjectors.ml index f8f99584..0421a46c 100644 --- a/compiler/InterpreterProjectors.ml +++ b/compiler/InterpreterProjectors.ml @@ -18,7 +18,7 @@ let rec apply_proj_borrows_on_shared_borrow (meta : Meta.meta) (ctx : eval_ctx) (* Sanity check - TODO: move those elsewhere (here we perform the check at every * recursive call which is a bit overkill...) *) let ety = Subst.erase_regions ty in - sanity_check (ty_is_rty ty && ety = v.ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty ty && ety = v.ty) meta; (* Project - if there are no regions from the abstraction in the type, return [_] *) if not (ty_has_regions_in_set regions ty) then [] else @@ -41,7 +41,7 @@ let rec apply_proj_borrows_on_shared_borrow (meta : Meta.meta) (ctx : eval_ctx) fields_types in List.concat proj_fields - | VBottom, _ -> craise meta "Unreachable" + | VBottom, _ -> craise __FILE__ __LINE__ meta "Unreachable" | VBorrow bc, TRef (r, ref_ty, kind) -> (* Retrieve the bid of the borrow and the asb of the projected borrowed value *) let bid, asb = @@ -64,13 +64,13 @@ let rec apply_proj_borrows_on_shared_borrow (meta : Meta.meta) (ctx : eval_ctx) | _, Abstract (ASharedLoan (_, sv, _)) -> apply_proj_borrows_on_shared_borrow meta ctx fresh_reborrow regions sv ref_ty - | _ -> craise meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Unexpected" in (bid, asb) | VReservedMutBorrow _, _ -> - craise meta + craise __FILE__ __LINE__ meta "Can't apply a proj_borrow over a reserved mutable borrow" - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in let asb = (* Check if the region is in the set of projected regions (note that @@ -81,15 +81,15 @@ let rec apply_proj_borrows_on_shared_borrow (meta : Meta.meta) (ctx : eval_ctx) else asb in asb - | VLoan _, _ -> craise meta "Unreachable" + | VLoan _, _ -> craise __FILE__ __LINE__ meta "Unreachable" | VSymbolic s, _ -> (* Check that the projection doesn't contain ended regions *) - sanity_check + sanity_check __FILE__ __LINE__ (not (projections_intersect meta s.sv_ty ctx.ended_regions ty regions)) meta; [ AsbProjReborrows (s, ty) ] - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) (ctx : eval_ctx) (fresh_reborrow : BorrowId.id -> BorrowId.id) @@ -98,7 +98,7 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) (* Sanity check - TODO: move this elsewhere (here we perform the check at every * recursive call which is a bit overkill...) *) let ety = Substitute.erase_regions ty in - sanity_check (ty_is_rty ty && ety = v.ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty ty && ety = v.ty) meta; (* Project - if there are no regions from the abstraction in the type, return [_] *) if not (ty_has_regions_in_set regions ty) then { value = AIgnored; ty } else @@ -121,7 +121,7 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) fields_types in AAdt { variant_id = adt.variant_id; field_values = proj_fields } - | VBottom, _ -> craise meta "Unreachable" + | VBottom, _ -> craise __FILE__ __LINE__ meta "Unreachable" | VBorrow bc, TRef (r, ref_ty, kind) -> if (* Check if the region is in the set of projected regions (note that @@ -152,9 +152,9 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) *) ASharedBorrow bid | VReservedMutBorrow _, _ -> - craise meta + craise __FILE__ __LINE__ meta "Can't apply a proj_borrow over a reserved mutable borrow" - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in ABorrow bc else @@ -186,16 +186,16 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) | _, Abstract (ASharedLoan (_, sv, _)) -> apply_proj_borrows_on_shared_borrow meta ctx fresh_reborrow regions sv ref_ty - | _ -> craise meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Unexpected" in AProjSharedBorrow asb | VReservedMutBorrow _, _ -> - craise meta + craise __FILE__ __LINE__ meta "Can't apply a proj_borrow over a reserved mutable borrow" - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in ABorrow bc - | VLoan _, _ -> craise meta "Unreachable" + | VLoan _, _ -> craise __FILE__ __LINE__ meta "Unreachable" | VSymbolic s, _ -> (* Check that the projection doesn't contain already ended regions, * if necessary *) @@ -212,7 +212,7 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) ^ "\n- ty2: " ^ ty_to_string ctx ty2 ^ "\n- rset2: " ^ RegionId.Set.to_string None rset2 ^ "\n")); - sanity_check (not (projections_intersect meta ty1 rset1 ty2 rset2))) + sanity_check __FILE__ __LINE__ (not (projections_intersect meta ty1 rset1 ty2 rset2))) meta; ASymbolic (AProjBorrows (s, ty)) | _ -> @@ -221,7 +221,7 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) ("apply_proj_borrows: unexpected inputs:\n- input value: " ^ typed_value_to_string ~meta:(Some meta) ctx v ^ "\n- proj rty: " ^ ty_to_string ctx ty)); - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in { value; ty } @@ -237,7 +237,7 @@ let symbolic_expansion_non_borrow_to_value (meta : Meta.meta) in VAdt { variant_id; field_values } | SeMutRef (_, _) | SeSharedRef (_, _) -> - craise meta "Unexpected symbolic reference expansion" + craise __FILE__ __LINE__ meta "Unexpected symbolic reference expansion" in { value; ty } @@ -250,7 +250,7 @@ let symbolic_expansion_non_shared_borrow_to_value (meta : Meta.meta) let value = VBorrow (VMutBorrow (bid, bv)) in { value; ty } | SeSharedRef (_, _) -> - craise meta "Unexpected symbolic shared reference expansion" + craise __FILE__ __LINE__ meta "Unexpected symbolic shared reference expansion" | _ -> symbolic_expansion_non_borrow_to_value meta sv see (** Apply (and reduce) a projector over loans to a value. @@ -262,7 +262,7 @@ let apply_proj_loans_on_symbolic_expansion (meta : Meta.meta) (see : symbolic_expansion) (original_sv_ty : rty) : typed_avalue = (* Sanity check: if we have a proj_loans over a symbolic value, it should * contain regions which we will project *) - sanity_check (ty_has_regions_in_set regions original_sv_ty) meta; + sanity_check __FILE__ __LINE__ (ty_has_regions_in_set regions original_sv_ty) meta; (* Match *) let (value, ty) : avalue * ty = match (see, original_sv_ty) with @@ -277,7 +277,7 @@ let apply_proj_loans_on_symbolic_expansion (meta : Meta.meta) (AAdt { variant_id; field_values }, original_sv_ty) | SeMutRef (bid, spc), TRef (r, ref_ty, RMut) -> (* Sanity check *) - sanity_check (spc.sv_ty = ref_ty) meta; + sanity_check __FILE__ __LINE__ (spc.sv_ty = ref_ty) meta; (* Apply the projector to the borrowed value *) let child_av = mk_aproj_loans_value_from_symbolic_value regions spc in (* Check if the region is in the set of projected regions (note that @@ -295,7 +295,7 @@ let apply_proj_loans_on_symbolic_expansion (meta : Meta.meta) (ALoan (AIgnoredMutLoan (opt_bid, child_av)), ref_ty) | SeSharedRef (bids, spc), TRef (r, ref_ty, RShared) -> (* Sanity check *) - sanity_check (spc.sv_ty = ref_ty) meta; + sanity_check __FILE__ __LINE__ (spc.sv_ty = ref_ty) meta; (* Apply the projector to the borrowed value *) let child_av = mk_aproj_loans_value_from_symbolic_value regions spc in (* Check if the region is in the set of projected regions (note that @@ -307,7 +307,7 @@ let apply_proj_loans_on_symbolic_expansion (meta : Meta.meta) else (* Not in the set: ignore *) (ALoan (AIgnoredSharedLoan child_av), ref_ty) - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in { value; ty } @@ -465,7 +465,7 @@ let apply_reborrows (meta : Meta.meta) (* Visit *) let ctx = obj#visit_eval_ctx () ctx in (* Check that there are no reborrows remaining *) - sanity_check (!reborrows = []) meta; + sanity_check __FILE__ __LINE__ (!reborrows = []) meta; (* Return *) ctx @@ -479,13 +479,13 @@ let prepare_reborrows (config : config) (meta : Meta.meta) let bid' = fresh_borrow_id () in reborrows := (bid, bid') :: !reborrows; bid') - else craise meta "Unexpected reborrow" + else craise __FILE__ __LINE__ meta "Unexpected reborrow" in (* The function to apply the reborrows in a context *) let apply_registered_reborrows (ctx : eval_ctx) : eval_ctx = match config.mode with | ConcreteMode -> - sanity_check (!reborrows = []) meta; + sanity_check __FILE__ __LINE__ (!reborrows = []) meta; ctx | SymbolicMode -> (* Apply the reborrows *) @@ -498,7 +498,7 @@ let apply_proj_borrows_on_input_value (config : config) (meta : Meta.meta) (ctx : eval_ctx) (regions : RegionId.Set.t) (ancestors_regions : RegionId.Set.t) (v : typed_value) (ty : rty) : eval_ctx * typed_avalue = - cassert (ty_is_rty ty) meta "TODO: error message"; + cassert __FILE__ __LINE__ (ty_is_rty ty) meta "TODO: error message"; let check_symbolic_no_ended = true in let allow_reborrows = true in (* Prepare the reborrows *) diff --git a/compiler/InterpreterStatements.ml b/compiler/InterpreterStatements.ml index fa7bbc51..ccf8a5ac 100644 --- a/compiler/InterpreterStatements.ml +++ b/compiler/InterpreterStatements.ml @@ -121,7 +121,7 @@ let assign_to_place (config : config) (meta : Meta.meta) (rv : typed_value) let ctx = ctx_push_dummy_var ctx dest_vid mv in (* Write to the destination *) (* Checks - maybe the bookkeeping updated the rvalue and introduced bottoms *) - exec_assert + exec_assert __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions rv)) meta "The value to move contains bottom"; (* Update the destination *) @@ -152,7 +152,7 @@ let eval_assertion_concrete (config : config) (meta : Meta.meta) (* Branch *) if b = assertion.expected then cf Unit ctx else cf Panic ctx | _ -> - craise meta + craise __FILE__ __LINE__ meta ("Expected a boolean, got: " ^ typed_value_to_string ~meta:(Some meta) ctx v) in @@ -173,7 +173,7 @@ let eval_assertion (config : config) (meta : Meta.meta) (assertion : assertion) (* Evaluate the assertion *) let eval_assert cf (v : typed_value) : m_fun = fun ctx -> - sanity_check (v.ty = TLiteral TBool) meta; + sanity_check __FILE__ __LINE__ (v.ty = TLiteral TBool) meta; (* We make a choice here: we could completely decouple the concrete and * symbolic executions here but choose not to. In the case where we * know the concrete value of the boolean we test, we use this value @@ -184,8 +184,8 @@ let eval_assertion (config : config) (meta : Meta.meta) (assertion : assertion) (* Delegate to the concrete evaluation function *) eval_assertion_concrete config meta assertion cf ctx | VSymbolic sv -> - sanity_check (config.mode = SymbolicMode) meta; - sanity_check (sv.sv_ty = TLiteral TBool) meta; + sanity_check __FILE__ __LINE__ (config.mode = SymbolicMode) meta; + sanity_check __FILE__ __LINE__ (sv.sv_ty = TLiteral TBool) meta; (* We continue the execution as if the test had succeeded, and thus * perform the symbolic expansion: sv ~~> true. * We will of course synthesize an assertion in the generated code @@ -199,7 +199,7 @@ let eval_assertion (config : config) (meta : Meta.meta) (assertion : assertion) (* Add the synthesized assertion *) S.synthesize_assertion ctx v expr | _ -> - craise meta + craise __FILE__ __LINE__ meta ("Expected a boolean, got: " ^ typed_value_to_string ~meta:(Some meta) ctx v) in @@ -243,7 +243,7 @@ let set_discriminant (config : config) (meta : Meta.meta) (p : place) a variant with all its fields set to {!Bottom} *) match av.variant_id with - | None -> craise meta "Found a struct value while expected an enum" + | None -> craise __FILE__ __LINE__ meta "Found a struct value while expected an enum" | Some variant_id' -> if variant_id' = variant_id then (* Nothing to do *) cf Unit ctx @@ -254,7 +254,7 @@ let set_discriminant (config : config) (meta : Meta.meta) (p : place) | TAdtId def_id -> compute_expanded_bottom_adt_value meta ctx def_id (Some variant_id) generics - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in assign_to_place config meta bottom_v p (cf Unit) ctx) | TAdt ((TAdtId _ as type_id), generics), VBottom -> @@ -263,11 +263,11 @@ let set_discriminant (config : config) (meta : Meta.meta) (p : place) | TAdtId def_id -> compute_expanded_bottom_adt_value meta ctx def_id (Some variant_id) generics - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in assign_to_place config meta bottom_v p (cf Unit) ctx | _, VSymbolic _ -> - sanity_check (config.mode = SymbolicMode) meta; + sanity_check __FILE__ __LINE__ (config.mode = SymbolicMode) meta; (* This is a bit annoying: in theory we should expand the symbolic value * then set the discriminant, because in the case the discriminant is * exactly the one we set, the fields are left untouched, and in the @@ -275,9 +275,9 @@ let set_discriminant (config : config) (meta : Meta.meta) (p : place) * For now, we forbid setting the discriminant of a symbolic value: * setting a discriminant should only be used to initialize a value, * or reset an already initialized value, really. *) - craise meta "Unexpected value" - | _, (VAdt _ | VBottom) -> craise meta "Inconsistent state" - | _, (VLiteral _ | VBorrow _ | VLoan _) -> craise meta "Unexpected value" + craise __FILE__ __LINE__ meta "Unexpected value" + | _, (VAdt _ | VBottom) -> craise __FILE__ __LINE__ meta "Inconsistent state" + | _, (VLiteral _ | VBorrow _ | VLoan _) -> craise __FILE__ __LINE__ meta "Unexpected value" in (* Compose and apply *) comp cc update_value cf ctx @@ -294,13 +294,13 @@ let push_frame : cm_fun = fun cf ctx -> cf (ctx_push_frame ctx) *) let get_assumed_function_return_type (meta : Meta.meta) (ctx : eval_ctx) (fid : assumed_fun_id) (generics : generic_args) : ety = - sanity_check (generics.trait_refs = []) meta; + sanity_check __FILE__ __LINE__ (generics.trait_refs = []) meta; (* [Box::free] has a special treatment *) match fid with | BoxFree -> - sanity_check (generics.regions = []) meta; - sanity_check (List.length generics.types = 1) meta; - sanity_check (generics.const_generics = []) meta; + sanity_check __FILE__ __LINE__ (generics.regions = []) meta; + sanity_check __FILE__ __LINE__ (List.length generics.types = 1) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; mk_unit_ty | _ -> (* Retrieve the function's signature *) @@ -337,7 +337,7 @@ let pop_frame (config : config) (meta : Meta.meta) (pop_return_value : bool) let ret_vid = VarId.zero in let rec list_locals env = match env with - | [] -> craise meta "Inconsistent environment" + | [] -> craise __FILE__ __LINE__ meta "Inconsistent environment" | EAbs _ :: env -> list_locals env | EBinding (BDummy _, _) :: env -> list_locals env | EBinding (BVar var, _) :: env -> @@ -361,7 +361,7 @@ let pop_frame (config : config) (meta : Meta.meta) (pop_return_value : bool) match ret_value with | None -> () | Some ret_value -> - sanity_check + sanity_check __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions ret_value)) meta) in @@ -394,7 +394,7 @@ let pop_frame (config : config) (meta : Meta.meta) (pop_return_value : bool) * no outer loans) as dummy variables in the caller frame *) let rec pop env = match env with - | [] -> craise meta "Inconsistent environment" + | [] -> craise __FILE__ __LINE__ meta "Inconsistent environment" | EAbs abs :: env -> EAbs abs :: pop env | EBinding (_, v) :: env -> let vid = fresh_dummy_var_id () in @@ -434,7 +434,7 @@ let eval_box_new_concrete (config : config) (meta : Meta.meta) :: EBinding (_ret_var, _) :: EFrame :: _ ) -> (* Required type checking *) - cassert (input_value.ty = boxed_ty) meta "TODO: Error message"; + cassert __FILE__ __LINE__ (input_value.ty = boxed_ty) meta "TODO: Error message"; (* Move the input value *) let cf_move = @@ -461,7 +461,7 @@ let eval_box_new_concrete (config : config) (meta : Meta.meta) (* Compose and apply *) comp cf_move cf_create cf ctx - | _ -> craise meta "Inconsistent state" + | _ -> craise __FILE__ __LINE__ meta "Inconsistent state" (** Auxiliary function - see {!eval_assumed_function_call}. @@ -492,7 +492,7 @@ let eval_box_free (config : config) (meta : Meta.meta) (generics : generic_args) InterpreterPaths.read_place meta Write input_box_place ctx in (let input_ty = ty_get_box input_box.ty in - sanity_check (input_ty = boxed_ty)) + sanity_check __FILE__ __LINE__ (input_ty = boxed_ty)) meta; (* Drop the value *) @@ -503,7 +503,7 @@ let eval_box_free (config : config) (meta : Meta.meta) (generics : generic_args) (* Continue *) cc cf ctx - | _ -> craise meta "Inconsistent state" + | _ -> craise __FILE__ __LINE__ meta "Inconsistent state" (** Evaluate a non-local function call in concrete mode *) let eval_assumed_function_call_concrete (config : config) (meta : Meta.meta) @@ -513,12 +513,12 @@ let eval_assumed_function_call_concrete (config : config) (meta : Meta.meta) match call.func with | FnOpMove _ -> (* Closure case: TODO *) - craise meta "Closures are not supported yet" + craise __FILE__ __LINE__ meta "Closures are not supported yet" | FnOpRegular func -> ( let generics = func.generics in (* Sanity check: we don't fully handle the const generic vars environment in concrete mode yet *) - sanity_check (generics.const_generics = []) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; (* There are two cases (and this is extremely annoying): - the function is not box_free - the function is box_free @@ -571,11 +571,11 @@ let eval_assumed_function_call_concrete (config : config) (meta : Meta.meta) | BoxNew -> eval_box_new_concrete config meta generics | BoxFree -> (* Should have been treated above *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | ArrayIndexShared | ArrayIndexMut | ArrayToSliceShared | ArrayToSliceMut | ArrayRepeat | SliceIndexShared | SliceIndexMut -> - craise meta "Unimplemented" + craise __FILE__ __LINE__ meta "Unimplemented" in let cc = comp cc cf_eval_body in @@ -755,7 +755,7 @@ let eval_transparent_function_call_symbolic_inst (meta : Meta.meta) match call.func with | FnOpMove _ -> (* Closure case: TODO *) - craise meta "Closures are not supported yet" + craise __FILE__ __LINE__ meta "Closures are not supported yet" | FnOpRegular func -> ( match func.func with | FunId (FRegular fid) -> @@ -779,7 +779,7 @@ let eval_transparent_function_call_symbolic_inst (meta : Meta.meta) (func.func, func.generics, None, def, regions_hierarchy, inst_sg) | FunId (FAssumed _) -> (* Unreachable: must be a transparent function *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | TraitMethod (trait_ref, method_name, _) -> ( log#ldebug (lazy @@ -839,7 +839,7 @@ let eval_transparent_function_call_symbolic_inst (meta : Meta.meta) | None -> (* If not found, lookup the methods provided by the trait *declaration* (remember: for now, we forbid overriding provided methods) *) - cassert + cassert __FILE__ __LINE__ (trait_impl.provided_methods = []) meta "Overriding provided methods is currently forbidden"; let trait_decl = @@ -996,7 +996,7 @@ let rec eval_statement (config : config) (st : statement) : st_cm_fun = * also it can lead to issues - for instance, if we borrow a * reserved borrow, we later can't translate it to pure values...) *) match rvalue with - | Global _ -> craise st.meta "Unreachable" + | Global _ -> craise __FILE__ __LINE__ st.meta "Unreachable" | Use _ | RvRef (_, (BShared | BMut | BTwoPhaseMut | BShallow)) | UnaryOp _ | BinaryOp _ | Discriminant _ | Aggregate _ -> @@ -1063,7 +1063,7 @@ and eval_global (config : config) (dest : place) (gid : GlobalDeclId.id) | SymbolicMode -> (* Generate a fresh symbolic value. In the translation, this fresh symbolic value will be * defined as equal to the value of the global (see {!S.synthesize_global_eval}). *) - cassert (ty_no_regions global.ty) global.meta + cassert __FILE__ __LINE__ (ty_no_regions global.ty) global.meta "Const globals should not contain regions"; (* Instantiate the type *) (* There shouldn't be any reference to Self *) @@ -1125,7 +1125,7 @@ and eval_switch (config : config) (meta : Meta.meta) (switch : switch) : expand_symbolic_bool config meta sv (S.mk_opt_place_from_op meta op ctx) cf_true cf_false cf ctx - | _ -> craise meta "Inconsistent state" + | _ -> craise __FILE__ __LINE__ meta "Inconsistent state" in (* Compose *) comp cf_eval_op cf_if cf ctx @@ -1140,7 +1140,7 @@ and eval_switch (config : config) (meta : Meta.meta) (switch : switch) : (* Evaluate the branch *) let cf_eval_branch cf = (* Sanity check *) - sanity_check (sv.int_ty = int_ty) meta; + sanity_check __FILE__ __LINE__ (sv.int_ty = int_ty) meta; (* Find the branch *) match List.find_opt (fun (svl, _) -> List.mem sv svl) stgts with | None -> eval_statement config otherwise cf @@ -1172,7 +1172,7 @@ and eval_switch (config : config) (meta : Meta.meta) (switch : switch) : expand_symbolic_int config meta sv (S.mk_opt_place_from_op meta op ctx) int_ty stgts otherwise cf ctx - | _ -> craise meta "Inconsistent state" + | _ -> craise __FILE__ __LINE__ meta "Inconsistent state" in (* Compose *) comp cf_eval_op cf_switch cf ctx @@ -1199,7 +1199,7 @@ and eval_switch (config : config) (meta : Meta.meta) (switch : switch) : match List.find_opt (fun (svl, _) -> List.mem dv svl) stgts with | None -> ( match otherwise with - | None -> craise meta "No otherwise branch" + | None -> craise __FILE__ __LINE__ meta "No otherwise branch" | Some otherwise -> eval_statement config otherwise cf ctx) | Some (_, tgt) -> eval_statement config tgt cf ctx) | VSymbolic sv -> @@ -1211,7 +1211,7 @@ and eval_switch (config : config) (meta : Meta.meta) (switch : switch) : (* Re-evaluate the switch - the value is not symbolic anymore, which means we will go to the other branch *) cf_expand (eval_switch config meta switch) cf ctx - | _ -> craise meta "Inconsistent state" + | _ -> craise __FILE__ __LINE__ meta "Inconsistent state" in (* Compose *) comp cf_read_p cf_match cf ctx @@ -1235,7 +1235,7 @@ and eval_function_call_concrete (config : config) (meta : Meta.meta) (call : call) : st_cm_fun = fun cf ctx -> match call.func with - | FnOpMove _ -> craise meta "Closures are not supported yet" + | FnOpMove _ -> craise __FILE__ __LINE__ meta "Closures are not supported yet" | FnOpRegular func -> ( match func.func with | FunId (FRegular fid) -> @@ -1246,12 +1246,12 @@ and eval_function_call_concrete (config : config) (meta : Meta.meta) * where we haven't panicked. Of course, the translation needs to take the * panic case into account... *) eval_assumed_function_call_concrete config meta fid call (cf Unit) ctx - | TraitMethod _ -> craise meta "Unimplemented") + | TraitMethod _ -> craise __FILE__ __LINE__ meta "Unimplemented") and eval_function_call_symbolic (config : config) (meta : Meta.meta) (call : call) : st_cm_fun = match call.func with - | FnOpMove _ -> craise meta "Closures are not supported yet" + | FnOpMove _ -> craise __FILE__ __LINE__ meta "Closures are not supported yet" | FnOpRegular func -> ( match func.func with | FunId (FRegular _) | TraitMethod _ -> @@ -1265,12 +1265,12 @@ and eval_transparent_function_call_concrete (config : config) (meta : Meta.meta) let args = call.args in let dest = call.dest in match call.func with - | FnOpMove _ -> craise meta "Closures are not supported yet" + | FnOpMove _ -> craise __FILE__ __LINE__ meta "Closures are not supported yet" | FnOpRegular func -> let generics = func.generics in (* Sanity check: we don't fully handle the const generic vars environment in concrete mode yet *) - sanity_check (generics.const_generics = []) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; fun cf ctx -> (* Retrieve the (correctly instantiated) body *) let def = ctx_lookup_fun_decl ctx fid in @@ -1278,13 +1278,13 @@ and eval_transparent_function_call_concrete (config : config) (meta : Meta.meta) let body = match def.body with | None -> - craise meta + craise __FILE__ __LINE__ meta ("Can't evaluate a call to an opaque function: " ^ name_to_string ctx def.name) | Some body -> body in (* TODO: we need to normalize the types if we want to correctly support traits *) - cassert (generics.trait_refs = []) body.meta + cassert __FILE__ __LINE__ (generics.trait_refs = []) body.meta "Traits are not supported yet in concrete mode"; (* There shouldn't be any reference to Self *) let tr_self = UnknownTrait __FUNCTION__ in @@ -1294,7 +1294,7 @@ and eval_transparent_function_call_concrete (config : config) (meta : Meta.meta) let locals, body_st = Subst.fun_body_substitute_in_body subst body in (* Evaluate the input operands *) - sanity_check (List.length args = body.arg_count) body.meta; + sanity_check __FILE__ __LINE__ (List.length args = body.arg_count) body.meta; let cc = eval_operands config body.meta args in (* Push a frame delimiter - we use {!comp_transmit} to transmit the result @@ -1307,7 +1307,7 @@ and eval_transparent_function_call_concrete (config : config) (meta : Meta.meta) let ret_var, locals = match locals with | ret_ty :: locals -> (ret_ty, locals) - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in let input_locals, locals = Collections.List.split_at locals body.arg_count @@ -1343,7 +1343,7 @@ and eval_transparent_function_call_concrete (config : config) (meta : Meta.meta) pop_frame_assign config meta dest (cf Unit) | Break _ | Continue _ | Unit | LoopReturn _ | EndEnterLoop _ | EndContinue _ -> - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in let cc = comp cc cf_finish in @@ -1358,7 +1358,7 @@ and eval_transparent_function_call_symbolic (config : config) (meta : Meta.meta) eval_transparent_function_call_symbolic_inst meta call ctx in (* Sanity check *) - sanity_check + sanity_check __FILE__ __LINE__ (List.length call.args = List.length def.signature.inputs) def.meta; (* Evaluate the function call *) @@ -1418,7 +1418,7 @@ and eval_function_call_symbolic_from_inst_sig (config : config) let args_with_rtypes = List.combine args inst_sg.inputs in (* Check the type of the input arguments *) - cassert + cassert __FILE__ __LINE__ (List.for_all (fun ((arg, rty) : typed_value * rty) -> arg.ty = Subst.erase_regions rty) @@ -1428,7 +1428,7 @@ and eval_function_call_symbolic_from_inst_sig (config : config) * be fed to functions (i.e., symbolic values output from function return * values and which contain borrows of borrows can't be used as function * inputs *) - sanity_check + sanity_check __FILE__ __LINE__ (List.for_all (fun arg -> not (value_has_ret_symbolic_value_with_borrow_under_mut ctx arg)) @@ -1536,7 +1536,7 @@ and eval_assumed_function_call_symbolic (config : config) (meta : Meta.meta) let dest = call.dest in (* Sanity check: make sure the type parameters don't contain regions - * this is a current limitation of our synthesis *) - sanity_check + sanity_check __FILE__ __LINE__ (List.for_all (fun ty -> not (ty_has_borrows ctx.type_ctx.type_infos ty)) generics.types) @@ -1561,7 +1561,7 @@ and eval_assumed_function_call_symbolic (config : config) (meta : Meta.meta) match fid with | BoxFree -> (* Should have been treated above *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | _ -> let regions_hierarchy = LlbcAstUtils.FunIdMap.find (FAssumed fid) diff --git a/compiler/InterpreterUtils.ml b/compiler/InterpreterUtils.ml index 9ffab771..4fd7722e 100644 --- a/compiler/InterpreterUtils.ml +++ b/compiler/InterpreterUtils.ml @@ -21,7 +21,7 @@ let get_cf_ctx_no_synth (meta : Meta.meta) (f : cm_fun) (ctx : eval_ctx) : eval_ctx = let nctx = ref None in let cf ctx = - sanity_check (!nctx = None) meta; + sanity_check __FILE__ __LINE__ (!nctx = None) meta; nctx := Some ctx; None in @@ -85,19 +85,19 @@ let mk_place_from_var_id (var_id : VarId.id) : place = (** Create a fresh symbolic value *) let mk_fresh_symbolic_value (meta : Meta.meta) (ty : ty) : symbolic_value = (* Sanity check *) - sanity_check (ty_is_rty ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty ty) meta; let sv_id = fresh_symbolic_value_id () in let svalue = { sv_id; sv_ty = ty } in svalue let mk_fresh_symbolic_value_from_no_regions_ty (meta : Meta.meta) (ty : ty) : symbolic_value = - sanity_check (ty_no_regions ty) meta; + sanity_check __FILE__ __LINE__ (ty_no_regions ty) meta; mk_fresh_symbolic_value meta ty (** Create a fresh symbolic value *) let mk_fresh_symbolic_typed_value (meta : Meta.meta) (rty : ty) : typed_value = - sanity_check (ty_is_rty rty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty rty) meta; let ty = Substitute.erase_regions rty in (* Generate the fresh a symbolic value *) let value = mk_fresh_symbolic_value meta rty in @@ -106,7 +106,7 @@ let mk_fresh_symbolic_typed_value (meta : Meta.meta) (rty : ty) : typed_value = let mk_fresh_symbolic_typed_value_from_no_regions_ty (meta : Meta.meta) (ty : ty) : typed_value = - sanity_check (ty_no_regions ty) meta; + sanity_check __FILE__ __LINE__ (ty_no_regions ty) meta; mk_fresh_symbolic_typed_value meta ty (** Create a typed value from a symbolic value. *) @@ -136,7 +136,7 @@ let mk_aproj_loans_value_from_symbolic_value (regions : RegionId.Set.t) let mk_aproj_borrows_from_symbolic_value (meta : Meta.meta) (proj_regions : RegionId.Set.t) (svalue : symbolic_value) (proj_ty : ty) : aproj = - sanity_check (ty_is_rty proj_ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty proj_ty) meta; if ty_has_regions_in_set proj_regions proj_ty then AProjBorrows (svalue, proj_ty) else AIgnoredProjBorrows @@ -162,7 +162,7 @@ let remove_borrow_from_asb (meta : Meta.meta) (bid : BorrowId.id) false)) asb in - sanity_check (!removed = 1) meta; + sanity_check __FILE__ __LINE__ (!removed = 1) meta; asb (** We sometimes need to return a value whose type may vary depending on @@ -508,8 +508,8 @@ let instantiate_fun_sig (meta : Meta.meta) (ctx : eval_ctx) (* Generate the type substitution Note that for now we don't support instantiating the type parameters with types containing regions. *) - sanity_check (List.for_all TypesUtils.ty_no_regions generics.types) meta; - sanity_check (TypesUtils.trait_instance_id_no_regions tr_self) meta; + sanity_check __FILE__ __LINE__ (List.for_all TypesUtils.ty_no_regions generics.types) meta; + sanity_check __FILE__ __LINE__ (TypesUtils.trait_instance_id_no_regions tr_self) meta; let tsubst = Substitute.make_type_subst_from_vars sg.generics.types generics.types in diff --git a/compiler/Invariants.ml b/compiler/Invariants.ml index 1c10bf7e..830661d2 100644 --- a/compiler/Invariants.ml +++ b/compiler/Invariants.ml @@ -79,12 +79,12 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : let infos = !borrows_infos in (* Use the first borrow id as representant *) let repr_bid = BorrowId.Set.min_elt bids in - sanity_check (not (BorrowId.Map.mem repr_bid infos)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem repr_bid infos)) meta; (* Insert the mappings to the representant *) let reprs = BorrowId.Set.fold (fun bid reprs -> - sanity_check (not (BorrowId.Map.mem bid reprs)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem bid reprs)) meta; BorrowId.Map.add bid repr_bid reprs) bids reprs in @@ -107,8 +107,8 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : let reprs = !ids_reprs in let infos = !borrows_infos in (* Sanity checks *) - sanity_check (not (BorrowId.Map.mem bid reprs)) meta; - sanity_check (not (BorrowId.Map.mem bid infos)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem bid reprs)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem bid infos)) meta; (* Add the mapping for the representant *) let reprs = BorrowId.Map.add bid bid reprs in (* Add the mapping for the loan info *) @@ -186,7 +186,7 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : ^ BorrowId.to_string bid ^ ":\nContext:\n" ^ context_to_string () in log#serror err; - craise meta err + craise __FILE__ __LINE__ meta err in let update_info (bid : BorrowId.id) (info : borrow_info) : unit = @@ -196,7 +196,7 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : let infos = BorrowId.Map.update repr_bid (fun x -> - match x with Some _ -> Some info | None -> craise meta "Unreachable") + match x with Some _ -> Some info | None -> craise __FILE__ __LINE__ meta "Unreachable") !borrows_infos in borrows_infos := infos @@ -210,12 +210,12 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : (* Check that the borrow kind is consistent *) (match (info.loan_kind, kind) with | RShared, (BShared | BReserved) | RMut, BMut -> () - | _ -> craise meta "Invariant not satisfied"); + | _ -> craise __FILE__ __LINE__ meta "Invariant not satisfied"); (* A reserved borrow can't point to a value inside an abstraction *) - sanity_check (kind <> BReserved || not info.loan_in_abs) meta; + sanity_check __FILE__ __LINE__ (kind <> BReserved || not info.loan_in_abs) meta; (* Insert the borrow id *) let borrow_ids = info.borrow_ids in - sanity_check (not (BorrowId.Set.mem bid borrow_ids)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Set.mem bid borrow_ids)) meta; let info = { info with borrow_ids = BorrowId.Set.add bid borrow_ids } in (* Update the info in the map *) update_info bid info @@ -270,7 +270,7 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : List.iter (fun (rkind, bid) -> let info = find_info bid in - sanity_check (info.loan_kind = rkind) meta) + sanity_check __FILE__ __LINE__ (info.loan_kind = rkind) meta) !ignored_loans; (* Then, check the borrow infos *) @@ -278,12 +278,12 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : (fun _ info -> (* Note that we can't directly compare the sets - I guess they are * different depending on the order in which we add the elements... *) - sanity_check + sanity_check __FILE__ __LINE__ (BorrowId.Set.elements info.loan_ids = BorrowId.Set.elements info.borrow_ids) meta; match info.loan_kind with - | RMut -> sanity_check (BorrowId.Set.cardinal info.loan_ids = 1) meta + | RMut -> sanity_check __FILE__ __LINE__ (BorrowId.Set.cardinal info.loan_ids = 1) meta | RShared -> ()) !borrows_infos @@ -298,7 +298,7 @@ let check_borrowed_values_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = method! visit_VBottom info = (* No ⊥ inside borrowed values *) - sanity_check + sanity_check __FILE__ __LINE__ (Config.allow_bottom_below_borrow || not info.outer_borrow) meta @@ -313,7 +313,7 @@ let check_borrowed_values_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = | VSharedLoan (_, _) -> set_outer_shared info | VMutLoan _ -> (* No mutable loan inside a shared loan *) - sanity_check (not info.outer_shared) meta; + sanity_check __FILE__ __LINE__ (not info.outer_shared) meta; set_outer_mut info in (* Continue exploring *) @@ -325,7 +325,7 @@ let check_borrowed_values_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = match bc with | VSharedBorrow _ -> set_outer_shared info | VReservedMutBorrow _ -> - sanity_check (not info.outer_borrow) meta; + sanity_check __FILE__ __LINE__ (not info.outer_borrow) meta; set_outer_shared info | VMutBorrow (_, _) -> set_outer_mut info in @@ -373,9 +373,9 @@ let check_borrowed_values_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = let check_literal_type (meta : Meta.meta) (cv : literal) (ty : literal_type) : unit = match (cv, ty) with - | VScalar sv, TInteger int_ty -> sanity_check (sv.int_ty = int_ty) meta + | VScalar sv, TInteger int_ty -> sanity_check __FILE__ __LINE__ (sv.int_ty = int_ty) meta | VBool _, TBool | VChar _, TChar -> () - | _ -> craise meta "Erroneous typing" + | _ -> craise __FILE__ __LINE__ meta "Erroneous typing" let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = (* TODO: the type of aloans doens't make sense: they have a type @@ -397,17 +397,17 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = method! visit_EBinding info binder v = (* We also check that the regions are erased *) - sanity_check (ty_is_ety v.ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_ety v.ty) meta; super#visit_EBinding info binder v method! visit_symbolic_value inside_abs v = (* Check that the types have regions *) - sanity_check (ty_is_rty v.sv_ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty v.sv_ty) meta; super#visit_symbolic_value inside_abs v method! visit_typed_value info tv = (* Check that the types have erased regions *) - sanity_check (ty_is_ety tv.ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_ety tv.ty) meta; (* Check the current pair (value, type) *) (match (tv.value, tv.ty) with | VLiteral cv, TLiteral ty -> check_literal_type meta cv ty @@ -417,20 +417,20 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = * parameters, etc. *) let def = ctx_lookup_type_decl ctx def_id in (* Check the number of parameters *) - sanity_check + sanity_check __FILE__ __LINE__ (List.length generics.regions = List.length def.generics.regions) meta; - sanity_check + sanity_check __FILE__ __LINE__ (List.length generics.types = List.length def.generics.types) meta; (* Check that the variant id is consistent *) (match (av.variant_id, def.kind) with | Some variant_id, Enum variants -> - sanity_check + sanity_check __FILE__ __LINE__ (VariantId.to_int variant_id < List.length variants) meta | None, Struct _ -> () - | _ -> craise meta "Erroneous typing"); + | _ -> craise __FILE__ __LINE__ meta "Erroneous typing"); (* Check that the field types are correct *) let field_types = AssociatedTypes.type_decl_get_inst_norm_field_etypes meta ctx def @@ -439,13 +439,13 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = let fields_with_types = List.combine av.field_values field_types in List.iter (fun ((v, ty) : typed_value * ty) -> - sanity_check (v.ty = ty) meta) + sanity_check __FILE__ __LINE__ (v.ty = ty) meta) fields_with_types (* Tuple case *) | VAdt av, TAdt (TTuple, generics) -> - sanity_check (generics.regions = []) meta; - sanity_check (generics.const_generics = []) meta; - sanity_check (av.variant_id = None) meta; + sanity_check __FILE__ __LINE__ (generics.regions = []) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; + sanity_check __FILE__ __LINE__ (av.variant_id = None) meta; (* Check that the fields have the proper values - and check that there * are as many fields as field types at the same time *) let fields_with_types = @@ -453,11 +453,11 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = in List.iter (fun ((v, ty) : typed_value * ty) -> - sanity_check (v.ty = ty) meta) + sanity_check __FILE__ __LINE__ (v.ty = ty) meta) fields_with_types (* Assumed type case *) | VAdt av, TAdt (TAssumed aty_id, generics) -> ( - sanity_check (av.variant_id = None) meta; + sanity_check __FILE__ __LINE__ (av.variant_id = None) meta; match ( aty_id, av.field_values, @@ -467,10 +467,10 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = with (* Box *) | TBox, [ inner_value ], [], [ inner_ty ], [] -> - sanity_check (inner_value.ty = inner_ty) meta + sanity_check __FILE__ __LINE__ (inner_value.ty = inner_ty) meta | TArray, inner_values, _, [ inner_ty ], [ cg ] -> (* *) - sanity_check + sanity_check __FILE__ __LINE__ (List.for_all (fun (v : typed_value) -> v.ty = inner_ty) inner_values) @@ -481,9 +481,9 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = (TypesUtils.const_generic_as_literal cg)) .value in - sanity_check (Z.of_int (List.length inner_values) = len) meta - | (TSlice | TStr), _, _, _, _ -> craise meta "Unexpected" - | _ -> craise meta "Erroneous type") + sanity_check __FILE__ __LINE__ (Z.of_int (List.length inner_values) = len) meta + | (TSlice | TStr), _, _, _, _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Erroneous type") | VBottom, _ -> (* Nothing to check *) () | VBorrow bc, TRef (_, ref_ty, rkind) -> ( match (bc, rkind) with @@ -493,30 +493,30 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = match glc with | Concrete (VSharedLoan (_, sv)) | Abstract (ASharedLoan (_, sv, _)) -> - sanity_check (sv.ty = ref_ty) meta - | _ -> craise meta "Inconsistent context") + sanity_check __FILE__ __LINE__ (sv.ty = ref_ty) meta + | _ -> craise __FILE__ __LINE__ meta "Inconsistent context") | VMutBorrow (_, bv), RMut -> - sanity_check + sanity_check __FILE__ __LINE__ ((* Check that the borrowed value has the proper type *) bv.ty = ref_ty) meta - | _ -> craise meta "Erroneous typing") + | _ -> craise __FILE__ __LINE__ meta "Erroneous typing") | VLoan lc, ty -> ( match lc with - | VSharedLoan (_, sv) -> sanity_check (sv.ty = ty) meta + | VSharedLoan (_, sv) -> sanity_check __FILE__ __LINE__ (sv.ty = ty) meta | VMutLoan bid -> ( (* Lookup the borrowed value to check it has the proper type *) let glc = lookup_borrow meta ek_all bid ctx in match glc with | Concrete (VMutBorrow (_, bv)) -> - sanity_check (bv.ty = ty) meta + sanity_check __FILE__ __LINE__ (bv.ty = ty) meta | Abstract (AMutBorrow (_, sv)) -> - sanity_check (Substitute.erase_regions sv.ty = ty) meta - | _ -> craise meta "Inconsistent context")) + sanity_check __FILE__ __LINE__ (Substitute.erase_regions sv.ty = ty) meta + | _ -> craise __FILE__ __LINE__ meta "Inconsistent context")) | VSymbolic sv, ty -> let ty' = Substitute.erase_regions sv.sv_ty in - sanity_check (ty' = ty) meta - | _ -> craise meta "Erroneous typing"); + sanity_check __FILE__ __LINE__ (ty' = ty) meta + | _ -> craise __FILE__ __LINE__ meta "Erroneous typing"); (* Continue exploring to inspect the subterms *) super#visit_typed_value info tv @@ -530,7 +530,7 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = * *) method! visit_typed_avalue info atv = (* Check that the types have regions *) - sanity_check (ty_is_rty atv.ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty atv.ty) meta; (* Check the current pair (value, type) *) (match (atv.value, atv.ty) with (* ADT case *) @@ -539,24 +539,24 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = * parameters, etc. *) let def = ctx_lookup_type_decl ctx def_id in (* Check the number of parameters *) - sanity_check + sanity_check __FILE__ __LINE__ (List.length generics.regions = List.length def.generics.regions) meta; - sanity_check + sanity_check __FILE__ __LINE__ (List.length generics.types = List.length def.generics.types) meta; - sanity_check + sanity_check __FILE__ __LINE__ (List.length generics.const_generics = List.length def.generics.const_generics) meta; (* Check that the variant id is consistent *) (match (av.variant_id, def.kind) with | Some variant_id, Enum variants -> - sanity_check + sanity_check __FILE__ __LINE__ (VariantId.to_int variant_id < List.length variants) meta | None, Struct _ -> () - | _ -> craise meta "Erroneous typing"); + | _ -> craise __FILE__ __LINE__ meta "Erroneous typing"); (* Check that the field types are correct *) let field_types = AssociatedTypes.type_decl_get_inst_norm_field_rtypes meta ctx def @@ -565,13 +565,13 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = let fields_with_types = List.combine av.field_values field_types in List.iter (fun ((v, ty) : typed_avalue * ty) -> - sanity_check (v.ty = ty) meta) + sanity_check __FILE__ __LINE__ (v.ty = ty) meta) fields_with_types (* Tuple case *) | AAdt av, TAdt (TTuple, generics) -> - sanity_check (generics.regions = []) meta; - sanity_check (generics.const_generics = []) meta; - sanity_check (av.variant_id = None) meta; + sanity_check __FILE__ __LINE__ (generics.regions = []) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; + sanity_check __FILE__ __LINE__ (av.variant_id = None) meta; (* Check that the fields have the proper values - and check that there * are as many fields as field types at the same time *) let fields_with_types = @@ -579,11 +579,11 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = in List.iter (fun ((v, ty) : typed_avalue * ty) -> - sanity_check (v.ty = ty) meta) + sanity_check __FILE__ __LINE__ (v.ty = ty) meta) fields_with_types (* Assumed type case *) | AAdt av, TAdt (TAssumed aty_id, generics) -> ( - sanity_check (av.variant_id = None) meta; + sanity_check __FILE__ __LINE__ (av.variant_id = None) meta; match ( aty_id, av.field_values, @@ -593,66 +593,66 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = with (* Box *) | TBox, [ boxed_value ], [], [ boxed_ty ], [] -> - sanity_check (boxed_value.ty = boxed_ty) meta - | _ -> craise meta "Erroneous type") + sanity_check __FILE__ __LINE__ (boxed_value.ty = boxed_ty) meta + | _ -> craise __FILE__ __LINE__ meta "Erroneous type") | ABottom, _ -> (* Nothing to check *) () | ABorrow bc, TRef (_, ref_ty, rkind) -> ( match (bc, rkind) with | AMutBorrow (_, av), RMut -> (* Check that the child value has the proper type *) - sanity_check (av.ty = ref_ty) meta + sanity_check __FILE__ __LINE__ (av.ty = ref_ty) meta | ASharedBorrow bid, RShared -> ( (* Lookup the borrowed value to check it has the proper type *) let _, glc = lookup_loan meta ek_all bid ctx in match glc with | Concrete (VSharedLoan (_, sv)) | Abstract (ASharedLoan (_, sv, _)) -> - sanity_check (sv.ty = Substitute.erase_regions ref_ty) meta - | _ -> craise meta "Inconsistent context") + sanity_check __FILE__ __LINE__ (sv.ty = Substitute.erase_regions ref_ty) meta + | _ -> craise __FILE__ __LINE__ meta "Inconsistent context") | AIgnoredMutBorrow (_opt_bid, av), RMut -> - sanity_check (av.ty = ref_ty) meta + sanity_check __FILE__ __LINE__ (av.ty = ref_ty) meta | ( AEndedIgnoredMutBorrow { given_back; child; given_back_meta = _ }, RMut ) -> - sanity_check (given_back.ty = ref_ty) meta; - sanity_check (child.ty = ref_ty) meta + sanity_check __FILE__ __LINE__ (given_back.ty = ref_ty) meta; + sanity_check __FILE__ __LINE__ (child.ty = ref_ty) meta | AProjSharedBorrow _, RShared -> () - | _ -> craise meta "Inconsistent context") + | _ -> craise __FILE__ __LINE__ meta "Inconsistent context") | ALoan lc, aty -> ( match lc with | AMutLoan (bid, child_av) | AIgnoredMutLoan (Some bid, child_av) -> ( let borrowed_aty = aloan_get_expected_child_type aty in - sanity_check (child_av.ty = borrowed_aty) meta; + sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) meta; (* Lookup the borrowed value to check it has the proper type *) let glc = lookup_borrow meta ek_all bid ctx in match glc with | Concrete (VMutBorrow (_, bv)) -> - sanity_check + sanity_check __FILE__ __LINE__ (bv.ty = Substitute.erase_regions borrowed_aty) meta | Abstract (AMutBorrow (_, sv)) -> - sanity_check + sanity_check __FILE__ __LINE__ (Substitute.erase_regions sv.ty = Substitute.erase_regions borrowed_aty) meta - | _ -> craise meta "Inconsistent context") + | _ -> craise __FILE__ __LINE__ meta "Inconsistent context") | AIgnoredMutLoan (None, child_av) -> let borrowed_aty = aloan_get_expected_child_type aty in - sanity_check (child_av.ty = borrowed_aty) meta + sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) meta | ASharedLoan (_, sv, child_av) | AEndedSharedLoan (sv, child_av) -> let borrowed_aty = aloan_get_expected_child_type aty in - sanity_check + sanity_check __FILE__ __LINE__ (sv.ty = Substitute.erase_regions borrowed_aty) meta; (* TODO: the type of aloans doesn't make sense, see above *) - sanity_check (child_av.ty = borrowed_aty) meta + sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) meta | AEndedMutLoan { given_back; child; given_back_meta = _ } | AEndedIgnoredMutLoan { given_back; child; given_back_meta = _ } -> let borrowed_aty = aloan_get_expected_child_type aty in - sanity_check (given_back.ty = borrowed_aty) meta; - sanity_check (child.ty = borrowed_aty) meta + sanity_check __FILE__ __LINE__ (given_back.ty = borrowed_aty) meta; + sanity_check __FILE__ __LINE__ (child.ty = borrowed_aty) meta | AIgnoredSharedLoan child_av -> - sanity_check + sanity_check __FILE__ __LINE__ (child_av.ty = aloan_get_expected_child_type aty) meta) | ASymbolic aproj, ty -> ( @@ -660,25 +660,25 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = match aproj with | AProjLoans (sv, _) -> let ty2 = Substitute.erase_regions sv.sv_ty in - sanity_check (ty1 = ty2) meta; + sanity_check __FILE__ __LINE__ (ty1 = ty2) meta; (* Also check that the symbolic values contain regions of interest - * otherwise they should have been reduced to [_] *) let abs = Option.get info in - sanity_check (ty_has_regions_in_set abs.regions sv.sv_ty) meta + sanity_check __FILE__ __LINE__ (ty_has_regions_in_set abs.regions sv.sv_ty) meta | AProjBorrows (sv, proj_ty) -> let ty2 = Substitute.erase_regions sv.sv_ty in - sanity_check (ty1 = ty2) meta; + sanity_check __FILE__ __LINE__ (ty1 = ty2) meta; (* Also check that the symbolic values contain regions of interest - * otherwise they should have been reduced to [_] *) let abs = Option.get info in - sanity_check (ty_has_regions_in_set abs.regions proj_ty) meta + sanity_check __FILE__ __LINE__ (ty_has_regions_in_set abs.regions proj_ty) meta | AEndedProjLoans (_msv, given_back_ls) -> List.iter (fun (_, proj) -> match proj with - | AProjBorrows (_sv, ty') -> sanity_check (ty' = ty) meta + | AProjBorrows (_sv, ty') -> sanity_check __FILE__ __LINE__ (ty' = ty) meta | AEndedProjBorrows _ | AIgnoredProjBorrows -> () - | _ -> craise meta "Unexpected") + | _ -> craise __FILE__ __LINE__ meta "Unexpected") given_back_ls | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()) | AIgnored, _ -> () @@ -689,7 +689,7 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = ^ "\n- value: " ^ typed_avalue_to_string ~meta:(Some meta) ctx atv ^ "\n- type: " ^ ty_to_string ctx atv.ty)); - craise meta "Erroneous typing"); + craise __FILE__ __LINE__ meta "Erroneous typing"); (* Continue exploring to inspect the subterms *) super#visit_typed_avalue info atv end @@ -796,17 +796,17 @@ let check_symbolic_values (meta : Meta.meta) (ctx : eval_ctx) : unit = *) (* A symbolic value can't be both in the regular environment and inside * projectors of borrows in abstractions *) - sanity_check (info.env_count = 0 || info.aproj_borrows = []) meta; + sanity_check __FILE__ __LINE__ (info.env_count = 0 || info.aproj_borrows = []) meta; (* A symbolic value containing borrows can't be duplicated (i.e., copied): * it must be expanded first *) if ty_has_borrows ctx.type_ctx.type_infos info.ty then - sanity_check (info.env_count <= 1) meta; + sanity_check __FILE__ __LINE__ (info.env_count <= 1) meta; (* A duplicated symbolic value is necessarily primitively copyable *) - sanity_check + sanity_check __FILE__ __LINE__ (info.env_count <= 1 || ty_is_primitively_copyable info.ty) meta; - sanity_check (info.aproj_borrows = [] || info.aproj_loans <> []) meta; + sanity_check __FILE__ __LINE__ (info.aproj_borrows = [] || info.aproj_loans <> []) meta; (* At the same time: * - check that the loans don't intersect * - compute the set of regions for which we project loans @@ -818,7 +818,7 @@ let check_symbolic_values (meta : Meta.meta) (ctx : eval_ctx) : unit = let regions = RegionId.Set.fold (fun rid regions -> - sanity_check (not (RegionId.Set.mem rid regions)) meta; + sanity_check __FILE__ __LINE__ (not (RegionId.Set.mem rid regions)) meta; RegionId.Set.add rid regions) regions linfo.regions in @@ -828,7 +828,7 @@ let check_symbolic_values (meta : Meta.meta) (ctx : eval_ctx) : unit = (* Check that the union of the loan projectors contains the borrow projections. *) List.iter (fun binfo -> - sanity_check + sanity_check __FILE__ __LINE__ (projection_contains meta info.ty loan_regions binfo.proj_ty binfo.regions) meta) diff --git a/compiler/PrePasses.ml b/compiler/PrePasses.ml index 8c346a8c..5e0aa289 100644 --- a/compiler/PrePasses.ml +++ b/compiler/PrePasses.ml @@ -217,11 +217,11 @@ let remove_loop_breaks (crate : crate) (f : fun_decl) : fun_decl = method! visit_statement entered_loop st = match st.content with | Loop loop -> - cassert (not entered_loop) st.meta + cassert __FILE__ __LINE__ (not entered_loop) st.meta "Nested loops are not supported yet"; { st with content = super#visit_Loop true loop } | Break i -> - cassert (i = 0) st.meta + cassert __FILE__ __LINE__ (i = 0) st.meta "Breaks to outer loops are not supported yet"; { st with content = nst.content } | _ -> super#visit_statement entered_loop st @@ -238,7 +238,7 @@ let remove_loop_breaks (crate : crate) (f : fun_decl) : fun_decl = method! visit_Sequence env st1 st2 = match st1.content with | Loop _ -> - sanity_check (statement_has_no_loop_break_continue st2) st2.meta; + sanity_check __FILE__ __LINE__ (statement_has_no_loop_break_continue st2) st2.meta; (replace_breaks_with st1 st2).content | _ -> super#visit_Sequence env st1 st2 end @@ -405,7 +405,7 @@ let remove_shallow_borrows (crate : crate) (f : fun_decl) : fun_decl = method! visit_statement _ st = super#visit_statement st.meta st method! visit_var_id meta id = - cassert + cassert __FILE__ __LINE__ (not (VarId.Set.mem id !filtered)) meta "Filtered variables should have completely disappeared from the \ diff --git a/compiler/Print.ml b/compiler/Print.ml index b570bf5f..a136f87e 100644 --- a/compiler/Print.ml +++ b/compiler/Print.ml @@ -85,9 +85,9 @@ module Values = struct (* Happens when we aggregate values *) "@Array[" ^ String.concat ", " field_values ^ "]" | _ -> - craise_opt_meta meta + craise_opt_meta __FILE__ __LINE__ meta ("Inconsistent value: " ^ show_typed_value v)) - | _ -> craise_opt_meta meta "Inconsistent typed value") + | _ -> craise_opt_meta __FILE__ __LINE__ meta "Inconsistent typed value") | VBottom -> "⊥ : " ^ ty_to_string env v.ty | VBorrow bc -> borrow_content_to_string ~meta env bc | VLoan lc -> loan_content_to_string ~meta env lc @@ -183,8 +183,8 @@ module Values = struct (* Assumed type *) match (aty, field_values) with | TBox, [ bv ] -> "@Box(" ^ bv ^ ")" - | _ -> craise_opt_meta meta "Inconsistent value") - | _ -> craise_opt_meta meta "Inconsistent typed value") + | _ -> craise_opt_meta __FILE__ __LINE__ meta "Inconsistent value") + | _ -> craise_opt_meta __FILE__ __LINE__ meta "Inconsistent typed value") | ABottom -> "⊥ : " ^ ty_to_string env v.ty | ABorrow bc -> aborrow_content_to_string ~meta env bc | ALoan lc -> aloan_content_to_string ~meta env lc @@ -343,7 +343,7 @@ module Contexts = struct in indent ^ bv ^ ty ^ " -> " ^ typed_value_to_string ~meta env tv ^ " ;" | EAbs abs -> abs_to_string ~meta env verbose indent indent_incr abs - | EFrame -> craise_opt_meta meta "Can't print a Frame element" + | EFrame -> craise_opt_meta __FILE__ __LINE__ meta "Can't print a Frame element" let opt_env_elem_to_string ?(meta : Meta.meta option = None) (env : fmt_env) (verbose : bool) (with_var_types : bool) (indent : string) @@ -498,7 +498,7 @@ module Contexts = struct | EBinding (BDummy _, _) -> num_dummies := !num_abs + 1 | EBinding (BVar _, _) -> num_bindings := !num_bindings + 1 | EAbs _ -> num_abs := !num_abs + 1 - | _ -> craise_opt_meta meta "Unreachable") + | _ -> craise_opt_meta __FILE__ __LINE__ meta "Unreachable") f; "\n# Frame " ^ string_of_int i ^ ":" ^ "\n- locals: " ^ string_of_int !num_bindings diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml index 1162251a..a1b19ea3 100644 --- a/compiler/PrintPure.ml +++ b/compiler/PrintPure.ml @@ -308,34 +308,34 @@ let adt_variant_to_string ?(meta = None) (env : fmt_env) (adt_id : type_id) match aty with | TState | TArray | TSlice | TStr | TRawPtr _ -> (* Those types are opaque: we can't get there *) - craise_opt_meta meta "Unreachable" + craise_opt_meta __FILE__ __LINE__ meta "Unreachable" | TResult -> let variant_id = Option.get variant_id in if variant_id = result_return_id then "@Result::Return" else if variant_id = result_fail_id then "@Result::Fail" else - craise_opt_meta meta + craise_opt_meta __FILE__ __LINE__ meta "Unreachable: improper variant id for result type" | TError -> let variant_id = Option.get variant_id in if variant_id = error_failure_id then "@Error::Failure" else if variant_id = error_out_of_fuel_id then "@Error::OutOfFuel" else - craise_opt_meta meta + craise_opt_meta __FILE__ __LINE__ meta "Unreachable: improper variant id for error type" | TFuel -> let variant_id = Option.get variant_id in if variant_id = fuel_zero_id then "@Fuel::Zero" else if variant_id = fuel_succ_id then "@Fuel::Succ" else - craise_opt_meta meta + craise_opt_meta __FILE__ __LINE__ meta "Unreachable: improper variant id for fuel type") let adt_field_to_string ?(meta = None) (env : fmt_env) (adt_id : type_id) (field_id : FieldId.id) : string = match adt_id with | TTuple -> - craise_opt_meta meta "Unreachable" + craise_opt_meta __FILE__ __LINE__ meta "Unreachable" (* Tuples don't use the opaque field id for the field indices, but [int] *) | TAdtId def_id -> ( (* "Regular" ADT *) @@ -348,10 +348,10 @@ let adt_field_to_string ?(meta = None) (env : fmt_env) (adt_id : type_id) match aty with | TState | TFuel | TArray | TSlice | TStr -> (* Opaque types: we can't get there *) - craise_opt_meta meta "Unreachable" + craise_opt_meta __FILE__ __LINE__ meta "Unreachable" | TResult | TError | TRawPtr _ -> (* Enumerations: we can't get there *) - craise_opt_meta meta "Unreachable") + craise_opt_meta __FILE__ __LINE__ meta "Unreachable") (** TODO: we don't need a general function anymore (it is now only used for patterns) @@ -391,49 +391,49 @@ let adt_g_value_to_string ?(meta : Meta.meta option = None) (env : fmt_env) match aty with | TState | TRawPtr _ -> (* This type is opaque: we can't get there *) - craise_opt_meta meta "Unreachable" + craise_opt_meta __FILE__ __LINE__ meta "Unreachable" | TResult -> let variant_id = Option.get variant_id in if variant_id = result_return_id then match field_values with | [ v ] -> "@Result::Return " ^ v - | _ -> craise_opt_meta meta "Result::Return takes exactly one value" + | _ -> craise_opt_meta __FILE__ __LINE__ meta "Result::Return takes exactly one value" else if variant_id = result_fail_id then match field_values with | [ v ] -> "@Result::Fail " ^ v - | _ -> craise_opt_meta meta "Result::Fail takes exactly one value" + | _ -> craise_opt_meta __FILE__ __LINE__ meta "Result::Fail takes exactly one value" else - craise_opt_meta meta + craise_opt_meta __FILE__ __LINE__ meta "Unreachable: improper variant id for result type" | TError -> - cassert_opt_meta (field_values = []) meta "TODO: error message"; + cassert_opt_meta __FILE__ __LINE__ (field_values = []) meta "TODO: error message"; let variant_id = Option.get variant_id in if variant_id = error_failure_id then "@Error::Failure" else if variant_id = error_out_of_fuel_id then "@Error::OutOfFuel" else - craise_opt_meta meta + craise_opt_meta __FILE__ __LINE__ meta "Unreachable: improper variant id for error type" | TFuel -> let variant_id = Option.get variant_id in if variant_id = fuel_zero_id then ( - cassert_opt_meta (field_values = []) meta "TODO: error message"; + cassert_opt_meta __FILE__ __LINE__ (field_values = []) meta "TODO: error message"; "@Fuel::Zero") else if variant_id = fuel_succ_id then match field_values with | [ v ] -> "@Fuel::Succ " ^ v - | _ -> craise_opt_meta meta "@Fuel::Succ takes exactly one value" + | _ -> craise_opt_meta __FILE__ __LINE__ meta "@Fuel::Succ takes exactly one value" else - craise_opt_meta meta + craise_opt_meta __FILE__ __LINE__ meta "Unreachable: improper variant id for fuel type" | TArray | TSlice | TStr -> - cassert_opt_meta (variant_id = None) meta "TODO: error message"; + cassert_opt_meta __FILE__ __LINE__ (variant_id = None) meta "TODO: error message"; let field_values = List.mapi (fun i v -> string_of_int i ^ " -> " ^ v) field_values in let id = assumed_ty_to_string aty in id ^ " [" ^ String.concat "; " field_values ^ "]") | _ -> - craise_opt_meta meta + craise_opt_meta __FILE__ __LINE__ meta ("Inconsistently typed value: expected ADT type but found:" ^ "\n- ty: " ^ ty_to_string env false ty ^ "\n- variant_id: " ^ Print.option_to_string VariantId.to_string variant_id) @@ -597,7 +597,7 @@ let rec texpression_to_string ?(metadata : Meta.meta option = None) supd.updates in "[ " ^ String.concat ", " fields ^ " ]" - | _ -> craise_opt_meta metadata "Unexpected") + | _ -> craise_opt_meta __FILE__ __LINE__ metadata "Unexpected") | Meta (meta, e) -> ( let meta_s = emeta_to_string ~metadata env meta in let e = texpression_to_string ~metadata env inside indent indent_incr e in diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index e58b318a..95c74a7b 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -222,7 +222,7 @@ let compute_pretty_names (def : fun_decl) : fun_decl = (* Register a variable for constraints propagation - used when an variable is * introduced (left-hand side of a left binding) *) let register_var (ctx : pn_ctx) (v : var) : pn_ctx = - sanity_check (not (VarId.Map.mem v.id ctx.pure_vars)) def.meta; + sanity_check __FILE__ __LINE__ (not (VarId.Map.mem v.id ctx.pure_vars)) def.meta; match v.basename with | None -> ctx | Some name -> @@ -756,7 +756,7 @@ let simplify_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = else if variant_id = result_fail_id then (* Fail case *) self#visit_expression env rv.e - else craise def.meta "Unexpected" + else craise __FILE__ __LINE__ def.meta "Unexpected" | App _ -> (* This might be the tuple case *) if not monadic then @@ -1198,13 +1198,13 @@ let simplify_aggregates (ctx : trans_ctx) (def : fun_decl) : fun_decl = in let fields = match adt_decl.kind with - | Enum _ | Opaque -> craise def.meta "Unreachable" + | Enum _ | Opaque -> craise __FILE__ __LINE__ def.meta "Unreachable" | Struct fields -> fields in let num_fields = List.length fields in (* In order to simplify, there must be as many arguments as * there are fields *) - sanity_check (num_fields > 0) def.meta; + sanity_check __FILE__ __LINE__ (num_fields > 0) def.meta; if num_fields = List.length args then (* We now need to check that all the arguments are of the form: * [x.field] for some variable [x], and where the projection @@ -1240,7 +1240,7 @@ let simplify_aggregates (ctx : trans_ctx) (def : fun_decl) : fun_decl = if List.for_all (fun (_, y) -> y = x) end_args then ( (* We can substitute *) (* Sanity check: all types correct *) - sanity_check + sanity_check __FILE__ __LINE__ (List.for_all (fun (generics1, _) -> generics1 = generics) args) @@ -1399,7 +1399,7 @@ let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : { fwd_info; effect_info = loop_fwd_effect_info; ignore_output } in - cassert + cassert __FILE__ __LINE__ (fun_sig_info_is_wf loop_fwd_sig_info) def.meta "TODO: error message"; @@ -1441,7 +1441,7 @@ let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : (* Introduce the forward input state *) let fwd_state_var, fwd_state_lvs = - cassert + cassert __FILE__ __LINE__ (loop_fwd_effect_info.stateful = Option.is_some loop.input_state) def.meta "TODO: error message"; @@ -1577,7 +1577,7 @@ let eliminate_box_functions (_ctx : trans_ctx) (def : fun_decl) : fun_decl = let arg, args = Collections.List.pop args in mk_apps def.meta arg args | BoxFree -> - sanity_check (args = []) def.meta; + sanity_check __FILE__ __LINE__ (args = []) def.meta; mk_unit_rvalue | SliceIndexShared | SliceIndexMut | ArrayIndexShared | ArrayIndexMut | ArrayToSliceShared | ArrayToSliceMut @@ -1772,7 +1772,7 @@ let unfold_monadic_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = (* TODO: this information should be computed in SymbolicToPure and * store in an enum ("monadic" should be an enum, not a bool). *) let re_ty = Option.get (opt_destruct_result def.meta re.ty) in - sanity_check (lv.ty = re_ty) def.meta; + sanity_check __FILE__ __LINE__ (lv.ty = re_ty) def.meta; let err_vid = fresh_id () in let err_var : var = { @@ -2025,7 +2025,7 @@ let filter_loop_inputs (ctx : trans_ctx) (transl : pure_fun_translation list) : ^ String.concat ", " (List.map (var_to_string ctx) inputs_prefix) ^ "\n")); let inputs_set = VarId.Set.of_list (List.map var_get_id inputs_prefix) in - sanity_check (Option.is_some decl.loop_id) decl.meta; + sanity_check __FILE__ __LINE__ (Option.is_some decl.loop_id) decl.meta; let fun_id = (E.FRegular decl.def_id, decl.loop_id) in @@ -2177,7 +2177,7 @@ let filter_loop_inputs (ctx : trans_ctx) (transl : pure_fun_translation list) : in let fwd_info = { fwd_info; effect_info; ignore_output } in - sanity_check (fun_sig_info_is_wf fwd_info) decl.meta; + sanity_check __FILE__ __LINE__ (fun_sig_info_is_wf fwd_info) decl.meta; let signature = { generics; diff --git a/compiler/PureTypeCheck.ml b/compiler/PureTypeCheck.ml index 7576af90..9e144c50 100644 --- a/compiler/PureTypeCheck.ml +++ b/compiler/PureTypeCheck.ml @@ -15,9 +15,9 @@ let get_adt_field_types (meta : Meta.meta) match type_id with | TTuple -> (* Tuple *) - sanity_check (generics.const_generics = []) meta; - sanity_check (generics.trait_refs = []) meta; - sanity_check (variant_id = None) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; + sanity_check __FILE__ __LINE__ (generics.trait_refs = []) meta; + sanity_check __FILE__ __LINE__ (variant_id = None) meta; generics.types | TAdtId def_id -> (* "Regular" ADT *) @@ -28,17 +28,17 @@ let get_adt_field_types (meta : Meta.meta) match aty with | TState -> (* This type is opaque *) - craise meta "Unreachable: opaque type" + craise __FILE__ __LINE__ meta "Unreachable: opaque type" | TResult -> let ty = Collections.List.to_cons_nil generics.types in let variant_id = Option.get variant_id in if variant_id = result_return_id then [ ty ] else if variant_id = result_fail_id then [ mk_error_ty ] - else craise meta "Unreachable: improper variant id for result type" + else craise __FILE__ __LINE__ meta "Unreachable: improper variant id for result type" | TError -> - sanity_check (generics = empty_generic_args) meta; + sanity_check __FILE__ __LINE__ (generics = empty_generic_args) meta; let variant_id = Option.get variant_id in - sanity_check + sanity_check __FILE__ __LINE__ (variant_id = error_failure_id || variant_id = error_out_of_fuel_id) meta; [] @@ -46,11 +46,11 @@ let get_adt_field_types (meta : Meta.meta) let variant_id = Option.get variant_id in if variant_id = fuel_zero_id then [] else if variant_id = fuel_succ_id then [ mk_fuel_ty ] - else craise meta "Unreachable: improper variant id for fuel type" + else craise __FILE__ __LINE__ meta "Unreachable: improper variant id for fuel type" | TArray | TSlice | TStr | TRawPtr _ -> (* Array: when not symbolic values (for instance, because of aggregates), the array expressions are introduced as struct updates *) - craise meta "Attempting to access the fields of an opaque type") + craise __FILE__ __LINE__ meta "Attempting to access the fields of an opaque type") type tc_ctx = { type_decls : type_decl TypeDeclId.Map.t; (** The type declarations *) @@ -64,9 +64,9 @@ type tc_ctx = { let check_literal (meta : Meta.meta) (v : literal) (ty : literal_type) : unit = match (ty, v) with - | TInteger int_ty, VScalar sv -> sanity_check (int_ty = sv.int_ty) meta + | TInteger int_ty, VScalar sv -> sanity_check __FILE__ __LINE__ (int_ty = sv.int_ty) meta | TBool, VBool _ | TChar, VChar _ -> () - | _ -> craise meta "Inconsistent type" + | _ -> craise __FILE__ __LINE__ meta "Inconsistent type" let rec check_typed_pattern (meta : Meta.meta) (ctx : tc_ctx) (v : typed_pattern) : tc_ctx = @@ -77,7 +77,7 @@ let rec check_typed_pattern (meta : Meta.meta) (ctx : tc_ctx) ctx | PatDummy -> ctx | PatVar (var, _) -> - sanity_check (var.ty = v.ty) meta; + sanity_check __FILE__ __LINE__ (var.ty = v.ty) meta; let env = VarId.Map.add var.id var.ty ctx.env in { ctx with env } | PatAdt av -> @@ -92,7 +92,7 @@ let rec check_typed_pattern (meta : Meta.meta) (ctx : tc_ctx) log#serror ("check_typed_pattern: not the same types:" ^ "\n- ty: " ^ show_ty ty ^ "\n- v.ty: " ^ show_ty v.ty); - craise meta "Inconsistent types"); + craise __FILE__ __LINE__ meta "Inconsistent types"); check_typed_pattern meta ctx v in (* Check the field types: check that the field patterns have the expected @@ -112,21 +112,21 @@ let rec check_texpression (meta : Meta.meta) (ctx : tc_ctx) (e : texpression) : * we use a locally nameless representation *) match VarId.Map.find_opt var_id ctx.env with | None -> () - | Some ty -> sanity_check (ty = e.ty) meta) + | Some ty -> sanity_check __FILE__ __LINE__ (ty = e.ty) meta) | CVar cg_id -> let ty = T.ConstGenericVarId.Map.find cg_id ctx.const_generics in - sanity_check (ty = e.ty) meta + sanity_check __FILE__ __LINE__ (ty = e.ty) meta | Const cv -> check_literal meta cv (ty_as_literal meta e.ty) | App (app, arg) -> let input_ty, output_ty = destruct_arrow meta app.ty in - sanity_check (input_ty = arg.ty) meta; - sanity_check (output_ty = e.ty) meta; + sanity_check __FILE__ __LINE__ (input_ty = arg.ty) meta; + sanity_check __FILE__ __LINE__ (output_ty = e.ty) meta; check_texpression meta ctx app; check_texpression meta ctx arg | Lambda (pat, body) -> let pat_ty, body_ty = destruct_arrow meta e.ty in - sanity_check (pat.ty = pat_ty) meta; - sanity_check (body.ty = body_ty) meta; + sanity_check __FILE__ __LINE__ (pat.ty = pat_ty) meta; + sanity_check __FILE__ __LINE__ (body.ty = body_ty) meta; (* Check the pattern and register the introduced variables at the same time *) let ctx = check_typed_pattern meta ctx pat in check_texpression meta ctx body @@ -141,8 +141,8 @@ let rec check_texpression (meta : Meta.meta) (ctx : tc_ctx) (e : texpression) : let adt_ty, field_ty = destruct_arrow meta e.ty in let adt_id, adt_generics = ty_as_adt meta adt_ty in (* Check the ADT type *) - sanity_check (adt_id = proj_adt_id) meta; - sanity_check (adt_generics = qualif.generics) meta; + sanity_check __FILE__ __LINE__ (adt_id = proj_adt_id) meta; + sanity_check __FILE__ __LINE__ (adt_generics = qualif.generics) meta; (* Retrieve and check the expected field type *) let variant_id = None in let expected_field_tys = @@ -150,25 +150,25 @@ let rec check_texpression (meta : Meta.meta) (ctx : tc_ctx) (e : texpression) : qualif.generics in let expected_field_ty = FieldId.nth expected_field_tys field_id in - sanity_check (expected_field_ty = field_ty) meta + sanity_check __FILE__ __LINE__ (expected_field_ty = field_ty) meta | AdtCons id -> ( let expected_field_tys = get_adt_field_types meta ctx.type_decls id.adt_id id.variant_id qualif.generics in let field_tys, adt_ty = destruct_arrows e.ty in - sanity_check (expected_field_tys = field_tys) meta; + sanity_check __FILE__ __LINE__ (expected_field_tys = field_tys) meta; match adt_ty with | TAdt (type_id, generics) -> - sanity_check (type_id = id.adt_id) meta; - sanity_check (generics = qualif.generics) meta - | _ -> craise meta "Unreachable")) + sanity_check __FILE__ __LINE__ (type_id = id.adt_id) meta; + sanity_check __FILE__ __LINE__ (generics = qualif.generics) meta + | _ -> craise __FILE__ __LINE__ meta "Unreachable")) | Let (monadic, pat, re, e_next) -> let expected_pat_ty = if monadic then destruct_result meta re.ty else re.ty in - sanity_check (pat.ty = expected_pat_ty) meta; - sanity_check (e.ty = e_next.ty) meta; + sanity_check __FILE__ __LINE__ (pat.ty = expected_pat_ty) meta; + sanity_check __FILE__ __LINE__ (e.ty = e_next.ty) meta; (* Check the right-expression *) check_texpression meta ctx re; (* Check the pattern and register the introduced variables at the same time *) @@ -179,20 +179,20 @@ let rec check_texpression (meta : Meta.meta) (ctx : tc_ctx) (e : texpression) : check_texpression meta ctx scrut; match switch_body with | If (e_then, e_else) -> - sanity_check (scrut.ty = TLiteral TBool) meta; - sanity_check (e_then.ty = e.ty) meta; - sanity_check (e_else.ty = e.ty) meta; + sanity_check __FILE__ __LINE__ (scrut.ty = TLiteral TBool) meta; + sanity_check __FILE__ __LINE__ (e_then.ty = e.ty) meta; + sanity_check __FILE__ __LINE__ (e_else.ty = e.ty) meta; check_texpression meta ctx e_then; check_texpression meta ctx e_else | Match branches -> let check_branch (br : match_branch) : unit = - sanity_check (br.pat.ty = scrut.ty) meta; + sanity_check __FILE__ __LINE__ (br.pat.ty = scrut.ty) meta; let ctx = check_typed_pattern meta ctx br.pat in check_texpression meta ctx br.branch in List.iter check_branch branches) | Loop loop -> - sanity_check (loop.fun_end.ty = e.ty) meta; + sanity_check __FILE__ __LINE__ (loop.fun_end.ty = e.ty) meta; check_texpression meta ctx loop.fun_end; check_texpression meta ctx loop.loop_body | StructUpdate supd -> ( @@ -200,11 +200,11 @@ let rec check_texpression (meta : Meta.meta) (ctx : tc_ctx) (e : texpression) : (if Option.is_some supd.init then match VarId.Map.find_opt (Option.get supd.init) ctx.env with | None -> () - | Some ty -> sanity_check (ty = e.ty) meta); + | Some ty -> sanity_check __FILE__ __LINE__ (ty = e.ty) meta); (* Check the fields *) (* Retrieve and check the expected field type *) let adt_id, adt_generics = ty_as_adt meta e.ty in - sanity_check (adt_id = supd.struct_id) meta; + sanity_check __FILE__ __LINE__ (adt_id = supd.struct_id) meta; (* The id can only be: a custom type decl or an array *) match adt_id with | TAdtId _ -> @@ -216,7 +216,7 @@ let rec check_texpression (meta : Meta.meta) (ctx : tc_ctx) (e : texpression) : List.iter (fun ((fid, fe) : _ * texpression) -> let expected_field_ty = FieldId.nth expected_field_tys fid in - sanity_check (expected_field_ty = fe.ty) meta; + sanity_check __FILE__ __LINE__ (expected_field_ty = fe.ty) meta; check_texpression meta ctx fe) supd.updates | TAssumed TArray -> @@ -225,10 +225,10 @@ let rec check_texpression (meta : Meta.meta) (ctx : tc_ctx) (e : texpression) : in List.iter (fun ((_, fe) : _ * texpression) -> - sanity_check (expected_field_ty = fe.ty) meta; + sanity_check __FILE__ __LINE__ (expected_field_ty = fe.ty) meta; check_texpression meta ctx fe) supd.updates - | _ -> craise meta "Unexpected") + | _ -> craise __FILE__ __LINE__ meta "Unexpected") | Meta (_, e_next) -> - sanity_check (e_next.ty = e.ty) meta; + sanity_check __FILE__ __LINE__ (e_next.ty = e.ty) meta; check_texpression meta ctx e_next diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index 328f757a..215bebe3 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -78,7 +78,7 @@ let fun_sig_info_is_wf (info : fun_sig_info) : bool = let dest_arrow_ty (meta : Meta.meta) (ty : ty) : ty * ty = match ty with | TArrow (arg_ty, ret_ty) -> (arg_ty, ret_ty) - | _ -> craise meta "Not an arrow type" + | _ -> craise __FILE__ __LINE__ meta "Not an arrow type" let compute_literal_type (cv : literal) : literal_type = match cv with @@ -227,7 +227,7 @@ let rec let_group_requires_parentheses (meta : Meta.meta) (e : texpression) : true | Loop _ -> (* Should have been eliminated *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" let texpression_requires_parentheses meta e = match !Config.backend with @@ -238,7 +238,7 @@ let is_var (e : texpression) : bool = match e.e with Var _ -> true | _ -> false let as_var (meta : Meta.meta) (e : texpression) : VarId.id = - match e.e with Var v -> v | _ -> craise meta "Not a var" + match e.e with Var v -> v | _ -> craise __FILE__ __LINE__ meta "Not a var" let is_cvar (e : texpression) : bool = match e.e with CVar _ -> true | _ -> false @@ -252,7 +252,7 @@ let is_const (e : texpression) : bool = let ty_as_adt (meta : Meta.meta) (ty : ty) : type_id * generic_args = match ty with | TAdt (id, generics) -> (id, generics) - | _ -> craise meta "Not an ADT" + | _ -> craise __FILE__ __LINE__ meta "Not an ADT" (** Remove the external occurrences of {!Meta} *) let rec unmeta (e : texpression) : texpression = @@ -295,7 +295,7 @@ let destruct_lets_no_interleave (meta : Meta.meta) (e : texpression) : let m = match e.e with | Let (monadic, _, _, _) -> monadic - | _ -> craise meta "Not a let-binding" + | _ -> craise __FILE__ __LINE__ meta "Not a let-binding" in (* Destruct the rest *) let rec destruct_lets (e : texpression) : @@ -325,7 +325,7 @@ let destruct_apps (e : texpression) : texpression * texpression list = let mk_app (meta : Meta.meta) (app : texpression) (arg : texpression) : texpression = let raise_or_return msg = - save_error (Some meta) msg; + save_error __FILE__ __LINE__ (Some meta) msg; let e = App (app, arg) in (* Dummy type - TODO: introduce an error type *) let ty = app.ty in @@ -373,8 +373,8 @@ let opt_destruct_function_call (e : texpression) : let opt_destruct_result (meta : Meta.meta) (ty : ty) : ty option = match ty with | TAdt (TAssumed TResult, generics) -> - sanity_check (generics.const_generics = []) meta; - sanity_check (generics.trait_refs = []) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; + sanity_check __FILE__ __LINE__ (generics.trait_refs = []) meta; Some (Collections.List.to_cons_nil generics.types) | _ -> None @@ -384,15 +384,15 @@ let destruct_result (meta : Meta.meta) (ty : ty) : ty = let opt_destruct_tuple (meta : Meta.meta) (ty : ty) : ty list option = match ty with | TAdt (TTuple, generics) -> - sanity_check (generics.const_generics = []) meta; - sanity_check (generics.trait_refs = []) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; + sanity_check __FILE__ __LINE__ (generics.trait_refs = []) meta; Some generics.types | _ -> None let destruct_arrow (meta : Meta.meta) (ty : ty) : ty * ty = match ty with | TArrow (ty0, ty1) -> (ty0, ty1) - | _ -> craise meta "Not an arrow type" + | _ -> craise __FILE__ __LINE__ meta "Not an arrow type" let rec destruct_arrows (ty : ty) : ty list * ty = match ty with @@ -430,14 +430,14 @@ let mk_switch (meta : Meta.meta) (scrut : texpression) (sb : switch_body) : texpression = (* Sanity check: the scrutinee has the proper type *) (match sb with - | If (_, _) -> sanity_check (scrut.ty = TLiteral TBool) meta + | If (_, _) -> sanity_check __FILE__ __LINE__ (scrut.ty = TLiteral TBool) meta | Match branches -> List.iter - (fun (b : match_branch) -> sanity_check (b.pat.ty = scrut.ty) meta) + (fun (b : match_branch) -> sanity_check __FILE__ __LINE__ (b.pat.ty = scrut.ty) meta) branches); (* Sanity check: all the branches have the same type *) let ty = get_switch_body_ty sb in - iter_switch_body_branches (fun e -> sanity_check (e.ty = ty) meta) sb; + iter_switch_body_branches (fun e -> sanity_check __FILE__ __LINE__ (e.ty = ty) meta) sb; (* Put together *) let e = Switch (scrut, sb) in { e; ty } @@ -526,10 +526,10 @@ let mk_adt_pattern (adt_ty : ty) (variant_id : VariantId.id option) let ty_as_integer (meta : Meta.meta) (t : ty) : T.integer_type = match t with | TLiteral (TInteger int_ty) -> int_ty - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" let ty_as_literal (meta : Meta.meta) (t : ty) : T.literal_type = - match t with TLiteral ty -> ty | _ -> craise meta "Unreachable" + match t with TLiteral ty -> ty | _ -> craise __FILE__ __LINE__ meta "Unreachable" let mk_state_ty : ty = TAdt (TAssumed TState, empty_generic_args) @@ -552,7 +552,7 @@ let unwrap_result_ty (meta : Meta.meta) (ty : ty) : ty = ( TAssumed TResult, { types = [ ty ]; const_generics = []; trait_refs = [] } ) -> ty - | _ -> craise meta "not a result type" + | _ -> craise __FILE__ __LINE__ meta "not a result type" let mk_result_fail_texpression (meta : Meta.meta) (error : texpression) (ty : ty) : texpression = diff --git a/compiler/RegionsHierarchy.ml b/compiler/RegionsHierarchy.ml index 7267dd3d..713cdef9 100644 --- a/compiler/RegionsHierarchy.ml +++ b/compiler/RegionsHierarchy.ml @@ -108,8 +108,8 @@ let compute_regions_hierarchy_for_sig (meta : Meta.meta option) let add_edge ~(short : region) ~(long : region) = (* Sanity checks *) - sanity_check_opt_meta (short <> RErased) meta; - sanity_check_opt_meta (long <> RErased) meta; + sanity_check_opt_meta __FILE__ __LINE__ (short <> RErased) meta; + sanity_check_opt_meta __FILE__ __LINE__ (long <> RErased) meta; (* Ignore the locally bound regions (at the level of arrow types for instance *) match (short, long) with | RBVar _, _ | _, RBVar _ -> () @@ -175,14 +175,14 @@ let compute_regions_hierarchy_for_sig (meta : Meta.meta option) | TTraitType (trait_ref, _) -> (* The trait should reference a clause, and not an implementation (otherwise it should have been normalized) *) - sanity_check_opt_meta + sanity_check_opt_meta __FILE__ __LINE__ (AssociatedTypes.trait_instance_id_is_local_clause trait_ref.trait_id) meta; (* We have nothing to do *) () | TArrow (regions, inputs, output) -> (* TODO: *) - cassert_opt_meta (regions = []) meta + cassert_opt_meta __FILE__ __LINE__ (regions = []) meta "We don't support arrow types with locally quantified regions"; (* We can ignore the outer regions *) List.iter (explore_ty []) (output :: inputs) @@ -226,7 +226,7 @@ let compute_regions_hierarchy_for_sig (meta : Meta.meta option) (SccId.Map.bindings sccs.sccs) in (* The SCC should only contain the 'static *) - sanity_check_opt_meta (static_scc = [ RStatic ]) meta; + sanity_check_opt_meta __FILE__ __LINE__ (static_scc = [ RStatic ]) meta; (* Remove the group as well as references to this group from the other SCCs *) let { sccs; scc_deps } = sccs in @@ -282,7 +282,7 @@ let compute_regions_hierarchy_for_sig (meta : Meta.meta option) (fun r -> match r with | RFVar rid -> RegionId.Map.find rid region_id_to_var_map - | _ -> craise (Option.get meta) "Unreachable") + | _ -> craise __FILE__ __LINE__ (Option.get meta) "Unreachable") scc in diff --git a/compiler/Substitute.ml b/compiler/Substitute.ml index 182dfabf..b9eebc25 100644 --- a/compiler/Substitute.ml +++ b/compiler/Substitute.ml @@ -76,19 +76,19 @@ let ctx_adt_value_get_instantiated_field_types (meta : Meta.meta) (* Retrieve the types of the fields *) ctx_adt_get_instantiated_field_types ctx id adt.variant_id generics | TTuple -> - cassert (generics.regions = []) meta + cassert __FILE__ __LINE__ (generics.regions = []) meta "Regions should be empty TODO: error message"; generics.types | TAssumed aty -> ( match aty with | TBox -> - sanity_check (generics.regions = []) meta; - sanity_check (List.length generics.types = 1) meta; - sanity_check (generics.const_generics = []) meta; + sanity_check __FILE__ __LINE__ (generics.regions = []) meta; + sanity_check __FILE__ __LINE__ (List.length generics.types = 1) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; generics.types | TArray | TSlice | TStr -> (* Those types don't have fields *) - craise meta "Unreachable") + craise __FILE__ __LINE__ meta "Unreachable") (** Substitute a function signature, together with the regions hierarchy associated to that signature. @@ -153,7 +153,7 @@ let typed_value_subst_ids (meta : Meta.meta) (cg_subst : ConstGenericVarId.id -> ConstGenericVarId.id) (ssubst : SymbolicValueId.id -> SymbolicValueId.id) (bsubst : BorrowId.id -> BorrowId.id) (v : typed_value) : typed_value = - let asubst _ = craise meta "Unreachable" in + let asubst _ = craise __FILE__ __LINE__ meta "Unreachable" in let vis = subst_ids_visitor r_subst ty_subst cg_subst ssubst bsubst asubst in vis#visit_typed_value () v @@ -172,7 +172,7 @@ let typed_avalue_subst_ids (meta : Meta.meta) (cg_subst : ConstGenericVarId.id -> ConstGenericVarId.id) (ssubst : SymbolicValueId.id -> SymbolicValueId.id) (bsubst : BorrowId.id -> BorrowId.id) (v : typed_avalue) : typed_avalue = - let asubst _ = craise meta "Unreachable" in + let asubst _ = craise __FILE__ __LINE__ meta "Unreachable" in let vis = subst_ids_visitor r_subst ty_subst cg_subst ssubst bsubst asubst in vis#visit_typed_avalue () v @@ -196,7 +196,7 @@ let env_subst_ids (r_subst : RegionId.id -> RegionId.id) let typed_avalue_subst_rids (meta : Meta.meta) (r_subst : RegionId.id -> RegionId.id) (x : typed_avalue) : typed_avalue = - let asubst _ = craise meta "Unreachable" in + let asubst _ = craise __FILE__ __LINE__ meta "Unreachable" in let vis = subst_ids_visitor r_subst (fun x -> x) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index db32c2ce..031c29f7 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -436,7 +436,7 @@ and translate_trait_instance_id (meta : Meta.meta) (translate_ty : T.ty -> ty) | TraitImpl id -> TraitImpl id | BuiltinOrAuto _ -> (* We should have eliminated those in the prepasses *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" | Clause id -> Clause id | ParentClause (inst_id, decl_id, clause_id) -> let inst_id = translate_trait_instance_id inst_id in @@ -445,8 +445,8 @@ and translate_trait_instance_id (meta : Meta.meta) (translate_ty : T.ty -> ty) let inst_id = translate_trait_instance_id inst_id in ItemClause (inst_id, decl_id, item_name, clause_id) | TraitRef tr -> TraitRef (translate_trait_ref meta translate_ty tr) - | FnPointer _ | Closure _ -> craise meta "Closures are not supported yet" - | UnknownTrait s -> craise meta ("Unknown trait found: " ^ s) + | FnPointer _ | Closure _ -> craise __FILE__ __LINE__ meta "Closures are not supported yet" + | UnknownTrait s -> craise __FILE__ __LINE__ meta ("Unknown trait found: " ^ s) (** Translate a signature type - TODO: factor out the different translation functions *) let rec translate_sty (meta : Meta.meta) (ty : T.ty) : ty = @@ -457,7 +457,7 @@ let rec translate_sty (meta : Meta.meta) (ty : T.ty) : ty = match type_id with | T.TAdtId adt_id -> TAdt (TAdtId adt_id, generics) | T.TTuple -> - cassert (generics.const_generics = []) meta "TODO: error message"; + cassert __FILE__ __LINE__ (generics.const_generics = []) meta "TODO: error message"; mk_simpl_tuple_ty generics.types | T.TAssumed aty -> ( match aty with @@ -466,14 +466,14 @@ let rec translate_sty (meta : Meta.meta) (ty : T.ty) : ty = match generics.types with | [ ty ] -> ty | _ -> - craise meta + craise __FILE__ __LINE__ meta "Box/vec/option type with incorrect number of arguments") | T.TArray -> TAdt (TAssumed TArray, generics) | T.TSlice -> TAdt (TAssumed TSlice, generics) | T.TStr -> TAdt (TAssumed TStr, generics))) | TVar vid -> TVar vid | TLiteral ty -> TLiteral ty - | TNever -> craise meta "Unreachable" + | TNever -> craise __FILE__ __LINE__ meta "Unreachable" | TRef (_, rty, _) -> translate meta rty | TRawPtr (ty, rkind) -> let mut = match rkind with RMut -> Mut | RShared -> Const in @@ -483,7 +483,7 @@ let rec translate_sty (meta : Meta.meta) (ty : T.ty) : ty = | TTraitType (trait_ref, type_name) -> let trait_ref = translate_strait_ref meta trait_ref in TTraitType (trait_ref, type_name) - | TArrow _ -> craise meta "TODO: error message" + | TArrow _ -> craise __FILE__ __LINE__ meta "TODO: error message" and translate_sgeneric_args (meta : Meta.meta) (generics : T.generic_args) : generic_args = @@ -567,7 +567,7 @@ let translate_type_decl (ctx : Contexts.decls_ctx) (def : T.type_decl) : let name = Print.Types.name_to_string env def.name in let { T.regions; types; const_generics; trait_clauses } = def.generics in (* Can't translate types with regions for now *) - cassert (regions = []) def.meta + cassert __FILE__ __LINE__ (regions = []) def.meta "ADTs containing borrows are not supported yet"; let trait_clauses = List.map (translate_trait_clause def.meta) trait_clauses @@ -601,7 +601,7 @@ let translate_type_id (meta : Meta.meta) (id : T.type_id) : type_id = | T.TBox -> (* Boxes have to be eliminated: this type id shouldn't be translated *) - craise meta "Unreachable" + craise __FILE__ __LINE__ meta "Unreachable" in TAssumed aty | TTuple -> TTuple @@ -632,7 +632,7 @@ let rec translate_fwd_ty (meta : Meta.meta) (type_infos : type_infos) | TAssumed TBox -> ( (* We eliminate boxes *) (* No general parametricity for now *) - cassert + cassert __FILE__ __LINE__ (not (List.exists (TypesUtils.ty_has_borrows type_infos) @@ -641,11 +641,11 @@ let rec translate_fwd_ty (meta : Meta.meta) (type_infos : type_infos) match t_generics.types with | [ bty ] -> bty | _ -> - craise meta + craise __FILE__ __LINE__ meta "Unreachable: box/vec/option receives exactly one type \ parameter")) | TVar vid -> TVar vid - | TNever -> craise meta "Unreachable" + | TNever -> craise __FILE__ __LINE__ meta "Unreachable" | TLiteral lty -> TLiteral lty | TRef (_, rty, _) -> translate rty | TRawPtr (ty, rkind) -> @@ -656,7 +656,7 @@ let rec translate_fwd_ty (meta : Meta.meta) (type_infos : type_infos) | TTraitType (trait_ref, type_name) -> let trait_ref = translate_fwd_trait_ref meta type_infos trait_ref in TTraitType (trait_ref, type_name) - | TArrow _ -> craise meta "TODO: error message" + | TArrow _ -> craise __FILE__ __LINE__ meta "TODO: error message" and translate_fwd_generic_args (meta : Meta.meta) (type_infos : type_infos) (generics : T.generic_args) : generic_args = @@ -721,14 +721,14 @@ let rec translate_back_ty (meta : Meta.meta) (type_infos : type_infos) else None | TAssumed TBox -> ( (* Don't accept ADTs (which are not tuples) with borrows for now *) - cassert + cassert __FILE__ __LINE__ (not (TypesUtils.ty_has_borrows type_infos ty)) meta "ADTs containing borrows are not supported yet"; (* Eliminate the box *) match generics.types with | [ bty ] -> translate bty | _ -> - craise meta + craise __FILE__ __LINE__ meta "Unreachable: boxes receive exactly one type parameter") | TTuple -> ( (* Tuples can contain borrows (which we eliminate) *) @@ -740,7 +740,7 @@ let rec translate_back_ty (meta : Meta.meta) (type_infos : type_infos) * is the identity *) Some (mk_simpl_tuple_ty tys_t))) | TVar vid -> wrap (TVar vid) - | TNever -> craise meta "Unreachable" + | TNever -> craise __FILE__ __LINE__ meta "Unreachable" | TLiteral lty -> wrap (TLiteral lty) | TRef (r, rty, rkind) -> ( match rkind with @@ -765,7 +765,7 @@ let rec translate_back_ty (meta : Meta.meta) (type_infos : type_infos) let trait_ref = translate_fwd_trait_ref meta type_infos trait_ref in Some (TTraitType (trait_ref, type_name)) else None - | TArrow _ -> craise meta "TODO: error message" + | TArrow _ -> craise __FILE__ __LINE__ meta "TODO: error message" (** Simply calls [translate_back_ty] *) let ctx_translate_back_ty (ctx : bs_ctx) (keep_region : 'r -> bool) @@ -817,7 +817,7 @@ let bs_ctx_register_forward_call (call_id : V.FunCallId.id) (forward : S.call) (back_funs : texpression option RegionGroupId.Map.t option) (ctx : bs_ctx) : bs_ctx = let calls = ctx.calls in - sanity_check (not (V.FunCallId.Map.mem call_id calls)) ctx.fun_decl.meta; + sanity_check __FILE__ __LINE__ (not (V.FunCallId.Map.mem call_id calls)) ctx.fun_decl.meta; let info = { forward; forward_inputs = args; back_funs } in let calls = V.FunCallId.Map.add call_id info calls in { ctx with calls } @@ -839,7 +839,7 @@ let bs_ctx_register_backward_call (abs : V.abs) (call_id : V.FunCallId.id) let calls = V.FunCallId.Map.add call_id info ctx.calls in (* Insert the abstraction in the abstractions map *) let abstractions = ctx.abstractions in - sanity_check + sanity_check __FILE__ __LINE__ (not (V.AbstractionId.Map.mem abs.abs_id abstractions)) ctx.fun_decl.meta; let abstractions = @@ -922,7 +922,7 @@ let compute_raw_fun_effect_info (meta : Meta.meta) is_rec = info.is_rec || Option.is_some lid; } | FunId (FAssumed aid) -> - sanity_check (lid = None) meta; + sanity_check __FILE__ __LINE__ (lid = None) meta; { can_fail = Assumed.assumed_fun_can_fail aid; stateful_group = false; @@ -953,14 +953,14 @@ let get_fun_effect_info (ctx : bs_ctx) (fun_id : A.fun_id_or_trait_method_ref) (* This is necessarily for the current function *) match fun_id with | FunId (FRegular fid) -> ( - sanity_check (fid = ctx.fun_decl.def_id) ctx.fun_decl.meta; + sanity_check __FILE__ __LINE__ (fid = ctx.fun_decl.def_id) ctx.fun_decl.meta; (* Lookup the loop *) let lid = V.LoopId.Map.find lid ctx.loop_ids_map in let loop_info = LoopId.Map.find lid ctx.loops in match gid with | None -> loop_info.fwd_effect_info | Some gid -> RegionGroupId.Map.find gid loop_info.back_effect_infos) - | _ -> craise ctx.fun_decl.meta "Unreachable") + | _ -> craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable") (** Translate a function signature to a decomposed function signature. @@ -1047,8 +1047,8 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed (meta : Meta.meta) let keep_region r = match r with | T.RStatic -> raise Unimplemented - | RErased -> craise meta "Unexpected erased region" - | RBVar _ -> craise meta "Unexpected bound region" + | RErased -> craise __FILE__ __LINE__ meta "Unexpected erased region" + | RBVar _ -> craise __FILE__ __LINE__ meta "Unexpected bound region" | RFVar rid -> T.RegionId.Set.mem rid gr_regions in let inside_mut = false in @@ -1058,7 +1058,7 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed (meta : Meta.meta) (* For now we don't supported nested borrows, so we check that there aren't parent regions *) let parents = list_ancestor_region_groups regions_hierarchy gid in - cassert + cassert __FILE__ __LINE__ (T.RegionGroupId.Set.is_empty parents) meta "Nested borrows are not supported yet"; (* For now, we don't allow nested borrows, so the additional inputs to the @@ -1217,7 +1217,7 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed (meta : Meta.meta) else false in let info = { fwd_info; effect_info = fwd_effect_info; ignore_output } in - sanity_check (fun_sig_info_is_wf info) meta; + sanity_check __FILE__ __LINE__ (fun_sig_info_is_wf info) meta; info in @@ -1506,7 +1506,7 @@ let lookup_var_for_symbolic_value (sv : V.symbolic_value) (ctx : bs_ctx) : var = match V.SymbolicValueId.Map.find_opt sv.sv_id ctx.sv_to_var with | Some v -> v | None -> - craise ctx.fun_decl.meta + craise __FILE__ __LINE__ ctx.fun_decl.meta ("Could not find var for symbolic value: " ^ V.SymbolicValueId.to_string sv.sv_id) @@ -1517,7 +1517,7 @@ let rec unbox_typed_value (meta : Meta.meta) (v : V.typed_value) : V.typed_value | V.VAdt av, T.TAdt (T.TAssumed T.TBox, _) -> ( match av.field_values with | [ bv ] -> unbox_typed_value meta bv - | _ -> craise meta "Unreachable") + | _ -> craise __FILE__ __LINE__ meta "Unreachable") | _ -> v (** Translate a symbolic value. @@ -1570,7 +1570,7 @@ let rec typed_value_to_texpression (ctx : bs_ctx) (ectx : C.eval_ctx) (* Eliminate the tuple wrapper if it is a tuple with exactly one field *) match v.ty with | TAdt (TTuple, _) -> - sanity_check (variant_id = None) ctx.fun_decl.meta; + sanity_check __FILE__ __LINE__ (variant_id = None) ctx.fun_decl.meta; mk_simpl_tuple_texpression ctx.fun_decl.meta field_values | _ -> (* Retrieve the type and the translated generics from the translated @@ -1587,11 +1587,11 @@ let rec typed_value_to_texpression (ctx : bs_ctx) (ectx : C.eval_ctx) let cons = { e = cons_e; ty = cons_ty } in (* Apply the constructor *) mk_apps ctx.fun_decl.meta cons field_values) - | VBottom -> craise ctx.fun_decl.meta "Unreachable" + | VBottom -> craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" | VLoan lc -> ( match lc with | VSharedLoan (_, v) -> translate v - | VMutLoan _ -> craise ctx.fun_decl.meta "Unreachable") + | VMutLoan _ -> craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable") | VBorrow bc -> ( match bc with | VSharedBorrow bid -> @@ -1654,7 +1654,7 @@ let rec typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) let adt_id, _ = TypesUtils.ty_as_adt av.ty in match adt_id with | TAdtId _ | TAssumed (TBox | TArray | TSlice | TStr) -> - cassert (field_values = []) ctx.fun_decl.meta + cassert __FILE__ __LINE__ (field_values = []) ctx.fun_decl.meta "ADTs containing borrows are not supported yet"; None | TTuple -> @@ -1667,7 +1667,7 @@ let rec typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) mk_simpl_tuple_texpression ctx.fun_decl.meta field_values in Some rv) - | ABottom -> craise ctx.fun_decl.meta "Unreachable" + | ABottom -> craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" | ALoan lc -> aloan_content_to_consumed ctx ectx lc | ABorrow bc -> aborrow_content_to_consumed ctx bc | ASymbolic aproj -> aproj_to_consumed ctx aproj @@ -1685,7 +1685,7 @@ and aloan_content_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) (lc : V.aloan_content) : texpression option = match lc with | AMutLoan (_, _) | ASharedLoan (_, _, _) -> - craise ctx.fun_decl.meta "Unreachable" + craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" | AEndedMutLoan { child = _; given_back = _; given_back_meta } -> (* Return the meta-value *) Some (typed_value_to_texpression ctx ectx given_back_meta) @@ -1697,7 +1697,7 @@ and aloan_content_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) None | AIgnoredMutLoan (_, _) -> (* There can be *inner* not ended mutable loans, but not outer ones *) - craise ctx.fun_decl.meta "Unreachable" + craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" | AEndedIgnoredMutLoan _ -> (* This happens with nested borrows: we need to dive in *) raise Unimplemented @@ -1709,7 +1709,7 @@ and aborrow_content_to_consumed (_ctx : bs_ctx) (bc : V.aborrow_content) : texpression option = match bc with | V.AMutBorrow (_, _) | ASharedBorrow _ | AIgnoredMutBorrow (_, _) -> - craise _ctx.fun_decl.meta "Unreachable" + craise __FILE__ __LINE__ _ctx.fun_decl.meta "Unreachable" | AEndedMutBorrow (_, _) -> (* We collect consumed values: ignore *) None @@ -1726,7 +1726,7 @@ and aproj_to_consumed (ctx : bs_ctx) (aproj : V.aproj) : texpression option = (* The symbolic value was left unchanged *) Some (symbolic_value_to_texpression ctx msv) | V.AEndedProjLoans (_, [ (mnv, child_aproj) ]) -> - sanity_check (child_aproj = AIgnoredProjBorrows) ctx.fun_decl.meta; + sanity_check __FILE__ __LINE__ (child_aproj = AIgnoredProjBorrows) ctx.fun_decl.meta; (* The symbolic value was updated *) Some (symbolic_value_to_texpression ctx mnv) | V.AEndedProjLoans (_, _) -> @@ -1735,7 +1735,7 @@ and aproj_to_consumed (ctx : bs_ctx) (aproj : V.aproj) : texpression option = raise Unimplemented | AEndedProjBorrows _ -> (* We consider consumed values *) None | AIgnoredProjBorrows | AProjLoans (_, _) | AProjBorrows (_, _) -> - craise ctx.fun_decl.meta "Unreachable" + craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" (** Convert the abstraction values in an abstraction to consumed values. @@ -1801,20 +1801,20 @@ let rec typed_avalue_to_given_back (mp : mplace option) (av : V.typed_avalue) let adt_id, _ = TypesUtils.ty_as_adt av.ty in match adt_id with | TAdtId _ | TAssumed (TBox | TArray | TSlice | TStr) -> - cassert (field_values = []) ctx.fun_decl.meta + cassert __FILE__ __LINE__ (field_values = []) ctx.fun_decl.meta "ADTs with borrows are not supported yet"; (ctx, None) | TTuple -> (* Return *) let variant_id = adt_v.variant_id in - sanity_check (variant_id = None) ctx.fun_decl.meta; + sanity_check __FILE__ __LINE__ (variant_id = None) ctx.fun_decl.meta; if field_values = [] then (ctx, None) else (* Note that if there is exactly one field value, [mk_simpl_tuple_pattern] * is the identity *) let lv = mk_simpl_tuple_pattern field_values in (ctx, Some lv)) - | ABottom -> craise ctx.fun_decl.meta "Unreachable" + | ABottom -> craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" | ALoan lc -> aloan_content_to_given_back mp lc ctx | ABorrow bc -> aborrow_content_to_given_back mp bc ctx | ASymbolic aproj -> aproj_to_given_back mp aproj ctx @@ -1830,14 +1830,14 @@ and aloan_content_to_given_back (_mp : mplace option) (lc : V.aloan_content) (ctx : bs_ctx) : bs_ctx * typed_pattern option = match lc with | AMutLoan (_, _) | ASharedLoan (_, _, _) -> - craise ctx.fun_decl.meta "Unreachable" + craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" | AEndedMutLoan { child = _; given_back = _; given_back_meta = _ } | AEndedSharedLoan (_, _) -> (* We consider given back values, and thus ignore those *) (ctx, None) | AIgnoredMutLoan (_, _) -> (* There can be *inner* not ended mutable loans, but not outer ones *) - craise ctx.fun_decl.meta "Unreachable" + craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" | AEndedIgnoredMutLoan _ -> (* This happens with nested borrows: we need to dive in *) raise Unimplemented @@ -1849,7 +1849,7 @@ and aborrow_content_to_given_back (mp : mplace option) (bc : V.aborrow_content) (ctx : bs_ctx) : bs_ctx * typed_pattern option = match bc with | V.AMutBorrow (_, _) | ASharedBorrow _ | AIgnoredMutBorrow (_, _) -> - craise ctx.fun_decl.meta "Unreachable" + craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" | AEndedMutBorrow (msv, _) -> (* Return the meta-symbolic-value *) let ctx, var = fresh_var_for_symbolic_value msv ctx in @@ -1867,7 +1867,7 @@ and aproj_to_given_back (mp : mplace option) (aproj : V.aproj) (ctx : bs_ctx) : | V.AEndedProjLoans (_, child_projs) -> (* There may be children borrow projections in case of nested borrows, * in which case we need to dive in - we disallow nested borrows for now *) - cassert + cassert __FILE__ __LINE__ (List.for_all (fun (_, aproj) -> aproj = V.AIgnoredProjBorrows) child_projs) @@ -1878,7 +1878,7 @@ and aproj_to_given_back (mp : mplace option) (aproj : V.aproj) (ctx : bs_ctx) : let ctx, var = fresh_var_for_symbolic_value mv ctx in (ctx, Some (mk_typed_pattern_from_var var mp)) | AIgnoredProjBorrows | AProjLoans (_, _) | AProjBorrows (_, _) -> - craise ctx.fun_decl.meta "Unreachable" + craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" (** Convert the abstraction values in an abstraction to given back values. @@ -2064,7 +2064,7 @@ and translate_return (ectx : C.eval_ctx) (opt_v : V.typed_value option) | Some _ -> (* Backward function *) (* Sanity check *) - sanity_check (opt_v = None) ctx.fun_decl.meta; + sanity_check __FILE__ __LINE__ (opt_v = None) ctx.fun_decl.meta; (* Group the variables in which we stored the values we need to give back. See the explanations for the [SynthInput] case in [translate_end_abstraction] *) let backward_outputs = Option.get ctx.backward_outputs in @@ -2087,9 +2087,9 @@ and translate_return (ectx : C.eval_ctx) (opt_v : V.typed_value option) and translate_return_with_loop (loop_id : V.LoopId.id) (is_continue : bool) (ctx : bs_ctx) : texpression = - sanity_check (is_continue = ctx.inside_loop) ctx.fun_decl.meta; + sanity_check __FILE__ __LINE__ (is_continue = ctx.inside_loop) ctx.fun_decl.meta; let loop_id = V.LoopId.Map.find loop_id ctx.loop_ids_map in - sanity_check (loop_id = Option.get ctx.loop_id) ctx.fun_decl.meta; + sanity_check __FILE__ __LINE__ (loop_id = Option.get ctx.loop_id) ctx.fun_decl.meta; (* Lookup the loop information *) let loop_id = Option.get ctx.loop_id in @@ -2229,7 +2229,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : | PeIdent (s, _) -> s | PeImpl _ -> (* We shouldn't get there *) - craise decl.meta "Unexpected") + craise __FILE__ __LINE__ decl.meta "Unexpected") in name ^ "_back" in @@ -2333,7 +2333,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let ctx, dest = fresh_var_for_symbolic_value call.dest ctx in let dest = mk_typed_pattern_from_var dest dest_mplace in (ctx, Unop (Neg int_ty), effect_info, args, dest) - | _ -> craise ctx.fun_decl.meta "Unreachable") + | _ -> craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable") | S.Unop (E.Cast cast_kind) -> ( match cast_kind with | CastScalar (src_ty, tgt_ty) -> @@ -2350,7 +2350,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let ctx, dest = fresh_var_for_symbolic_value call.dest ctx in let dest = mk_typed_pattern_from_var dest dest_mplace in (ctx, Unop (Cast (src_ty, tgt_ty)), effect_info, args, dest) - | CastFnPtr _ -> craise ctx.fun_decl.meta "TODO: function casts") + | CastFnPtr _ -> craise __FILE__ __LINE__ ctx.fun_decl.meta "TODO: function casts") | S.Binop binop -> ( match args with | [ arg0; arg1 ] -> @@ -2359,7 +2359,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : (match binop with (* The Rust compiler accepts bitshifts for any integer type combination for ty0, ty1 *) | E.Shl | E.Shr -> () - | _ -> sanity_check (int_ty0 = int_ty1) ctx.fun_decl.meta); + | _ -> sanity_check __FILE__ __LINE__ (int_ty0 = int_ty1) ctx.fun_decl.meta); let effect_info = { can_fail = ExpressionsUtils.binop_can_fail binop; @@ -2372,7 +2372,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let ctx, dest = fresh_var_for_symbolic_value call.dest ctx in let dest = mk_typed_pattern_from_var dest dest_mplace in (ctx, Binop (binop, int_ty0), effect_info, args, dest) - | _ -> craise ctx.fun_decl.meta "Unreachable") + | _ -> craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable") in let func = { id = FunOrOp fun_id; generics } in let input_tys = (List.map (fun (x : texpression) -> x.ty)) args in @@ -2429,7 +2429,7 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) for a parent backward function. *) let bid = Option.get ctx.bid in - sanity_check (rg_id = bid) ctx.fun_decl.meta; + sanity_check __FILE__ __LINE__ (rg_id = bid) ctx.fun_decl.meta; (* First, introduce the given back variables. @@ -2477,7 +2477,7 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) if !Config.type_check_pure_code then List.iter (fun (var, v) -> - sanity_check ((var : var).ty = (v : texpression).ty) ctx.fun_decl.meta) + sanity_check __FILE__ __LINE__ ((var : var).ty = (v : texpression).ty) ctx.fun_decl.meta) variables_values; (* Translate the next expression *) let next_e = translate_expression e ctx in @@ -2498,7 +2498,7 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) | S.Fun (fun_id, _) -> fun_id | Unop _ | Binop _ -> (* Those don't have backward functions *) - craise ctx.fun_decl.meta "Unreachable" + craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" in let effect_info = get_fun_effect_info ctx fun_id None (Some rg_id) in (* Retrieve the values consumed upon ending the loans inside this @@ -2571,8 +2571,8 @@ and translate_end_abstraction_identity (ectx : C.eval_ctx) (abs : V.abs) (* We can do this simply by checking that it consumes and gives back nothing *) let inputs = abs_to_consumed ctx ectx abs in let ctx, outputs = abs_to_given_back None abs ctx in - sanity_check (inputs = []) ctx.fun_decl.meta; - sanity_check (outputs = []) ctx.fun_decl.meta; + sanity_check __FILE__ __LINE__ (inputs = []) ctx.fun_decl.meta; + sanity_check __FILE__ __LINE__ (outputs = []) ctx.fun_decl.meta; (* Translate the next expression *) translate_expression e ctx @@ -2614,7 +2614,7 @@ and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs) (* Retrieve the values consumed upon ending the loans inside this * abstraction: as there are no nested borrows, there should be none. *) let consumed = abs_to_consumed ctx ectx abs in - cassert (consumed = []) ctx.fun_decl.meta + cassert __FILE__ __LINE__ (consumed = []) ctx.fun_decl.meta "Nested borrows are not supported yet"; (* Retrieve the values given back upon ending this abstraction - note that * we don't provide meta-place information, because those assignments will @@ -2633,7 +2633,7 @@ and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs) ^ pure_ty_to_string ctx given_back.ty ^ "\n- sig input ty: " ^ pure_ty_to_string ctx input.ty)); - sanity_check (given_back.ty = input.ty) ctx.fun_decl.meta) + sanity_check __FILE__ __LINE__ (given_back.ty = input.ty) ctx.fun_decl.meta) given_back_inputs; (* Translate the next expression *) let next_e = translate_expression e ctx in @@ -2650,7 +2650,7 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) texpression = let vloop_id = loop_id in let loop_id = V.LoopId.Map.find loop_id ctx.loop_ids_map in - sanity_check (loop_id = Option.get ctx.loop_id) ctx.fun_decl.meta; + sanity_check __FILE__ __LINE__ (loop_id = Option.get ctx.loop_id) ctx.fun_decl.meta; let rg_id = Option.get rg_id in (* There are two cases depending on the [abs_kind] (whether this is a synth input or a regular loop call) *) @@ -2792,7 +2792,7 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) | V.SeLiteral _ -> (* We do not *register* symbolic expansions to literal values in the symbolic ADT *) - craise ctx.fun_decl.meta "Unreachable" + craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" | SeMutRef (_, nsv) | SeSharedRef (_, nsv) -> (* The (mut/shared) borrow type is extracted to identity: we thus simply introduce an reassignment *) @@ -2805,11 +2805,11 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) next_e | SeAdt _ -> (* Should be in the [ExpandAdt] case *) - craise ctx.fun_decl.meta "Unreachable") + craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable") | ExpandAdt branches -> ( (* We don't do the same thing if there is a branching or not *) match branches with - | [] -> craise ctx.fun_decl.meta "Unreachable" + | [] -> craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" | [ (variant_id, svl, branch) ] when not (TypesUtils.ty_is_custom_adt sv.V.sv_ty @@ -2848,7 +2848,7 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) let branch = List.hd branches in let ty = branch.branch.ty in (* Sanity check *) - sanity_check + sanity_check __FILE__ __LINE__ (List.for_all (fun br -> br.branch.ty = ty) branches) ctx.fun_decl.meta; (* Return *) @@ -2870,7 +2870,7 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) ^ pure_ty_to_string ctx true_e.ty ^ "\n\nfalse_e.ty: " ^ pure_ty_to_string ctx false_e.ty)); - save_error ~b:(ty = false_e.ty) (Some ctx.fun_decl.meta) + save_error __FILE__ __LINE__ ~b:(ty = false_e.ty) (Some ctx.fun_decl.meta) "Internal error, please file an issue"; { e; ty } | ExpandInt (int_ty, branches, otherwise) -> @@ -2896,7 +2896,7 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) Match all_branches ) in let ty = otherwise.branch.ty in - sanity_check + sanity_check __FILE__ __LINE__ (List.for_all (fun (br : match_branch) -> br.branch.ty = ty) branches) ctx.fun_decl.meta; { e; ty } @@ -3001,7 +3001,7 @@ and translate_ExpandAdt_one_branch (sv : V.symbolic_value) let var = match vars with | [ v ] -> v - | _ -> craise ctx.fun_decl.meta "Unreachable" + | _ -> craise __FILE__ __LINE__ ctx.fun_decl.meta "Unreachable" in (* We simply introduce an assignment - the box type is the * identity when extracted ([box a = a]) *) @@ -3015,7 +3015,7 @@ and translate_ExpandAdt_one_branch (sv : V.symbolic_value) * through the functions provided by the API (note that we don't * know how to expand values like vectors or arrays, because they have a variable number * of fields!) *) - craise ctx.fun_decl.meta "Attempt to expand a non-expandable value" + craise __FILE__ __LINE__ ctx.fun_decl.meta "Attempt to expand a non-expandable value" and translate_intro_symbolic (ectx : C.eval_ctx) (p : S.mplace option) (sv : V.symbolic_value) (v : S.value_aggregate) (e : S.expression) @@ -3436,7 +3436,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = in (* Sanity check: all the non-fresh symbolic values are in the context *) - sanity_check + sanity_check __FILE__ __LINE__ (List.for_all (fun (sv : V.symbolic_value) -> V.SymbolicValueId.Map.mem sv.sv_id ctx.sv_to_var) @@ -3461,7 +3461,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = (* The types shouldn't contain borrows - we can translate them as forward types *) List.map (fun ty -> - cassert + cassert __FILE__ __LINE__ (not (TypesUtils.ty_has_borrows !ctx.type_ctx.type_infos ty)) !ctx.fun_decl.meta "The types shouldn't contain borrows"; ctx_translate_fwd_ty !ctx ty) @@ -3542,7 +3542,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = (* Add the loop information in the context *) let ctx = - sanity_check (not (LoopId.Map.mem loop_id ctx.loops)) ctx.fun_decl.meta; + sanity_check __FILE__ __LINE__ (not (LoopId.Map.mem loop_id ctx.loops)) ctx.fun_decl.meta; (* Note that we will retrieve the input values later in the [ForwardEnd] (and will introduce the outputs at that moment, together with the actual @@ -3798,7 +3798,7 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = (List.map (pure_ty_to_string ctx) signature.inputs))); (* TODO: we need to normalize the types *) if !Config.type_check_pure_code then - sanity_check + sanity_check __FILE__ __LINE__ (List.for_all (fun (var, ty) -> (var : var).ty = ty) (List.combine inputs signature.inputs)) diff --git a/compiler/SynthesizeSymbolic.ml b/compiler/SynthesizeSymbolic.ml index f7437f7e..74b333f3 100644 --- a/compiler/SynthesizeSymbolic.ml +++ b/compiler/SynthesizeSymbolic.ml @@ -41,7 +41,7 @@ let synthesize_symbolic_expansion (meta : Meta.meta) (sv : symbolic_value) (Some (SeLiteral (VBool false)), false_exp); ] -> ExpandBool (true_exp, false_exp) - | _ -> craise meta "Ill-formed boolean expansion") + | _ -> craise __FILE__ __LINE__ meta "Ill-formed boolean expansion") | TLiteral (TInteger int_ty) -> (* Switch over an integer: split between the "regular" branches and the "otherwise" branch (which should be the last branch) *) @@ -51,9 +51,9 @@ let synthesize_symbolic_expansion (meta : Meta.meta) (sv : symbolic_value) let get_scalar (see : symbolic_expansion option) : scalar_value = match see with | Some (SeLiteral (VScalar cv)) -> - sanity_check (cv.int_ty = int_ty) meta; + sanity_check __FILE__ __LINE__ (cv.int_ty = int_ty) meta; cv - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" in let branches = List.map (fun (see, exp) -> (get_scalar see, exp)) branches @@ -61,7 +61,7 @@ let synthesize_symbolic_expansion (meta : Meta.meta) (sv : symbolic_value) (* For the otherwise branch, the symbolic value should have been left * unchanged *) let otherwise_see, otherwise = otherwise in - sanity_check (otherwise_see = None) meta; + sanity_check __FILE__ __LINE__ (otherwise_see = None) meta; (* Return *) ExpandInt (int_ty, branches, otherwise) | TAdt (_, _) -> @@ -70,7 +70,7 @@ let synthesize_symbolic_expansion (meta : Meta.meta) (sv : symbolic_value) VariantId.id option * symbolic_value list = match see with | Some (SeAdt (vid, fields)) -> (vid, fields) - | _ -> craise meta "Ill-formed branching ADT expansion" + | _ -> craise __FILE__ __LINE__ meta "Ill-formed branching ADT expansion" in let exp = List.map @@ -84,10 +84,10 @@ let synthesize_symbolic_expansion (meta : Meta.meta) (sv : symbolic_value) (* Reference expansion: there should be one branch *) match ls with | [ (Some see, exp) ] -> ExpandNoBranch (see, exp) - | _ -> craise meta "Ill-formed borrow expansion") + | _ -> craise __FILE__ __LINE__ meta "Ill-formed borrow expansion") | TVar _ | TLiteral TChar | TNever | TTraitType _ | TArrow _ | TRawPtr _ -> - craise meta "Ill-formed symbolic expansion" + craise __FILE__ __LINE__ meta "Ill-formed symbolic expansion" in Some (Expansion (place, sv, expansion)) @@ -193,7 +193,7 @@ let synthesize_loop (loop_id : LoopId.id) (input_svalues : symbolic_value list) loop_expr; meta; }) - | _ -> craise meta "Unreachable" + | _ -> craise __FILE__ __LINE__ meta "Unreachable" let save_snapshot (ctx : Contexts.eval_ctx) (e : expression option) : expression option = diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 9834fe81..4c0f2e0d 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -176,7 +176,7 @@ let translate_function_to_pure (trans_ctx : trans_ctx) SymbolicToPure.fresh_named_vars_for_symbolic_values input_svs ctx in { ctx with forward_inputs } - | _ -> craise fdef.meta "Unreachable" + | _ -> craise __FILE__ __LINE__ fdef.meta "Unreachable" in (* Add the backward inputs *) @@ -447,7 +447,7 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx) let global_decls = ctx.trans_ctx.global_ctx.global_decls in let global = GlobalDeclId.Map.find id global_decls in let trans = FunDeclId.Map.find global.body ctx.trans_funs in - sanity_check (trans.loops = []) global.meta; + sanity_check __FILE__ __LINE__ (trans.loops = []) global.meta; let body = trans.f in let is_opaque = Option.is_none body.Pure.body in diff --git a/compiler/TypesAnalysis.ml b/compiler/TypesAnalysis.ml index c4fcdb4a..e6621c7a 100644 --- a/compiler/TypesAnalysis.ml +++ b/compiler/TypesAnalysis.ml @@ -289,7 +289,7 @@ let analyze_type_decl (updated : bool ref) (infos : type_infos) (List.map (fun v -> List.map (fun f -> f.field_ty) v.fields) variants) - | Opaque -> craise def.meta "unreachable" + | Opaque -> craise __FILE__ __LINE__ def.meta "unreachable" in (* Explore the types and accumulate information *) let type_decl_info = TypeDeclId.Map.find def.def_id infos in diff --git a/compiler/ValuesUtils.ml b/compiler/ValuesUtils.ml index d2c48d13..980ebef7 100644 --- a/compiler/ValuesUtils.ml +++ b/compiler/ValuesUtils.ml @@ -12,28 +12,28 @@ let mk_unit_value : typed_value = { value = VAdt { variant_id = None; field_values = [] }; ty = mk_unit_ty } let mk_typed_value (meta : Meta.meta) (ty : ty) (value : value) : typed_value = - sanity_check (ty_is_ety ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_ety ty) meta; { value; ty } let mk_typed_avalue (meta : Meta.meta) (ty : ty) (value : avalue) : typed_avalue = - sanity_check (ty_is_rty ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty ty) meta; { value; ty } let mk_bottom (meta : Meta.meta) (ty : ty) : typed_value = - sanity_check (ty_is_ety ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_ety ty) meta; { value = VBottom; ty } let mk_abottom (meta : Meta.meta) (ty : ty) : typed_avalue = - sanity_check (ty_is_rty ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty ty) meta; { value = ABottom; ty } let mk_aignored (meta : Meta.meta) (ty : ty) : typed_avalue = - sanity_check (ty_is_rty ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty ty) meta; { value = AIgnored; ty } let value_as_symbolic (meta : Meta.meta) (v : value) : symbolic_value = - match v with VSymbolic v -> v | _ -> craise meta "Unexpected" + match v with VSymbolic v -> v | _ -> craise __FILE__ __LINE__ meta "Unexpected" (** Box a value *) let mk_box_value (meta : Meta.meta) (v : typed_value) : typed_value = @@ -50,13 +50,13 @@ let is_symbolic (v : value) : bool = match v with VSymbolic _ -> true | _ -> false let as_symbolic (meta : Meta.meta) (v : value) : symbolic_value = - match v with VSymbolic s -> s | _ -> craise meta "Unexpected" + match v with VSymbolic s -> s | _ -> craise __FILE__ __LINE__ meta "Unexpected" let as_mut_borrow (meta : Meta.meta) (v : typed_value) : BorrowId.id * typed_value = match v.value with | VBorrow (VMutBorrow (bid, bv)) -> (bid, bv) - | _ -> craise meta "Unexpected" + | _ -> craise __FILE__ __LINE__ meta "Unexpected" let is_unit (v : typed_value) : bool = ty_is_unit v.ty |