Mercurial > urweb

comparison src/cjrize.sml @ 269:fac9fae654e2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Cjrize query
author Adam Chlipala <adamc@hcoop.net>
date Tue, 02 Sep 2008 09:53:15 -0400
parents 7e9bd70ad3ce
children 42dfb0d61cf0
comparison
equal deleted inserted replaced
268:bacd0ba869e1 269:fac9fae654e2
273 val (e2, sm) = cifyExp (e2, sm) 273 val (e2, sm) = cifyExp (e2, sm)
274 in 274 in
275 ((L'.ESeq (e1, e2), loc), sm) 275 ((L'.ESeq (e1, e2), loc), sm)
276 end 276 end
277 277
278 | L.ELet _ => raise Fail "Cjrize ELet" 278 | L.ELet (x, t, e1, e2) =>
279 let
280 val (t, sm) = cifyTyp (t, sm)
281 val (e1, sm) = cifyExp (e1, sm)
282 val (e2, sm) = cifyExp (e2, sm)
283 in
284 ((L'.ELet (x, t, e1, e2), loc), sm)
285 end
279 286
280 | L.EClosure _ => (ErrorMsg.errorAt loc "Nested closure remains in code generation"; 287 | L.EClosure _ => (ErrorMsg.errorAt loc "Nested closure remains in code generation";
281 (dummye, sm)) 288 (dummye, sm))
282 289
283 | L.EQuery _ => raise Fail "Cjrize EQuery" 290 | L.EQuery {exps, tables, state, query, body, initial} =>
291 let
292 val (exps', sm) = ListUtil.foldlMap (fn ((x, t), sm) =>
293 let
294 val (t, sm) = cifyTyp (t, sm)
295 in
296 ((x, t), sm)
297 end) sm exps
298 val (tables', sm) = ListUtil.foldlMap (fn ((x, xts), sm) =>
299 let
300 val (xts, sm) = ListUtil.foldlMap
301 (fn ((x, t), sm) =>
302 let
303 val (t, sm) = cifyTyp (t, sm)
304 in
305 ((x, t), sm)
306 end) sm xts
307 in
308 ((x, xts), sm)
309 end) sm tables
310
311 val row = exps @ map (fn (x, xts) => (x, (L.TRecord xts, loc))) tables
312 val row = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row
313
314 val (tableRows, sm) = ListUtil.foldlMap (fn (((x, xts), (_, xts')), sm) =>
315 let
316 val (sm, rnum) = Sm.find (sm, xts, xts')
317 in
318 ((x, rnum), sm)
319 end)
320 sm (ListPair.zip (tables, tables'))
321 val row' = exps' @ map (fn (x, n) => (x, (L'.TRecord n, loc))) tableRows
322 val row' = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row'
323
324 val (sm, rnum) = Sm.find (sm, row, row')
325
326 val (state, sm) = cifyTyp (state, sm)
327 val (query, sm) = cifyExp (query, sm)
328 val (body, sm) = cifyExp (body, sm)
329 val (initial, sm) = cifyExp (initial, sm)
330 in
331 ((L'.EQuery {exps = exps', tables = tables', rnum = rnum, state = state,
332 query = query, body = body, initial = initial}, loc), sm)
333 end
334
284 335
285 fun cifyDecl ((d, loc), sm) = 336 fun cifyDecl ((d, loc), sm) =
286 case d of 337 case d of
287 L.DDatatype (x, n, xncs) => 338 L.DDatatype (x, n, xncs) =>
288 let 339 let