Mercurial > urweb

comparison src/monoize.sml @ 1833:be0c4e2e488a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Allow any FFI module to declare new HTML tags
author Adam Chlipala <adam@chlipala.net>
date Wed, 28 Nov 2012 16:56:45 -0500
parents 373e2c3f03b2
children a8b273f1f7e3
comparison
equal deleted inserted replaced
1832:373e2c3f03b2 1833:be0c4e2e488a
3201 tag), _), 3201 tag), _),
3202 xml) => 3202 xml) =>
3203 let 3203 let
3204 fun getTag' (e, _) = 3204 fun getTag' (e, _) =
3205 case e of 3205 case e of
3206 L.EFfi ("Basis", tag) => (tag, []) 3206 L.EFfi (_, tag) => (tag, [])
3207 | L.ECApp (e, t) => let 3207 | L.ECApp (e, t) => let
3208 val (tag, ts) = getTag' e 3208 val (tag, ts) = getTag' e
3209 in 3209 in
3210 (tag, ts @ [t]) 3210 (tag, ts @ [t])
3211 end 3211 end
3213 Print.eprefaces' [("Expression", CorePrint.p_exp env tag)]; 3213 Print.eprefaces' [("Expression", CorePrint.p_exp env tag)];
3214 ("", [])) 3214 ("", []))
3215 3215
3216 fun getTag (e, _) = 3216 fun getTag (e, _) =
3217 case e of 3217 case e of
3218 L.EFfiApp ("Basis", tag, [((L.ERecord [], _), _)]) => (tag, []) 3218 L.EFfiApp (_, tag, [((L.ERecord [], _), _)]) => (tag, [])
3219 | L.EApp (e, (L.ERecord [], _)) => getTag' e 3219 | L.EApp (e, (L.ERecord [], _)) => getTag' e
3220 | _ => (E.errorAt loc "Non-constant XML tag"; 3220 | _ => (E.errorAt loc "Non-constant XML tag";
3221 Print.eprefaces' [("Expression", CorePrint.p_exp env tag)]; 3221 Print.eprefaces' [("Expression", CorePrint.p_exp env tag)];
3222 ("", [])) 3222 ("", []))
3223 3223