summaryrefslogtreecommitdiff
path: root/src/urweb.grm
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-04-12 14:19:15 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-04-12 14:19:15 -0400
commit2f324fc9e868e0775e1401833b74af15652c6732 (patch)
tree09447cbf30adcc3cc79bc4ebe766f74d8a60a4a9 /src/urweb.grm
parent84168a777e28ab53917bc3ed448cc90e6b00a4ed (diff)
Classes as optional arguments to Basis.tag
Diffstat (limited to 'src/urweb.grm')
-rw-r--r--src/urweb.grm67
1 files changed, 44 insertions, 23 deletions
diff --git a/src/urweb.grm b/src/urweb.grm
index 0251d3f4..d47aaf47 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -176,6 +176,8 @@ fun tagIn bt =
datatype prop_kind = Delete | Update
+datatype attr = Class of exp | Normal of con * exp
+
%%
%header (functor UrwebLrValsFn(structure Token : TOKEN))
@@ -296,8 +298,8 @@ datatype prop_kind = Delete | Update
| rpat of (string * pat) list * bool
| ptuple of pat list
- | attrs of (con * exp) list
- | attr of con * exp
+ | attrs of exp option * (con * exp) list
+ | attr of attr
| attrv of exp
| query of exp
@@ -1266,13 +1268,18 @@ xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer)
tag : tagHead attrs (let
val pos = s (tagHeadleft, attrsright)
+
+ val e = (EVar (["Basis"], "tag", Infer), pos)
+ val eo = case #1 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 (#2 attrs), pos)), pos)
+ val e = (EApp (e, (EApp (#2 tagHead,
+ (ERecord [], pos)), pos)), pos)
in
- (#1 tagHead,
- (EApp ((EApp ((EVar (["Basis"], "tag", Infer), pos),
- (ERecord attrs, pos)), pos),
- (EApp (#2 tagHead,
- (ERecord [], pos)), pos)),
- pos))
+ (#1 tagHead, e)
end)
tagHead: BEGIN_TAG (let
@@ -1284,22 +1291,36 @@ tagHead: BEGIN_TAG (let
end)
| tagHead LBRACE cexp RBRACE (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright)))
-attrs : ([])
- | attr attrs (attr :: attrs)
-
-attr : SYMBOL EQ attrv ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)),
- if (SYMBOL = "href" orelse SYMBOL = "src")
- andalso (case #1 attrv of
- EPrim _ => true
- | _ => false) then
- let
- val loc = s (attrvleft, attrvright)
- in
- (EApp ((EVar (["Basis"], "bless", Infer), loc),
- attrv), loc)
- end
+attrs : (NONE, [])
+ | attr attrs (let
+ val loc = s (attrleft, attrsright)
+ in
+ case attr of
+ Class e =>
+ (case #1 attrs of
+ NONE => ()
+ | SOME _ => ErrorMsg.errorAt loc "Multiple classes specified for tag";
+ (SOME e, #2 attrs))
+ | Normal xe =>
+ (#1 attrs, xe :: #2 attrs)
+ end)
+
+attr : SYMBOL EQ attrv (if SYMBOL = "class" then
+ Class attrv
else
- attrv)
+ Normal ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)),
+ if (SYMBOL = "href" orelse SYMBOL = "src")
+ andalso (case #1 attrv of
+ EPrim _ => true
+ | _ => false) then
+ let
+ val loc = s (attrvleft, attrvright)
+ in
+ (EApp ((EVar (["Basis"], "bless", Infer), loc),
+ attrv), loc)
+ end
+ else
+ attrv))
attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright))
| FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))