1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
exception Multiple_definition_of_var of Dolmen.Std.Expr.Term.Var.t
exception Multiple_definition_of_cst of Dolmen.Std.Expr.Term.Const.t
exception Partial_interpretation of
Dolmen.Std.Expr.Term.Const.t * Value.t list
exception Incorrect_extension of
Dolmen.Std.Expr.Term.Const.t * Value.t list * Value.t
module V = Map.Make(Dolmen.Std.Expr.Term.Var)
module C = Map.Make(Dolmen.Std.Expr.Term.Const)
type t = {
vars : Value.t V.t;
csts : Value.t C.t;
}
let empty =
{ vars = V.empty; csts = C.empty; }
let print fmt model =
Format.fprintf fmt "@[<hv>@[<hv 2>{";
V.iter (fun var value ->
Format.fprintf fmt "@ %a -> @[<hov 2>%a@]"
Dolmen.Std.Expr.Term.Var.print var Value.print value
) model.vars;
C.iter (fun cst value ->
Format.fprintf fmt "@ %a -> @[<hov 2>%a@]"
Dolmen.Std.Expr.Term.Const.print cst Value.print value
) model.csts;
Format.fprintf fmt "@]@ }@]"
let disjoint_union m m' =
let vars =
V.union
(fun v _ _ -> raise (Multiple_definition_of_var v))
m.vars m'.vars
in
let csts =
C.union
(fun c _ _ -> raise (Multiple_definition_of_cst c))
m.csts m'.csts
in
{ vars; csts; }
module type S = sig
type key
val find_opt : key -> t -> Value.t option
val add : key -> Value.t -> t -> t
val remove : key -> t -> t
end
module Var
: S with type key := Dolmen.Std.Expr.Term.Var.t
= struct
let[@inline] find_opt v t =
match V.find v t.vars with
| res -> Some res
| exception Not_found -> None
let add v value t =
{ t with vars = V.add v value t.vars; }
let remove v t =
{ t with vars = V.remove v t.vars; }
end
module Cst
: S with type key := Dolmen.Std.Expr.Term.Const.t
= struct
let[@inline] find_opt c t =
match C.find c t.csts with
| res -> Some res
| exception Not_found -> None
let add c value t =
{ t with csts = C.add c value t.csts; }
let remove c t =
{ t with csts = C.remove c t.csts; }
end