Mercurial > urweb

comparison src/monoize.sml @ 695:500e93aa436f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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, _), _)), _),