diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-08-31 13:58:47 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-08-31 13:58:47 -0400 |
| commit | 769dd2e60357a97baee02b9595340a3c0ee79fb8 (patch) | |
| tree | 5473200fdf38863018a2ba54f02b520bd02492ca /src/mono_util.sml | |
| parent | 4688519e58b0b2923e291d6a719a7f34810bfdc1 (diff) | |
Monoized and optimized initial query test
Diffstat (limited to 'src/mono_util.sml')
| -rw-r--r-- | src/mono_util.sml | 30 |
1 files changed, 29 insertions, 1 deletions
diff --git a/src/mono_util.sml b/src/mono_util.sml index 8f5b29e8..0b2817f1 100644 --- a/src/mono_util.sml +++ b/src/mono_util.sml @@ -218,7 +218,7 @@ fun mapfoldB {typ = fc, exp = fe, bind} = fn t' => S.bind2 (mfe ctx e1, fn e1' => - S.map2 (mfe (bind (ctx, RelE (x, t))) e2, + S.map2 (mfe (bind (ctx, RelE (x, t'))) e2, fn e2' => (ELet (x, t', e1', e2'), loc)))) @@ -226,6 +226,34 @@ fun mapfoldB {typ = fc, exp = fe, bind} = S.map2 (ListUtil.mapfold (mfe ctx) es, fn es' => (EClosure (n, es'), loc)) + + | EQuery {exps, tables, state, query, body, initial} => + S.bind2 (ListUtil.mapfold (fn (x, t) => + S.map2 (mft t, + fn t' => (x, t'))) exps, + fn exps' => + S.bind2 (ListUtil.mapfold (fn (x, xts) => + S.map2 (ListUtil.mapfold + (fn (x, t) => + S.map2 (mft t, + fn t' => (x, t'))) xts, + fn xts' => (x, xts'))) tables, + fn tables' => + S.bind2 (mft state, + fn state' => + S.bind2 (mfe ctx query, + fn query' => + S.bind2 (mfe ctx body, + fn body' => + S.map2 (mfe ctx initial, + fn initial' => + (EQuery {exps = exps', + tables = tables', + state = state', + query = query', + body = body', + initial = initial'}, + loc))))))) in mfe end |