comparison src/lacweb.grm @ 141:63c699450281

Initial form support
author Adam Chlipala <adamc@hcoop.net>
date Sun, 20 Jul 2008 11:33:23 -0400
parents f214c535d253
children 6f9e224692ec
comparison
equal deleted inserted replaced
140:f214c535d253 141:63c699450281
88 | eapps of exp 88 | eapps of exp
89 | eterm of exp 89 | eterm of exp
90 | rexp of (con * exp) list 90 | rexp of (con * exp) list
91 | xml of exp 91 | xml of exp
92 | xmlOne of exp 92 | xmlOne of exp
93 | tag of string * exp
94 | tagHead of string * exp
93 95
94 | attrs of (con * exp) list 96 | attrs of (con * exp) list
95 | attr of con * exp 97 | attr of con * exp
96 | attrv of exp 98 | attrv of exp
97 99
304 306
305 rexp : ([]) 307 rexp : ([])
306 | ident EQ eexp ([(ident, eexp)]) 308 | ident EQ eexp ([(ident, eexp)])
307 | ident EQ eexp COMMA rexp ((ident, eexp) :: rexp) 309 | ident EQ eexp COMMA rexp ((ident, eexp) :: rexp)
308 310
309 xml : xmlOne xml (let 311 xml : xmlOne xml (let
310 val pos = s (xmlOneleft, xmlright) 312 val pos = s (xmlOneleft, xmlright)
311 in 313 in
312 (EApp ((EApp ( 314 (EApp ((EApp (
313 (EVar (["Basis"], "join"), pos), 315 (EVar (["Basis"], "join"), pos),
314 xmlOne), pos), 316 xmlOne), pos),
315 xml), pos) 317 xml), pos)
316 end) 318 end)
317 | xmlOne (xmlOne) 319 | xmlOne (xmlOne)
318 320
319 xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata"), s (NOTAGSleft, NOTAGSright)), 321 xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata"), s (NOTAGSleft, NOTAGSright)),
320 (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))), 322 (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))),
321 s (NOTAGSleft, NOTAGSright)) 323 s (NOTAGSleft, NOTAGSright))
322 | BEGIN_TAG attrs DIVIDE GT (let 324 | tag DIVIDE GT (let
323 val pos = s (BEGIN_TAGleft, GTright) 325 val pos = s (tagleft, GTright)
324 in 326 in
325 (EApp ((EApp ((EApp ((EVar (["Basis"], "tag"), pos), 327 (EApp (#2 tag,
326 (ERecord attrs, pos)), pos), 328 (EApp ((EVar (["Basis"], "cdata"), pos),
327 ((EApp ((EVar ([], BEGIN_TAG), pos), 329 (EPrim (Prim.String ""), pos)),
328 (ERecord [], pos)), pos))), 330 pos)), pos)
329 pos), 331 end)
330 (EApp ((EVar (["Basis"], "cdata"), pos), 332
331 (EPrim (Prim.String ""), pos)), 333 | tag GT xml END_TAG (let
332 pos)), pos) 334 val pos = s (tagleft, GTright)
333 end) 335 in
334 336 if #1 tag = END_TAG then
335 | BEGIN_TAG attrs GT xml END_TAG(let 337 if END_TAG = "lform" then
336 val pos = s (BEGIN_TAGleft, GTright) 338 (EApp ((EVar (["Basis"], "lform"), pos),
337 in 339 xml), pos)
338 if BEGIN_TAG = END_TAG then 340 else
339 (EApp ((EApp ((EApp ((EVar (["Basis"], "tag"), pos), 341 (EApp (#2 tag, xml), pos)
340 (ERecord attrs, pos)), pos), 342 else
341 (EApp ((EVar ([], BEGIN_TAG), pos), 343 (ErrorMsg.errorAt pos "Begin and end tags don't match.";
342 (ERecord [], pos)), pos)), 344 (EFold, pos))
343 pos), 345 end)
344 xml), pos) 346 | LBRACE eexp RBRACE (eexp)
345 else 347
346 (ErrorMsg.errorAt pos "Begin and end tags don't match."; 348 tag : tagHead attrs (let
347 (EFold, pos)) 349 val pos = s (tagHeadleft, attrsright)
348 end) 350 in
349 | LBRACE eexp RBRACE (eexp) 351 (#1 tagHead,
352 (EApp ((EApp ((EVar (["Basis"], "tag"), pos),
353 (ERecord attrs, pos)), pos),
354 (EApp (#2 tagHead,
355 (ERecord [], pos)), pos)),
356 pos))
357 end)
358
359 tagHead: BEGIN_TAG (let
360 val pos = s (BEGIN_TAGleft, BEGIN_TAGright)
361 in
362 (BEGIN_TAG,
363 (EVar ([], BEGIN_TAG), pos))
364 end)
365 | tagHead LBRACE cexp RBRACE (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright)))
350 366
351 attrs : ([]) 367 attrs : ([])
352 | attr attrs (attr :: attrs) 368 | attr attrs (attr :: attrs)
353 369
354 attr : SYMBOL EQ attrv ((CName (uppercaseFirst SYMBOL), s (SYMBOLleft, SYMBOLright)), attrv) 370 attr : SYMBOL EQ attrv ((CName (uppercaseFirst SYMBOL), s (SYMBOLleft, SYMBOLright)), attrv)