Mercurial > urweb

comparison src/monoize.sml @ 568:55fc747a67dc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial <dyn> support
author Adam Chlipala <adamc@hcoop.net>
date Sat, 20 Dec 2008 15:46:48 -0500
parents a152905c3c3b
children 162d5308e34f
comparison
equal deleted inserted replaced
567:1901db85acb4 568:55fc747a67dc
133 133
134 | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) => 134 | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) =>
135 (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc) 135 (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc)
136 | L.CApp ((L.CFfi ("Basis", "source"), _), t) => 136 | L.CApp ((L.CFfi ("Basis", "source"), _), t) =>
137 (L'.TFfi ("Basis", "int"), loc) 137 (L'.TFfi ("Basis", "int"), loc)
138 | L.CApp ((L.CFfi ("Basis", "signal"), _), t) =>
139 (L'.TSignal (mt env dtmap t), loc)
138 | L.CApp ((L.CFfi ("Basis", "http_cookie"), _), _) => 140 | L.CApp ((L.CFfi ("Basis", "http_cookie"), _), _) =>
139 (L'.TFfi ("Basis", "string"), loc) 141 (L'.TFfi ("Basis", "string"), loc)
140 | L.CApp ((L.CFfi ("Basis", "sql_table"), _), _) => 142 | L.CApp ((L.CFfi ("Basis", "sql_table"), _), _) =>
141 (L'.TFfi ("Basis", "string"), loc) 143 (L'.TFfi ("Basis", "string"), loc)
142 | L.CFfi ("Basis", "sql_sequence") => 144 | L.CFfi ("Basis", "sql_sequence") =>
973 in 975 in
974 ((L'.EAbs ("x", t, (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "int"), loc)), loc), 976 ((L'.EAbs ("x", t, (L'.TFun ((L'.TRecord [], loc), (L'.TFfi ("Basis", "int"), loc)), loc),
975 (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "int"), loc), 977 (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "int"), loc),
976 (L'.EFfiApp ("Basis", "new_client_source", [(L'.ERecord [], loc)]), loc)), loc)), 978 (L'.EFfiApp ("Basis", "new_client_source", [(L'.ERecord [], loc)]), loc)), loc)),
977 loc), 979 loc),
980 fm)
981 end
982
983 | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), _), _), t), _),
984 (L.EFfi ("Basis", "signal_monad"), _)) =>
985 let
986 val t = monoType env t
987 in
988 ((L'.EAbs ("x", t, (L'.TSignal t, loc),
989 (L'.ESignalReturn (L'.ERel 0, loc), loc)), loc),
978 fm) 990 fm)
979 end 991 end
980 992
981 | L.ECApp ((L.EFfi ("Basis", "getCookie"), _), t) => 993 | L.ECApp ((L.EFfi ("Basis", "getCookie"), _), t) =>
982 let 994 let
1750 in 1762 in
1751 ((L'.EStrcat (s, 1763 ((L'.EStrcat (s,
1752 (L'.EStrcat ( 1764 (L'.EStrcat (
1753 (L'.EPrim (Prim.String s'), loc), 1765 (L'.EPrim (Prim.String s'), loc),
1754 (L'.EStrcat ( 1766 (L'.EStrcat (
1755 (L'.EJavaScript e, loc), 1767 (L'.EJavaScript (L'.Attribute, e), loc),
1756 (L'.EPrim (Prim.String "'"), loc)), loc)), 1768 (L'.EPrim (Prim.String "'"), loc)), loc)),
1757 loc)), loc), 1769 loc)), loc),
1758 fm) 1770 fm)
1759 end 1771 end
1760 | _ => 1772 | _ =>
1831 end 1843 end
1832 in 1844 in
1833 case tag of 1845 case tag of
1834 "body" => normal ("body", NONE, 1846 "body" => normal ("body", NONE,
1835 SOME (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), loc)) 1847 SOME (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), loc))
1848
1849 | "dyn" =>
1850 (case #1 attrs of
1851 (*L'.ERecord [("Signal", (L'.ESignalReturn e, _), _)] => (e, fm)
1852 | L'.ERecord [("Signal", (L'.EApp ((L'.EAbs (_, _, _, (L'.ESignalReturn (L'.ERel 0, _), _)), _),
1853 e), _), _)] => (e, fm) *)
1854
1855 L'.ERecord [("Signal", e, _)] =>
1856 ((L'.EStrcat
1857 ((L'.EPrim (Prim.String "<script type=\"text/javascript\">"), loc),
1858 (L'.EStrcat ((L'.EJavaScript (L'.Script,
1859 (L'.ELet ("signal", (L'.TSignal
1860 (L'.TFfi ("Basis", "string"), loc),
1861 loc),
1862 e,
1863 (L'.EWrite (L'.ERel 0, loc), loc)), loc)), loc),
1864 (L'.EPrim (Prim.String "</script>"), loc)), loc)), loc),
1865 fm)
1866 | _ => raise Fail "Monoize: Bad dyn attributes")
1836 1867
1837 | "submit" => normal ("input type=\"submit\"", NONE, NONE) 1868 | "submit" => normal ("input type=\"submit\"", NONE, NONE)
1838 1869
1839 | "textbox" => 1870 | "textbox" =>
1840 (case targs of 1871 (case targs of