Mercurial > urweb

comparison src/jscomp.sml @ 2304:6fb9232ade99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge Sqlcache
author Adam Chlipala <adam@chlipala.net>
date Sun, 20 Dec 2015 14:18:52 -0500
parents 6eae499c56cb 8428c534913a
children
comparison
equal deleted inserted replaced
2201:1091227f535a 2304:6fb9232ade99
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)];*)
799 end 799 end
800 | EField (e', x) => seek (e', x :: xs) 800 | EField (e', x) => seek (e', x :: xs)
801 | _ => default () 801 | _ => default ()
802 in 802 in
803 seek (e', [x]) 803 seek (e', [x])
804 end 804 end
805 805
806 | ECase (e', pes, _) => 806 | ECase (e', pes, _) =>
807 let 807 let
808 val (e', st) = jsE inner (e', st) 808 val (e', st) = jsE inner (e', st)
809 809
1030 | _ => (); 1030 | _ => ();
1031 (e, st)) 1031 (e, st))
1032 | ERel _ => (e, st) 1032 | ERel _ => (e, st)
1033 | ENamed _ => (e, st) 1033 | ENamed _ => (e, st)
1034 | ECon (_, _, NONE) => (e, st) 1034 | ECon (_, _, NONE) => (e, st)
1035 | ECon (dk, pc, SOME e) => 1035 | ECon (dk, pc, SOME e) =>
1036 let 1036 let
1037 val (e, st) = exp outer (e, st) 1037 val (e, st) = exp outer (e, st)
1038 in 1038 in
1039 ((ECon (dk, pc, SOME e), loc), st) 1039 ((ECon (dk, pc, SOME e), loc), st)
1040 end 1040 end
1082 val (e1, st) = exp outer (e1, st) 1082 val (e1, st) = exp outer (e1, st)
1083 val (e2, st) = exp outer (e2, st) 1083 val (e2, st) = exp outer (e2, st)
1084 in 1084 in
1085 ((EBinop (bi, s, e1, e2), loc), st) 1085 ((EBinop (bi, s, e1, e2), loc), st)
1086 end 1086 end
1087 1087
1088 | ERecord xets => 1088 | ERecord xets =>
1089 let 1089 let
1090 val (xets, st) = ListUtil.foldlMap (fn ((x, e, t), st) => 1090 val (xets, st) = ListUtil.foldlMap (fn ((x, e, t), st) =>
1091 let 1091 let
1092 val (e, st) = exp outer (e, st) 1092 val (e, st) = exp outer (e, st)
1257 let 1257 let
1258 val (e, st) = exp outer (e, st) 1258 val (e, st) = exp outer (e, st)
1259 in 1259 in
1260 ((ESignalSource e, loc), st) 1260 ((ESignalSource e, loc), st)
1261 end 1261 end
1262 1262
1263 | EServerCall (e1, t, ef, fm) => 1263 | EServerCall (e1, t, ef, fm) =>
1264 let 1264 let
1265 val (e1, st) = exp outer (e1, st) 1265 val (e1, st) = exp outer (e1, st)
1266 in 1266 in
1267 ((EServerCall (e1, t, ef, fm), loc), st) 1267 ((EServerCall (e1, t, ef, fm), loc), st)