From 53c633b53e8825cb9058fb88e86d1ca7828b83e6 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Thu, 27 Dec 2012 15:34:11 -0500
Subject: Add some name-mangling rules to allow XML attribute 'name' and
 attributes with dashes

---
 src/monoize.sml |  5 +++++
 src/urweb.grm   | 11 +++++++----
 src/urweb.lex   |  3 ++-
 3 files changed, 14 insertions(+), 5 deletions(-)

(limited to 'src')

diff --git a/src/monoize.sml b/src/monoize.sml
index 39e4853b..d324b235 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3364,8 +3364,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                         val x =
                                                             case x of
                                                                 "Typ" => "Type"
+                                                              | "Nam" => "Name"
                                                               | "Link" => "Href"
                                                               | _ => x
+
+                                                        val x = String.translate (fn #"_" => "-"
+                                                                                   | ch => String.str ch) x
+
                                                         val xp = " " ^ lowercaseFirst x ^ "=\""
 
                                                         val (e, fm) = fooify env fm (e, t)
diff --git a/src/urweb.grm b/src/urweb.grm
index a45c7ffa..c2a48742 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -35,6 +35,12 @@ val dummy = ErrorMsg.dummySpan
 fun capitalize "" = ""
   | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
 
+fun makeAttr s =
+    case s of
+        "type" => "Typ"
+      | "name" => "Nam"
+      | _ => capitalize (String.translate (fn ch => if ch = #"-" then "_" else str ch) s)
+
 fun entable t =
     case #1 t of
         TRecord c => c
@@ -1648,10 +1654,7 @@ attr   : SYMBOL EQ attrv                (case SYMBOL of
 					   | "dynStyle" => DynStyle attrv
 					   | _ =>
                                              let
-                                                 val sym =
-                                                     case SYMBOL of
-                                                         "type" => "Typ"
-                                                       | x => capitalize x
+                                                 val sym = makeAttr SYMBOL
                                              in
                                                  Normal ((CName sym, s (SYMBOLleft, SYMBOLright)),
                                                          if (sym = "Href" orelse sym = "Src")
diff --git a/src/urweb.lex b/src/urweb.lex
index 0994ecec..293c6dc6 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -177,6 +177,7 @@ fun unescape loc s =
 %s COMMENT STRING CHAR XML XMLTAG;
 
 id = [a-z_][A-Za-z0-9_']*;
+xmlid = [A-Za-z][A-Za-z0-9-_]*;
 cid = [A-Z][A-Za-z0-9_]*;
 ws = [\ \t\012\r];
 intconst = [0-9]+;
@@ -313,7 +314,7 @@ xint = x[0-9a-fA-F][0-9a-fA-F];
 
 <XMLTAG> {ws}+        => (lex ());
 
-<XMLTAG> {id}         => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext));
+<XMLTAG> {xmlid}      => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext));
 <XMLTAG> "="          => (Tokens.EQ (yypos, yypos + size yytext));
 
 <XMLTAG> {intconst}   => (case Int64.fromString yytext of
-- 
cgit v1.2.3