summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorSon Ho2021-11-25 15:20:33 +0100
committerSon Ho2021-11-25 15:20:33 +0100
commit33814c82e8465a0d5f7c6d8f1d39bae087ffb547 (patch)
tree3b87946ba3946df6139fbf12e3cf19b338d38ee5 /src
parent333a286b627948320cc522a0e49350f9c878014c (diff)
Replace `open Values` with `module V = Values` in Interpreter
Diffstat (limited to 'src')
-rw-r--r--src/Interpreter.ml796
1 files changed, 412 insertions, 384 deletions
diff --git a/src/Interpreter.ml b/src/Interpreter.ml
index a4bc9713..59e58721 100644
--- a/src/Interpreter.ml
+++ b/src/Interpreter.ml
@@ -1,5 +1,5 @@
open Types
-open Values
+module V = Values
open Scalars
module E = Expressions
open Errors
@@ -25,78 +25,78 @@ type exploration_kind = {
*)
(** Apply a predicate to all the borrows in a value *)
-let rec check_borrows_in_value (check : borrow_content -> bool)
- (v : typed_value) : bool =
- match v.value with
- | Concrete _ | Bottom | Symbolic _ -> true
- | Adt av -> FieldId.for_all (check_borrows_in_value check) av.field_values
- | Tuple values -> FieldId.for_all (check_borrows_in_value check) values
- | Assumed (Box bv) -> check_borrows_in_value check bv
- | Borrow bc -> (
+let rec check_borrows_in_value (check : V.borrow_content -> bool)
+ (v : V.typed_value) : bool =
+ match v.V.value with
+ | V.Concrete _ | V.Bottom | V.Symbolic _ -> true
+ | V.Adt av -> FieldId.for_all (check_borrows_in_value check) av.field_values
+ | V.Tuple values -> FieldId.for_all (check_borrows_in_value check) values
+ | V.Assumed (Box bv) -> check_borrows_in_value check bv
+ | V.Borrow bc -> (
check bc
&&
match bc with
- | SharedBorrow _ | InactivatedMutBorrow _ -> true
- | MutBorrow (_, mv) -> check_borrows_in_value check mv)
- | Loan lc -> (
+ | V.SharedBorrow _ | V.InactivatedMutBorrow _ -> true
+ | V.MutBorrow (_, mv) -> check_borrows_in_value check mv)
+ | V.Loan lc -> (
match lc with
- | SharedLoan (_, sv) -> check_borrows_in_value check sv
- | MutLoan _ -> true)
+ | V.SharedLoan (_, sv) -> check_borrows_in_value check sv
+ | V.MutLoan _ -> true)
(** Apply a predicate to all the loans in a value *)
-let rec check_loans_in_value (check : loan_content -> bool) (v : typed_value) :
- bool =
- match v.value with
- | Concrete _ | Bottom | Symbolic _ -> true
- | Adt av -> FieldId.for_all (check_loans_in_value check) av.field_values
- | Tuple values -> FieldId.for_all (check_loans_in_value check) values
- | Assumed (Box bv) -> check_loans_in_value check bv
- | Borrow bc -> (
+let rec check_loans_in_value (check : V.loan_content -> bool)
+ (v : V.typed_value) : bool =
+ match v.V.value with
+ | V.Concrete _ | V.Bottom | V.Symbolic _ -> true
+ | V.Adt av -> FieldId.for_all (check_loans_in_value check) av.field_values
+ | V.Tuple values -> FieldId.for_all (check_loans_in_value check) values
+ | V.Assumed (Box bv) -> check_loans_in_value check bv
+ | V.Borrow bc -> (
match bc with
- | SharedBorrow _ | InactivatedMutBorrow _ -> true
- | MutBorrow (_, mv) -> check_loans_in_value check mv)
- | Loan lc -> (
+ | V.SharedBorrow _ | V.InactivatedMutBorrow _ -> true
+ | V.MutBorrow (_, mv) -> check_loans_in_value check mv)
+ | V.Loan lc -> (
check lc
&&
match lc with
- | SharedLoan (_, sv) -> check_loans_in_value check sv
- | MutLoan _ -> true)
+ | V.SharedLoan (_, sv) -> check_loans_in_value check sv
+ | V.MutLoan _ -> true)
(** Lookup a loan content in a value *)
-let rec lookup_loan_in_value (ek : exploration_kind) (l : BorrowId.id)
- (v : typed_value) : loan_content option =
- match v.value with
- | Concrete _ | Bottom | Symbolic _ -> None
- | Adt av ->
+let rec lookup_loan_in_value (ek : exploration_kind) (l : V.BorrowId.id)
+ (v : V.typed_value) : V.loan_content option =
+ match v.V.value with
+ | V.Concrete _ | V.Bottom | V.Symbolic _ -> None
+ | V.Adt av ->
let values = FieldId.vector_to_list av.field_values in
List.find_map (lookup_loan_in_value ek l) values
- | Tuple values ->
+ | V.Tuple values ->
let values = FieldId.vector_to_list values in
List.find_map (lookup_loan_in_value ek l) values
- | Assumed (Box bv) -> lookup_loan_in_value ek l bv
- | Borrow bc -> (
+ | V.Assumed (Box bv) -> lookup_loan_in_value ek l bv
+ | V.Borrow bc -> (
match bc with
- | SharedBorrow _ | InactivatedMutBorrow _ -> None
- | MutBorrow (_, mv) ->
+ | V.SharedBorrow _ | V.InactivatedMutBorrow _ -> None
+ | V.MutBorrow (_, mv) ->
if ek.enter_mut_borrows then lookup_loan_in_value ek l mv else None)
- | Loan lc -> (
+ | V.Loan lc -> (
match lc with
- | SharedLoan (bids, sv) ->
- if BorrowId.Set.mem l bids then Some lc
+ | V.SharedLoan (bids, sv) ->
+ if V.BorrowId.Set.mem l bids then Some lc
else if ek.enter_shared_loans then lookup_loan_in_value ek l sv
else None
- | MutLoan bid -> if bid = l then Some (MutLoan bid) else None)
+ | V.MutLoan bid -> if bid = l then Some (V.MutLoan bid) else None)
(** Lookup a loan content.
The loan is referred to by a borrow id.
*)
-let lookup_loan (ek : exploration_kind) (l : BorrowId.id) (env : C.env) :
- loan_content =
- let lookup_loan_in_env_value (ev : C.env_value) : loan_content option =
+let lookup_loan (ek : exploration_kind) (l : V.BorrowId.id) (env : C.env) :
+ V.loan_content =
+ let lookup_loan_in_env_value (ev : C.env_value) : V.loan_content option =
match ev with
- | Var (_, v) -> lookup_loan_in_value ek l v
- | Abs _ -> raise Unimplemented
+ | C.Var (_, v) -> lookup_loan_in_value ek l v
+ | C.Abs _ -> raise Unimplemented
(* TODO *)
in
match List.find_map lookup_loan_in_env_value env with
@@ -109,42 +109,42 @@ let lookup_loan (ek : exploration_kind) (l : BorrowId.id) (env : C.env) :
This is a helper function: it might break invariants.
*)
-let rec update_loan_in_value (ek : exploration_kind) (l : BorrowId.id)
- (nlc : loan_content) (v : typed_value) : typed_value =
- match v.value with
- | Concrete _ | Bottom | Symbolic _ -> v
- | Adt av ->
+let rec update_loan_in_value (ek : exploration_kind) (l : V.BorrowId.id)
+ (nlc : V.loan_content) (v : V.typed_value) : V.typed_value =
+ match v.V.value with
+ | V.Concrete _ | V.Bottom | V.Symbolic _ -> v
+ | V.Adt av ->
let values =
FieldId.map (update_loan_in_value ek l nlc) av.field_values
in
let av = { av with field_values = values } in
{ v with value = Adt av }
- | Tuple values ->
+ | V.Tuple values ->
let values = FieldId.map (update_loan_in_value ek l nlc) values in
{ v with value = Tuple values }
- | Assumed (Box bv) ->
+ | V.Assumed (Box bv) ->
{ v with value = Assumed (Box (update_loan_in_value ek l nlc bv)) }
- | Borrow bc -> (
+ | V.Borrow bc -> (
match bc with
- | SharedBorrow _ | InactivatedMutBorrow _ -> v
- | MutBorrow (bid, mv) ->
+ | V.SharedBorrow _ | V.InactivatedMutBorrow _ -> v
+ | V.MutBorrow (bid, mv) ->
if ek.enter_mut_borrows then
let v' =
- Borrow (MutBorrow (bid, update_loan_in_value ek l nlc mv))
+ V.Borrow (V.MutBorrow (bid, update_loan_in_value ek l nlc mv))
in
{ v with value = v' }
else v)
- | Loan lc -> (
+ | V.Loan lc -> (
match lc with
- | SharedLoan (bids, sv) ->
- if BorrowId.Set.mem l bids then { v with value = Loan nlc }
+ | V.SharedLoan (bids, sv) ->
+ if V.BorrowId.Set.mem l bids then { v with value = V.Loan nlc }
else if ek.enter_shared_loans then
let v' =
- Loan (SharedLoan (bids, update_loan_in_value ek l nlc sv))
+ V.Loan (V.SharedLoan (bids, update_loan_in_value ek l nlc sv))
in
{ v with value = v' }
else v
- | MutLoan bid -> if bid = l then { v with value = Loan nlc } else v)
+ | V.MutLoan bid -> if bid = l then { v with value = V.Loan nlc } else v)
(** Update a loan content.
@@ -152,49 +152,49 @@ let rec update_loan_in_value (ek : exploration_kind) (l : BorrowId.id)
This is a helper function: it might break invariants.
*)
-let update_loan (ek : exploration_kind) (l : BorrowId.id) (nlc : loan_content)
- (env : C.env) : C.env =
+let update_loan (ek : exploration_kind) (l : V.BorrowId.id)
+ (nlc : V.loan_content) (env : C.env) : C.env =
let update_loan_in_env_value (ev : C.env_value) : C.env_value =
match ev with
- | Var (vid, v) -> Var (vid, update_loan_in_value ek l nlc v)
- | Abs _ -> raise Unimplemented
+ | C.Var (vid, v) -> Var (vid, update_loan_in_value ek l nlc v)
+ | C.Abs _ -> raise Unimplemented
(* TODO *)
in
List.map update_loan_in_env_value env
(** Lookup a borrow content in a value *)
-let rec lookup_borrow_in_value (ek : exploration_kind) (l : BorrowId.id)
- (v : typed_value) : borrow_content option =
- match v.value with
- | Concrete _ | Bottom | Symbolic _ -> None
- | Adt av ->
+let rec lookup_borrow_in_value (ek : exploration_kind) (l : V.BorrowId.id)
+ (v : V.typed_value) : V.borrow_content option =
+ match v.V.value with
+ | V.Concrete _ | V.Bottom | V.Symbolic _ -> None
+ | V.Adt av ->
let values = FieldId.vector_to_list av.field_values in
List.find_map (lookup_borrow_in_value ek l) values
- | Tuple values ->
+ | V.Tuple values ->
let values = FieldId.vector_to_list values in
List.find_map (lookup_borrow_in_value ek l) values
- | Assumed (Box bv) -> lookup_borrow_in_value ek l bv
- | Borrow bc -> (
+ | V.Assumed (Box bv) -> lookup_borrow_in_value ek l bv
+ | V.Borrow bc -> (
match bc with
- | SharedBorrow bid -> if l = bid then Some bc else None
- | InactivatedMutBorrow bid -> if l = bid then Some bc else None
- | MutBorrow (bid, mv) ->
+ | V.SharedBorrow bid -> if l = bid then Some bc else None
+ | V.InactivatedMutBorrow bid -> if l = bid then Some bc else None
+ | V.MutBorrow (bid, mv) ->
if bid = l then Some bc
else if ek.enter_mut_borrows then lookup_borrow_in_value ek l mv
else None)
- | Loan lc -> (
+ | V.Loan lc -> (
match lc with
- | SharedLoan (_, sv) ->
+ | V.SharedLoan (_, sv) ->
if ek.enter_shared_loans then lookup_borrow_in_value ek l sv else None
- | MutLoan _ -> None)
+ | V.MutLoan _ -> None)
(** Lookup a borrow content from a borrow id. *)
-let lookup_borrow (ek : exploration_kind) (l : BorrowId.id) (env : C.env) :
- borrow_content =
+let lookup_borrow (ek : exploration_kind) (l : V.BorrowId.id) (env : C.env) :
+ V.borrow_content =
let lookup_borrow_in_env_value (ev : C.env_value) =
match ev with
- | Var (_, v) -> lookup_borrow_in_value ek l v
- | Abs _ -> raise Unimplemented
+ | C.Var (_, v) -> lookup_borrow_in_value ek l v
+ | C.Abs _ -> raise Unimplemented
(* TODO *)
in
match List.find_map lookup_borrow_in_env_value env with
@@ -207,43 +207,43 @@ let lookup_borrow (ek : exploration_kind) (l : BorrowId.id) (env : C.env) :
This is a helper function: it might break invariants.
*)
-let rec update_borrow_in_value (ek : exploration_kind) (l : BorrowId.id)
- (nbc : borrow_content) (v : typed_value) : typed_value =
- match v.value with
- | Concrete _ | Bottom | Symbolic _ -> v
- | Adt av ->
+let rec update_borrow_in_value (ek : exploration_kind) (l : V.BorrowId.id)
+ (nbc : V.borrow_content) (v : V.typed_value) : V.typed_value =
+ match v.V.value with
+ | V.Concrete _ | V.Bottom | V.Symbolic _ -> v
+ | V.Adt av ->
let values =
FieldId.map (update_borrow_in_value ek l nbc) av.field_values
in
let av = { av with field_values = values } in
{ v with value = Adt av }
- | Tuple values ->
+ | V.Tuple values ->
let values = FieldId.map (update_borrow_in_value ek l nbc) values in
{ v with value = Tuple values }
- | Assumed (Box bv) ->
+ | V.Assumed (Box bv) ->
{ v with value = Assumed (Box (update_borrow_in_value ek l nbc bv)) }
- | Borrow bc -> (
+ | V.Borrow bc -> (
match bc with
- | SharedBorrow bid | InactivatedMutBorrow bid ->
- if bid = l then { v with value = Borrow nbc } else v
- | MutBorrow (bid, mv) ->
- if bid = l then { v with value = Borrow nbc }
+ | V.SharedBorrow bid | V.InactivatedMutBorrow bid ->
+ if bid = l then { v with value = V.Borrow nbc } else v
+ | V.MutBorrow (bid, mv) ->
+ if bid = l then { v with value = V.Borrow nbc }
else if ek.enter_mut_borrows then
let v' =
- Borrow (MutBorrow (bid, update_borrow_in_value ek l nbc mv))
+ V.Borrow (V.MutBorrow (bid, update_borrow_in_value ek l nbc mv))
in
{ v with value = v' }
else v)
- | Loan lc -> (
+ | V.Loan lc -> (
match lc with
- | SharedLoan (bids, sv) ->
+ | V.SharedLoan (bids, sv) ->
if ek.enter_shared_loans then
let v' =
- Loan (SharedLoan (bids, update_borrow_in_value ek l nbc sv))
+ V.Loan (V.SharedLoan (bids, update_borrow_in_value ek l nbc sv))
in
{ v with value = v' }
else v
- | MutLoan _ -> v)
+ | V.MutLoan _ -> v)
(** Update a borrow content.
@@ -251,12 +251,12 @@ let rec update_borrow_in_value (ek : exploration_kind) (l : BorrowId.id)
This is a helper function: it might break invariants.
*)
-let update_borrow (ek : exploration_kind) (l : BorrowId.id)
- (nbc : borrow_content) (env : C.env) : C.env =
+let update_borrow (ek : exploration_kind) (l : V.BorrowId.id)
+ (nbc : V.borrow_content) (env : C.env) : C.env =
let update_borrow_in_env_value (ev : C.env_value) : C.env_value =
match ev with
- | Var (vid, v) -> Var (vid, update_borrow_in_value ek l nbc v)
- | Abs _ -> raise Unimplemented
+ | C.Var (vid, v) -> Var (vid, update_borrow_in_value ek l nbc v)
+ | C.Abs _ -> raise Unimplemented
(* TODO *)
in
List.map update_borrow_in_env_value env
@@ -269,13 +269,13 @@ let update_borrow (ek : exploration_kind) (l : BorrowId.id)
*)
type inner_outer = Inner | Outer
-type borrow_ids = Borrows of BorrowId.Set.t | Borrow of BorrowId.id
+type borrow_ids = Borrows of V.BorrowId.Set.t | Borrow of V.BorrowId.id
(** Borrow lookup result *)
type borrow_lres =
| NotFound
| Outer of borrow_ids
- | FoundMut of typed_value
+ | FoundMut of V.typed_value
| FoundShared
| FoundInactivatedMut
@@ -293,42 +293,42 @@ let unwrap_res_to_outer_or opt default =
match opt with Some x -> Outer x | None -> default
(** Check if a value contains loans *)
-let rec loans_in_value (v : typed_value) : bool =
- match v.value with
- | Concrete _ -> false
- | Adt av ->
+let rec loans_in_value (v : V.typed_value) : bool =
+ match v.V.value with
+ | V.Concrete _ -> false
+ | V.Adt av ->
let fields = FieldId.vector_to_list av.field_values in
List.exists loans_in_value fields
- | Tuple fields ->
+ | V.Tuple fields ->
let fields = FieldId.vector_to_list fields in
List.exists loans_in_value fields
- | Assumed (Box bv) -> loans_in_value bv
- | Borrow bc -> (
+ | V.Assumed (Box bv) -> loans_in_value bv
+ | V.Borrow bc -> (
match bc with
- | SharedBorrow _ | InactivatedMutBorrow _ -> false
- | MutBorrow (_, bv) -> loans_in_value bv)
- | Loan _ -> true
- | Bottom | Symbolic _ -> false
+ | V.SharedBorrow _ | V.InactivatedMutBorrow _ -> false
+ | V.MutBorrow (_, bv) -> loans_in_value bv)
+ | V.Loan _ -> true
+ | V.Bottom | V.Symbolic _ -> false
(** Return the first loan we find in a value *)
-let rec get_first_loan_in_value (v : typed_value) : loan_content option =
- match v.value with
- | Concrete _ -> None
- | Adt av ->
+let rec get_first_loan_in_value (v : V.typed_value) : V.loan_content option =
+ match v.V.value with
+ | V.Concrete _ -> None
+ | V.Adt av ->
let fields = FieldId.vector_to_list av.field_values in
get_first_loan_in_values fields
- | Tuple fields ->
+ | V.Tuple fields ->
let fields = FieldId.vector_to_list fields in
get_first_loan_in_values fields
- | Assumed (Box bv) -> get_first_loan_in_value bv
- | Borrow bc -> (
+ | V.Assumed (Box bv) -> get_first_loan_in_value bv
+ | V.Borrow bc -> (
match bc with
- | SharedBorrow _ | InactivatedMutBorrow _ -> None
- | MutBorrow (_, bv) -> get_first_loan_in_value bv)
- | Loan lc -> Some lc
- | Bottom | Symbolic _ -> None
+ | V.SharedBorrow _ | V.InactivatedMutBorrow _ -> None
+ | V.MutBorrow (_, bv) -> get_first_loan_in_value bv)
+ | V.Loan lc -> Some lc
+ | V.Bottom | V.Symbolic _ -> None
-and get_first_loan_in_values (vl : typed_value list) : loan_content option =
+and get_first_loan_in_values (vl : V.typed_value list) : V.loan_content option =
match vl with
| [] -> None
| v :: vl' -> (
@@ -337,35 +337,35 @@ and get_first_loan_in_values (vl : typed_value list) : loan_content option =
| None -> get_first_loan_in_values vl')
(** Check if a value contains ⊥ *)
-let rec bottom_in_value (v : typed_value) : bool =
- match v.value with
- | Concrete _ -> false
- | Adt av ->
+let rec bottom_in_value (v : V.typed_value) : bool =
+ match v.V.value with
+ | V.Concrete _ -> false
+ | V.Adt av ->
let fields = FieldId.vector_to_list av.field_values in
List.exists bottom_in_value fields
- | Tuple fields ->
+ | V.Tuple fields ->
let fields = FieldId.vector_to_list fields in
List.exists bottom_in_value fields
- | Assumed (Box bv) -> bottom_in_value bv
- | Borrow bc -> (
+ | V.Assumed (Box bv) -> bottom_in_value bv
+ | V.Borrow bc -> (
match bc with
- | SharedBorrow _ | InactivatedMutBorrow _ -> false
- | MutBorrow (_, bv) -> bottom_in_value bv)
- | Loan lc -> (
+ | V.SharedBorrow _ | V.InactivatedMutBorrow _ -> false
+ | V.MutBorrow (_, bv) -> bottom_in_value bv)
+ | V.Loan lc -> (
match lc with
- | SharedLoan (_, sv) -> bottom_in_value sv
- | MutLoan _ -> false)
- | Bottom -> true
- | Symbolic _ ->
+ | V.SharedLoan (_, sv) -> bottom_in_value sv
+ | V.MutLoan _ -> false)
+ | V.Bottom -> true
+ | V.Symbolic _ ->
(* This depends on the regions which have ended *)
raise Unimplemented
(** See [end_borrow_get_borrow_in_env] *)
let rec end_borrow_get_borrow_in_value config io l outer_borrows v0 :
- typed_value * borrow_lres =
- match v0.value with
- | Concrete _ | Bottom | Symbolic _ -> (v0, NotFound)
- | Assumed (Box bv) ->
+ V.typed_value * borrow_lres =
+ match v0.V.value with
+ | V.Concrete _ | V.Bottom | V.Symbolic _ -> (v0, NotFound)
+ | V.Assumed (Box bv) ->
let bv', res =
end_borrow_get_borrow_in_value config io l outer_borrows bv
in
@@ -375,22 +375,22 @@ let rec end_borrow_get_borrow_in_value config io l outer_borrows v0 :
* like new, deref, etc. which will enforce that we destroy
* boxes upon ending inner borrows *)
({ v0 with value = Assumed (Box bv') }, res)
- | Adt adt ->
+ | V.Adt adt ->
let values = FieldId.vector_to_list adt.field_values in
let values', res =
end_borrow_get_borrow_in_values config io l outer_borrows values
in
let values' = FieldId.vector_of_list values' in
({ v0 with value = Adt { adt with field_values = values' } }, res)
- | Tuple values ->
+ | V.Tuple values ->
let values = FieldId.vector_to_list values in
let values', res =
end_borrow_get_borrow_in_values config io l outer_borrows values
in
let values' = FieldId.vector_of_list values' in
({ v0 with value = Tuple values' }, res)
- | Loan (MutLoan _) -> (v0, NotFound)
- | Loan (SharedLoan (borrows, v)) ->
+ | V.Loan (V.MutLoan _) -> (v0, NotFound)
+ | V.Loan (V.SharedLoan (borrows, v)) ->
(* Update the outer borrows, if necessary *)
let outer_borrows =
update_outer_borrows io outer_borrows (Borrows borrows)
@@ -398,18 +398,18 @@ let rec end_borrow_get_borrow_in_value config io l outer_borrows v0 :
let v', res =
end_borrow_get_borrow_in_value config io l outer_borrows v
in
- ({ value = Loan (SharedLoan (borrows, v')); ty = v0.ty }, res)
- | Borrow (SharedBorrow l') ->
+ ({ value = V.Loan (V.SharedLoan (borrows, v')); ty = v0.ty }, res)
+ | V.Borrow (SharedBorrow l') ->
if l = l' then
( { v0 with value = Bottom },
unwrap_res_to_outer_or outer_borrows FoundInactivatedMut )
else (v0, NotFound)
- | Borrow (InactivatedMutBorrow l') ->
+ | V.Borrow (InactivatedMutBorrow l') ->
if l = l' then
( { v0 with value = Bottom },
unwrap_res_to_outer_or outer_borrows FoundInactivatedMut )
else (v0, NotFound)
- | Borrow (MutBorrow (l', bv)) ->
+ | V.Borrow (V.MutBorrow (l', bv)) ->
if l = l' then
( { v0 with value = Bottom },
unwrap_res_to_outer_or outer_borrows (FoundMut bv) )
@@ -419,10 +419,10 @@ let rec end_borrow_get_borrow_in_value config io l outer_borrows v0 :
let bv', res =
end_borrow_get_borrow_in_value config io l outer_borrows bv
in
- ({ v0 with value = Borrow (MutBorrow (l', bv')) }, res)
+ ({ v0 with value = V.Borrow (V.MutBorrow (l', bv')) }, res)
and end_borrow_get_borrow_in_values config io l outer_borrows vl0 :
- typed_value list * borrow_lres =
+ V.typed_value list * borrow_lres =
match vl0 with
| [] -> (vl0, NotFound)
| v :: vl -> (
@@ -461,11 +461,11 @@ let rec end_borrow_get_borrow_in_env (config : C.config) (io : inner_outer) l
raise Unimplemented
(** See [give_back_value]. *)
-let rec give_back_value_to_value config bid (v : typed_value)
- (destv : typed_value) : typed_value =
- match destv.value with
- | Concrete _ | Bottom | Symbolic _ -> destv
- | Adt av ->
+let rec give_back_value_to_value config bid (v : V.typed_value)
+ (destv : V.typed_value) : V.typed_value =
+ match destv.V.value with
+ | V.Concrete _ | V.Bottom | V.Symbolic _ -> destv
+ | V.Adt av ->
let field_values =
List.map
(give_back_value_to_value config bid v)
@@ -473,7 +473,7 @@ let rec give_back_value_to_value config bid (v : typed_value)
in
let field_values = FieldId.vector_of_list field_values in
{ destv with value = Adt { av with field_values } }
- | Tuple values ->
+ | V.Tuple values ->
let values =
List.map
(give_back_value_to_value config bid v)
@@ -481,37 +481,38 @@ let rec give_back_value_to_value config bid (v : typed_value)
in
let values = FieldId.vector_of_list values in
{ destv with value = Tuple values }
- | Assumed (Box destv') ->
+ | V.Assumed (Box destv') ->
{
destv with
value = Assumed (Box (give_back_value_to_value config bid v destv'));
}
- | Borrow bc ->
+ | V.Borrow bc ->
(* We may need to insert the value inside a borrowed value *)
let bc' =
match bc with
- | SharedBorrow _ | InactivatedMutBorrow _ -> bc
- | MutBorrow (bid', destv') ->
+ | V.SharedBorrow _ | V.InactivatedMutBorrow _ -> bc
+ | V.MutBorrow (bid', destv') ->
MutBorrow (bid', give_back_value_to_value config bid v destv')
in
- { destv with value = Borrow bc' }
- | Loan lc -> (
+ { destv with value = V.Borrow bc' }
+ | V.Loan lc -> (
match lc with
- | SharedLoan (_, _) -> destv
- | MutLoan bid' ->
- if bid' = bid then v else { destv with value = Loan (MutLoan bid') })
+ | V.SharedLoan (_, _) -> destv
+ | V.MutLoan bid' ->
+ if bid' = bid then v
+ else { destv with value = V.Loan (V.MutLoan bid') })
(** See [give_back_value]. *)
-let give_back_value_to_abs (_config : C.config) _bid _v _abs : abs =
+let give_back_value_to_abs (_config : C.config) _bid _v _abs : V.abs =
(* TODO *)
raise Unimplemented
(** See [give_back_shared]. *)
-let rec give_back_shared_to_value (config : C.config) bid (destv : typed_value)
- : typed_value =
- match destv.value with
- | Concrete _ | Bottom | Symbolic _ -> destv
- | Adt av ->
+let rec give_back_shared_to_value (config : C.config) bid
+ (destv : V.typed_value) : V.typed_value =
+ match destv.V.value with
+ | V.Concrete _ | V.Bottom | V.Symbolic _ -> destv
+ | V.Adt av ->
let field_values =
List.map
(give_back_shared_to_value config bid)
@@ -519,7 +520,7 @@ let rec give_back_shared_to_value (config : C.config) bid (destv : typed_value)
in
let field_values = FieldId.vector_of_list field_values in
{ destv with value = Adt { av with field_values } }
- | Tuple values ->
+ | V.Tuple values ->
let values =
List.map
(give_back_shared_to_value config bid)
@@ -527,43 +528,44 @@ let rec give_back_shared_to_value (config : C.config) bid (destv : typed_value)
in
let values = FieldId.vector_of_list values in
{ destv with value = Tuple values }
- | Assumed (Box destv') ->
+ | V.Assumed (Box destv') ->
{
destv with
value = Assumed (Box (give_back_shared_to_value config bid destv'));
}
- | Borrow bc ->
+ | V.Borrow bc ->
(* We may need to insert the value inside a borrowed value *)
let bc' =
match bc with
- | SharedBorrow _ | InactivatedMutBorrow _ -> bc
- | MutBorrow (bid', destv') ->
+ | V.SharedBorrow _ | V.InactivatedMutBorrow _ -> bc
+ | V.MutBorrow (bid', destv') ->
MutBorrow (bid', give_back_shared_to_value config bid destv')
in
- { destv with value = Borrow bc' }
- | Loan lc -> (
+ { destv with value = V.Borrow bc' }
+ | V.Loan lc -> (
match lc with
- | SharedLoan (bids, shared_value) ->
- if BorrowId.Set.mem bid bids then
- if BorrowId.Set.cardinal bids = 1 then shared_value
+ | V.SharedLoan (bids, shared_value) ->
+ if V.BorrowId.Set.mem bid bids then
+ if V.BorrowId.Set.cardinal bids = 1 then shared_value
else
{
destv with
value =
- Loan (SharedLoan (BorrowId.Set.remove bid bids, shared_value));
+ V.Loan
+ (V.SharedLoan (V.BorrowId.Set.remove bid bids, shared_value));
}
else
{
destv with
value =
- Loan
- (SharedLoan
+ V.Loan
+ (V.SharedLoan
(bids, give_back_shared_to_value config bid shared_value));
}
- | MutLoan _ -> destv)
+ | V.MutLoan _ -> destv)
(** See [give_back_shared]. *)
-let give_back_shared_to_abs _config _bid _abs : abs =
+let give_back_shared_to_abs _config _bid _abs : V.abs =
(* TODO *)
raise Unimplemented
@@ -572,8 +574,8 @@ let give_back_shared_to_abs _config _bid _abs : abs =
When we end a mutable borrow, we need to "give back" the value it contained
to its original owner by reinserting it at the proper position.
*)
-let give_back_value (config : C.config) (bid : BorrowId.id) (v : typed_value)
- (env : C.env) : C.env =
+let give_back_value (config : C.config) (bid : V.BorrowId.id)
+ (v : V.typed_value) (env : C.env) : C.env =
let give_back_value_to_env_value ev : C.env_value =
match ev with
| C.Var (vid, destv) ->
@@ -589,7 +591,7 @@ let give_back_value (config : C.config) (bid : BorrowId.id) (v : typed_value)
When we end a shared borrow, we need to remove the borrow id from the list
of borrows to the shared value.
*)
-let give_back_shared config (bid : BorrowId.id) (env : C.env) : C.env =
+let give_back_shared config (bid : V.BorrowId.id) (env : C.env) : C.env =
let give_back_shared_to_env_value ev : C.env_value =
match ev with
| C.Var (vid, destv) ->
@@ -605,40 +607,46 @@ let give_back_shared config (bid : BorrowId.id) (env : C.env) : C.env =
to an environment by inserting a new borrow id in the set of borrows tracked
by a shared value, referenced by the [original_bid] argument.
*)
-let reborrow_shared (config : C.config) (original_bid : BorrowId.id)
- (new_bid : BorrowId.id) (env : C.env) : C.env =
- let rec reborrow_in_value (v : typed_value) : typed_value =
- match v.value with
- | Concrete _ | Bottom | Symbolic _ -> v
- | Adt av ->
+let reborrow_shared (config : C.config) (original_bid : V.BorrowId.id)
+ (new_bid : V.BorrowId.id) (env : C.env) : C.env =
+ let rec reborrow_in_value (v : V.typed_value) : V.typed_value =
+ match v.V.value with
+ | V.Concrete _ | V.Bottom | V.Symbolic _ -> v
+ | V.Adt av ->
let fields = FieldId.vector_to_list av.field_values in
let fields = List.map reborrow_in_value fields in
let fields = FieldId.vector_of_list fields in
{ v with value = Adt { av with field_values = fields } }
- | Tuple fields ->
+ | V.Tuple fields ->
let fields = FieldId.vector_to_list fields in
let fields = List.map reborrow_in_value fields in
let fields = FieldId.vector_of_list fields in
{ v with value = Tuple fields }
- | Assumed (Box bv) ->
+ | V.Assumed (Box bv) ->
{ v with value = Assumed (Box (reborrow_in_value bv)) }
- | Borrow bc -> (
+ | V.Borrow bc -> (
match bc with
- | SharedBorrow _ | InactivatedMutBorrow _ -> v
- | MutBorrow (bid, bv) ->
- { v with value = Borrow (MutBorrow (bid, reborrow_in_value bv)) })
- | Loan lc -> (
+ | V.SharedBorrow _ | V.InactivatedMutBorrow _ -> v
+ | V.MutBorrow (bid, bv) ->
+ {
+ v with
+ value = V.Borrow (V.MutBorrow (bid, reborrow_in_value bv));
+ })
+ | V.Loan lc -> (
match lc with
- | MutLoan _ -> v
- | SharedLoan (bids, sv) ->
+ | V.MutLoan _ -> v
+ | V.SharedLoan (bids, sv) ->
(* Shared loan: check if the borrow id we are looking for is in the
set of borrow ids. If yes, insert the new borrow id, otherwise
explore inside the shared value *)
- if BorrowId.Set.mem original_bid bids then
- let bids' = BorrowId.Set.add new_bid bids in
- { v with value = Loan (SharedLoan (bids', sv)) }
+ if V.BorrowId.Set.mem original_bid bids then
+ let bids' = V.BorrowId.Set.add new_bid bids in
+ { v with value = V.Loan (V.SharedLoan (bids', sv)) }
else
- { v with value = Loan (SharedLoan (bids, reborrow_in_value sv)) })
+ {
+ v with
+ value = V.Loan (V.SharedLoan (bids, reborrow_in_value sv));
+ })
in
let reborrow_in_ev (ev : C.env_value) : C.env_value =
match ev with
@@ -655,7 +663,7 @@ let reborrow_shared (config : C.config) (original_bid : BorrowId.id)
then update the loan. Ends outer borrows before updating the borrow if
it is necessary.
*)
-let rec end_borrow (config : C.config) (io : inner_outer) (l : BorrowId.id)
+let rec end_borrow (config : C.config) (io : inner_outer) (l : V.BorrowId.id)
(env0 : C.env) : C.env =
match end_borrow_get_borrow_in_env config io l env0 with
(* It is possible that we can't find a borrow in symbolic mode (ending
@@ -677,9 +685,9 @@ let rec end_borrow (config : C.config) (io : inner_outer) (l : BorrowId.id)
(* If found shared or inactivated mut: remove the borrow id from the loan set of the shared value *)
| env, (FoundShared | FoundInactivatedMut) -> give_back_shared config l env
-and end_borrows (config : C.config) (io : inner_outer) (lset : BorrowId.Set.t)
+and end_borrows (config : C.config) (io : inner_outer) (lset : V.BorrowId.Set.t)
(env0 : C.env) : C.env =
- BorrowId.Set.fold (fun id env -> end_borrow config io id env) lset env0
+ V.BorrowId.Set.fold (fun id env -> end_borrow config io id env) lset env0
let end_outer_borrow config = end_borrow config Outer
@@ -703,17 +711,17 @@ let end_inner_borrows config = end_borrows config Inner
TODO: this kind of checks should be put in an auxiliary helper, because
they are redundant
*)
-let promote_shared_loan_to_mut_loan (l : BorrowId.id) (env : C.env) :
- C.env * typed_value =
+let promote_shared_loan_to_mut_loan (l : V.BorrowId.id) (env : C.env) :
+ C.env * V.typed_value =
(* Lookup the shared loan *)
let ek =
{ enter_shared_loans = false; enter_mut_borrows = true; enter_abs = false }
in
match lookup_loan ek l env with
- | MutLoan _ -> failwith "Expected a shared loan, found a mut loan"
- | SharedLoan (bids, sv) ->
+ | V.MutLoan _ -> failwith "Expected a shared loan, found a mut loan"
+ | V.SharedLoan (bids, sv) ->
(* Check that there is only one borrow id (l) and update the loan *)
- assert (BorrowId.Set.mem l bids && BorrowId.Set.cardinal bids = 1);
+ assert (V.BorrowId.Set.mem l bids && V.BorrowId.Set.cardinal bids = 1);
(* 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. *)
@@ -721,7 +729,7 @@ let promote_shared_loan_to_mut_loan (l : BorrowId.id) (env : C.env) :
(* Also need to check there isn't [Bottom] (this is actually an invariant *)
assert (not (bottom_in_value sv));
(* Update the loan content *)
- let env1 = update_loan ek l (MutLoan l) env in
+ let env1 = update_loan ek l (V.MutLoan l) env in
(* Return *)
(env1, sv)
@@ -729,8 +737,8 @@ let promote_shared_loan_to_mut_loan (l : BorrowId.id) (env : C.env) :
This function updates a shared borrow to a mutable borrow.
*)
-let promote_inactivated_borrow_to_mut_borrow (l : BorrowId.id)
- (borrowed_value : typed_value) (env : C.env) : C.env =
+let promote_inactivated_borrow_to_mut_borrow (l : V.BorrowId.id)
+ (borrowed_value : V.typed_value) (env : C.env) : C.env =
(* Lookup the inactivated borrow - note that we don't go inside borrows/loans:
there can't be inactivated borrows inside other borrows/loans
*)
@@ -738,25 +746,25 @@ let promote_inactivated_borrow_to_mut_borrow (l : BorrowId.id)
{ enter_shared_loans = false; enter_mut_borrows = false; enter_abs = false }
in
match lookup_borrow ek l env with
- | SharedBorrow _ | MutBorrow (_, _) ->
+ | V.SharedBorrow _ | V.MutBorrow (_, _) ->
failwith "Expected an inactivated mutable borrow"
- | InactivatedMutBorrow _ ->
+ | V.InactivatedMutBorrow _ ->
(* Update it *)
- update_borrow ek l (MutBorrow (l, borrowed_value)) env
+ update_borrow ek l (V.MutBorrow (l, borrowed_value)) env
(** Promote an inactivated mut borrow to a mut borrow.
The borrow must point to a shared value which is borrowed exactly once.
*)
let rec activate_inactivated_mut_borrow (config : C.config) (io : inner_outer)
- (l : BorrowId.id) (env : C.env) : C.env =
+ (l : V.BorrowId.id) (env : C.env) : C.env =
(* Lookup the value *)
let ek =
{ enter_shared_loans = false; enter_mut_borrows = true; enter_abs = false }
in
match lookup_loan ek l env with
- | MutLoan _ -> failwith "Unreachable"
- | SharedLoan (bids, sv) -> (
+ | V.MutLoan _ -> failwith "Unreachable"
+ | V.SharedLoan (bids, sv) -> (
(* If there are loans inside the value, end them. Note that there can't be
inactivated borrows inside the value.
If we perform an update, do a recursive call to lookup the updated value *)
@@ -765,8 +773,8 @@ let rec activate_inactivated_mut_borrow (config : C.config) (io : inner_outer)
(* End the loans *)
let env' =
match lc with
- | SharedLoan (bids, _) -> end_outer_borrows config bids env
- | MutLoan bid -> end_outer_borrow config bid env
+ | V.SharedLoan (bids, _) -> end_outer_borrows config bids env
+ | V.MutLoan bid -> end_outer_borrow config bid env
in
(* Recursive call *)
activate_inactivated_mut_borrow config io l env'
@@ -776,12 +784,12 @@ let rec activate_inactivated_mut_borrow (config : C.config) (io : inner_outer)
assert (not (loans_in_value sv));
assert (not (bottom_in_value sv));
let check_not_inactivated bc =
- match bc with InactivatedMutBorrow _ -> false | _ -> true
+ match bc with V.InactivatedMutBorrow _ -> false | _ -> true
in
assert (not (check_borrows_in_value check_not_inactivated sv));
(* 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
+ let bids = V.BorrowId.Set.remove l bids in
let env1 = end_borrows config io bids env in
(* Promote the loan *)
let env2, borrowed_value = promote_shared_loan_to_mut_loan l env1 in
@@ -796,14 +804,14 @@ let rec activate_inactivated_mut_borrow (config : C.config) (io : inner_outer)
need to update the environment by ending borrows, expanding symbolic
values, etc. The following type is used to convey this information. *)
type path_fail_kind =
- | FailSharedLoan of BorrowId.Set.t
+ | FailSharedLoan of V.BorrowId.Set.t
(** Failure because we couldn't go inside a shared loan *)
- | FailMutLoan of BorrowId.id
+ | FailMutLoan of V.BorrowId.id
(** Failure because we couldn't go inside a mutable loan *)
- | FailInactivatedMutBorrow of BorrowId.id
+ | FailInactivatedMutBorrow of V.BorrowId.id
(** Failure because we couldn't go inside an inactivated mutable borrow
(which should get activated) *)
- | FailSymbolic of (E.projection_elem * symbolic_proj_comp)
+ | FailSymbolic of (E.projection_elem * V.symbolic_proj_comp)
(** Failure because we need to enter a symbolic value (and thus need to expand it) *)
| FailBottom of (int * E.projection_elem * ety)
(** Failure because we need to enter an any value - we can expand Bottom
@@ -811,7 +819,7 @@ type path_fail_kind =
were remaining in the path when we reached the error - this allows to
properly update the Bottom value, if needs be.
*)
- | FailBorrow of borrow_content
+ | FailBorrow of V.borrow_content
(** We got stuck because we couldn't enter a borrow *)
(** Result of evaluating a path (reading from a path/writing to a path)
@@ -822,7 +830,7 @@ type path_fail_kind =
type 'a path_access_result = ('a, path_fail_kind) result
(** The result of reading from/writing to a place *)
-type updated_read_value = { read : typed_value; updated : typed_value }
+type updated_read_value = { read : V.typed_value; updated : V.typed_value }
type projection_access = {
enter_shared_loans : bool;
@@ -837,8 +845,8 @@ type projection_access = {
*)
let rec access_projection (access : projection_access) (env : C.env)
(* Function to (eventually) update the value we find *)
- (update : typed_value -> typed_value) (p : E.projection) (v : typed_value)
- : (C.env * updated_read_value) path_access_result =
+ (update : V.typed_value -> V.typed_value) (p : E.projection)
+ (v : V.typed_value) : (C.env * updated_read_value) path_access_result =
(* For looking up/updating shared loans *)
let ek : exploration_kind =
{ enter_shared_loans = true; enter_mut_borrows = true; enter_abs = true }
@@ -851,9 +859,9 @@ let rec access_projection (access : projection_access) (env : C.env)
Ok (env, { read = v; updated = nv })
| pe :: p' -> (
(* Match on the projection element and the value *)
- match (pe, v.value) with
+ match (pe, v.V.value) with
(* Field projection *)
- | Field (ProjAdt (_def_id, opt_variant_id), field_id), Adt adt -> (
+ | Field (ProjAdt (_def_id, opt_variant_id), field_id), V.Adt adt -> (
(* Check that the projection is consistent with the current value *)
(match (opt_variant_id, adt.variant_id) with
| None, None -> ()
@@ -868,11 +876,11 @@ let rec access_projection (access : projection_access) (env : C.env)
let nvalues =
FieldId.update_nth adt.field_values field_id res.updated
in
- let nadt = Adt { adt with field_values = nvalues } in
+ let nadt = V.Adt { adt with V.field_values = nvalues } in
let updated = { v with value = nadt } in
Ok (env1, { res with updated }))
(* Tuples *)
- | Field (ProjTuple arity, field_id), Tuple values -> (
+ | Field (ProjTuple arity, field_id), V.Tuple values -> (
assert (arity = FieldId.length values);
let fv = FieldId.nth values field_id in
(* Project *)
@@ -881,12 +889,12 @@ let rec access_projection (access : projection_access) (env : C.env)
| Ok (env1, res) ->
(* Update the field value *)
let nvalues = FieldId.update_nth values field_id res.updated in
- let ntuple = Tuple nvalues in
+ let ntuple = V.Tuple nvalues in
let updated = { v with value = ntuple } in
Ok (env1, { res with updated })
(* If we reach Bottom, it may mean we need to expand an uninitialized
* enumeration value *))
- | Field (ProjAdt (_, Some _variant_id), _), Bottom ->
+ | Field (ProjAdt (_, Some _variant_id), _), V.Bottom ->
Error (FailBottom (1 + List.length p', pe, v.ty))
(* Symbolic value: needs to be expanded *)
| _, Symbolic sp ->
@@ -898,17 +906,17 @@ let rec access_projection (access : projection_access) (env : C.env)
match access_projection access env update p' bv with
| Error err -> Error err
| Ok (env1, res) ->
- let nv = { v with value = Assumed (Box res.updated) } in
+ let nv = { v with value = V.Assumed (V.Box res.updated) } in
Ok (env1, { res with updated = nv }))
(* Borrows *)
- | Deref, Borrow bc -> (
+ | Deref, V.Borrow bc -> (
match bc with
- | SharedBorrow bid ->
+ | V.SharedBorrow bid ->
(* Lookup the loan content, and explore from there *)
if access.lookup_shared_borrows then
match lookup_loan ek bid env with
- | MutLoan _ -> failwith "Expected a shared loan"
- | SharedLoan (bids, sv) -> (
+ | V.MutLoan _ -> failwith "Expected a shared loan"
+ | V.SharedLoan (bids, sv) -> (
(* Explore the shared value *)
match access_projection access env update p' sv with
| Error err -> Error err
@@ -917,27 +925,30 @@ let rec access_projection (access : projection_access) (env : C.env)
by [access_projection] *)
let env2 =
update_loan ek bid
- (SharedLoan (bids, res.updated))
+ (V.SharedLoan (bids, res.updated))
env1
in
(* Return - note that we don't need to update the borrow itself *)
Ok (env2, { res with updated = v }))
else Error (FailBorrow bc)
- | InactivatedMutBorrow bid -> Error (FailInactivatedMutBorrow bid)
- | MutBorrow (bid, bv) ->
+ | V.InactivatedMutBorrow bid -> Error (FailInactivatedMutBorrow bid)
+ | V.MutBorrow (bid, bv) ->
if access.enter_mut_borrows then
match access_projection access env update p' bv with
| Error err -> Error err
| Ok (env1, res) ->
let nv =
- { v with value = Borrow (MutBorrow (bid, res.updated)) }
+ {
+ v with
+ value = V.Borrow (V.MutBorrow (bid, res.updated));
+ }
in
Ok (env1, { res with updated = nv })
else Error (FailBorrow bc))
- | _, Loan lc -> (
+ | _, V.Loan lc -> (
match lc with
- | MutLoan bid -> Error (FailMutLoan bid)
- | SharedLoan (bids, sv) ->
+ | V.MutLoan bid -> Error (FailMutLoan bid)
+ | V.SharedLoan (bids, sv) ->
(* If we can enter shared loan, we ignore the loan. Pay attention
to the fact that we need to reexplore the *whole* place (i.e,
we mustn't ignore the current projection element *)
@@ -946,11 +957,16 @@ let rec access_projection (access : projection_access) (env : C.env)
| Error err -> Error err
| Ok (env1, res) ->
let nv =
- { v with value = Loan (SharedLoan (bids, res.updated)) }
+ {
+ v with
+ value = V.Loan (V.SharedLoan (bids, res.updated));
+ }
in
Ok (env1, { res with updated = nv })
else Error (FailSharedLoan bids))
- | _, (Concrete _ | Adt _ | Tuple _ | Bottom | Assumed _ | Borrow _) ->
+ | ( _,
+ ( V.Concrete _ | V.Adt _ | V.Tuple _ | V.Bottom | V.Assumed _
+ | V.Borrow _ ) ) ->
failwith "Inconsistent projection")
(** Generic function to access (read/write) the value at a given place.
@@ -961,8 +977,8 @@ let rec access_projection (access : projection_access) (env : C.env)
*)
let access_place (access : projection_access)
(* Function to (eventually) update the value we find *)
- (update : typed_value -> typed_value) (p : E.place) (env : C.env) :
- (C.env * typed_value) path_access_result =
+ (update : V.typed_value -> V.typed_value) (p : E.place) (env : C.env) :
+ (C.env * V.typed_value) path_access_result =
(* Lookup the variable's value *)
let value = C.env_lookup_var_value env p.var_id in
(* Apply the projection *)
@@ -1003,7 +1019,7 @@ let access_kind_to_projection_access (access : access_kind) : projection_access
(** Read the value at a given place *)
let read_place (config : C.config) (access : access_kind) (p : E.place)
- (env : C.env) : typed_value path_access_result =
+ (env : C.env) : V.typed_value path_access_result =
let access = access_kind_to_projection_access access in
(* The update function is the identity *)
let update v = v in
@@ -1017,14 +1033,14 @@ let read_place (config : C.config) (access : access_kind) (p : E.place)
Ok read_value
let read_place_unwrap (config : C.config) (access : access_kind) (p : E.place)
- (env : C.env) : typed_value =
+ (env : C.env) : V.typed_value =
match read_place config access p env with
| Error _ -> failwith "Unreachable"
| Ok v -> v
(** Update the value at a given place *)
let write_place (_config : C.config) (access : access_kind) (p : E.place)
- (nv : typed_value) (env : C.env) : C.env path_access_result =
+ (nv : V.typed_value) (env : C.env) : C.env path_access_result =
let access = access_kind_to_projection_access access in
(* The update function substitutes the value with the new value *)
let update _ = nv in
@@ -1035,7 +1051,7 @@ let write_place (_config : C.config) (access : access_kind) (p : E.place)
Ok env1
let write_place_unwrap (config : C.config) (access : access_kind) (p : E.place)
- (nv : typed_value) (env : C.env) : C.env =
+ (nv : V.typed_value) (env : C.env) : C.env =
match write_place config access p nv env with
| Error _ -> failwith "Unreachable"
| Ok env -> env
@@ -1103,11 +1119,11 @@ let expand_bottom_value (config : C.config) (access : access_kind)
let fields = FieldId.vector_to_list fields in
let fields =
List.map
- (fun f -> { value = Bottom; ty = erase_regions f.field_ty })
+ (fun f -> { V.value = Bottom; ty = erase_regions f.field_ty })
fields
in
let fields = FieldId.vector_of_list fields in
- Values.Adt
+ V.Adt
{
def_id;
variant_id = opt_variant_id;
@@ -1118,12 +1134,12 @@ let expand_bottom_value (config : C.config) (access : access_kind)
| Field (ProjTuple arity, _), Types.Tuple tys ->
assert (arity = List.length tys);
(* Generate the field values *)
- let fields = List.map (fun ty -> { value = Bottom; ty }) tys in
+ let fields = List.map (fun ty -> { V.value = Bottom; ty }) tys in
let fields = FieldId.vector_of_list fields in
- Values.Tuple fields
+ V.Tuple fields
| _ -> failwith "Unreachable"
in
- let nv = { value = nv; ty } in
+ let nv = { V.value = nv; ty } in
(* Update the environment by inserting the expanded value at the proper place *)
match write_place config access p' nv env with
| Ok env -> env
@@ -1164,7 +1180,7 @@ let rec update_env_along_read_place (config : C.config) (access : access_kind)
See [update_env_alond_read_place].
*)
let rec update_env_along_write_place (config : C.config) (access : access_kind)
- (tyctx : type_def TypeDefId.vector) (p : E.place) (nv : typed_value)
+ (tyctx : type_def TypeDefId.vector) (p : E.place) (nv : V.typed_value)
(env : C.env) : C.env =
(* Attempt to write the place: if it fails, update the environment and retry *)
match write_place config access p nv env with
@@ -1209,31 +1225,31 @@ let rec collect_borrows_at_place (config : C.config) (access : access_kind)
We use exceptions to make it handy.
*)
let rec inspect_update v : unit =
- match v.value with
- | Concrete _ -> ()
- | Bottom ->
+ match v.V.value with
+ | V.Concrete _ -> ()
+ | V.Bottom ->
failwith "Unreachable"
(* note that we don't really need to fail here *)
- | Symbolic _ ->
+ | V.Symbolic _ ->
(* Nothing to do for symbolic values - note that if the value needs
to be copied, etc. we perform additional checks later *)
()
- | Adt adt -> FieldId.iter inspect_update adt.field_values
- | Tuple values -> FieldId.iter inspect_update values
- | Assumed (Box v) -> inspect_update v
- | Borrow bc -> (
+ | V.Adt adt -> FieldId.iter inspect_update adt.field_values
+ | V.Tuple values -> FieldId.iter inspect_update values
+ | V.Assumed (Box v) -> inspect_update v
+ | V.Borrow bc -> (
match bc with
- | SharedBorrow _ -> ()
- | MutBorrow (_, tv) -> inspect_update tv
- | InactivatedMutBorrow bid ->
+ | V.SharedBorrow _ -> ()
+ | V.MutBorrow (_, tv) -> inspect_update tv
+ | V.InactivatedMutBorrow bid ->
(* We need to activate inactivated borrows *)
let env' =
activate_inactivated_mut_borrow config Inner bid env
in
raise (UpdateEnv env'))
- | Loan lc -> (
+ | V.Loan lc -> (
match lc with
- | SharedLoan (bids, ty) -> (
+ | V.SharedLoan (bids, ty) -> (
(* End the loans if we need a modification access, otherwise dive into
the shared value *)
match access with
@@ -1241,7 +1257,7 @@ let rec collect_borrows_at_place (config : C.config) (access : access_kind)
| Write | Move ->
let env' = end_outer_borrows config bids env in
raise (UpdateEnv env'))
- | MutLoan bid ->
+ | V.MutLoan bid ->
(* We always need to end mutable borrows *)
let env' = end_outer_borrow config bid env in
raise (UpdateEnv env'))
@@ -1293,20 +1309,20 @@ let rec drop_borrows_at_place (config : C.config) (p : E.place) (env : C.env) :
We use exceptions to make it handy.
*)
let rec inspect_update (end_loans : bool) v : unit =
- match v.value with
- | Concrete _ -> ()
- | Bottom ->
+ match v.V.value with
+ | V.Concrete _ -> ()
+ | V.Bottom ->
(* Note that we are going to *write* to the value: it is ok if this
value contains [Bottom] - and actually we introduce some
occurrences of [Bottom] by ending borrows *)
()
- | Symbolic _ ->
+ | V.Symbolic _ ->
(* Nothing to do for symbolic values - TODO: not sure *)
raise Unimplemented
- | Adt adt -> FieldId.iter (inspect_update end_loans) adt.field_values
- | Tuple values -> FieldId.iter (inspect_update end_loans) values
- | Assumed (Box v) -> inspect_update end_loans v
- | Borrow bc -> (
+ | V.Adt adt -> FieldId.iter (inspect_update end_loans) adt.field_values
+ | V.Tuple values -> FieldId.iter (inspect_update end_loans) values
+ | V.Assumed (Box v) -> inspect_update end_loans v
+ | V.Borrow bc -> (
assert (not end_loans);
(* Sanity check *)
(* We need to end all borrows. Note that we ignore the outer borrows
@@ -1316,16 +1332,16 @@ let rec drop_borrows_at_place (config : C.config) (p : E.place) (env : C.env) :
ourselves at the value at place p.
*)
match bc with
- | SharedBorrow bid | MutBorrow (bid, _) ->
+ | V.SharedBorrow bid | V.MutBorrow (bid, _) ->
raise (UpdateEnv (end_inner_borrow config bid env))
- | InactivatedMutBorrow bid ->
+ | V.InactivatedMutBorrow bid ->
(* We need to activate inactivated borrows - later, we will
* actually end it *)
let env' =
activate_inactivated_mut_borrow config Inner bid env
in
raise (UpdateEnv env'))
- | Loan lc ->
+ | V.Loan lc ->
if (* If we can, end the loans, otherwise ignore *)
end_loans then
(* We need to end all loans. Note that as all the borrows inside
@@ -1335,9 +1351,9 @@ let rec drop_borrows_at_place (config : C.config) (p : E.place) (env : C.env) :
(we can't ignore outer borrows this time).
*)
match lc with
- | SharedLoan (bids, _) ->
+ | V.SharedLoan (bids, _) ->
raise (UpdateEnv (end_outer_borrows config bids env))
- | MutLoan bid ->
+ | V.MutLoan bid ->
raise (UpdateEnv (end_outer_borrow config bid env))
else ()
in
@@ -1361,49 +1377,50 @@ let rec drop_borrows_at_place (config : C.config) (p : E.place) (env : C.env) :
Note that copying values might update the context. For instance, when
copying shared borrows, we need to insert new shared borrows in the context.
*)
-let rec copy_value (config : C.config) (ctx : C.eval_ctx) (v : typed_value) :
- C.eval_ctx * typed_value =
- match v.value with
- | Values.Concrete _ -> (ctx, v)
- | Values.Adt av ->
+let rec copy_value (config : C.config) (ctx : C.eval_ctx) (v : V.typed_value) :
+ C.eval_ctx * V.typed_value =
+ match v.V.value with
+ | V.Concrete _ -> (ctx, v)
+ | V.Adt av ->
let fields = FieldId.vector_to_list av.field_values in
let ctx', fields = List.fold_left_map (copy_value config) ctx fields in
let fields = FieldId.vector_of_list fields in
- (ctx', { v with value = Values.Adt { av with field_values = fields } })
- | Values.Tuple fields ->
+ (ctx', { v with V.value = V.Adt { av with field_values = fields } })
+ | V.Tuple fields ->
let fields = FieldId.vector_to_list fields in
let ctx', fields = List.fold_left_map (copy_value config) ctx fields in
let fields = FieldId.vector_of_list fields in
- (ctx', { v with value = Values.Tuple fields })
- | Values.Bottom -> failwith "Can't copy ⊥"
- | Values.Assumed _ -> failwith "Can't copy an assumed value"
- | Values.Borrow bc -> (
+ (ctx', { v with V.value = V.Tuple fields })
+ | V.Bottom -> failwith "Can't copy ⊥"
+ | V.Assumed _ -> failwith "Can't copy an assumed value"
+ | V.Borrow bc -> (
(* We can only copy shared borrows *)
match bc with
| SharedBorrow bid ->
let ctx', bid' = C.fresh_borrow_id ctx in
let env'' = reborrow_shared config bid bid' ctx'.env in
let ctx'' = { ctx' with env = env'' } in
- (ctx'', { v with value = Values.Borrow (SharedBorrow bid') })
+ (ctx'', { v with V.value = V.Borrow (SharedBorrow bid') })
| MutBorrow (_, _) -> failwith "Can't copy a mutable borrow"
- | InactivatedMutBorrow _ ->
+ | V.InactivatedMutBorrow _ ->
failwith "Can't copy an inactivated mut borrow")
- | Values.Loan lc -> (
+ | V.Loan lc -> (
(* We can only copy shared loans *)
match lc with
- | MutLoan _ -> failwith "Can't copy a mutable loan"
- | SharedLoan (_, sv) -> copy_value config ctx sv)
- | Values.Symbolic _sp ->
+ | V.MutLoan _ -> failwith "Can't copy a mutable loan"
+ | V.SharedLoan (_, sv) -> copy_value config ctx sv)
+ | V.Symbolic _sp ->
(* TODO: check that the value is copyable *)
raise Unimplemented
(** Convert a constant operand value to a typed value *)
let constant_value_to_typed_value (ctx : C.eval_ctx) (ty : ety)
- (cv : E.operand_constant_value) : typed_value =
+ (cv : E.operand_constant_value) : V.typed_value =
(* Check the type while converting *)
match (ty, cv) with
(* Unit *)
- | Types.Tuple [], Unit -> { value = Tuple (FieldId.vector_of_list []); ty }
+ | Types.Tuple [], Unit ->
+ { V.value = V.Tuple (FieldId.vector_of_list []); ty }
(* Adt with one variant and no fields *)
| Types.Adt (def_id, [], []), ConstantAdt def_id' ->
assert (def_id = def_id');
@@ -1425,7 +1442,7 @@ let constant_value_to_typed_value (ctx : C.eval_ctx) (ty : ety)
Some variant_id
in
let value =
- Adt
+ V.Adt
{
def_id;
variant_id;
@@ -1436,14 +1453,15 @@ let constant_value_to_typed_value (ctx : C.eval_ctx) (ty : ety)
in
{ value; ty }
(* Scalar, boolean... *)
- | Types.Bool, ConstantValue (Bool v) -> { value = Concrete (Bool v); ty }
- | Types.Char, ConstantValue (Char v) -> { value = Concrete (Char v); ty }
- | Types.Str, ConstantValue (String v) -> { value = Concrete (String v); ty }
- | Types.Integer int_ty, ConstantValue (Scalar v) ->
+ | Types.Bool, ConstantValue (Bool v) -> { V.value = V.Concrete (Bool v); ty }
+ | Types.Char, ConstantValue (Char v) -> { V.value = V.Concrete (Char v); ty }
+ | Types.Str, ConstantValue (String v) ->
+ { V.value = V.Concrete (String v); ty }
+ | Types.Integer int_ty, ConstantValue (V.Scalar v) ->
(* Check the type and the ranges *)
assert (int_ty == v.int_ty);
assert (check_scalar_value_in_range v);
- { value = Concrete (Scalar v); ty }
+ { V.value = V.Concrete (V.Scalar v); ty }
(* Remaining cases (invalid) - listing as much as we can on purpose
(allows to catch errors at compilation if the definitions change) *)
| _, Unit | _, ConstantAdt _ | _, ConstantValue _ ->
@@ -1451,7 +1469,7 @@ let constant_value_to_typed_value (ctx : C.eval_ctx) (ty : ety)
(** Small utility *)
let prepare_rplace (config : C.config) (access : access_kind) (p : E.place)
- (ctx : C.eval_ctx) : C.eval_ctx * typed_value =
+ (ctx : C.eval_ctx) : C.eval_ctx * V.typed_value =
let env1 = update_env_along_read_place config access p ctx.env in
let env2 = collect_borrows_at_place config access p env1 in
let v = read_place_unwrap config access p env2 in
@@ -1484,7 +1502,7 @@ let eval_operand_prepare (config : C.config) (ctx : C.eval_ctx) (op : E.operand)
(** See [eval_operand_prepare] (which should have been called before) *)
let eval_operand_apply (config : C.config) (ctx : C.eval_ctx) (op : E.operand) :
- C.eval_ctx * typed_value =
+ C.eval_ctx * V.typed_value =
match op with
| Expressions.Constant (ty, cv) ->
let v = constant_value_to_typed_value ctx ty cv in
@@ -1502,7 +1520,7 @@ let eval_operand_apply (config : C.config) (ctx : C.eval_ctx) (op : E.operand) :
let v = read_place_unwrap config access p ctx.env in
(* Move the value *)
assert (not (bottom_in_value v));
- let bottom = { value = Bottom; ty = v.ty } in
+ let bottom = { V.value = Bottom; ty = v.ty } in
match write_place config access p bottom ctx.env with
| Error _ -> failwith "Unreachable"
| Ok env1 ->
@@ -1517,7 +1535,7 @@ let eval_operand_apply (config : C.config) (ctx : C.eval_ctx) (op : E.operand) :
values via borrows).
*)
let eval_operand (config : C.config) (ctx : C.eval_ctx) (op : E.operand) :
- C.eval_ctx * typed_value =
+ C.eval_ctx * V.typed_value =
let ctx1 = eval_operand_prepare config ctx op in
eval_operand_apply config ctx1 op
@@ -1525,7 +1543,7 @@ let eval_operand (config : C.config) (ctx : C.eval_ctx) (op : E.operand) :
*)
let eval_operands (config : C.config) (ctx : C.eval_ctx) (ops : E.operand list)
- : C.eval_ctx * typed_value list =
+ : C.eval_ctx * V.typed_value list =
(* First prepare the values to end/activate the borrows *)
let ctx1 =
List.fold_left (fun ctx op -> eval_operand_prepare config ctx op) ctx ops
@@ -1534,30 +1552,30 @@ let eval_operands (config : C.config) (ctx : C.eval_ctx) (ops : E.operand list)
List.fold_left_map (fun ctx op -> eval_operand_apply config ctx op) ctx1 ops
let eval_two_operands (config : C.config) (ctx : C.eval_ctx) (op1 : E.operand)
- (op2 : E.operand) : C.eval_ctx * typed_value * typed_value =
+ (op2 : E.operand) : C.eval_ctx * V.typed_value * V.typed_value =
match eval_operands config ctx [ op1; op2 ] with
| ctx', [ v1; v2 ] -> (ctx', v1, v2)
| _ -> failwith "Unreachable"
let eval_unary_op (config : C.config) (ctx : C.eval_ctx) (unop : E.unop)
- (op : E.operand) : (C.eval_ctx * typed_value) eval_result =
+ (op : E.operand) : (C.eval_ctx * V.typed_value) eval_result =
(* Evaluate the operand *)
let ctx1, v = eval_operand config ctx op in
(* Apply the unop *)
- match (unop, v.value) with
- | E.Not, Concrete (Bool b) ->
- Ok (ctx1, { v with value = Concrete (Bool (not b)) })
- | E.Neg, Concrete (Scalar sv) -> (
- let i = Z.neg sv.value in
+ match (unop, v.V.value) with
+ | E.Not, V.Concrete (Bool b) ->
+ Ok (ctx1, { v with V.value = V.Concrete (Bool (not b)) })
+ | E.Neg, V.Concrete (V.Scalar sv) -> (
+ let i = Z.neg sv.V.value in
match mk_scalar sv.int_ty i with
| Error _ -> Error Panic
- | Ok sv -> Ok (ctx1, { v with value = Concrete (Scalar sv) }))
+ | Ok sv -> Ok (ctx1, { v with V.value = V.Concrete (V.Scalar sv) }))
| (E.Not | E.Neg), Symbolic _ -> raise Unimplemented (* TODO *)
| _ -> failwith "Invalid value for unop"
let eval_binary_op (config : C.config) (ctx : C.eval_ctx) (binop : E.binop)
- (op1 : E.operand) (op2 : E.operand) : (C.eval_ctx * typed_value) eval_result
- =
+ (op1 : E.operand) (op2 : E.operand) :
+ (C.eval_ctx * V.typed_value) eval_result =
(* Evaluate the operands *)
let ctx2, v1, v2 = eval_two_operands config ctx op1 op2 in
if
@@ -1568,10 +1586,10 @@ let eval_binary_op (config : C.config) (ctx : C.eval_ctx) (binop : E.binop)
(* Equality/inequality check is primitive only on primitive types *)
assert (v1.ty = v2.ty);
let b = v1 = v2 in
- Ok (ctx2, { value = Concrete (Bool b); ty = Types.Bool }))
+ Ok (ctx2, { V.value = V.Concrete (Bool b); ty = Types.Bool }))
else
- match (v1.value, v2.value) with
- | Concrete (Scalar sv1), Concrete (Scalar sv2) -> (
+ match (v1.V.value, v2.V.value) with
+ | V.Concrete (V.Scalar sv1), V.Concrete (V.Scalar sv2) -> (
let res =
(* There are binops which require the two operands to have the same
type, and binops for which it is not the case.
@@ -1584,15 +1602,15 @@ let eval_binary_op (config : C.config) (ctx : C.eval_ctx) (binop : E.binop)
assert (sv1.int_ty = sv2.int_ty);
let b =
match binop with
- | E.Lt -> Z.lt sv1.value sv1.value
- | E.Le -> Z.leq sv1.value sv1.value
- | E.Ge -> Z.geq sv1.value sv1.value
- | E.Gt -> Z.gt sv1.value sv1.value
+ | E.Lt -> Z.lt sv1.V.value sv1.V.value
+ | E.Le -> Z.leq sv1.V.value sv1.V.value
+ | E.Ge -> Z.geq sv1.V.value sv1.V.value
+ | E.Gt -> Z.gt sv1.V.value sv1.V.value
| E.Div | E.Rem | E.Add | E.Sub | E.Mul | E.BitXor | E.BitAnd
| E.BitOr | E.Shl | E.Shr | E.Ne | E.Eq ->
failwith "Unreachable"
in
- Ok { value = Concrete (Bool b); ty = Types.Bool }
+ Ok { V.value = V.Concrete (Bool b); ty = Types.Bool }
| E.Div | E.Rem | E.Add | E.Sub | E.Mul | E.BitXor | E.BitAnd
| E.BitOr -> (
(* The two operands must have the same type and the result is an integer *)
@@ -1600,15 +1618,15 @@ let eval_binary_op (config : C.config) (ctx : C.eval_ctx) (binop : E.binop)
let res =
match binop with
| E.Div ->
- if sv2.value = Z.zero then Error ()
- else mk_scalar sv1.int_ty (Z.div sv1.value sv2.value)
+ if sv2.V.value = Z.zero then Error ()
+ else mk_scalar sv1.int_ty (Z.div sv1.V.value sv2.V.value)
| E.Rem ->
(* See [https://github.com/ocaml/Zarith/blob/master/z.mli] *)
- if sv2.value = Z.zero then Error ()
- else mk_scalar sv1.int_ty (Z.rem sv1.value sv2.value)
- | E.Add -> mk_scalar sv1.int_ty (Z.add sv1.value sv2.value)
- | E.Sub -> mk_scalar sv1.int_ty (Z.sub sv1.value sv2.value)
- | E.Mul -> mk_scalar sv1.int_ty (Z.mul sv1.value sv2.value)
+ if sv2.V.value = Z.zero then Error ()
+ else mk_scalar sv1.int_ty (Z.rem sv1.V.value sv2.V.value)
+ | E.Add -> mk_scalar sv1.int_ty (Z.add sv1.V.value sv2.V.value)
+ | E.Sub -> mk_scalar sv1.int_ty (Z.sub sv1.V.value sv2.V.value)
+ | E.Mul -> mk_scalar sv1.int_ty (Z.mul sv1.V.value sv2.V.value)
| E.BitXor -> raise Unimplemented
| E.BitAnd -> raise Unimplemented
| E.BitOr -> raise Unimplemented
@@ -1618,7 +1636,11 @@ let eval_binary_op (config : C.config) (ctx : C.eval_ctx) (binop : E.binop)
match res with
| Error err -> Error err
| Ok sv ->
- Ok { value = Concrete (Scalar sv); ty = Integer sv1.int_ty })
+ Ok
+ {
+ V.value = V.Concrete (V.Scalar sv);
+ ty = Integer sv1.int_ty;
+ })
| E.Shl | E.Shr -> raise Unimplemented
| E.Ne | E.Eq -> failwith "Unreachable"
in
@@ -1628,7 +1650,7 @@ let eval_binary_op (config : C.config) (ctx : C.eval_ctx) (binop : E.binop)
(** Evaluate an rvalue in a given context: return the updated context and
the computed value *)
let eval_rvalue (config : C.config) (ctx : C.eval_ctx) (rvalue : E.rvalue) :
- (C.eval_ctx * typed_value) eval_result =
+ (C.eval_ctx * V.typed_value) eval_result =
match rvalue with
| E.Use op -> Ok (eval_operand config ctx op)
| E.Ref (p, bkind) -> (
@@ -1641,21 +1663,23 @@ let eval_rvalue (config : C.config) (ctx : C.eval_ctx) (rvalue : E.rvalue) :
let ctx3, bid = C.fresh_borrow_id ctx2 in
let rv_ty = Types.Ref (Erased, v.ty, Shared) in
let bc =
- if bkind = E.Shared then SharedBorrow bid
- else InactivatedMutBorrow bid
+ if bkind = E.Shared then V.SharedBorrow bid
+ else V.InactivatedMutBorrow bid
in
- let rv = { value = Borrow bc; ty = rv_ty } in
+ let rv = { V.value = V.Borrow bc; ty = rv_ty } in
(* Compute the value with which to replace the value at place p *)
let nv =
- match v.value with
- | Loan (SharedLoan (bids, sv)) ->
+ match v.V.value with
+ | V.Loan (V.SharedLoan (bids, sv)) ->
(* Shared loan: insert the new borrow id *)
- let bids1 = BorrowId.Set.add bid bids in
- { v with value = Loan (SharedLoan (bids1, sv)) }
+ let bids1 = V.BorrowId.Set.add bid bids in
+ { v with V.value = V.Loan (V.SharedLoan (bids1, sv)) }
| _ ->
(* Not a shared loan: add a wrapper *)
- let v' = Loan (SharedLoan (BorrowId.Set.singleton bid, v)) in
- { v with value = v' }
+ let v' =
+ V.Loan (V.SharedLoan (V.BorrowId.Set.singleton bid, v))
+ in
+ { v with V.value = v' }
in
(* Update the value in the environment *)
let env4 = write_place_unwrap config access p nv ctx3.env in
@@ -1668,9 +1692,9 @@ let eval_rvalue (config : C.config) (ctx : C.eval_ctx) (rvalue : E.rvalue) :
(* Compute the rvalue - wrap the value in a mutable borrow with a fresh id *)
let ctx3, bid = C.fresh_borrow_id ctx2 in
let rv_ty = Types.Ref (Erased, v.ty, Mut) in
- let rv = { value = Borrow (MutBorrow (bid, v)); ty = rv_ty } in
+ let rv = { V.value = V.Borrow (V.MutBorrow (bid, v)); ty = rv_ty } in
(* Compute the value with which to replace the value at place p *)
- let nv = { v with value = Loan (MutLoan bid) } in
+ let nv = { v with V.value = V.Loan (V.MutLoan bid) } in
(* Update the value in the environment *)
let env4 = write_place_unwrap config access p nv ctx3.env in
(* Return *)
@@ -1682,7 +1706,7 @@ let eval_rvalue (config : C.config) (ctx : C.eval_ctx) (rvalue : E.rvalue) :
(* Access the value *)
let access = Read in
let ctx1, v = prepare_rplace config access p ctx in
- match v.value with
+ match v.V.value with
| Adt av -> (
match av.variant_id with
| None ->
@@ -1695,8 +1719,10 @@ let eval_rvalue (config : C.config) (ctx : C.eval_ctx) (rvalue : E.rvalue) :
failwith "Disciminant id out of range"
(* Should really never happen *)
| Ok sv ->
- Ok (ctx1, { value = Concrete (Scalar sv); ty = Integer Isize })
- ))
+ Ok
+ ( ctx1,
+ { V.value = V.Concrete (V.Scalar sv); ty = Integer Isize }
+ )))
| _ -> failwith "Invalid input for `discriminant`")
| E.Aggregate (aggregate_kind, ops) -> (
(* Evaluate the operands *)
@@ -1705,8 +1731,10 @@ let eval_rvalue (config : C.config) (ctx : C.eval_ctx) (rvalue : E.rvalue) :
(* Match on the aggregate kind *)
match aggregate_kind with
| E.AggregatedTuple ->
- let tys = List.map (fun v -> v.ty) (FieldId.vector_to_list values) in
- Ok (ctx1, { value = Tuple values; ty = Types.Tuple tys })
+ let tys =
+ List.map (fun v -> v.V.ty) (FieldId.vector_to_list values)
+ in
+ Ok (ctx1, { V.value = Tuple values; ty = Types.Tuple tys })
| E.AggregatedAdt (def_id, opt_variant_id, regions, types) ->
(* Sanity checks *)
let type_def = C.ctx_lookup_type_def ctx def_id in
@@ -1716,19 +1744,19 @@ let eval_rvalue (config : C.config) (ctx : C.eval_ctx) (rvalue : E.rvalue) :
Subst.ctx_adt_get_instantiated_field_types ctx1 def_id
opt_variant_id types
in
- assert (expected_field_types = FieldId.map (fun v -> v.ty) values);
+ assert (expected_field_types = FieldId.map (fun v -> v.V.ty) values);
(* Construct the value *)
let av =
{
- def_id;
- variant_id = opt_variant_id;
- regions;
- types;
- field_values = values;
+ V.def_id;
+ V.variant_id = opt_variant_id;
+ V.regions;
+ V.types;
+ V.field_values = values;
}
in
let aty = Types.Adt (def_id, regions, types) in
- Ok (ctx1, { value = Adt av; ty = aty }))
+ Ok (ctx1, { V.value = Adt av; ty = aty }))
(** Result of evaluating a statement *)
type statement_eval_res = Unit | Break of int | Continue of int | Panic