diff 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
line wrap: on
line diff
--- a/src/lacweb.grm	Sun Jul 20 10:40:25 2008 -0400
+++ b/src/lacweb.grm	Sun Jul 20 11:33:23 2008 -0400
@@ -90,6 +90,8 @@
  | rexp of (con * exp) list
  | xml of exp
  | xmlOne of exp
+ | tag of string * exp
+ | tagHead of string * exp
 
  | attrs of (con * exp) list
  | attr of con * exp
@@ -306,47 +308,61 @@
        | ident EQ eexp                  ([(ident, eexp)])
        | ident EQ eexp COMMA rexp       ((ident, eexp) :: rexp)
 
-xml    : xmlOne xml                  (let
-                                          val pos = s (xmlOneleft, xmlright)
-                                      in
-                                          (EApp ((EApp (
-                                                  (EVar (["Basis"], "join"), pos),
+xml    : xmlOne xml                     (let
+                                             val pos = s (xmlOneleft, xmlright)
+                                         in
+                                             (EApp ((EApp (
+                                                     (EVar (["Basis"], "join"), pos),
                                                   xmlOne), pos),
-                                                 xml), pos)
-                                      end)
-       | xmlOne                      (xmlOne)
+                                                    xml), pos)
+                                         end)
+       | xmlOne                         (xmlOne)
 
-xmlOne : NOTAGS                      (EApp ((EVar (["Basis"], "cdata"), s (NOTAGSleft, NOTAGSright)),
-                                            (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))),
-                                      s (NOTAGSleft, NOTAGSright))
-       | BEGIN_TAG attrs DIVIDE GT   (let
-                                          val pos = s (BEGIN_TAGleft, GTright)
-                                      in
-                                          (EApp ((EApp ((EApp ((EVar (["Basis"], "tag"), pos),
-                                                               (ERecord attrs, pos)), pos),
-                                                        ((EApp ((EVar ([], BEGIN_TAG), pos),
-                                                                (ERecord [], pos)), pos))),
-                                                  pos),
-                                                 (EApp ((EVar (["Basis"], "cdata"), pos),
-                                                        (EPrim (Prim.String ""), pos)),
-                                                  pos)), pos)
-                                      end)
+xmlOne : NOTAGS                         (EApp ((EVar (["Basis"], "cdata"), s (NOTAGSleft, NOTAGSright)),
+                                               (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))),
+                                         s (NOTAGSleft, NOTAGSright))
+       | tag DIVIDE GT                  (let
+                                             val pos = s (tagleft, GTright)
+                                         in
+                                             (EApp (#2 tag,
+                                                    (EApp ((EVar (["Basis"], "cdata"), pos),
+                                                           (EPrim (Prim.String ""), pos)),
+                                                     pos)), pos)
+                                         end)
+         
+       | tag GT xml END_TAG             (let
+                                             val pos = s (tagleft, GTright)
+                                         in
+                                             if #1 tag = END_TAG then
+                                                 if END_TAG = "lform" then
+                                                     (EApp ((EVar (["Basis"], "lform"), pos),
+                                                            xml), pos)
+                                                 else
+                                                     (EApp (#2 tag, xml), pos)
+                                             else
+                                                 (ErrorMsg.errorAt pos "Begin and end tags don't match.";
+                                                  (EFold, pos))
+                                         end)
+       | LBRACE eexp RBRACE             (eexp)
 
-       | 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),
-                                                              (EApp ((EVar ([], BEGIN_TAG), pos),
-                                                                     (ERecord [], pos)), pos)),
-                                                        pos),
-                                                       xml), pos)
-                                            else
-                                                (ErrorMsg.errorAt pos "Begin and end tags don't match.";
-                                                 (EFold, pos))
-                                        end)
-       | LBRACE eexp RBRACE          (eexp)
+tag    : tagHead attrs                  (let
+                                             val pos = s (tagHeadleft, attrsright)
+                                         in
+                                             (#1 tagHead,
+                                              (EApp ((EApp ((EVar (["Basis"], "tag"), pos),
+                                                            (ERecord attrs, pos)), pos),
+                                                     (EApp (#2 tagHead,
+                                                            (ERecord [], pos)), pos)),
+                                               pos))
+                                         end)
+
+tagHead: BEGIN_TAG                      (let
+                                             val pos = s (BEGIN_TAGleft, BEGIN_TAGright)
+                                         in
+                                             (BEGIN_TAG,
+                                              (EVar ([], BEGIN_TAG), pos))
+                                         end)
+       | tagHead LBRACE cexp RBRACE     (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright)))
                                           
 attrs  :                                ([])
        | attr attrs                     (attr :: attrs)