ziv@2213
|
1 structure Sqlcache (* :> SQLCACHE *) = struct
|
ziv@2209
|
2
|
ziv@2209
|
3 open Sql
|
ziv@2209
|
4 open Mono
|
ziv@2209
|
5
|
ziv@2209
|
6 structure IS = IntBinarySet
|
ziv@2209
|
7 structure IM = IntBinaryMap
|
ziv@2213
|
8 structure SK = struct type ord_key = string val compare = String.compare end
|
ziv@2213
|
9 structure SS = BinarySetFn(SK)
|
ziv@2213
|
10 structure SM = BinaryMapFn(SK)
|
ziv@2213
|
11 structure SIMM = MultimapFn(structure KeyMap = SM structure ValSet = IS)
|
ziv@2209
|
12
|
ziv@2213
|
13 (* Filled in by cacheWrap during Sqlcache. *)
|
ziv@2213
|
14 val ffiInfo : {index : int, params : int} list ref = ref []
|
ziv@2209
|
15
|
ziv@2213
|
16 fun getFfiInfo () = !ffiInfo
|
ziv@2213
|
17
|
ziv@2213
|
18 (* Program analysis. *)
|
ziv@2213
|
19
|
ziv@2213
|
20 val useInjIfPossible =
|
ziv@2213
|
21 fn SqConst prim => Inj (EPrim (Prim.String (Prim.Normal, Prim.toString prim)), ErrorMsg.dummySpan)
|
ziv@2213
|
22 | sqexp => sqexp
|
ziv@2213
|
23
|
ziv@2213
|
24 fun equalities (canonicalTable : string -> string) :
|
ziv@2213
|
25 sqexp -> ((string * string) * Mono.exp) list option =
|
ziv@2213
|
26 let
|
ziv@2213
|
27 val rec eqs =
|
ziv@2213
|
28 fn Binop (Exps f, e1, e2) =>
|
ziv@2213
|
29 (* TODO: use a custom datatype in Exps instead of a function. *)
|
ziv@2213
|
30 (case f (Var 1, Var 2) of
|
ziv@2213
|
31 Reln (Eq, [Var 1, Var 2]) =>
|
ziv@2213
|
32 let
|
ziv@2213
|
33 val (e1', e2') = (useInjIfPossible e1, useInjIfPossible e2)
|
ziv@2213
|
34 in
|
ziv@2213
|
35 case (e1', e2') of
|
ziv@2213
|
36 (Field (t, f), Inj i) => SOME [((canonicalTable t, f), i)]
|
ziv@2213
|
37 | (Inj i, Field (t, f)) => SOME [((canonicalTable t, f), i)]
|
ziv@2213
|
38 | _ => NONE
|
ziv@2213
|
39 end
|
ziv@2213
|
40 | _ => NONE)
|
ziv@2213
|
41 | Binop (Props f, e1, e2) =>
|
ziv@2213
|
42 (* TODO: use a custom datatype in Props instead of a function. *)
|
ziv@2213
|
43 (case f (True, False) of
|
ziv@2213
|
44 And (True, False) =>
|
ziv@2213
|
45 (case (eqs e1, eqs e2) of
|
ziv@2213
|
46 (SOME eqs1, SOME eqs2) => SOME (eqs1 @ eqs2)
|
ziv@2213
|
47 | _ => NONE)
|
ziv@2213
|
48 | _ => NONE)
|
ziv@2213
|
49 | _ => NONE
|
ziv@2213
|
50 in
|
ziv@2213
|
51 eqs
|
ziv@2213
|
52 end
|
ziv@2213
|
53
|
ziv@2213
|
54 val equalitiesQuery =
|
ziv@2213
|
55 fn Query1 {From = tablePairs, Where = SOME exp, ...} =>
|
ziv@2213
|
56 equalities
|
ziv@2213
|
57 (* If we have [SELECT ... FROM T AS T' ...], use T, not T'. *)
|
ziv@2213
|
58 (fn t =>
|
ziv@2213
|
59 case List.find (fn (_, tAs) => t = tAs) tablePairs of
|
ziv@2213
|
60 NONE => t
|
ziv@2213
|
61 | SOME (tOrig, _) => tOrig)
|
ziv@2213
|
62 exp
|
ziv@2213
|
63 | Query1 {Where = NONE, ...} => SOME []
|
ziv@2213
|
64 | _ => NONE
|
ziv@2213
|
65
|
ziv@2213
|
66 val equalitiesDml =
|
ziv@2213
|
67 fn Insert (tab, eqs) => SOME (List.mapPartial
|
ziv@2213
|
68 (fn (name, sqexp) =>
|
ziv@2213
|
69 case useInjIfPossible sqexp of
|
ziv@2213
|
70 Inj e => SOME ((tab, name), e)
|
ziv@2213
|
71 | _ => NONE)
|
ziv@2213
|
72 eqs)
|
ziv@2213
|
73 | Delete (tab, exp) => equalities (fn _ => tab) exp
|
ziv@2213
|
74 (* TODO: examine the updated values and not just the way they're filtered. *)
|
ziv@2213
|
75 (* For example, UPDATE foo SET Id = 9001 WHERE Id = 42 should update both the
|
ziv@2213
|
76 Id = 42 and Id = 9001 cache entries. Could also think of it as doing a
|
ziv@2213
|
77 Delete immediately followed by an Insert. *)
|
ziv@2213
|
78 | Update (tab, _, exp) => equalities (fn _ => tab) exp
|
ziv@2213
|
79
|
ziv@2213
|
80 val rec tablesQuery =
|
ziv@2213
|
81 fn Query1 {From = tablePairs, ...} => SS.fromList (map #1 tablePairs)
|
ziv@2213
|
82 | Union (q1, q2) => SS.union (tablesQuery q1, tablesQuery q2)
|
ziv@2213
|
83
|
ziv@2213
|
84 val tableDml =
|
ziv@2213
|
85 fn Insert (tab, _) => tab
|
ziv@2213
|
86 | Delete (tab, _) => tab
|
ziv@2213
|
87 | Update (tab, _, _) => tab
|
ziv@2213
|
88
|
ziv@2213
|
89
|
ziv@2213
|
90 (* Program instrumentation. *)
|
ziv@2213
|
91
|
ziv@2213
|
92 val stringTyp = (TFfi ("Basis", "string"), ErrorMsg.dummySpan)
|
ziv@2213
|
93
|
ziv@2213
|
94 val sequence =
|
ziv@2213
|
95 fn (exp :: exps) =>
|
ziv@2213
|
96 let
|
ziv@2213
|
97 val loc = ErrorMsg.dummySpan
|
ziv@2213
|
98 in
|
ziv@2213
|
99 List.foldl (fn (e', seq) => ESeq ((seq, loc), (e', loc))) exp exps
|
ziv@2213
|
100 end
|
ziv@2213
|
101 | _ => raise Match
|
ziv@2213
|
102
|
ziv@2213
|
103 fun ffiAppCache' (func, index, args) : Mono.exp' =
|
ziv@2213
|
104 EFfiApp ("Sqlcache", func ^ Int.toString index, args)
|
ziv@2213
|
105
|
ziv@2213
|
106 fun ffiAppCache (func, index, args) : Mono. exp =
|
ziv@2213
|
107 (ffiAppCache' (func, index, args), ErrorMsg.dummySpan)
|
ziv@2213
|
108
|
ziv@2213
|
109 val varPrefix = "queryResult"
|
ziv@2213
|
110
|
ziv@2213
|
111 fun indexOfName varName =
|
ziv@2213
|
112 if String.isPrefix varPrefix varName
|
ziv@2213
|
113 then Int.fromString (String.extract (varName, String.size varPrefix, NONE))
|
ziv@2213
|
114 else NONE
|
ziv@2213
|
115
|
ziv@2213
|
116 val incRels = MonoUtil.Exp.map {typ = fn x => x, exp = fn ERel n => ERel (n + 1) | x => x}
|
ziv@2213
|
117
|
ziv@2213
|
118 (* Filled in by instrumentQuery during Monoize, used during Sqlcache. *)
|
ziv@2213
|
119 val urlifiedRel0s : Mono.exp IM.map ref = ref IM.empty
|
ziv@2213
|
120
|
ziv@2213
|
121 (* Used by Monoize. *)
|
ziv@2213
|
122 val instrumentQuery =
|
ziv@2213
|
123 let
|
ziv@2213
|
124 val nextQuery = ref 0
|
ziv@2213
|
125 fun iq (query, urlifiedRel0) =
|
ziv@2213
|
126 case query of
|
ziv@2213
|
127 (EQuery {state = typ, ...}, loc) =>
|
ziv@2213
|
128 let
|
ziv@2213
|
129 val i = !nextQuery before nextQuery := !nextQuery + 1
|
ziv@2213
|
130 in
|
ziv@2213
|
131 urlifiedRel0s := IM.insert (!urlifiedRel0s, i, urlifiedRel0);
|
ziv@2213
|
132 (* ASK: name variables properly? *)
|
ziv@2213
|
133 (ELet (varPrefix ^ Int.toString i, typ, query,
|
ziv@2213
|
134 (* Uses a dummy FFI call to keep the urlified expression around, which
|
ziv@2213
|
135 in turn keeps the declarations required for urlification safe from
|
ziv@2213
|
136 MonoShake. The dummy call is removed during Sqlcache. *)
|
ziv@2213
|
137 (* ASK: is there a better way? *)
|
ziv@2213
|
138 (ESeq ((EFfiApp ("Sqlcache", "dummy", [(urlifiedRel0, stringTyp)]), loc),
|
ziv@2213
|
139 (ERel 0, loc)),
|
ziv@2213
|
140 loc)),
|
ziv@2213
|
141 loc)
|
ziv@2213
|
142 end
|
ziv@2213
|
143 | _ => raise Match
|
ziv@2213
|
144 in
|
ziv@2213
|
145 iq
|
ziv@2213
|
146 end
|
ziv@2213
|
147
|
ziv@2213
|
148 val gunk : ((string * string) * Mono.exp) list list ref = ref [[]]
|
ziv@2213
|
149
|
ziv@2213
|
150 fun cacheWrap (query, i, urlifiedRel0, eqs) =
|
ziv@2213
|
151 case query of
|
ziv@2213
|
152 (EQuery {state = typ, ...}, _) =>
|
ziv@2213
|
153 let
|
ziv@2213
|
154 val loc = ErrorMsg.dummySpan
|
ziv@2213
|
155 (* TODO: deal with effectful injected expressions. *)
|
ziv@2213
|
156 val args = (ffiInfo := {index = i, params = length eqs} :: !ffiInfo;
|
ziv@2213
|
157 map (fn (_, e) => (e, stringTyp)) eqs) before gunk := eqs :: !gunk
|
ziv@2213
|
158 val argsInc = map (fn (e, t) => (incRels e, t)) args
|
ziv@2213
|
159 in
|
ziv@2213
|
160 (ECase (ffiAppCache ("check", i, args),
|
ziv@2213
|
161 [((PNone stringTyp, loc),
|
ziv@2213
|
162 (ELet ("q", typ, query,
|
ziv@2213
|
163 (ESeq (ffiAppCache ("store", i, (urlifiedRel0, stringTyp) :: argsInc),
|
ziv@2213
|
164 (ERel 0, loc)),
|
ziv@2213
|
165 loc)),
|
ziv@2213
|
166 loc)),
|
ziv@2213
|
167 ((PSome (stringTyp, (PVar ("hit", stringTyp), loc)), loc),
|
ziv@2213
|
168 (* ASK: what does this bool do? *)
|
ziv@2213
|
169 (EUnurlify ((ERel 0, loc), typ, false), loc))],
|
ziv@2213
|
170 {disc = stringTyp, result = typ}),
|
ziv@2213
|
171 loc)
|
ziv@2213
|
172 end
|
ziv@2213
|
173 | _ => raise Match
|
ziv@2213
|
174
|
ziv@2213
|
175 fun fileMapfold doExp file start =
|
ziv@2213
|
176 case MonoUtil.File.mapfold {typ = Search.return2,
|
ziv@2213
|
177 exp = fn x => (fn s => Search.Continue (doExp x s)),
|
ziv@2213
|
178 decl = Search.return2} file start of
|
ziv@2213
|
179 Search.Continue x => x
|
ziv@2213
|
180 | Search.Return _ => raise Match
|
ziv@2213
|
181
|
ziv@2213
|
182 fun fileMap doExp file = #1 (fileMapfold (fn x => fn _ => (doExp x, ())) file ())
|
ziv@2213
|
183
|
ziv@2213
|
184 val addChecking =
|
ziv@2213
|
185 let
|
ziv@2213
|
186 fun doExp queryInfo =
|
ziv@2213
|
187 fn e' as ELet (v, t, queryExp as (EQuery {query = queryText, ...}, _), body) =>
|
ziv@2213
|
188 let
|
ziv@2213
|
189 fun bind x f = Option.mapPartial f x
|
ziv@2213
|
190 val attempt =
|
ziv@2213
|
191 (* Ziv misses Haskell's do notation.... *)
|
ziv@2213
|
192 bind (parse query queryText) (fn queryParsed =>
|
ziv@2213
|
193 (Print.preface ("gunk> ", (MonoPrint.p_exp MonoEnv.empty queryExp));
|
ziv@2213
|
194 bind (indexOfName v) (fn i =>
|
ziv@2213
|
195 bind (equalitiesQuery queryParsed) (fn eqs =>
|
ziv@2213
|
196 bind (IM.find (!urlifiedRel0s, i)) (fn urlifiedRel0 =>
|
ziv@2213
|
197 SOME (ELet (v, t, cacheWrap (queryExp, i, urlifiedRel0, eqs), body),
|
ziv@2213
|
198 SS.foldr (fn (tab, qi) => SIMM.insert (qi, tab, i))
|
ziv@2213
|
199 queryInfo
|
ziv@2213
|
200 (tablesQuery queryParsed)))))))
|
ziv@2213
|
201 in
|
ziv@2213
|
202 case attempt of
|
ziv@2213
|
203 SOME pair => pair
|
ziv@2213
|
204 | NONE => (e', queryInfo)
|
ziv@2213
|
205 end
|
ziv@2213
|
206 | ESeq ((EFfiApp ("Sqlcache", "dummy", _), _), (e', _)) => (e', queryInfo)
|
ziv@2213
|
207 | e' => (e', queryInfo)
|
ziv@2213
|
208 in
|
ziv@2213
|
209 fn file => fileMapfold (fn exp => fn state => doExp state exp) file SIMM.empty
|
ziv@2213
|
210 end
|
ziv@2213
|
211
|
ziv@2213
|
212 fun addFlushing (file, queryInfo) =
|
ziv@2213
|
213 let
|
ziv@2213
|
214 val allIndices : int list = SM.foldr (fn (x, acc) => IS.listItems x @ acc) [] queryInfo
|
ziv@2213
|
215 fun flushes indices = map (fn i => ffiAppCache' ("flush", i, [])) indices
|
ziv@2213
|
216 val doExp =
|
ziv@2213
|
217 fn dmlExp as EDml (dmlText, _) =>
|
ziv@2213
|
218 let
|
ziv@2213
|
219 val indices =
|
ziv@2213
|
220 case parse dml dmlText of
|
ziv@2213
|
221 SOME dmlParsed => SIMM.findList (queryInfo, tableDml dmlParsed)
|
ziv@2213
|
222 | NONE => allIndices
|
ziv@2213
|
223 in
|
ziv@2213
|
224 sequence (flushes indices @ [dmlExp])
|
ziv@2213
|
225 end
|
ziv@2213
|
226 | e' => e'
|
ziv@2213
|
227 in
|
ziv@2213
|
228 fileMap doExp file
|
ziv@2213
|
229 end
|
ziv@2213
|
230
|
ziv@2213
|
231 fun go file =
|
ziv@2213
|
232 let
|
ziv@2213
|
233 val () = Sql.sqlcacheMode := true
|
ziv@2213
|
234 in
|
ziv@2213
|
235 addFlushing (addChecking file) before Sql.sqlcacheMode := false
|
ziv@2213
|
236 end
|
ziv@2213
|
237
|
ziv@2213
|
238
|
ziv@2213
|
239 (* BEGIN OLD
|
ziv@2212
|
240
|
ziv@2212
|
241 fun intExp (n, loc) = (EPrim (Prim.Int (Int64.fromInt n)), loc)
|
ziv@2212
|
242 fun intTyp loc = (TFfi ("Basis", "int"), loc)
|
ziv@2213
|
243 fun stringExp (s, loc) = (EPrim (Prim.String (Prim.Normal, s)), loc)
|
ziv@2213
|
244
|
ziv@2212
|
245 fun boolPat (b, loc) = (PCon (Enum,
|
ziv@2212
|
246 PConFfi {mod = "Basis", datatyp = "bool", arg = NONE,
|
ziv@2212
|
247 con = if b then "True" else "False"},
|
ziv@2212
|
248 NONE),
|
ziv@2212
|
249 loc)
|
ziv@2212
|
250 fun boolTyp loc = (TFfi ("Basis", "int"), loc)
|
ziv@2212
|
251
|
ziv@2213
|
252 fun ffiAppExp (module, func, index, args, loc) =
|
ziv@2213
|
253 (EFfiApp (module, func ^ Int.toString index, args), loc)
|
ziv@2212
|
254
|
ziv@2213
|
255 val sequence =
|
ziv@2213
|
256 fn ((exp :: exps), loc) =>
|
ziv@2212
|
257 List.foldl (fn (exp, seq) => (ESeq (seq, exp), loc)) exp exps
|
ziv@2213
|
258 | _ => raise Match
|
ziv@2212
|
259
|
ziv@2212
|
260 fun antiguardUnit (cond, exp, loc) =
|
ziv@2212
|
261 (ECase (cond,
|
ziv@2212
|
262 [(boolPat (false, loc), exp),
|
ziv@2212
|
263 (boolPat (true, loc), (ERecord [], loc))],
|
ziv@2212
|
264 {disc = boolTyp loc, result = (TRecord [], loc)}),
|
ziv@2212
|
265 loc)
|
ziv@2212
|
266
|
ziv@2212
|
267 fun underAbs f (exp as (exp', loc)) =
|
ziv@2212
|
268 case exp' of
|
ziv@2212
|
269 EAbs (x, y, z, body) => (EAbs (x, y, z, underAbs f body), loc)
|
ziv@2212
|
270 | _ => f exp
|
ziv@2212
|
271
|
ziv@2212
|
272
|
ziv@2209
|
273 val rec tablesRead =
|
ziv@2213
|
274 fn Query1 {From = tablePairs, ...} => SS.fromList (map #1 tablePairs)
|
ziv@2213
|
275 | Union (q1, q2) => SS.union (tablesRead q1, tablesRead q2)
|
ziv@2209
|
276
|
ziv@2209
|
277 val tableWritten =
|
ziv@2209
|
278 fn Insert (tab, _) => tab
|
ziv@2209
|
279 | Delete (tab, _) => tab
|
ziv@2209
|
280 | Update (tab, _, _) => tab
|
ziv@2209
|
281
|
ziv@2209
|
282 fun tablesInExp' exp' =
|
ziv@2209
|
283 let
|
ziv@2209
|
284 val nothing = {read = SS.empty, written = SS.empty}
|
ziv@2209
|
285 in
|
ziv@2209
|
286 case exp' of
|
ziv@2213
|
287 EQuery {query = e, ...} =>
|
ziv@2209
|
288 (case parse query e of
|
ziv@2209
|
289 SOME q => {read = tablesRead q, written = SS.empty}
|
ziv@2209
|
290 | NONE => nothing)
|
ziv@2209
|
291 | EDml (e, _) =>
|
ziv@2209
|
292 (case parse dml e of
|
ziv@2209
|
293 SOME q => {read = SS.empty, written = SS.singleton (tableWritten q)}
|
ziv@2209
|
294 | NONE => nothing)
|
ziv@2209
|
295 | _ => nothing
|
ziv@2209
|
296 end
|
ziv@2209
|
297
|
ziv@2209
|
298 val tablesInExp =
|
ziv@2209
|
299 let
|
ziv@2209
|
300 fun addTables (exp', {read, written}) =
|
ziv@2213
|
301 let
|
ziv@2213
|
302 val {read = r, written = w} = tablesInExp' exp'
|
ziv@2213
|
303 in
|
ziv@2213
|
304 {read = SS.union (r, read), written = SS.union (w, written)}
|
ziv@2213
|
305 end
|
ziv@2209
|
306 in
|
ziv@2209
|
307 MonoUtil.Exp.fold {typ = #2, exp = addTables}
|
ziv@2209
|
308 {read = SS.empty, written = SS.empty}
|
ziv@2209
|
309 end
|
ziv@2209
|
310
|
ziv@2209
|
311 fun addCacheCheck (index, exp) =
|
ziv@2209
|
312 let
|
ziv@2209
|
313 fun f (body as (_, loc)) =
|
ziv@2209
|
314 let
|
ziv@2209
|
315 val check = ffiAppExp ("Cache", "check", index, loc)
|
ziv@2209
|
316 val store = ffiAppExp ("Cache", "store", index, loc)
|
ziv@2209
|
317 in
|
ziv@2212
|
318 antiguardUnit (check, sequence ([body, store], loc), loc)
|
ziv@2209
|
319 end
|
ziv@2209
|
320 in
|
ziv@2209
|
321 underAbs f exp
|
ziv@2209
|
322 end
|
ziv@2209
|
323
|
ziv@2209
|
324 fun addCacheFlush (exp, tablesToIndices) =
|
ziv@2209
|
325 let
|
ziv@2209
|
326 fun addIndices (table, indices) = IS.union (indices, SIMM.find (tablesToIndices, table))
|
ziv@2209
|
327 fun f (body as (_, loc)) =
|
ziv@2209
|
328 let
|
ziv@2209
|
329 fun mapFfi func = List.map (fn i => ffiAppExp ("Cache", func, i, loc))
|
ziv@2209
|
330 val flushes =
|
ziv@2209
|
331 IS.listItems (SS.foldr addIndices IS.empty (#written (tablesInExp body)))
|
ziv@2209
|
332 in
|
ziv@2212
|
333 sequence (mapFfi "flush" flushes @ [body] @ mapFfi "ready" flushes, loc)
|
ziv@2209
|
334 end
|
ziv@2209
|
335 in
|
ziv@2209
|
336 underAbs f exp
|
ziv@2209
|
337 end
|
ziv@2209
|
338
|
ziv@2209
|
339 val handlerIndices =
|
ziv@2209
|
340 let
|
ziv@2209
|
341 val isUnit =
|
ziv@2209
|
342 fn (TRecord [], _) => true
|
ziv@2209
|
343 | _ => false
|
ziv@2209
|
344 fun maybeAdd (d, soFar as {readers, writers}) =
|
ziv@2209
|
345 case d of
|
ziv@2209
|
346 DExport (Link ReadOnly, _, name, typs, typ, _) =>
|
ziv@2209
|
347 if List.all isUnit (typ::typs)
|
ziv@2209
|
348 then {readers = IS.add (readers, name), writers = writers}
|
ziv@2209
|
349 else soFar
|
ziv@2209
|
350 | DExport (_, _, name, _, _, _) => (* Not read only. *)
|
ziv@2209
|
351 {readers = readers, writers = IS.add (writers, name)}
|
ziv@2209
|
352 | _ => soFar
|
ziv@2209
|
353 in
|
ziv@2209
|
354 MonoUtil.File.fold {typ = #2, exp = #2, decl = maybeAdd}
|
ziv@2209
|
355 {readers = IS.empty, writers = IS.empty}
|
ziv@2209
|
356 end
|
ziv@2209
|
357
|
ziv@2209
|
358 fun fileFoldMapiSelected f init (file, indices) =
|
ziv@2209
|
359 let
|
ziv@2209
|
360 fun doExp (original as ((a, index, b, exp, c), state)) =
|
ziv@2209
|
361 if IS.member (indices, index)
|
ziv@2209
|
362 then let val (newExp, newState) = f (index, exp, state)
|
ziv@2209
|
363 in ((a, index, b, newExp, c), newState) end
|
ziv@2209
|
364 else original
|
ziv@2209
|
365 fun doDecl decl state =
|
ziv@2209
|
366 let
|
ziv@2209
|
367 val result =
|
ziv@2209
|
368 case decl of
|
ziv@2209
|
369 DVal x =>
|
ziv@2209
|
370 let val (y, newState) = doExp (x, state)
|
ziv@2209
|
371 in (DVal y, newState) end
|
ziv@2209
|
372 | DValRec xs =>
|
ziv@2209
|
373 let val (ys, newState) = ListUtil.foldlMap doExp state xs
|
ziv@2209
|
374 in (DValRec ys, newState) end
|
ziv@2209
|
375 | _ => (decl, state)
|
ziv@2209
|
376 in
|
ziv@2209
|
377 Search.Continue result
|
ziv@2209
|
378 end
|
ziv@2209
|
379 fun nada x y = Search.Continue (x, y)
|
ziv@2209
|
380 in
|
ziv@2209
|
381 case MonoUtil.File.mapfold {typ = nada, exp = nada, decl = doDecl} file init of
|
ziv@2209
|
382 Search.Continue x => x
|
ziv@2213
|
383 | _ => raise Match (* Should never happen. *)
|
ziv@2209
|
384 end
|
ziv@2209
|
385
|
ziv@2209
|
386 fun fileMapSelected f = #1 o fileFoldMapiSelected (fn (_, x, _) => (f x, ())) ()
|
ziv@2209
|
387
|
ziv@2209
|
388 val addCacheChecking =
|
ziv@2209
|
389 let
|
ziv@2209
|
390 fun f (index, exp, tablesToIndices) =
|
ziv@2209
|
391 (addCacheCheck (index, exp),
|
ziv@2209
|
392 SS.foldr (fn (table, tsToIs) => SIMM.insert (tsToIs, table, index))
|
ziv@2209
|
393 tablesToIndices
|
ziv@2209
|
394 (#read (tablesInExp exp)))
|
ziv@2209
|
395 in
|
ziv@2209
|
396 fileFoldMapiSelected f (SM.empty)
|
ziv@2209
|
397 end
|
ziv@2209
|
398
|
ziv@2209
|
399 fun addCacheFlushing (file, tablesToIndices, writers) =
|
ziv@2209
|
400 fileMapSelected (fn exp => addCacheFlush (exp, tablesToIndices)) (file, writers)
|
ziv@2209
|
401
|
ziv@2209
|
402 fun go file =
|
ziv@2209
|
403 let
|
ziv@2209
|
404 val {readers, writers} = handlerIndices file
|
ziv@2209
|
405 val (fileWithChecks, tablesToIndices) = addCacheChecking (file, readers)
|
ziv@2209
|
406 in
|
ziv@2209
|
407 ffiIndices := IS.listItems readers;
|
ziv@2209
|
408 addCacheFlushing (fileWithChecks, tablesToIndices, writers)
|
ziv@2209
|
409 end
|
ziv@2209
|
410
|
ziv@2213
|
411 END OLD *)
|
ziv@2213
|
412
|
ziv@2209
|
413 end
|