Mercurial > urweb

comparison src/monoize.sml @ 721:9864b64b1700

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Classes as optional arguments to Basis.tag
author Adam Chlipala <adamc@hcoop.net>
date Sun, 12 Apr 2009 14:19:15 -0400
parents acb8537f58f0
children 12ec14a6be0b
comparison
equal deleted inserted replaced
720:acb8537f58f0 721:9864b64b1700
129 | L.CFfi ("Basis", "url") => (L'.TFfi ("Basis", "string"), loc) 129 | L.CFfi ("Basis", "url") => (L'.TFfi ("Basis", "string"), loc)
130 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) => 130 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) =>
131 (L'.TFfi ("Basis", "string"), loc) 131 (L'.TFfi ("Basis", "string"), loc)
132 | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) => 132 | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) =>
133 (L'.TFfi ("Basis", "string"), loc) 133 (L'.TFfi ("Basis", "string"), loc)
134 | L.CFfi ("Basis", "css_class") => (L'.TFfi ("Basis", "string"), loc)
134 135
135 | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) => 136 | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) =>
136 (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc) 137 (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc)
137 | L.CApp ((L.CFfi ("Basis", "source"), _), t) => 138 | L.CApp ((L.CFfi ("Basis", "source"), _), t) =>
138 (L'.TSource, loc) 139 (L'.TSource, loc)
2033 end 2034 end
2034 2035
2035 | L.EApp ( 2036 | L.EApp (
2036 (L.EApp ( 2037 (L.EApp (
2037 (L.EApp ( 2038 (L.EApp (
2038 (L.ECApp ( 2039 (L.EApp (
2039 (L.ECApp ( 2040 (L.ECApp (
2040 (L.ECApp ( 2041 (L.ECApp (
2041 (L.ECApp ( 2042 (L.ECApp (
2042 (L.ECApp ( 2043 (L.ECApp (
2043 (L.ECApp ( 2044 (L.ECApp (
2044 (L.ECApp ( 2045 (L.ECApp (
2045 (L.ECApp ( 2046 (L.ECApp (
2046 (L.EFfi ("Basis", "tag"), 2047 (L.ECApp (
2047 _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), 2048 (L.EFfi ("Basis", "tag"),
2049 _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
2050 class), _),
2048 attrs), _), 2051 attrs), _),
2049 tag), _), 2052 tag), _),
2050 xml) => 2053 xml) =>
2051 let 2054 let
2052 fun getTag' (e, _) = 2055 fun getTag' (e, _) =
2094 2097
2095 fun lowercaseFirst "" = "" 2098 fun lowercaseFirst "" = ""
2096 | lowercaseFirst s = String.str (Char.toLower (String.sub (s, 0))) 2099 | lowercaseFirst s = String.str (Char.toLower (String.sub (s, 0)))
2097 ^ String.extract (s, 1, NONE) 2100 ^ String.extract (s, 1, NONE)
2098 2101
2102 val (class, fm) = monoExp (env, st, fm) class
2103
2099 fun tagStart tag = 2104 fun tagStart tag =
2100 let 2105 let
2106 val t = (L'.TFfi ("Basis", "string"), loc)
2101 val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc) 2107 val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc)
2108
2109 val s = (L'.ECase (class,
2110 [((L'.PNone t, loc),
2111 s),
2112 ((L'.PSome (t, (L'.PVar ("x", t), loc)), loc),
2113 (L'.EStrcat (s,
2114 (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc),
2115 (L'.EStrcat ((L'.ERel 0, loc),
2116 (L'.EPrim (Prim.String "\""), loc)),
2117 loc)), loc)), loc))],
2118 {disc = (L'.TOption t, loc),
2119 result = t}), loc)
2102 in 2120 in
2103 foldl (fn (("Action", _, _), acc) => acc 2121 foldl (fn (("Action", _, _), acc) => acc
2104 | (("Source", _, _), acc) => acc 2122 | (("Source", _, _), acc) => acc
2105 | ((x, e, t), (s, fm)) => 2123 | ((x, e, t), (s, fm)) =>
2106 case t of 2124 case t of