diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-07-10 15:04:32 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-07-10 15:04:32 -0400 |
| commit | 81a4a8171274586428288bd7e75ea6721ca56e27 (patch) | |
| tree | 7f4e2dbcd67a12d31a44d95d39c31ebe92328033 /src/lacweb.grm | |
| parent | 4a72cb276ab63dc4d00222f191160eda6b342ec5 (diff) | |
Initial HTML attributes support
Diffstat (limited to 'src/lacweb.grm')
| -rw-r--r-- | src/lacweb.grm | 45 |
1 files changed, 31 insertions, 14 deletions
diff --git a/src/lacweb.grm b/src/lacweb.grm index 811876f2..6e71721f 100644 --- a/src/lacweb.grm +++ b/src/lacweb.grm @@ -31,6 +31,9 @@ open Source 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 @@ val s = ErrorMsg.spanOf | 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 @@ xml : xmlOne xml (let 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 @@ xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata"), s (NOTAG 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)) |