summaryrefslogtreecommitdiff
path: root/src/InterpreterBorrowsCore.ml
diff options
context:
space:
mode:
authorSon Ho2022-01-12 20:28:08 +0100
committerSon Ho2022-01-12 20:28:08 +0100
commitcca136848b4310a02b78f2567d7c476df8c88025 (patch)
tree0816dd7790bd425e4150100e3722698eed80f2ae /src/InterpreterBorrowsCore.ml
parent14f7c587a6100fe0b2985e3afd123f79fde8d468 (diff)
Update end_borrow to check if there are loans in borrowed values
Diffstat (limited to 'src/InterpreterBorrowsCore.ml')
-rw-r--r--src/InterpreterBorrowsCore.ml50
1 files changed, 47 insertions, 3 deletions
diff --git a/src/InterpreterBorrowsCore.ml b/src/InterpreterBorrowsCore.ml
index 13ad8ee6..3d908e73 100644
--- a/src/InterpreterBorrowsCore.ml
+++ b/src/InterpreterBorrowsCore.ml
@@ -38,19 +38,27 @@ let ek_all : exploration_kind =
*)
type inner_outer = Inner | Outer
-type borrow_ids = Borrows of V.BorrowId.Set.t | Borrow of V.BorrowId.id
+type borrow_ids = Borrows of V.BorrowId.set_t | Borrow of V.BorrowId.id
+[@@deriving show]
exception FoundBorrowIds of borrow_ids
-type outer_borrows_or_abs =
+type priority_borrows_or_abs =
| OuterBorrows of borrow_ids
| OuterAbs of V.AbstractionId.id
+ | InnerLoans of borrow_ids
+[@@deriving show]
let update_if_none opt x = match opt with None -> Some x | _ -> opt
-exception FoundOuter of outer_borrows_or_abs
+exception FoundPriority of priority_borrows_or_abs
(** Utility exception *)
+type loan_or_borrow_content =
+ | LoanContent of V.loan_content
+ | BorrowContent of V.borrow_content
+[@@deriving show]
+
(** Lookup a loan content.
The loan is referred to by a borrow id.
@@ -469,3 +477,39 @@ let get_first_loan_in_value (v : V.typed_value) : V.loan_content option =
obj#visit_typed_value () v;
None
with FoundLoanContent lc -> Some lc
+
+(** Return the first borrow we find in a value *)
+let get_first_borrow_in_value (v : V.typed_value) : V.borrow_content option =
+ let obj =
+ object
+ inherit [_] V.iter_typed_value
+
+ method! visit_borrow_content _ bc = raise (FoundBorrowContent bc)
+ end
+ in
+ (* We use exceptions *)
+ try
+ obj#visit_typed_value () v;
+ None
+ with FoundBorrowContent bc -> Some bc
+
+(** Return the first loan or borrow content we find in a value (starting with
+ the outer ones) *)
+let get_first_loan_or_borrow_in_value (v : V.typed_value) :
+ loan_or_borrow_content option =
+ let obj =
+ object
+ inherit [_] V.iter_typed_value
+
+ method! visit_borrow_content _ bc = raise (FoundBorrowContent bc)
+
+ method! visit_loan_content _ lc = raise (FoundLoanContent lc)
+ end
+ in
+ (* We use exceptions *)
+ try
+ obj#visit_typed_value () v;
+ None
+ with
+ | FoundLoanContent lc -> Some (LoanContent lc)
+ | FoundBorrowContent bc -> Some (BorrowContent bc)