Mercurial > urweb
diff src/urweb.grm @ 721:9864b64b1700
Classes as optional arguments to Basis.tag
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 12 Apr 2009 14:19:15 -0400 |
parents | acb8537f58f0 |
children | 12ec14a6be0b |
line wrap: on
line diff
--- a/src/urweb.grm Sun Apr 12 12:31:54 2009 -0400 +++ b/src/urweb.grm Sun Apr 12 14:19:15 2009 -0400 @@ -176,6 +176,8 @@ datatype prop_kind = Delete | Update +datatype attr = Class of exp | Normal of con * exp + %% %header (functor UrwebLrValsFn(structure Token : TOKEN)) @@ -296,8 +298,8 @@ | 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 @@ 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 @@ end) | tagHead LBRACE cexp RBRACE (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright))) -attrs : ([]) - | attr attrs (attr :: attrs) +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 ((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 +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))