diff src/urweb.grm @ 1643:b0720700c36e

'dynClass' pseudo-attribute
author Adam Chlipala <adam@chlipala.net>
date Tue, 27 Dec 2011 16:20:48 -0500
parents 5c1f10cdac63
children ca3b73a7b4d0
line wrap: on
line diff
--- a/src/urweb.grm	Tue Dec 20 21:06:25 2011 -0500
+++ b/src/urweb.grm	Tue Dec 27 16:20:48 2011 -0500
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2010, Adam Chlipala
+(* Copyright (c) 2008-2011, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -219,7 +219,7 @@
 
 datatype prop_kind = Delete | Update
 
-datatype attr = Class of exp | Normal of con * exp
+datatype attr = Class of exp | DynClass of exp | Normal of con * exp
 
 fun patType loc (p : pat) =
     case #1 p of
@@ -355,7 +355,7 @@
  | xml of exp
  | xmlOne of exp
  | xmlOpt of exp
- | tag of (string * exp) * exp option * exp
+ | tag of (string * exp) * exp option * exp option * exp
  | tagHead of string * exp
  | bind of string * con option * exp
  | edecl of edecl
@@ -376,7 +376,7 @@
  | rpat of (string * pat) list * bool
  | ptuple of pat list
 
- | attrs of exp option * (con * exp) list
+ | attrs of exp option * exp option * (con * exp) list
  | attr of attr
  | attrv of exp
 
@@ -1442,7 +1442,7 @@
                                                                 (EPrim (Prim.String ""), pos)),
                                                           pos)
                                          in
-                                             (EApp (#3 tag, cdata), pos)
+                                             (EApp (#4 tag, cdata), pos)
                                          end)
          
        | tag GT xmlOpt END_TAG          (let
@@ -1461,6 +1461,9 @@
                                                          val e = (EApp (e, case #2 tag of
                                                                                NONE => (EVar (["Basis"], "None", Infer), pos)
                                                                              | SOME c => (EApp ((EVar (["Basis"], "Some", Infer), pos), c), pos)), pos)
+                                                         val e = (EApp (e, case #3 tag of
+                                                                               NONE => (EVar (["Basis"], "None", Infer), pos)
+                                                                             | SOME c => (EApp ((EVar (["Basis"], "Some", Infer), pos), c), pos)), pos)
                                                      in
                                                          (EApp (e, xmlOpt), pos)
                                                      end
@@ -1471,7 +1474,7 @@
                                                      (EApp ((EVar (["Basis"], "entry", Infer), pos),
                                                             xmlOpt), pos)
                                                  else
-                                                     (EApp (#3 tag, xmlOpt), pos)
+                                                     (EApp (#4 tag, xmlOpt), pos)
                                              else
                                                  (if ErrorMsg.anyErrors () then
                                                       ()
@@ -1500,11 +1503,16 @@
                                                         | SOME e => (EApp ((EVar (["Basis"], "Some", Infer), pos),
                                                                            e), pos)
                                              val e = (EApp (e, eo), pos)
-                                             val e = (EApp (e, (ERecord (#2 attrs), pos)), pos)
+                                             val eo = case #2 attrs of
+                                                          NONE => (EVar (["Basis"], "None", Infer), pos)
+                                                        | SOME e => (EApp ((EVar (["Basis"], "Some", Infer), pos),
+                                                                           e), pos)
+                                             val e = (EApp (e, eo), pos)
+                                             val e = (EApp (e, (ERecord (#3 attrs), pos)), pos)
                                              val e = (EApp (e, (EApp (#2 tagHead,
                                                                       (ERecord [], pos)), pos)), pos)
                                          in
-                                             (tagHead, #1 attrs, e)
+                                             (tagHead, #1 attrs, #2 attrs, e)
                                          end)
 
 tagHead: BEGIN_TAG                      (let
@@ -1516,7 +1524,7 @@
                                          end)
        | tagHead LBRACE cexp RBRACE     (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright)))
                                           
-attrs  :                                (NONE, [])
+attrs  :                                (NONE, NONE, [])
        | attr attrs                     (let
                                              val loc = s (attrleft, attrsright)
                                          in
@@ -1525,14 +1533,20 @@
                                                  (case #1 attrs of
                                                       NONE => ()
                                                     | SOME _ => ErrorMsg.errorAt loc "Multiple classes specified for tag";
-                                                  (SOME e, #2 attrs))
+                                                  (SOME e, #2 attrs, #3 attrs))
+                                               | DynClass e =>
+                                                 (case #2 attrs of
+                                                      NONE => ()
+                                                    | SOME _ => ErrorMsg.errorAt loc "Multiple dynamic classes specified for tag";
+                                                  (#1 attrs, SOME e, #3 attrs))
                                                | Normal xe =>
-                                                 (#1 attrs, xe :: #2 attrs)
+                                                 (#1 attrs, #2 attrs, xe :: #3 attrs)
                                          end)
 
-attr   : SYMBOL EQ attrv                (if SYMBOL = "class" then
-                                             Class attrv
-                                         else
+attr   : SYMBOL EQ attrv                (case SYMBOL of
+					     "class" => Class attrv
+					   | "dynClass" => DynClass attrv
+					   | _ =>
                                              let
                                                  val sym =
                                                      case SYMBOL of