Mercurial > urweb

comparison src/sqlcache.sml @ 2212:388ba4dc7c96

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Small cleanup.
author Ziv Scully <ziv@mit.edu>
date Mon, 15 Sep 2014 20:01:16 -0400
parents 0ca11d57c175
children 365727ff68f4
comparison
equal deleted inserted replaced
2211:ef766ef6e242 2212:388ba4dc7c96
9 structure SS = BinarySetFn (StringKey) 9 structure SS = BinarySetFn (StringKey)
10 structure SM = BinaryMapFn (StringKey) 10 structure SM = BinaryMapFn (StringKey)
11 structure SIMM = MultimapFn (structure KeyMap = SM structure ValSet = IS) 11 structure SIMM = MultimapFn (structure KeyMap = SM structure ValSet = IS)
12 12
13 val ffiIndices : int list ref = ref [] 13 val ffiIndices : int list ref = ref []
14
15 (* Expression construction utilities. *)
16
17 fun intExp (n, loc) = (EPrim (Prim.Int (Int64.fromInt n)), loc)
18 fun intTyp loc = (TFfi ("Basis", "int"), loc)
19 fun boolPat (b, loc) = (PCon (Enum,
20 PConFfi {mod = "Basis", datatyp = "bool", arg = NONE,
21 con = if b then "True" else "False"},
22 NONE),
23 loc)
24 fun boolTyp loc = (TFfi ("Basis", "int"), loc)
25
26 fun ffiAppExp (module, func, index, loc) =
27 (EFfiApp (module, func ^ Int.toString index, []), loc)
28
29 fun sequence ((exp :: exps), loc) =
30 List.foldl (fn (exp, seq) => (ESeq (seq, exp), loc)) exp exps
31
32 fun antiguardUnit (cond, exp, loc) =
33 (ECase (cond,
34 [(boolPat (false, loc), exp),
35 (boolPat (true, loc), (ERecord [], loc))],
36 {disc = boolTyp loc, result = (TRecord [], loc)}),
37 loc)
38
39 fun underAbs f (exp as (exp', loc)) =
40 case exp' of
41 EAbs (x, y, z, body) => (EAbs (x, y, z, underAbs f body), loc)
42 | _ => f exp
43
44 (* Program analysis and augmentation. *)
14 45
15 val rec tablesRead = 46 val rec tablesRead =
16 fn Query1 {From=tablePairs, ...} => SS.fromList (map #1 tablePairs) 47 fn Query1 {From=tablePairs, ...} => SS.fromList (map #1 tablePairs)
17 | Union (q1,q2) => SS.union (tablesRead q1, tablesRead q2) 48 | Union (q1,q2) => SS.union (tablesRead q1, tablesRead q2)
18 49
45 in 76 in
46 MonoUtil.Exp.fold {typ = #2, exp = addTables} 77 MonoUtil.Exp.fold {typ = #2, exp = addTables}
47 {read = SS.empty, written = SS.empty} 78 {read = SS.empty, written = SS.empty}
48 end 79 end
49 80
50 fun intExp (n, loc) = (EPrim (Prim.Int (Int64.fromInt n)), loc)
51 fun intTyp loc = (TFfi ("Basis", "int"), loc)
52 fun boolPat (b, loc) = (PCon (Enum,
53 PConFfi {mod = "Basis", datatyp = "bool", arg = NONE,
54 con = if b then "True" else "False"},
55 NONE),
56 loc)
57 fun boolTyp loc = (TFfi ("Basis", "int"), loc)
58
59 fun ffiAppExp (module, func, index, loc) =
60 (EFfiApp (module, func ^ Int.toString index, []), loc)
61
62 fun sequence (befores, center, afters, loc) =
63 List.foldr (fn (exp, seq) => (ESeq (exp, seq), loc))
64 (List.foldl (fn (exp, seq) => (ESeq (seq, exp), loc))
65 center
66 afters)
67 befores
68
69 fun antiguardUnit (cond, exp, loc) =
70 (ECase (cond,
71 [(boolPat (false, loc), exp),
72 (boolPat (true, loc), (ERecord [], loc))],
73 {disc = boolTyp loc, result = (TRecord [], loc)}),
74 loc)
75
76 fun underAbs f (exp as (exp', loc)) =
77 case exp' of
78 EAbs (x, y, z, body) => (EAbs (x, y, z, underAbs f body), loc)
79 | _ => f exp
80
81 fun addCacheCheck (index, exp) = 81 fun addCacheCheck (index, exp) =
82 let 82 let
83 fun f (body as (_, loc)) = 83 fun f (body as (_, loc)) =
84 let 84 let
85 val check = ffiAppExp ("Cache", "check", index, loc) 85 val check = ffiAppExp ("Cache", "check", index, loc)
86 val store = ffiAppExp ("Cache", "store", index, loc) 86 val store = ffiAppExp ("Cache", "store", index, loc)
87 in 87 in
88 antiguardUnit (check, sequence ([], body, [store], loc), loc) 88 antiguardUnit (check, sequence ([body, store], loc), loc)
89 end 89 end
90 in 90 in
91 underAbs f exp 91 underAbs f exp
92 end 92 end
93 93
97 fun f (body as (_, loc)) = 97 fun f (body as (_, loc)) =
98 let 98 let
99 fun mapFfi func = List.map (fn i => ffiAppExp ("Cache", func, i, loc)) 99 fun mapFfi func = List.map (fn i => ffiAppExp ("Cache", func, i, loc))
100 val flushes = 100 val flushes =
101 IS.listItems (SS.foldr addIndices IS.empty (#written (tablesInExp body))) 101 IS.listItems (SS.foldr addIndices IS.empty (#written (tablesInExp body)))
102
103 in 102 in
104 sequence (mapFfi "flush" flushes, body, mapFfi "ready" flushes, loc) 103 sequence (mapFfi "flush" flushes @ [body] @ mapFfi "ready" flushes, loc)
105 end 104 end
106 in 105 in
107 underAbs f exp 106 underAbs f exp
108 end 107 end
109 108