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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
(** Cache of post-conditions and evaluations *)
open Flow
open Eval
open Post
open Manager
open Ast.Expr
open Ast.Stmt
open Route
open Alarm
open Mopsa_utils
let debug fmt = Debug.debug ~channel:"framework.core.cache" fmt
let opt_cache = ref 2
(** {2 Queue} *)
module type KEY =
sig
type t
val equal : t -> t -> bool
end
module Queue(Key:KEY) =
struct
type 'a t = {
elements: (Key.t * 'a) option array;
size: int;
mutable next: int;
}
let create (size:int) : 'a t =
{
elements = Array.make size None;
size = size;
next = 0;
}
let add (k:Key.t) (v:'a) (q:'a t) : unit =
Array.set q.elements q.next (Some (k, v));
q.next <- (q.next + 1) mod q.size
let find (k:Key.t) (q:'a t) : 'a =
let prev i =
if i = 0 then q.size - 1 else i - 1
in
let rec aux i =
if i = q.next
then raise Not_found
else match Array.get q.elements i with
| None -> raise Not_found
| Some (k',v) when Key.equal k k' -> v
| _ -> aux (prev i)
in
aux (prev q.next)
end
(** {2 Cache} *)
module Make(Domain: sig type t end) =
struct
(** {2 Cache of post-conditions} *)
(** **************************** *)
module ExecCache = Queue(
struct
type t = route * stmt * Domain.t Token.TokenMap.t * Alarm.report
let equal (route1,stmt1,tmap1,report1) (route2,stmt2,tmap2,report2) =
compare_route route1 route2 = 0 &&
stmt1 == stmt2 &&
tmap1 == tmap2 &&
report1 == report2
end
)
let exec_cache : Domain.t post option ExecCache.t = ExecCache.create !opt_cache
let exec f semantic stmt man flow =
if !opt_cache = 0
then f stmt man flow
else try
let tmap = Flow.get_token_map flow in
let report = Flow.get_report flow in
let opost = ExecCache.find (semantic,stmt,tmap,report) exec_cache in
OptionExt.lift (fun post ->
Cases.set_ctx (
Context.most_recent_ctx (Cases.get_ctx post) (Flow.get_ctx flow)
) post
) opost
with Not_found ->
let post = f stmt man flow in
ExecCache.add (semantic, stmt, Flow.get_token_map flow, Flow.get_report flow) post exec_cache;
post
(** {2 Cache of evaluations} *)
(** ************************ *)
module EvalCache = Queue(
struct
type t = route * expr * Domain.t Token.TokenMap.t * Alarm.report
let equal (route1,exp1,tmap1,report1) (route2,exp2,tmap2,report2) =
compare_route route1 route2 = 0 &&
exp1 == exp2 &&
tmap1 == tmap2 &&
report1 == report2
end
)
let eval_cache : Domain.t eval option EvalCache.t = EvalCache.create !opt_cache
let eval f route exp man flow =
if !opt_cache = 0
then f exp man flow
else try
let tmap = Flow.get_token_map flow in
let report = Flow.get_report flow in
let evls = EvalCache.find (route,exp,tmap,report) eval_cache in
OptionExt.lift (fun evl ->
let ctx = Context.most_recent_ctx (Cases.get_ctx evl) (Flow.get_ctx flow) in
Cases.set_ctx ctx evl
) evls
with Not_found ->
let evals = f exp man flow in
EvalCache.add (route, exp, Flow.get_token_map flow, Flow.get_report flow) evals eval_cache;
evals
end