summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/AssociatedTypes.ml16
-rw-r--r--compiler/Contexts.ml18
-rw-r--r--compiler/Errors.ml38
-rw-r--r--compiler/Extract.ml50
-rw-r--r--compiler/ExtractBase.ml33
-rw-r--r--compiler/ExtractName.ml2
-rw-r--r--compiler/ExtractTypes.ml58
-rw-r--r--compiler/FunsAnalysis.ml6
-rw-r--r--compiler/Interpreter.ml24
-rw-r--r--compiler/InterpreterBorrows.ml258
-rw-r--r--compiler/InterpreterBorrowsCore.ml98
-rw-r--r--compiler/InterpreterExpansion.ml52
-rw-r--r--compiler/InterpreterExpressions.ml104
-rw-r--r--compiler/InterpreterLoops.ml20
-rw-r--r--compiler/InterpreterLoopsCore.ml4
-rw-r--r--compiler/InterpreterLoopsFixedPoint.ml56
-rw-r--r--compiler/InterpreterLoopsJoinCtxs.ml46
-rw-r--r--compiler/InterpreterLoopsMatchCtxs.ml162
-rw-r--r--compiler/InterpreterPaths.ml48
-rw-r--r--compiler/InterpreterProjectors.ml56
-rw-r--r--compiler/InterpreterStatements.ml106
-rw-r--r--compiler/InterpreterUtils.ml18
-rw-r--r--compiler/Invariants.ml178
-rw-r--r--compiler/PrePasses.ml8
-rw-r--r--compiler/Print.ml12
-rw-r--r--compiler/PrintPure.ml38
-rw-r--r--compiler/PureMicroPasses.ml22
-rw-r--r--compiler/PureTypeCheck.ml78
-rw-r--r--compiler/PureUtils.ml34
-rw-r--r--compiler/RegionsHierarchy.ml12
-rw-r--r--compiler/Substitute.ml16
-rw-r--r--compiler/SymbolicToPure.ml148
-rw-r--r--compiler/SynthesizeSymbolic.ml16
-rw-r--r--compiler/Translate.ml4
-rw-r--r--compiler/TypesAnalysis.ml2
-rw-r--r--compiler/ValuesUtils.ml16
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