Mercurial > urweb
comparison src/jscomp.sml @ 800:e92cfac1608f
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"}) |