Mercurial > urweb
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) |