Mercurial > urweb

comparison src/monoize.sml @ 601:7c3c21eb5b4c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial experiments with nested <dyn>
author Adam Chlipala <adamc@hcoop.net>
date Tue, 13 Jan 2009 15:17:11 -0500
parents 889dc9fceb3a
children b1064de2b1f9
comparison
equal deleted inserted replaced
600:d1cce194180d 601:7c3c21eb5b4c
996 (L'.EFfiApp ("Basis", "set_client_source", 996 (L'.EFfiApp ("Basis", "set_client_source",
997 [(L'.ERel 2, loc), 997 [(L'.ERel 2, loc),
998 (L'.EJavaScript (L'.Source t, 998 (L'.EJavaScript (L'.Source t,
999 (L'.ERel 1, loc), NONE), loc)]), 999 (L'.ERel 1, loc), NONE), loc)]),
1000 loc)), loc)), loc)), loc), 1000 loc)), loc)), loc)), loc),
1001 fm)
1002 end
1003 | L.ECApp ((L.EFfi ("Basis", "get"), _), t) =>
1004 let
1005 val t = monoType env t
1006 in
1007 ((L'.EAbs ("src", (L'.TSource, loc),
1008 (L'.TFun ((L'.TRecord [], loc), t), loc),
1009 (L'.EAbs ("_", (L'.TRecord [], loc), t,
1010 (L'.EFfiApp ("Basis", "get_client_source",
1011 [(L'.ERel 1, loc)]),
1012 loc)), loc)), loc),
1001 fm) 1013 fm)
1002 end 1014 end
1003 1015
1004 | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), _), _), t), _), 1016 | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), _), _), t), _),
1005 (L.EFfi ("Basis", "signal_monad"), _)) => 1017 (L.EFfi ("Basis", "signal_monad"), _)) =>
1903 (L'.EPrim (Prim.String ")</script>"), loc)), loc)), loc), 1915 (L'.EPrim (Prim.String ")</script>"), loc)), loc)), loc),
1904 fm) 1916 fm)
1905 | _ => raise Fail "Monoize: Bad dyn attributes") 1917 | _ => raise Fail "Monoize: Bad dyn attributes")
1906 1918
1907 | "submit" => normal ("input type=\"submit\"", NONE, NONE) 1919 | "submit" => normal ("input type=\"submit\"", NONE, NONE)
1920 | "button" => normal ("input type=\"submit\"", NONE, NONE)
1908 1921
1909 | "textbox" => 1922 | "textbox" =>
1910 (case targs of 1923 (case targs of
1911 [_, (L.CName name, _)] => 1924 [_, (L.CName name, _)] =>
1912 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of 1925 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of
1975 loc), 1988 loc),
1976 fm) 1989 fm)
1977 end 1990 end
1978 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); 1991 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
1979 raise Fail "No name passed to lselect tag")) 1992 raise Fail "No name passed to lselect tag"))
1993
1994 | "ctextbox" =>
1995 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of
1996 NONE =>
1997 let
1998 val (ts, fm) = tagStart "input"
1999 in
2000 ((L'.EStrcat (ts,
2001 (L'.EPrim (Prim.String "/>"), loc)),
2002 loc), fm)
2003 end
2004 | SOME (_, src, _) =>
2005 (strcat [str "<script>inp(\"input\",",
2006 (L'.EJavaScript (L'.Script, src, NONE), loc),
2007 str ")</script>"],
2008 fm))
1980 2009
1981 | "option" => normal ("option", NONE, NONE) 2010 | "option" => normal ("option", NONE, NONE)
1982 2011
1983 | "tabl" => normal ("table", NONE, NONE) 2012 | "tabl" => normal ("table", NONE, NONE)
1984 | _ => normal (tag, NONE, NONE) 2013 | _ => normal (tag, NONE, NONE)