Mercurial > urweb
comparison src/monoize.sml @ 695:500e93aa436f
sleep and better Scriptcheck
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 04 Apr 2009 15:56:47 -0400 |
parents | 7ea0df9e56b6 |
children | 755a71c99be5 |
comparison
equal
deleted
inserted
replaced
694:7ea0df9e56b6 | 695:500e93aa436f |
---|---|
998 ((L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc), | 998 ((L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc), |
999 (L'.EAbs ("_", un, un, | 999 (L'.EAbs ("_", un, un, |
1000 (L'.ERecv (liftExpInExp 0 (liftExpInExp 0 ch), | 1000 (L'.ERecv (liftExpInExp 0 (liftExpInExp 0 ch), |
1001 (L'.ERel 1, loc), | 1001 (L'.ERel 1, loc), |
1002 t1), loc)), loc)), loc), | 1002 t1), loc)), loc)), loc), |
1003 fm) | |
1004 end | |
1005 | L.EApp ((L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), _), _), _), _), t2), _), | |
1006 (L.EFfi ("Basis", "transaction_monad"), _)), _), | |
1007 (L.EAbs (_, _, _, | |
1008 (L.EFfiApp ("Basis", "sleep", [n]), _)), loc)) => | |
1009 let | |
1010 val t2 = monoType env t2 | |
1011 val un = (L'.TRecord [], loc) | |
1012 val mt2 = (L'.TFun (un, t2), loc) | |
1013 val (n, fm) = monoExp (env, st, fm) n | |
1014 in | |
1015 ((L'.EAbs ("m2", (L'.TFun (un, mt2), loc), (L'.TFun (un, un), loc), | |
1016 (L'.EAbs ("_", un, un, | |
1017 (L'.ESleep (n, (L'.EApp ((L'.ERel 1, loc), | |
1018 (L'.ERecord [], loc)), loc)), | |
1019 loc)), loc)), loc), | |
1003 fm) | 1020 fm) |
1004 end | 1021 end |
1005 | 1022 |
1006 | L.ECApp ((L.EFfi ("Basis", "source"), _), t) => | 1023 | L.ECApp ((L.EFfi ("Basis", "source"), _), t) => |
1007 let | 1024 let |
1950 val (tagStart, fm) = tagStart tag | 1967 val (tagStart, fm) = tagStart tag |
1951 val tagStart = case extra of | 1968 val tagStart = case extra of |
1952 NONE => tagStart | 1969 NONE => tagStart |
1953 | SOME extra => (L'.EStrcat (tagStart, extra), loc) | 1970 | SOME extra => (L'.EStrcat (tagStart, extra), loc) |
1954 | 1971 |
1972 val xml = case extraInner of | |
1973 NONE => xml | |
1974 | SOME ei => (L.EFfiApp ("Basis", "strcat", [ei, xml]), loc) | |
1975 | |
1955 fun normal () = | 1976 fun normal () = |
1956 let | 1977 let |
1957 val (xml, fm) = monoExp (env, st, fm) xml | 1978 val (xml, fm) = monoExp (env, st, fm) xml |
1958 val xml = case extraInner of | |
1959 NONE => xml | |
1960 | SOME ei => (L'.EStrcat (ei, xml), loc) | |
1961 in | 1979 in |
1962 ((L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc), | 1980 ((L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc), |
1963 (L'.EStrcat (xml, | 1981 (L'.EStrcat (xml, |
1964 (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])), | 1982 (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])), |
1965 loc)), loc)), | 1983 loc)), loc)), |
2010 in | 2028 in |
2011 (L'.EJavaScript (L'.Attribute, e, NONE), loc) | 2029 (L'.EJavaScript (L'.Attribute, e, NONE), loc) |
2012 end | 2030 end |
2013 in | 2031 in |
2014 normal ("body", | 2032 normal ("body", |
2015 SOME (L'.EStrcat ((L'.EPrim (Prim.String " onload='"), loc), | 2033 SOME (L'.EFfiApp ("Basis", "maybe_onload", |
2016 (L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings", | 2034 [(L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings", |
2017 [(L'.ERecord [], loc)]), loc), | 2035 [(L'.ERecord [], loc)]), loc), |
2018 (L'.EStrcat (onload, | 2036 onload), loc)]), |
2019 (L'.EPrim (Prim.String "'"), | 2037 loc), |
2020 loc)), loc)), loc)), loc), | 2038 SOME (L.EFfiApp ("Basis", "get_script", [(L.ERecord [], loc)]), loc)) |
2021 SOME (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), loc)) | |
2022 end | 2039 end |
2023 | 2040 |
2024 | "dyn" => | 2041 | "dyn" => |
2025 (case attrs of | 2042 (case attrs of |
2026 [("Signal", (L'.EApp ((L'.EAbs (_, _, _, (L'.ESignalReturn (L'.ERel 0, _), _)), _), | 2043 [("Signal", (L'.EApp ((L'.EAbs (_, _, _, (L'.ESignalReturn (L'.ERel 0, _), _)), _), |