Mercurial > urweb

comparison src/monoize.sml @ 104:b1e5398a7f30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial HTML attributes support
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 15:04:32 -0400
parents 5f04adf47f48
children da760c34f5ed
comparison
equal deleted inserted replaced
103:8921f0344193 104:b1e5398a7f30
107 xml1), _), 107 xml1), _),
108 xml2) => (L'.EStrcat (monoExp env xml1, monoExp env xml2), loc) 108 xml2) => (L'.EStrcat (monoExp env xml1, monoExp env xml2), loc)
109 109
110 | L.EApp ( 110 | L.EApp (
111 (L.EApp ( 111 (L.EApp (
112 (L.ECApp ( 112 (L.EApp (
113 (L.ECApp ( 113 (L.ECApp (
114 (L.EFfi ("Basis", "tag"), 114 (L.ECApp (
115 _), _), _), 115 (L.ECApp (
116 _), _), 116 (L.ECApp (
117 (L.EFfi ("Basis", "tag"),
118 _), _), _), _), _), _), _), _), _),
119 attrs), _),
117 tag), _), 120 tag), _),
118 xml) => 121 xml) =>
119 let 122 let
120 fun getTag (e, _) = 123 fun getTag (e, _) =
121 case e of 124 case e of
124 Print.eprefaces' [("Expression", CorePrint.p_exp env tag)]; 127 Print.eprefaces' [("Expression", CorePrint.p_exp env tag)];
125 "") 128 "")
126 129
127 val tag = getTag tag 130 val tag = getTag tag
128 131
132 val attrs = monoExp env attrs
133
134 val tagStart =
135 case #1 attrs of
136 L'.ERecord xes =>
137 let
138 fun lowercaseFirst "" = ""
139 | lowercaseFirst s = str (Char.toLower (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
140
141 val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc)
142 in
143 foldl (fn ((x, e, _), s) =>
144 let
145 val xp = " " ^ lowercaseFirst x ^ "=\""
146 in
147 (L'.EStrcat (s,
148 (L'.EStrcat ((L'.EPrim (Prim.String xp), loc),
149 (L'.EStrcat (e,
150 (L'.EPrim (Prim.String "\""), loc)),
151 loc)),
152 loc)), loc)
153 end)
154 s xes
155 end
156 | _ => raise Fail "Attributes!"
157
129 fun normal () = 158 fun normal () =
130 (L'.EStrcat ((L'.EPrim (Prim.String (String.concat ["<", tag, ">"])), loc), 159 (L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc),
131 (L'.EStrcat (monoExp env xml, 160 (L'.EStrcat (monoExp env xml,
132 (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])), loc)), loc)), 161 (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])), loc)), loc)),
133 loc) 162 loc)
163
164
134 in 165 in
135 case xml of 166 case xml of
136 (L.EApp ((L.ECApp ((L.EFfi ("Basis", "cdata"), _), 167 (L.EApp ((L.ECApp ((L.EFfi ("Basis", "cdata"), _),
137 _), _), (L.EPrim (Prim.String s), _)), _) => 168 _), _), (L.EPrim (Prim.String s), _)), _) =>
138 if CharVector.all Char.isSpace s then 169 if CharVector.all Char.isSpace s then
139 (L'.EPrim (Prim.String (String.concat ["<", tag, "/>"])), loc) 170 (L'.EStrcat (tagStart, (L'.EPrim (Prim.String "/>"), loc)), loc)
140 else 171 else
141 normal () 172 normal ()
142 | _ => normal () 173 | _ => normal ()
143 end 174 end
144 175