summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Values.ml54
-rw-r--r--src/dune2
2 files changed, 47 insertions, 9 deletions
diff --git a/src/Values.ml b/src/Values.ml
index 29a305aa..2cc12067 100644
--- a/src/Values.ml
+++ b/src/Values.ml
@@ -65,6 +65,13 @@ type symbolic_proj_comp = {
regions *but* the ones which are listed in the projector.
*)
+(** Polymorphic visitor *)
+class virtual ['self] iter_'r_ty_base =
+ object (self : 'self)
+ method visit_ty : 'env 'r. ('env -> 'r -> unit) -> 'env -> 'r ty -> unit =
+ fun visit_'r env ty -> ()
+ end
+
(** A generic, untyped value, used in the environments.
Parameterized by:
@@ -75,7 +82,7 @@ type symbolic_proj_comp = {
Can be specialized for "regular" values or values in abstractions *)
type ('r, 'sv, 'bc, 'lc) g_value =
- | Concrete of constant_value (** Concrete (non-symbolic) value *)
+ | Concrete of (constant_value[@opaque]) (** Concrete (non-symbolic) value *)
| Adt of ('r, 'sv, 'bc, 'lc) g_adt_value
(** Enumerations, structures, tuples, assumed types. Note that units
are encoded as 0-tuples *)
@@ -85,7 +92,7 @@ type ('r, 'sv, 'bc, 'lc) g_value =
| Symbolic of 'sv (** Unknown value *)
and ('r, 'sv, 'bc, 'lc) g_adt_value = {
- variant_id : VariantId.id option;
+ variant_id : VariantId.id option; [@opaque]
field_values : ('r, 'sv, 'bc, 'lc) g_typed_value list;
}
@@ -95,7 +102,26 @@ and ('r, 'sv, 'bc, 'lc) g_typed_value = {
value : ('r, 'sv, 'bc, 'lc) g_value;
ty : 'r ty;
}
-[@@deriving show]
+[@@deriving
+ show,
+ visitors
+ {
+ name = "iter_g_typed_value";
+ variety = "iter";
+ polymorphic = true;
+ ancestors = [ "iter_'r_ty_base" ];
+ }]
+
+class virtual ['self] iter_typed_value_base =
+ object (self : 'self)
+ inherit [_] iter_g_typed_value
+
+ method visit_erased_region : 'env. 'env -> erased_region -> unit =
+ fun env _ -> ()
+
+ method visit_symbolic_proj_comp : 'env. 'env -> symbolic_proj_comp -> unit =
+ fun env _ -> ()
+ end
type value =
(erased_region, symbolic_proj_comp, borrow_content, loan_content) g_value
@@ -110,13 +136,23 @@ and typed_value =
borrow_content,
loan_content )
g_typed_value
-[@@deriving show]
+[@@deriving
+ show,
+ visitors
+ {
+ name = "iter_typed_value";
+ variety = "iter";
+ ancestors = [ "iter_typed_value_base" ];
+ polymorphic = true;
+ nude = true (* Don't inherit [VisitorsRuntime.iter] *);
+ }]
(** "Regular" typed value (we map variables to typed values) *)
and borrow_content =
- | SharedBorrow of BorrowId.id (** A shared value *)
- | MutBorrow of BorrowId.id * typed_value (** A mutably borrowed value *)
- | InactivatedMutBorrow of BorrowId.id
+ | SharedBorrow of (BorrowId.id[@opaque]) (** A shared value *)
+ | MutBorrow of (BorrowId.id[@opaque]) * typed_value
+ (** A mutably borrowed value *)
+ | InactivatedMutBorrow of (BorrowId.id[@opaque])
(** An inactivated mut borrow.
This is used to model two-phase borrows. When evaluating a two-phase
@@ -129,8 +165,8 @@ and borrow_content =
*)
and loan_content =
- | SharedLoan of BorrowId.set_t * typed_value
- | MutLoan of BorrowId.id
+ | SharedLoan of (BorrowId.set_t[@opaque]) * typed_value
+ | MutLoan of (BorrowId.id[@opaque])
[@@deriving show]
type abstract_shared_borrows =
diff --git a/src/dune b/src/dune
index ac0480d3..e64c3cb1 100644
--- a/src/dune
+++ b/src/dune
@@ -8,11 +8,13 @@
:standard
-safe-string
-g
+ -dsource
-warn-error -9-11-33-20-21-26-27-39
))
(release (flags
:standard
-safe-string
-g
+ -dsource
-warn-error -9-11-33-20-21-26-27-39
)))