diff options
| author |  Adam Chlipala <adam@chlipala.net> | 2011-12-27 16:20:48 -0500 |
|---|---|---|
| committer | Adam Chlipala <adam@chlipala.net> | 2011-12-27 16:20:48 -0500 |
| commit | 7da813265f0601380cdc23e5f89b01dd187a4458 (patch) | |
| tree | b79292fd3c487498c7837ad6008636a1ed5163cf /src/urweb.grm | |
| parent | 0bd86cec8a712d19d4378d84584c7d0ba4e5a7af (diff) | |
'dynClass' pseudo-attribute
Diffstat (limited to 'src/urweb.grm')
| -rw-r--r-- | src/urweb.grm | 42 |
1 files changed, 28 insertions, 14 deletions
diff --git a/src/urweb.grm b/src/urweb.grm index 22616c79..167e841d 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -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 @@ fun tagIn bt = 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 @@ fun tnamesOf (e, _) = | 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 @@ fun tnamesOf (e, _) = | 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 @@ xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer) (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 @@ xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer) 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 @@ xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer) (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 @@ tag : tagHead attrs (let | 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 @@ tagHead: BEGIN_TAG (let 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 @@ attrs : (NONE, []) (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 |