Mercurial > urweb
changeset 934:36f787c02287
Fix a bug in Jscomp environment calculation for EQuery; smarter embedding of record projection in JavaScript
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Mon, 14 Sep 2009 19:04:38 -0400 |
| parents | 6a284a3519ba |
| children | 2422360c78a3 |
| files | src/jscomp.sml |
| diffstat | 1 files changed, 39 insertions(+), 6 deletions(-) [+] |
line wrap: on
line diff
--- a/src/jscomp.sml Sun Sep 13 15:33:11 2009 -0400 +++ b/src/jscomp.sml Mon Sep 14 19:04:38 2009 -0400 @@ -917,13 +917,42 @@ :: es), st) end - | EField (e, x) => + | EField (e', x) => let - val (e, st) = jsE inner (e, st) + fun default () = + let + val (e', st) = jsE inner (e', st) + in + (strcat [e', + str ("._" ^ x)], st) + end + + fun seek (e, xs) = + case #1 e of + ERel n => + if n < inner then + default () + else + let + val n = n - inner + val t = List.nth (outer, n) + val t = foldl (fn (x, (TRecord xts, _)) => + (case List.find (fn (x', _) => x' = x) xts of + NONE => raise Fail "Jscomp: Bad seek [1]" + | SOME (_, t) => t) + | _ => raise Fail "Jscomp: Bad seek [2]") + t xs + + val e = (ERel n, loc) + val e = foldl (fn (x, e) => (EField (e, x), loc)) e xs + in + quoteExp t (e, st) + end + | EField (e', x) => seek (e', x :: xs) + | _ => default () in - (strcat [e, - str ("._" ^ x)], st) - end + seek (e', [x]) + end | ECase (e', pes, {result, ...}) => let @@ -1274,8 +1303,12 @@ | EQuery {exps, tables, state, query, body, initial} => let + val row = exps @ map (fn (x, xts) => (x, (TRecord xts, loc))) tables + val row = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row + val row = (TRecord row, loc) + val (query, st) = exp outer (query, st) - val (body, st) = exp outer (body, st) + val (body, st) = exp (state :: row :: outer) (body, st) val (initial, st) = exp outer (initial, st) in ((EQuery {exps = exps, tables = tables, state = state,