Mercurial > urweb
comparison src/jscomp.sml @ 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 | 771449d8b411 |
| children | e2194a6793ae |
comparison
equal
deleted
inserted
replaced
| 933:6a284a3519ba | 934:36f787c02287 |
|---|---|
| 915 (strcat (str ("{_" ^ x ^ ":") | 915 (strcat (str ("{_" ^ x ^ ":") |
| 916 :: e | 916 :: e |
| 917 :: es), | 917 :: es), |
| 918 st) | 918 st) |
| 919 end | 919 end |
| 920 | EField (e, x) => | 920 | EField (e', x) => |
| 921 let | 921 let |
| 922 val (e, st) = jsE inner (e, st) | 922 fun default () = |
| 923 in | 923 let |
| 924 (strcat [e, | 924 val (e', st) = jsE inner (e', st) |
| 925 str ("._" ^ x)], st) | 925 in |
| 926 end | 926 (strcat [e', |
| 927 str ("._" ^ x)], st) | |
| 928 end | |
| 929 | |
| 930 fun seek (e, xs) = | |
| 931 case #1 e of | |
| 932 ERel n => | |
| 933 if n < inner then | |
| 934 default () | |
| 935 else | |
| 936 let | |
| 937 val n = n - inner | |
| 938 val t = List.nth (outer, n) | |
| 939 val t = foldl (fn (x, (TRecord xts, _)) => | |
| 940 (case List.find (fn (x', _) => x' = x) xts of | |
| 941 NONE => raise Fail "Jscomp: Bad seek [1]" | |
| 942 | SOME (_, t) => t) | |
| 943 | _ => raise Fail "Jscomp: Bad seek [2]") | |
| 944 t xs | |
| 945 | |
| 946 val e = (ERel n, loc) | |
| 947 val e = foldl (fn (x, e) => (EField (e, x), loc)) e xs | |
| 948 in | |
| 949 quoteExp t (e, st) | |
| 950 end | |
| 951 | EField (e', x) => seek (e', x :: xs) | |
| 952 | _ => default () | |
| 953 in | |
| 954 seek (e', [x]) | |
| 955 end | |
| 927 | 956 |
| 928 | ECase (e', pes, {result, ...}) => | 957 | ECase (e', pes, {result, ...}) => |
| 929 let | 958 let |
| 930 val plen = length pes | 959 val plen = length pes |
| 931 | 960 |
| 1272 ((EClosure (n, es), loc), st) | 1301 ((EClosure (n, es), loc), st) |
| 1273 end | 1302 end |
| 1274 | 1303 |
| 1275 | EQuery {exps, tables, state, query, body, initial} => | 1304 | EQuery {exps, tables, state, query, body, initial} => |
| 1276 let | 1305 let |
| 1306 val row = exps @ map (fn (x, xts) => (x, (TRecord xts, loc))) tables | |
| 1307 val row = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row | |
| 1308 val row = (TRecord row, loc) | |
| 1309 | |
| 1277 val (query, st) = exp outer (query, st) | 1310 val (query, st) = exp outer (query, st) |
| 1278 val (body, st) = exp outer (body, st) | 1311 val (body, st) = exp (state :: row :: outer) (body, st) |
| 1279 val (initial, st) = exp outer (initial, st) | 1312 val (initial, st) = exp outer (initial, st) |
| 1280 in | 1313 in |
| 1281 ((EQuery {exps = exps, tables = tables, state = state, | 1314 ((EQuery {exps = exps, tables = tables, state = state, |
| 1282 query = query, body = body, initial = initial}, loc), st) | 1315 query = query, body = body, initial = initial}, loc), st) |
| 1283 end | 1316 end |