diff src/lacweb.grm @ 104:b1e5398a7f30

Initial HTML attributes support
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 15:04:32 -0400
parents f0f59e918cac
children 813e5a52063d
line wrap: on
line diff
--- a/src/lacweb.grm	Thu Jul 10 14:14:23 2008 -0400
+++ b/src/lacweb.grm	Thu Jul 10 15:04:32 2008 -0400
@@ -31,6 +31,9 @@
 
 val s = ErrorMsg.spanOf
 
+fun uppercaseFirst "" = ""
+  | uppercaseFirst s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
+
 %%
 %header (functor LacwebLrValsFn(structure Token : TOKEN))
 
@@ -86,6 +89,10 @@
  | xml of exp
  | xmlOne of exp
 
+ | attrs of (con * exp) list
+ | attr of con * exp
+ | attrv of exp
+
 %verbose                                (* print summary of errors *)
 %pos int                                (* positions *)
 %start file
@@ -304,10 +311,11 @@
 xmlOne : NOTAGS                      (EApp ((EVar (["Basis"], "cdata"), s (NOTAGSleft, NOTAGSright)),
                                             (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))),
                                       s (NOTAGSleft, NOTAGSright))
-       | BEGIN_TAG DIVIDE GT         (let
+       | BEGIN_TAG attrs DIVIDE GT   (let
                                           val pos = s (BEGIN_TAGleft, GTright)
                                       in
-                                          (EApp ((EApp ((EVar (["Basis"], "tag"), pos),
+                                          (EApp ((EApp ((EApp ((EVar (["Basis"], "tag"), pos),
+                                                               (ERecord attrs, pos)), pos),
                                                         (EVar ([], BEGIN_TAG), pos)),
                                                   pos),
                                                  (EApp ((EVar (["Basis"], "cdata"), pos),
@@ -315,16 +323,25 @@
                                                   pos)), pos)
                                       end)
 
-       | BEGIN_TAG GT xml END_TAG    (let
-                                          val pos = s (BEGIN_TAGleft, GTright)
-                                      in
-                                          if BEGIN_TAG = END_TAG then
-                                              (EApp ((EApp ((EVar (["Basis"], "tag"), pos),
-                                                            (EVar ([], BEGIN_TAG), pos)),
-                                                      pos),
-                                                     xml), pos)
-                                          else
-                                              (ErrorMsg.errorAt pos "Begin and end tags don't match.";
-                                               (EFold, pos))
-                                      end)
+       | BEGIN_TAG attrs GT xml END_TAG(let
+                                            val pos = s (BEGIN_TAGleft, GTright)
+                                        in
+                                            if BEGIN_TAG = END_TAG then
+                                                (EApp ((EApp ((EApp ((EVar (["Basis"], "tag"), pos),
+                                                                     (ERecord attrs, pos)), pos),
+                                                              (EVar ([], BEGIN_TAG), pos)),
+                                                        pos),
+                                                       xml), pos)
+                                            else
+                                                (ErrorMsg.errorAt pos "Begin and end tags don't match.";
+                                                 (EFold, pos))
+                                        end)
                                           
+attrs  :                                ([])
+       | attr attrs                     (attr :: attrs)
+
+attr   : SYMBOL EQ attrv                ((CName (uppercaseFirst SYMBOL), s (SYMBOLleft, SYMBOLright)), attrv)
+
+attrv  : INT                            (EPrim (Prim.Int INT), s (INTleft, INTright))
+       | FLOAT                          (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
+       | STRING                         (EPrim (Prim.String STRING), s (STRINGleft, STRINGright))