# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1356640451 18000
# Node ID 146ec8e90063b93e7658b49d770b0c35a9696aca
# Parent  d8c260bcc1f9dd4eb8bf78ac90c865ab10b0f285
Add some name-mangling rules to allow XML attribute 'name' and attributes with dashes

diff -r d8c260bcc1f9 -r 146ec8e90063 lib/ur/list.ur
--- a/lib/ur/list.ur	Thu Dec 13 17:51:34 2012 -0500
+++ b/lib/ur/list.ur	Thu Dec 27 15:34:11 2012 -0500
@@ -437,3 +437,15 @@
     in
         mapXiM' 0
     end
+
+fun tabulateM [m] (_ : monad m) [a] (f : int -> m a) n =
+    let
+        fun tabulate' n acc =
+            if n <= 0 then
+                return acc
+            else
+                (v <- f (n-1);
+                 tabulate' (n-1) (v :: acc))
+    in
+        tabulate' n []
+    end
diff -r d8c260bcc1f9 -r 146ec8e90063 lib/ur/list.urs
--- a/lib/ur/list.urs	Thu Dec 13 17:51:34 2012 -0500
+++ b/lib/ur/list.urs	Thu Dec 27 15:34:11 2012 -0500
@@ -63,6 +63,9 @@
 val app : m ::: (Type -> Type) -> monad m -> a ::: Type
           -> (a -> m unit) -> t a -> m unit
 
+val tabulateM : m ::: (Type -> Type) -> monad m -> a ::: Type
+                -> (int -> m a) -> int -> m (t a)
+
 val mapQuery : tables ::: {{Type}} -> exps ::: {Type} -> t ::: Type
                -> [tables ~ exps] =>
     sql_query [] [] tables exps
diff -r d8c260bcc1f9 -r 146ec8e90063 src/monoize.sml
--- a/src/monoize.sml	Thu Dec 13 17:51:34 2012 -0500
+++ b/src/monoize.sml	Thu Dec 27 15:34:11 2012 -0500
@@ -3364,8 +3364,13 @@
                                                         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 -r d8c260bcc1f9 -r 146ec8e90063 src/urweb.grm
--- a/src/urweb.grm	Thu Dec 13 17:51:34 2012 -0500
+++ b/src/urweb.grm	Thu Dec 27 15:34:11 2012 -0500
@@ -35,6 +35,12 @@
 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 @@
 					   | "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 -r d8c260bcc1f9 -r 146ec8e90063 src/urweb.lex
--- a/src/urweb.lex	Thu Dec 13 17:51:34 2012 -0500
+++ b/src/urweb.lex	Thu Dec 27 15:34:11 2012 -0500
@@ -177,6 +177,7 @@
 %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 @@
 
 <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
diff -r d8c260bcc1f9 -r 146ec8e90063 tests/attrMangle.ur
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/attrMangle.ur	Thu Dec 27 15:34:11 2012 -0500
@@ -0,0 +1,5 @@
+open Goofy
+
+fun main () : transaction page = return <xml><body>
+  <goofy name="beppo" data-role="excellence"/>
+</body></xml>
diff -r d8c260bcc1f9 -r 146ec8e90063 tests/attrMangle.urp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/attrMangle.urp	Thu Dec 27 15:34:11 2012 -0500
@@ -0,0 +1,4 @@
+ffi goofy
+rewrite all AttrMangle/*
+
+attrMangle
diff -r d8c260bcc1f9 -r 146ec8e90063 tests/goofy.urs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/goofy.urs	Thu Dec 27 15:34:11 2012 -0500
@@ -0,0 +1,1 @@
+val goofy : bodyTag [Nam = string, Data_role = string]