comparison src/jscomp.sml @ 2221:278e10629ba1

Basic field-resolution invalidation.
author Ziv Scully <ziv@mit.edu>
date Sat, 29 Nov 2014 03:37:59 -0500
parents 4d64af730e35
children e10881cd92da
comparison
equal deleted inserted replaced
2220:794017f378de 2221:278e10629ba1
14 * 14 *
15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
193 (EApp ((ENamed n', loc), 193 (EApp ((ENamed n', loc),
194 (EField ((ERel 0, loc), "2"), loc)), loc), 194 (EField ((ERel 0, loc), "2"), loc)), loc),
195 str loc "}"])], 195 str loc "}"])],
196 {disc = t, result = s}), loc) 196 {disc = t, result = s}), loc)
197 val body = (EAbs ("x", t, s, body), loc) 197 val body = (EAbs ("x", t, s, body), loc)
198 198
199 val st = {decls = ("jsify", n', (TFun (t, s), loc), 199 val st = {decls = ("jsify", n', (TFun (t, s), loc),
200 body, "jsify") :: #decls st, 200 body, "jsify") :: #decls st,
201 script = #script st, 201 script = #script st,
202 included = #included st, 202 included = #included st,
203 injectors = #injectors st, 203 injectors = #injectors st,
573 val (e, st) = jsExp mode [] (e, st) 573 val (e, st) = jsExp mode [] (e, st)
574 val e = deStrcat 0 e 574 val e = deStrcat 0 e
575 val e = String.translate (fn #"'" => "\\'" 575 val e = String.translate (fn #"'" => "\\'"
576 | #"\\" => "\\\\" 576 | #"\\" => "\\\\"
577 | ch => String.str ch) e 577 | ch => String.str ch) e
578 578
579 val sc = "urfuncs[" ^ Int.toString n ^ "] = {c:\"t\",f:'" 579 val sc = "urfuncs[" ^ Int.toString n ^ "] = {c:\"t\",f:'"
580 ^ e ^ "'};\n" 580 ^ e ^ "'};\n"
581 in 581 in
582 (*Print.prefaces "jsify'" [("old", MonoPrint.p_exp MonoEnv.empty old), 582 (*Print.prefaces "jsify'" [("old", MonoPrint.p_exp MonoEnv.empty old),
583 ("new", MonoPrint.p_exp MonoEnv.empty new)];*) 583 ("new", MonoPrint.p_exp MonoEnv.empty new)];*)
797 end 797 end
798 | EField (e', x) => seek (e', x :: xs) 798 | EField (e', x) => seek (e', x :: xs)
799 | _ => default () 799 | _ => default ()
800 in 800 in
801 seek (e', [x]) 801 seek (e', [x])
802 end 802 end
803 803
804 | ECase (e', pes, _) => 804 | ECase (e', pes, _) =>
805 let 805 let
806 val (e', st) = jsE inner (e', st) 806 val (e', st) = jsE inner (e', st)
807 807
1028 | _ => (); 1028 | _ => ();
1029 (e, st)) 1029 (e, st))
1030 | ERel _ => (e, st) 1030 | ERel _ => (e, st)
1031 | ENamed _ => (e, st) 1031 | ENamed _ => (e, st)
1032 | ECon (_, _, NONE) => (e, st) 1032 | ECon (_, _, NONE) => (e, st)
1033 | ECon (dk, pc, SOME e) => 1033 | ECon (dk, pc, SOME e) =>
1034 let 1034 let
1035 val (e, st) = exp outer (e, st) 1035 val (e, st) = exp outer (e, st)
1036 in 1036 in
1037 ((ECon (dk, pc, SOME e), loc), st) 1037 ((ECon (dk, pc, SOME e), loc), st)
1038 end 1038 end
1080 val (e1, st) = exp outer (e1, st) 1080 val (e1, st) = exp outer (e1, st)
1081 val (e2, st) = exp outer (e2, st) 1081 val (e2, st) = exp outer (e2, st)
1082 in 1082 in
1083 ((EBinop (bi, s, e1, e2), loc), st) 1083 ((EBinop (bi, s, e1, e2), loc), st)
1084 end 1084 end
1085 1085
1086 | ERecord xets => 1086 | ERecord xets =>
1087 let 1087 let
1088 val (xets, st) = ListUtil.foldlMap (fn ((x, e, t), st) => 1088 val (xets, st) = ListUtil.foldlMap (fn ((x, e, t), st) =>
1089 let 1089 let
1090 val (e, st) = exp outer (e, st) 1090 val (e, st) = exp outer (e, st)
1174 val (es, st) = ListUtil.foldlMap (exp outer) st es 1174 val (es, st) = ListUtil.foldlMap (exp outer) st es
1175 in 1175 in
1176 ((EClosure (n, es), loc), st) 1176 ((EClosure (n, es), loc), st)
1177 end 1177 end
1178 1178
1179 | EQuery {exps, tables, state, query, body, initial} => 1179 | EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} =>
1180 let 1180 let
1181 val row = exps @ map (fn (x, xts) => (x, (TRecord xts, loc))) tables 1181 val row = exps @ map (fn (x, xts) => (x, (TRecord xts, loc))) tables
1182 val row = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row 1182 val row = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row
1183 val row = (TRecord row, loc) 1183 val row = (TRecord row, loc)
1184 1184
1185 val (query, st) = exp outer (query, st) 1185 val (query, st) = exp outer (query, st)
1186 val (body, st) = exp (state :: row :: outer) (body, st) 1186 val (body, st) = exp (state :: row :: outer) (body, st)
1187 val (initial, st) = exp outer (initial, st) 1187 val (initial, st) = exp outer (initial, st)
1188 in 1188 in
1189 ((EQuery {exps = exps, tables = tables, state = state, 1189 ((EQuery {exps = exps, tables = tables, state = state,
1190 query = query, body = body, initial = initial}, loc), st) 1190 query = query, body = body, initial = initial,
1191 sqlcacheInfo = sqlcacheInfo}, loc), st)
1191 end 1192 end
1192 | EDml (e, mode) => 1193 | EDml (e, mode) =>
1193 let 1194 let
1194 val (e, st) = exp outer (e, st) 1195 val (e, st) = exp outer (e, st)
1195 in 1196 in
1255 let 1256 let
1256 val (e, st) = exp outer (e, st) 1257 val (e, st) = exp outer (e, st)
1257 in 1258 in
1258 ((ESignalSource e, loc), st) 1259 ((ESignalSource e, loc), st)
1259 end 1260 end
1260 1261
1261 | EServerCall (e1, t, ef, fm) => 1262 | EServerCall (e1, t, ef, fm) =>
1262 let 1263 let
1263 val (e1, st) = exp outer (e1, st) 1264 val (e1, st) = exp outer (e1, st)
1264 in 1265 in
1265 ((EServerCall (e1, t, ef, fm), loc), st) 1266 ((EServerCall (e1, t, ef, fm), loc), st)