comparison src/jscomp.sml @ 905:7a4b026e45dd

Library improvements; proper list [un]urlification; remove server-side ServerCalls; eta reduction in type inference
author Adam Chlipala <adamc@hcoop.net>
date Sun, 09 Aug 2009 16:13:27 -0400
parents ae9e22822ec5
children c270fb847dc2
comparison
equal deleted inserted replaced
904:6d9538ce94d8 905:7a4b026e45dd
84 | EUnurlify _ => 0 84 | EUnurlify _ => 0
85 | EJavaScript _ => 0 85 | EJavaScript _ => 0
86 | ESignalReturn e => varDepth e 86 | ESignalReturn e => varDepth e
87 | ESignalBind (e1, e2) => Int.max (varDepth e1, varDepth e2) 87 | ESignalBind (e1, e2) => Int.max (varDepth e1, varDepth e2)
88 | ESignalSource e => varDepth e 88 | ESignalSource e => varDepth e
89 | EServerCall (e, ek, _, _) => Int.max (varDepth e, varDepth ek) 89 | EServerCall (e, ek, _, _, _) => Int.max (varDepth e, varDepth ek)
90 | ERecv (e, ek, _) => Int.max (varDepth e, varDepth ek) 90 | ERecv (e, ek, _) => Int.max (varDepth e, varDepth ek)
91 | ESleep (e, ek) => Int.max (varDepth e, varDepth ek) 91 | ESleep (e, ek) => Int.max (varDepth e, varDepth ek)
92 92
93 fun closedUpto d = 93 fun closedUpto d =
94 let 94 let
128 | EUnurlify (e, _) => cu inner e 128 | EUnurlify (e, _) => cu inner e
129 | EJavaScript (_, e) => cu inner e 129 | EJavaScript (_, e) => cu inner e
130 | ESignalReturn e => cu inner e 130 | ESignalReturn e => cu inner e
131 | ESignalBind (e1, e2) => cu inner e1 andalso cu inner e2 131 | ESignalBind (e1, e2) => cu inner e1 andalso cu inner e2
132 | ESignalSource e => cu inner e 132 | ESignalSource e => cu inner e
133 | EServerCall (e, ek, _, _) => cu inner e andalso cu inner ek 133 | EServerCall (e, ek, _, _, _) => cu inner e andalso cu inner ek
134 | ERecv (e, ek, _) => cu inner e andalso cu inner ek 134 | ERecv (e, ek, _) => cu inner e andalso cu inner ek
135 | ESleep (e, ek) => cu inner e andalso cu inner ek 135 | ESleep (e, ek) => cu inner e andalso cu inner ek
136 in 136 in
137 cu 0 137 cu 0
138 end 138 end
430 "{v:" ^ e ^ "}" 430 "{v:" ^ e ^ "}"
431 else 431 else
432 e 432 e
433 in 433 in
434 ("(t[i++]==\"Some\"?" ^ e ^ ":null)", st) 434 ("(t[i++]==\"Some\"?" ^ e ^ ":null)", st)
435 end
436
437 | TList t =>
438 let
439 val (e, st) = unurlifyExp loc (t, st)
440 in
441 ("uul(function(){return t[i++];},function(){return " ^ e ^ "})", st)
435 end 442 end
436 443
437 | TDatatype (n, ref (dk, cs)) => 444 | TDatatype (n, ref (dk, cs)) =>
438 (case IM.find (#decoders st, n) of 445 (case IM.find (#decoders st, n) of
439 SOME n' => ("(tmp=_n" ^ Int.toString n' ^ "(t,i),i=tmp._1,tmp._2)", st) 446 SOME n' => ("(tmp=_n" ^ Int.toString n' ^ "(t,i),i=tmp._1,tmp._2)", st)
1032 e, 1039 e,
1033 str ")"], 1040 str ")"],
1034 st) 1041 st)
1035 end 1042 end
1036 1043
1037 | EServerCall (e, ek, t, eff) => 1044 | EServerCall (e, ek, t, eff, _) =>
1038 let 1045 let
1039 val (e, st) = jsE inner (e, st) 1046 val (e, st) = jsE inner (e, st)
1040 val (ek, st) = jsE inner (ek, st) 1047 val (ek, st) = jsE inner (ek, st)
1041 val (unurl, st) = unurlifyExp loc (t, st) 1048 val (unurl, st) = unurlifyExp loc (t, st)
1042 in 1049 in
1311 val (e, st) = exp outer (e, st) 1318 val (e, st) = exp outer (e, st)
1312 in 1319 in
1313 ((ESignalSource e, loc), st) 1320 ((ESignalSource e, loc), st)
1314 end 1321 end
1315 1322
1316 | EServerCall (e1, e2, t, ef) => 1323 | EServerCall (e1, e2, t, ef, ue) =>
1317 let 1324 let
1318 val (e1, st) = exp outer (e1, st) 1325 val (e1, st) = exp outer (e1, st)
1319 val (e2, st) = exp outer (e2, st) 1326 val (e2, st) = exp outer (e2, st)
1320 in 1327 val (ue, st) = exp outer (ue, st)
1321 ((EServerCall (e1, e2, t, ef), loc), st) 1328 in
1329 ((EServerCall (e1, e2, t, ef, ue), loc), st)
1322 end 1330 end
1323 | ERecv (e1, e2, t) => 1331 | ERecv (e1, e2, t) =>
1324 let 1332 let
1325 val (e1, st) = exp outer (e1, st) 1333 val (e1, st) = exp outer (e1, st)
1326 val (e2, st) = exp outer (e2, st) 1334 val (e2, st) = exp outer (e2, st)