Mercurial > urweb

comparison src/toy_cache.sml @ 2231:67e801cf42c6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add missing file.
author Ziv Scully <ziv@mit.edu>
date Wed, 06 May 2015 14:50:55 -0400
parents
children af1585e7d645
comparison
equal deleted inserted replaced
2230:a749acc51ae4 2231:67e801cf42c6
1 structure ToyCache = struct
2
3 (* Mono *)
4
5 open Mono
6
7 val dummyLoc = ErrorMsg.dummySpan
8 val stringTyp = (TFfi ("Basis", "string"), dummyLoc)
9 val optionStringTyp = (TOption stringTyp, dummyLoc)
10 fun withTyp typ = map (fn exp => (exp, typ))
11
12 fun ffiAppCache' (func, index, argTyps) =
13 EFfiApp ("Sqlcache", func ^ Int.toString index, argTyps)
14
15 fun check (index, keys) =
16 ffiAppCache' ("check", index, withTyp stringTyp keys)
17
18 fun store (index, keys, value) =
19 ffiAppCache' ("store", index, (value, stringTyp) :: withTyp stringTyp keys)
20
21 fun flush (index, keys) =
22 ffiAppCache' ("flush", index, withTyp optionStringTyp keys)
23
24
25 (* Cjr *)
26
27 open Print
28 open Print.PD
29
30 fun setupQuery {index, params} =
31 let
32
33 val i = Int.toString index
34
35 fun paramRepeat itemi sep =
36 let
37 fun f n =
38 if n < 0 then ""
39 else if n = 0 then itemi (Int.toString 0)
40 else f (n-1) ^ sep ^ itemi (Int.toString n)
41 in
42 f (params - 1)
43 end
44
45 fun paramRepeatInit itemi sep =
46 if params = 0 then "" else sep ^ paramRepeat itemi sep
47
48 val args = paramRepeatInit (fn p => "uw_Basis_string p" ^ p) ", "
49
50 val decls = paramRepeat (fn p => "uw_Basis_string param" ^ i ^ "_"
51 ^ p ^ " = NULL;")
52 "\n"
53
54 val sets = paramRepeat (fn p => "param" ^ i ^ "_" ^ p
55 ^ " = strdup(p" ^ p ^ ");")
56 "\n"
57
58 val frees = paramRepeat (fn p => "free(param" ^ i ^ "_" ^ p ^ ");")
59 "\n"
60
61 val eqs = paramRepeatInit (fn p => "strcmp(param" ^ i ^ "_" ^ p
62 ^ ", p" ^ p ^ ")")
63 " || "
64
65 (* Using [!=] instead of [==] to mimic [strcmp]. *)
66 val eqsNull = paramRepeatInit (fn p => "(p" ^ p ^ " == NULL || "
67 ^ "!strcmp(param" ^ i ^ "_"
68 ^ p ^ ", p" ^ p ^ "))")
69 " && "
70
71 in
72 Print.box
73 [string "static char *cacheQuery",
74 string i,
75 string " = NULL;",
76 newline,
77 string "static char *cacheWrite",
78 string i,
79 string " = NULL;",
80 newline,
81 string decls,
82 newline,
83 string "static uw_Basis_string uw_Sqlcache_check",
84 string i,
85 string "(uw_context ctx",
86 string args,
87 string ") {",
88 newline,
89 string "if (cacheQuery",
90 string i,
91 (* ASK: is returning the pointer okay? Should we duplicate? *)
92 string " == NULL",
93 string eqs,
94 string ") {",
95 newline,
96 string "puts(\"SQLCACHE: miss ",
97 string i,
98 string ".\");",
99 newline,
100 string "uw_recordingStart(ctx);",
101 newline,
102 string "return NULL;",
103 newline,
104 string "} else {",
105 newline,
106 string "puts(\"SQLCACHE: hit ",
107 string i,
108 string ".\");",
109 newline,
110 string "uw_write(ctx, cacheWrite",
111 string i,
112 string ");",
113 newline,
114 string "return cacheQuery",
115 string i,
116 string ";",
117 newline,
118 string "} };",
119 newline,
120 string "static uw_unit uw_Sqlcache_store",
121 string i,
122 string "(uw_context ctx, uw_Basis_string s",
123 string args,
124 string ") {",
125 newline,
126 string "free(cacheQuery",
127 string i,
128 string "); free(cacheWrite",
129 string i,
130 string ");",
131 newline,
132 string frees,
133 newline,
134 string "cacheQuery",
135 string i,
136 string " = strdup(s); cacheWrite",
137 string i,
138 string " = uw_recordingRead(ctx);",
139 newline,
140 string sets,
141 newline,
142 string "puts(\"SQLCACHE: store ",
143 string i,
144 string ".\");",
145 newline,
146 string "return uw_unit_v;",
147 newline,
148 string "};",
149 newline,
150 string "static uw_unit uw_Sqlcache_flush",
151 string i,
152 string "(uw_context ctx",
153 string args,
154 string ") {",
155 newline,
156 string "if (cacheQuery",
157 string i,
158 string " != NULL",
159 string eqsNull,
160 string ") {",
161 newline,
162 string "free(cacheQuery",
163 string i,
164 string ");",
165 newline,
166 string "cacheQuery",
167 string i,
168 string " = NULL;",
169 newline,
170 string "puts(\"SQLCACHE: flush ",
171 string i,
172 string ".\");}",
173 newline,
174 string "else { puts(\"SQLCACHE: keep ",
175 string i,
176 string ".\"); } return uw_unit_v;",
177 newline,
178 string "};",
179 newline,
180 newline]
181 end
182
183 val setupGlobal = string "/* No global setup for toy cache. */"
184
185 end