comparison src/lacweb.grm @ 104:b1e5398a7f30

Initial HTML attributes support
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 15:04:32 -0400
parents f0f59e918cac
children 813e5a52063d
comparison
equal deleted inserted replaced
103:8921f0344193 104:b1e5398a7f30
29 29
30 open Source 30 open Source
31 31
32 val s = ErrorMsg.spanOf 32 val s = ErrorMsg.spanOf
33 33
34 fun uppercaseFirst "" = ""
35 | uppercaseFirst s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
36
34 %% 37 %%
35 %header (functor LacwebLrValsFn(structure Token : TOKEN)) 38 %header (functor LacwebLrValsFn(structure Token : TOKEN))
36 39
37 %term 40 %term
38 EOF 41 EOF
83 | eapps of exp 86 | eapps of exp
84 | eterm of exp 87 | eterm of exp
85 | rexp of (con * exp) list 88 | rexp of (con * exp) list
86 | xml of exp 89 | xml of exp
87 | xmlOne of exp 90 | xmlOne of exp
91
92 | attrs of (con * exp) list
93 | attr of con * exp
94 | attrv of exp
88 95
89 %verbose (* print summary of errors *) 96 %verbose (* print summary of errors *)
90 %pos int (* positions *) 97 %pos int (* positions *)
91 %start file 98 %start file
92 %pure 99 %pure
302 | xmlOne (xmlOne) 309 | xmlOne (xmlOne)
303 310
304 xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata"), s (NOTAGSleft, NOTAGSright)), 311 xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata"), s (NOTAGSleft, NOTAGSright)),
305 (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))), 312 (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))),
306 s (NOTAGSleft, NOTAGSright)) 313 s (NOTAGSleft, NOTAGSright))
307 | BEGIN_TAG DIVIDE GT (let 314 | BEGIN_TAG attrs DIVIDE GT (let
308 val pos = s (BEGIN_TAGleft, GTright) 315 val pos = s (BEGIN_TAGleft, GTright)
309 in 316 in
310 (EApp ((EApp ((EVar (["Basis"], "tag"), pos), 317 (EApp ((EApp ((EApp ((EVar (["Basis"], "tag"), pos),
318 (ERecord attrs, pos)), pos),
311 (EVar ([], BEGIN_TAG), pos)), 319 (EVar ([], BEGIN_TAG), pos)),
312 pos), 320 pos),
313 (EApp ((EVar (["Basis"], "cdata"), pos), 321 (EApp ((EVar (["Basis"], "cdata"), pos),
314 (EPrim (Prim.String ""), pos)), 322 (EPrim (Prim.String ""), pos)),
315 pos)), pos) 323 pos)), pos)
316 end) 324 end)
317 325
318 | BEGIN_TAG GT xml END_TAG (let 326 | BEGIN_TAG attrs GT xml END_TAG(let
319 val pos = s (BEGIN_TAGleft, GTright) 327 val pos = s (BEGIN_TAGleft, GTright)
320 in 328 in
321 if BEGIN_TAG = END_TAG then 329 if BEGIN_TAG = END_TAG then
322 (EApp ((EApp ((EVar (["Basis"], "tag"), pos), 330 (EApp ((EApp ((EApp ((EVar (["Basis"], "tag"), pos),
323 (EVar ([], BEGIN_TAG), pos)), 331 (ERecord attrs, pos)), pos),
324 pos), 332 (EVar ([], BEGIN_TAG), pos)),
325 xml), pos) 333 pos),
326 else 334 xml), pos)
327 (ErrorMsg.errorAt pos "Begin and end tags don't match."; 335 else
328 (EFold, pos)) 336 (ErrorMsg.errorAt pos "Begin and end tags don't match.";
329 end) 337 (EFold, pos))
338 end)
330 339
340 attrs : ([])
341 | attr attrs (attr :: attrs)
342
343 attr : SYMBOL EQ attrv ((CName (uppercaseFirst SYMBOL), s (SYMBOLleft, SYMBOLright)), attrv)
344
345 attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright))
346 | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
347 | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright))