Mercurial > urweb

comparison src/mono_util.sml @ 252:7e9bd70ad3ce

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Monoized and optimized initial query test
author Adam Chlipala <adamc@hcoop.net>
date Sun, 31 Aug 2008 13:58:47 -0400
parents 326fb4686f60
children f31e8da68e90
comparison
equal deleted inserted replaced
251:326fb4686f60 252:7e9bd70ad3ce
216 | ELet (x, t, e1, e2) => 216 | ELet (x, t, e1, e2) =>
217 S.bind2 (mft t, 217 S.bind2 (mft t,
218 fn t' => 218 fn t' =>
219 S.bind2 (mfe ctx e1, 219 S.bind2 (mfe ctx e1,
220 fn e1' => 220 fn e1' =>
221 S.map2 (mfe (bind (ctx, RelE (x, t))) e2, 221 S.map2 (mfe (bind (ctx, RelE (x, t'))) e2,
222 fn e2' => 222 fn e2' =>
223 (ELet (x, t', e1', e2'), loc)))) 223 (ELet (x, t', e1', e2'), loc))))
224 224
225 | EClosure (n, es) => 225 | EClosure (n, es) =>
226 S.map2 (ListUtil.mapfold (mfe ctx) es, 226 S.map2 (ListUtil.mapfold (mfe ctx) es,
227 fn es' => 227 fn es' =>
228 (EClosure (n, es'), loc)) 228 (EClosure (n, es'), loc))
229
230 | EQuery {exps, tables, state, query, body, initial} =>
231 S.bind2 (ListUtil.mapfold (fn (x, t) =>
232 S.map2 (mft t,
233 fn t' => (x, t'))) exps,
234 fn exps' =>
235 S.bind2 (ListUtil.mapfold (fn (x, xts) =>
236 S.map2 (ListUtil.mapfold
237 (fn (x, t) =>
238 S.map2 (mft t,
239 fn t' => (x, t'))) xts,
240 fn xts' => (x, xts'))) tables,
241 fn tables' =>
242 S.bind2 (mft state,
243 fn state' =>
244 S.bind2 (mfe ctx query,
245 fn query' =>
246 S.bind2 (mfe ctx body,
247 fn body' =>
248 S.map2 (mfe ctx initial,
249 fn initial' =>
250 (EQuery {exps = exps',
251 tables = tables',
252 state = state',
253 query = query',
254 body = body',
255 initial = initial'},
256 loc)))))))
229 in 257 in
230 mfe 258 mfe
231 end 259 end
232 260
233 fun mapfold {typ = fc, exp = fe} = 261 fun mapfold {typ = fc, exp = fe} =