# HG changeset patch # User Adam Chlipala # Date 1252969478 14400 # Node ID 36f787c022872d60700716d0ce0bc8a196736f56 # Parent 6a284a3519bad1176b7e7d9a2d03e5fc86cf6acd Fix a bug in Jscomp environment calculation for EQuery; smarter embedding of record projection in JavaScript diff -r 6a284a3519ba -r 36f787c02287 src/jscomp.sml --- 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,