Mercurial > urweb

comparison src/jscomp.sml @ 800:e92cfac1608f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Proper lifting of MonoEnv stored expressions; avoidance of onchange clobbering
author Adam Chlipala <adamc@hcoop.net>
date Thu, 14 May 2009 13:18:31 -0400
parents 83875a9eb9b8
children 5f49a6b759cb
comparison
equal deleted inserted replaced
799:9330ba3a2799 800:e92cfac1608f
34 structure U = MonoUtil 34 structure U = MonoUtil
35 35
36 structure IS = IntBinarySet 36 structure IS = IntBinarySet
37 structure IM = IntBinaryMap 37 structure IM = IntBinaryMap
38 38
39 structure TM = BinaryMapFn(struct
40 type ord_key = typ
41 val compare = U.Typ.compare
42 end)
43
39 type state = { 44 type state = {
40 decls : decl list, 45 decls : decl list,
41 script : string list, 46 script : string list,
42 included : IS.set, 47 included : IS.set,
43 injectors : int IM.map, 48 injectors : int IM.map,
49 listInjectors : int TM.map,
44 decoders : int IM.map, 50 decoders : int IM.map,
45 maxName : int 51 maxName : int
46 } 52 }
47 53
48 fun varDepth (e, _) = 54 fun varDepth (e, _) =
229 {disc = (TOption t, loc), 235 {disc = (TOption t, loc),
230 result = (TFfi ("Basis", "string"), loc)}), loc), 236 result = (TFfi ("Basis", "string"), loc)}), loc),
231 st) 237 st)
232 end 238 end
233 239
240 | TList t' =>
241 (case TM.find (#listInjectors st, t') of
242 SOME n' => ((EApp ((ENamed n', loc), e), loc), st)
243 | NONE =>
244 let
245 val rt = (TRecord [("1", t'), ("2", t)], loc)
246
247 val n' = #maxName st
248 val st = {decls = #decls st,
249 script = #script st,
250 included = #included st,
251 injectors = #injectors st,
252 listInjectors = TM.insert (#listInjectors st, t', n'),
253 decoders = #decoders st,
254 maxName = n' + 1}
255
256 val s = (TFfi ("Basis", "string"), loc)
257 val (e', st) = quoteExp loc t ((EField ((ERel 0, loc), "1"), loc), st)
258
259 val body = (ECase ((ERel 0, loc),
260 [((PNone rt, loc),
261 str loc "null"),
262 ((PSome (rt, (PVar ("x", rt), loc)), loc),
263 strcat loc [str loc "{v:{_1:",
264 e',
265 str loc ",_2:",
266 (EApp ((ENamed n', loc),
267 (EField ((ERel 0, loc), "2"), loc)), loc),
268 str loc "}}"])],
269 {disc = t, result = s}), loc)
270 val body = (EAbs ("x", t, s, body), loc)
271
272 val st = {decls = (DValRec [("jsify", n', (TFun (t, s), loc),
273 body, "jsify")], loc) :: #decls st,
274 script = #script st,
275 included = #included st,
276 injectors = #injectors st,
277 listInjectors = #listInjectors st,
278 decoders= #decoders st,
279 maxName = #maxName st}
280
281
282 in
283 ((EApp ((ENamed n', loc), e), loc), st)
284 end)
285
234 | TDatatype (n, ref (dk, cs)) => 286 | TDatatype (n, ref (dk, cs)) =>
235 (case IM.find (#injectors st, n) of 287 (case IM.find (#injectors st, n) of
236 SOME n' => ((EApp ((ENamed n', loc), e), loc), st) 288 SOME n' => ((EApp ((ENamed n', loc), e), loc), st)
237 | NONE => 289 | NONE =>
238 let 290 let
239 val n' = #maxName st 291 val n' = #maxName st
240 val st = {decls = #decls st, 292 val st = {decls = #decls st,
241 script = #script st, 293 script = #script st,
242 included = #included st, 294 included = #included st,
243 injectors = IM.insert (#injectors st, n, n'), 295 injectors = IM.insert (#injectors st, n, n'),
296 listInjectors = #listInjectors st,
244 decoders = #decoders st, 297 decoders = #decoders st,
245 maxName = n' + 1} 298 maxName = n' + 1}
246 299
247 val (pes, st) = ListUtil.foldlMap 300 val (pes, st) = ListUtil.foldlMap
248 (fn ((_, cn, NONE), st) => 301 (fn ((_, cn, NONE), st) =>
280 val st = {decls = (DValRec [("jsify", n', (TFun (t, s), loc), 333 val st = {decls = (DValRec [("jsify", n', (TFun (t, s), loc),
281 body, "jsify")], loc) :: #decls st, 334 body, "jsify")], loc) :: #decls st,
282 script = #script st, 335 script = #script st,
283 included = #included st, 336 included = #included st,
284 injectors = #injectors st, 337 injectors = #injectors st,
338 listInjectors = #listInjectors st,
285 decoders= #decoders st, 339 decoders= #decoders st,
286 maxName = #maxName st} 340 maxName = #maxName st}
287 in 341 in
288 ((EApp ((ENamed n', loc), e), loc), st) 342 ((EApp ((ENamed n', loc), e), loc), st)
289 end) 343 end)
348 val n' = #maxName st 402 val n' = #maxName st
349 val st = {decls = #decls st, 403 val st = {decls = #decls st,
350 script = #script st, 404 script = #script st,
351 included = #included st, 405 included = #included st,
352 injectors = #injectors st, 406 injectors = #injectors st,
407 listInjectors = #listInjectors st,
353 decoders = IM.insert (#decoders st, n, n'), 408 decoders = IM.insert (#decoders st, n, n'),
354 maxName = n' + 1} 409 maxName = n' + 1}
355 410
356 val (e, st) = foldl (fn ((x, cn, NONE), (e, st)) => 411 val (e, st) = foldl (fn ((x, cn, NONE), (e, st)) =>
357 ("x==\"" ^ x ^ "\"?" 412 ("x==\"" ^ x ^ "\"?"
382 437
383 val st = {decls = #decls st, 438 val st = {decls = #decls st,
384 script = body :: #script st, 439 script = body :: #script st,
385 included = #included st, 440 included = #included st,
386 injectors = #injectors st, 441 injectors = #injectors st,
442 listInjectors = #listInjectors st,
387 decoders = #decoders st, 443 decoders = #decoders st,
388 maxName = #maxName st} 444 maxName = #maxName st}
389 in 445 in
390 ("(tmp=_n" ^ Int.toString n' ^ "(t,i),i=tmp._1,tmp._2)", st) 446 ("(tmp=_n" ^ Int.toString n' ^ "(t,i),i=tmp._1,tmp._2)", st)
391 end) 447 end)
400 else 456 else
401 s 457 s
402 458
403 val foundJavaScript = ref false 459 val foundJavaScript = ref false
404 460
405 fun jsExp mode skip outer = 461 fun jsExp mode outer =
406 let 462 let
407 val len = length outer 463 val len = length outer
408 464
409 fun jsE inner (e as (_, loc), st) = 465 fun jsE inner (e as (_, loc), st) =
410 let 466 let
573 (str ("_" ^ var n), st) 629 (str ("_" ^ var n), st)
574 else 630 else
575 let 631 let
576 val n = n - inner 632 val n = n - inner
577 in 633 in
578 quoteExp (List.nth (outer, n)) ((ERel (n - skip), loc), st) 634 quoteExp (List.nth (outer, n)) ((ERel n, loc), st)
579 end 635 end
580 636
581 | ENamed n => 637 | ENamed n =>
582 let 638 let
583 val st = 639 val st =
590 let 646 let
591 val st = {decls = #decls st, 647 val st = {decls = #decls st,
592 script = #script st, 648 script = #script st,
593 included = IS.add (#included st, n), 649 included = IS.add (#included st, n),
594 injectors = #injectors st, 650 injectors = #injectors st,
651 listInjectors = #listInjectors st,
595 decoders = #decoders st, 652 decoders = #decoders st,
596 maxName = #maxName st} 653 maxName = #maxName st}
597 654
598 val (e, st) = jsExp mode skip [] 0 (e, st) 655 val (e, st) = jsExp mode [] 0 (e, st)
599 val e = deStrcat 0 e 656 val e = deStrcat 0 e
600 657
601 val sc = "_n" ^ Int.toString n ^ "=" ^ e ^ ";\n" 658 val sc = "_n" ^ Int.toString n ^ "=" ^ e ^ ";\n"
602 in 659 in
603 {decls = #decls st, 660 {decls = #decls st,
604 script = sc :: #script st, 661 script = sc :: #script st,
605 included = #included st, 662 included = #included st,
606 injectors = #injectors st, 663 injectors = #injectors st,
664 listInjectors = #listInjectors st,
607 decoders= #decoders st, 665 decoders= #decoders st,
608 maxName = #maxName st} 666 maxName = #maxName st}
609 end 667 end
610 in 668 in
611 (str ("_n" ^ Int.toString n), st) 669 (str ("_n" ^ Int.toString n), st)
986 1044
987 val decl : state -> decl -> decl * state = 1045 val decl : state -> decl -> decl * state =
988 U.Decl.foldMapB {typ = fn x => x, 1046 U.Decl.foldMapB {typ = fn x => x,
989 exp = fn (env, e, st) => 1047 exp = fn (env, e, st) =>
990 let 1048 let
991 fun doCode m skip env orig e = 1049 fun doCode m env orig e =
992 let 1050 let
993 val len = length env 1051 val len = length env
994 fun str s = (EPrim (Prim.String s), #2 e) 1052 fun str s = (EPrim (Prim.String s), #2 e)
995 1053
996 val locals = List.tabulate 1054 val locals = List.tabulate
997 (varDepth e, 1055 (varDepth e,
998 fn i => str ("var _" ^ Int.toString (len + i) ^ ";")) 1056 fn i => str ("var _" ^ Int.toString (len + i) ^ ";"))
999 val (e, st) = jsExp m skip env 0 (e, st) 1057 val (e, st) = jsExp m env 0 (e, st)
1000 in 1058 in
1001 (EJavaScript (m, orig, SOME (strcat (#2 e) (locals @ [e]))), st) 1059 (EJavaScript (m, orig, SOME (strcat (#2 e) (locals @ [e]))), st)
1002 end 1060 end
1003 in 1061 in
1004 case e of 1062 case e of
1005 EJavaScript (m, orig, NONE) => 1063 EJavaScript (m, orig, NONE) =>
1006 (foundJavaScript := true; 1064 (foundJavaScript := true;
1007 doCode m 0 env orig orig) 1065 doCode m env orig orig)
1008 | _ => (e, st) 1066 | _ => (e, st)
1009 end, 1067 end,
1010 decl = fn (_, e, st) => (e, st), 1068 decl = fn (_, e, st) => (e, st),
1011 bind = fn (env, U.Decl.RelE (_, t)) => t :: env 1069 bind = fn (env, U.Decl.RelE (_, t)) => t :: env
1012 | (env, _) => env} 1070 | (env, _) => env}
1019 (List.revAppend (#decls st, [d]), 1077 (List.revAppend (#decls st, [d]),
1020 {decls = [], 1078 {decls = [],
1021 script = #script st, 1079 script = #script st,
1022 included = #included st, 1080 included = #included st,
1023 injectors = #injectors st, 1081 injectors = #injectors st,
1082 listInjectors = #listInjectors st,
1024 decoders = #decoders st, 1083 decoders = #decoders st,
1025 maxName = #maxName st}) 1084 maxName = #maxName st})
1026 end 1085 end
1027 1086
1028 val (ds, st) = ListUtil.foldlMapConcat doDecl 1087 val (ds, st) = ListUtil.foldlMapConcat doDecl
1029 {decls = [], 1088 {decls = [],
1030 script = [], 1089 script = [],
1031 included = IS.empty, 1090 included = IS.empty,
1032 injectors = IM.empty, 1091 injectors = IM.empty,
1092 listInjectors = TM.empty,
1033 decoders = IM.empty, 1093 decoders = IM.empty,
1034 maxName = U.File.maxName file + 1} 1094 maxName = U.File.maxName file + 1}
1035 file 1095 file
1036 1096
1037 val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"}) 1097 val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"})