summaryrefslogtreecommitdiff
path: root/compiler/Values.ml
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--compiler/Values.ml58
1 files changed, 46 insertions, 12 deletions
diff --git a/compiler/Values.ml b/compiler/Values.ml
index 9c68ad4f..f6f4d1b6 100644
--- a/compiler/Values.ml
+++ b/compiler/Values.ml
@@ -15,6 +15,7 @@ module LoopId = IdGen ()
type big_int = PrimitiveValues.big_int [@@deriving show, ord]
type scalar_value = PrimitiveValues.scalar_value [@@deriving show, ord]
type primitive_value = PrimitiveValues.primitive_value [@@deriving show, ord]
+type symbolic_value_id = SymbolicValueId.id [@@deriving show, ord]
(** The kind of a symbolic value, which precises how the value was generated.
@@ -49,13 +50,54 @@ type sv_kind =
(** The result of a loop join (when computing loop fixed points) *)
[@@deriving show, ord]
+(** Ancestor for {!symbolic_value} iter visitor *)
+class ['self] iter_symbolic_value_base =
+ object (_self : 'self)
+ inherit [_] VisitorsRuntime.iter
+ method visit_sv_kind : 'env -> sv_kind -> unit = fun _ _ -> ()
+ method visit_rty : 'env -> rty -> unit = fun _ _ -> ()
+
+ method visit_symbolic_value_id : 'env -> symbolic_value_id -> unit =
+ fun _ _ -> ()
+ end
+
+(** Ancestor for {!symbolic_value} map visitor for *)
+class ['self] map_symbolic_value_base =
+ object (_self : 'self)
+ inherit [_] VisitorsRuntime.map
+ method visit_sv_kind : 'env -> sv_kind -> sv_kind = fun _ x -> x
+ method visit_rty : 'env -> rty -> rty = fun _ x -> x
+
+ method visit_symbolic_value_id
+ : 'env -> symbolic_value_id -> symbolic_value_id =
+ fun _ x -> x
+ end
+
(** A symbolic value *)
type symbolic_value = {
sv_kind : sv_kind;
- sv_id : SymbolicValueId.id;
+ sv_id : symbolic_value_id;
sv_ty : rty;
}
-[@@deriving show, ord]
+[@@deriving
+ show,
+ ord,
+ visitors
+ {
+ name = "iter_symbolic_value";
+ variety = "iter";
+ ancestors = [ "iter_symbolic_value_base" ];
+ nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
+ concrete = true;
+ },
+ visitors
+ {
+ name = "map_symbolic_value";
+ variety = "map";
+ ancestors = [ "map_symbolic_value_base" ];
+ nude = true (* Don't inherit {!VisitorsRuntime.iter} *);
+ concrete = true;
+ }]
type borrow_id = BorrowId.id [@@deriving show, ord]
type borrow_id_set = BorrowId.Set.t [@@deriving show, ord]
@@ -65,13 +107,12 @@ type loan_id_set = BorrowId.Set.t [@@deriving show, ord]
(** Ancestor for {!typed_value} iter visitor *)
class ['self] iter_typed_value_base =
object (self : 'self)
- inherit [_] VisitorsRuntime.iter
+ inherit [_] iter_symbolic_value
method visit_primitive_value : 'env -> primitive_value -> unit =
fun _ _ -> ()
method visit_erased_region : 'env -> erased_region -> unit = fun _ _ -> ()
- method visit_symbolic_value : 'env -> symbolic_value -> unit = fun _ _ -> ()
method visit_variant_id : 'env -> variant_id -> unit = fun _ _ -> ()
method visit_ety : 'env -> ety -> unit = fun _ _ -> ()
method visit_borrow_id : 'env -> borrow_id -> unit = fun _ _ -> ()
@@ -87,7 +128,7 @@ class ['self] iter_typed_value_base =
(** Ancestor for {!typed_value} map visitor for *)
class ['self] map_typed_value_base =
object (self : 'self)
- inherit [_] VisitorsRuntime.map
+ inherit [_] map_symbolic_value
method visit_primitive_value : 'env -> primitive_value -> primitive_value =
fun _ cv -> cv
@@ -95,9 +136,6 @@ class ['self] map_typed_value_base =
method visit_erased_region : 'env -> erased_region -> erased_region =
fun _ r -> r
- method visit_symbolic_value : 'env -> symbolic_value -> symbolic_value =
- fun _ sv -> sv
-
method visit_ety : 'env -> ety -> ety = fun _ ty -> ty
method visit_variant_id : 'env -> variant_id -> variant_id = fun _ x -> x
method visit_borrow_id : 'env -> borrow_id -> borrow_id = fun _ id -> id
@@ -243,8 +281,6 @@ class ['self] iter_typed_value =
method visit_msymbolic_value : 'env -> msymbolic_value -> unit =
fun _ _ -> ()
-
- method visit_rty : 'env -> rty -> unit = fun _ _ -> ()
end
class ['self] map_typed_value =
@@ -255,8 +291,6 @@ class ['self] map_typed_value =
to ignore meta-values *)
method! visit_mvalue : 'env -> mvalue -> mvalue = fun _ x -> x
- method visit_rty : 'env -> rty -> rty = fun _ ty -> ty
-
method visit_msymbolic_value : 'env -> msymbolic_value -> msymbolic_value =
fun _ m -> m
end