diff src/monoize.sml @ 598:4c2c740c6931

Hooking a source into an input
author Adam Chlipala <adamc@hcoop.net>
date Sun, 11 Jan 2009 10:05:06 -0500
parents 57f476c934da
children 889dc9fceb3a
line wrap: on
line diff
--- a/src/monoize.sml	Thu Jan 08 10:30:14 2009 -0500
+++ b/src/monoize.sml	Sun Jan 11 10:05:06 2009 -0500
@@ -510,6 +510,10 @@
 
 fun monoExp (env, st, fm) (all as (e, loc)) =
     let
+        val strcat = strcat loc
+        val strcatComma = strcatComma loc
+        fun str s = (L'.EPrim (Prim.String s), loc)
+
         fun poly () =
             (E.errorAt loc "Unsupported expression";
              Print.eprefaces' [("Expression", CorePrint.p_exp env all)];
@@ -1080,15 +1084,15 @@
                  in
                      ((L'.EAbs ("tab", s, (L'.TFun (rt, s), loc),
                                 (L'.EAbs ("fs", rt, s,
-                                          strcat loc [sc "INSERT INTO ",
-                                                      (L'.ERel 1, loc),
-                                                      sc " (",
-                                                      strcatComma loc (map (fn (x, _) => sc ("uw_" ^ x)) fields),
-                                                      sc ") VALUES (",
-                                                      strcatComma loc (map (fn (x, _) =>
-                                                                               (L'.EField ((L'.ERel 0, loc),
-                                                                                           x), loc)) fields),
-                                                      sc ")"]), loc)), loc),
+                                          strcat [sc "INSERT INTO ",
+                                                  (L'.ERel 1, loc),
+                                                  sc " (",
+                                                  strcatComma (map (fn (x, _) => sc ("uw_" ^ x)) fields),
+                                                  sc ") VALUES (",
+                                                  strcatComma (map (fn (x, _) =>
+                                                                       (L'.EField ((L'.ERel 0, loc),
+                                                                                   x), loc)) fields),
+                                                  sc ")"]), loc)), loc),
                       fm)
                  end
                | _ => poly ())
@@ -1105,19 +1109,19 @@
                      ((L'.EAbs ("fs", rt, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                                 (L'.EAbs ("tab", s, (L'.TFun (s, s), loc),
                                           (L'.EAbs ("e", s, s,
-                                                    strcat loc [sc "UPDATE ",
-                                                                (L'.ERel 1, loc),
-                                                                sc " AS T SET ",
-                                                                strcatComma loc (map (fn (x, _) =>
-                                                                                         strcat loc [sc ("uw_" ^ x
-                                                                                                         ^ " = "),
-                                                                                                     (L'.EField
-                                                                                                          ((L'.ERel 2,
-                                                                                                            loc),
-                                                                                                           x), loc)])
-                                                                                     changed),
-                                                                sc " WHERE ",
-                                                                (L'.ERel 0, loc)]), loc)), loc)), loc),
+                                                    strcat [sc "UPDATE ",
+                                                            (L'.ERel 1, loc),
+                                                            sc " AS T SET ",
+                                                            strcatComma (map (fn (x, _) =>
+                                                                                 strcat [sc ("uw_" ^ x
+                                                                                             ^ " = "),
+                                                                                         (L'.EField
+                                                                                              ((L'.ERel 2,
+                                                                                                loc),
+                                                                                               x), loc)])
+                                                                             changed),
+                                                            sc " WHERE ",
+                                                            (L'.ERel 0, loc)]), loc)), loc)), loc),
                       fm)
                  end
                | _ => poly ())
@@ -1129,10 +1133,10 @@
             in
                 ((L'.EAbs ("tab", s, (L'.TFun (s, s), loc),
                            (L'.EAbs ("e", s, s,
-                                     strcat loc [sc "DELETE FROM ",
-                                                 (L'.ERel 1, loc),
-                                                 sc " AS T WHERE ",
-                                                 (L'.ERel 0, loc)]), loc)), loc),
+                                     strcat [sc "DELETE FROM ",
+                                             (L'.ERel 1, loc),
+                                             sc " AS T WHERE ",
+                                             (L'.ERel 0, loc)]), loc)), loc),
                  fm)
             end
 
@@ -1198,15 +1202,15 @@
                 ((L'.EAbs ("r",
                            (L'.TRecord [("Rows", s), ("OrderBy", s), ("Limit", s), ("Offset", s)], loc),
                            s,
-                           strcat loc [gf "Rows",
-                                       (L'.ECase (gf "OrderBy",
-                                                  [((L'.PPrim (Prim.String ""), loc), sc ""),
-                                                   ((L'.PWild, loc),
-                                                    strcat loc [sc " ORDER BY ",
-                                                                gf "OrderBy"])],
-                                                  {disc = s, result = s}), loc),
-                                       gf "Limit",
-                                       gf "Offset"]), loc), fm)
+                           strcat [gf "Rows",
+                                   (L'.ECase (gf "OrderBy",
+                                              [((L'.PPrim (Prim.String ""), loc), sc ""),
+                                               ((L'.PWild, loc),
+                                                strcat [sc " ORDER BY ",
+                                                        gf "OrderBy"])],
+                                              {disc = s, result = s}), loc),
+                                   gf "Limit",
+                                   gf "Offset"]), loc), fm)
             end
 
           | L.ECApp (
@@ -1264,53 +1268,53 @@
                                                 ("SelectExps", (L'.TRecord (map (fn (x, _) => (x, s)) sexps), loc))],
                                     loc),
                                    s,
-                                   strcat loc [sc "SELECT ",
-                                               strcatComma loc (map (fn (x, t) =>
-                                                                        strcat loc [
-                                                                        (L'.EField (gf "SelectExps", x), loc),
-                                                                        sc (" AS _" ^ x)
-                                                                    ]) sexps
-                                                                @ map (fn (x, xts) =>
-                                                                          strcatComma loc
-                                                                                      (map (fn (x', _) =>
-                                                                                               sc (x ^ ".uw_" ^ x'))
-                                                                                           xts)) stables),
-                                               sc " FROM ",
-                                               strcatComma loc (map (fn (x, _) => strcat loc [(L'.EField (gf "From", x), loc),
-                                                                                              sc (" AS " ^ x)]) tables),
-                                               (L'.ECase (gf "Where",
-                                                          [((L'.PPrim (Prim.String "TRUE"), loc),
-                                                            sc ""),
-                                                           ((L'.PWild, loc),
-                                                            strcat loc [sc " WHERE ", gf "Where"])],
-                                                          {disc = s,
-                                                           result = s}), loc),
-                                               
-                                               if List.all (fn (x, xts) =>
-                                                               case List.find (fn (x', _) => x' = x) grouped of
-                                                                   NONE => List.null xts
-                                                                 | SOME (_, xts') =>
-                                                                   List.all (fn (x, _) =>
-                                                                                List.exists (fn (x', _) => x' = x)
-                                                                                            xts') xts) tables then
-                                                   sc ""
-                                               else
-                                                   strcat loc [
-                                                   sc " GROUP BY ",
-                                                   strcatComma loc (map (fn (x, xts) =>
-                                                                            strcatComma loc
-                                                                                        (map (fn (x', _) =>
-                                                                                                 sc (x ^ ".uw_" ^ x'))
-                                                                                             xts)) grouped)
-                                                   ],
+                                   strcat [sc "SELECT ",
+                                           strcatComma (map (fn (x, t) =>
+                                                                strcat [
+                                                                (L'.EField (gf "SelectExps", x), loc),
+                                                                sc (" AS _" ^ x)
+                                                            ]) sexps
+                                                        @ map (fn (x, xts) =>
+                                                                  strcatComma
+                                                                      (map (fn (x', _) =>
+                                                                               sc (x ^ ".uw_" ^ x'))
+                                                                           xts)) stables),
+                                           sc " FROM ",
+                                           strcatComma (map (fn (x, _) => strcat [(L'.EField (gf "From", x), loc),
+                                                                                  sc (" AS " ^ x)]) tables),
+                                           (L'.ECase (gf "Where",
+                                                      [((L'.PPrim (Prim.String "TRUE"), loc),
+                                                        sc ""),
+                                                       ((L'.PWild, loc),
+                                                        strcat [sc " WHERE ", gf "Where"])],
+                                                      {disc = s,
+                                                       result = s}), loc),
+                                           
+                                           if List.all (fn (x, xts) =>
+                                                           case List.find (fn (x', _) => x' = x) grouped of
+                                                               NONE => List.null xts
+                                                             | SOME (_, xts') =>
+                                                               List.all (fn (x, _) =>
+                                                                            List.exists (fn (x', _) => x' = x)
+                                                                                        xts') xts) tables then
+                                               sc ""
+                                           else
+                                               strcat [
+                                               sc " GROUP BY ",
+                                               strcatComma (map (fn (x, xts) =>
+                                                                    strcatComma
+                                                                        (map (fn (x', _) =>
+                                                                                 sc (x ^ ".uw_" ^ x'))
+                                                                             xts)) grouped)
+                                               ],
 
-                                               (L'.ECase (gf "Having",
-                                                          [((L'.PPrim (Prim.String "TRUE"), loc),
-                                                            sc ""),
-                                                           ((L'.PWild, loc),
-                                                            strcat loc [sc " HAVING ", gf "Having"])],
-                                                          {disc = s,
-                                                           result = s}), loc)
+                                           (L'.ECase (gf "Having",
+                                                      [((L'.PPrim (Prim.String "TRUE"), loc),
+                                                        sc ""),
+                                                       ((L'.PWild, loc),
+                                                        strcat [sc " HAVING ", gf "Having"])],
+                                                      {disc = s,
+                                                       result = s}), loc)
                                   ]), loc),
                          fm)
                     end
@@ -1398,13 +1402,13 @@
                                      (L'.EAbs ("e2", s, s,
                                                (L'.ECase ((L'.ERel 0, loc),
                                                           [((L'.PPrim (Prim.String ""), loc),
-                                                            strcat loc [(L'.ERel 2, loc),
-                                                                        (L'.ERel 1, loc)]),
+                                                            strcat [(L'.ERel 2, loc),
+                                                                    (L'.ERel 1, loc)]),
                                                            ((L'.PWild, loc),
-                                                            strcat loc [(L'.ERel 2, loc),
-                                                                        (L'.ERel 1, loc),
-                                                                        sc ", ",
-                                                                        (L'.ERel 0, loc)])],
+                                                            strcat [(L'.ERel 2, loc),
+                                                                    (L'.ERel 1, loc),
+                                                                    sc ", ",
+                                                                    (L'.ERel 0, loc)])],
                                                           {disc = s, result = s}), loc)), loc)), loc)), loc),
                  fm)
             end
@@ -1415,7 +1419,7 @@
             let
                 val (e, fm) = monoExp (env, st, fm) e
             in
-                (strcat loc [
+                (strcat [
                  (L'.EPrim (Prim.String " LIMIT "), loc),
                  (L'.EFfiApp ("Basis", "sqlifyInt", [e]), loc)
                  ],
@@ -1428,7 +1432,7 @@
             let
                 val (e, fm) = monoExp (env, st, fm) e
             in
-                (strcat loc [
+                (strcat [
                  (L'.EPrim (Prim.String " OFFSET "), loc),
                  (L'.EFfiApp ("Basis", "sqlifyInt", [e]), loc)
                  ],
@@ -1480,11 +1484,11 @@
             in
                 ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                            (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
-                                     strcat loc [sc "(",
-                                                 (L'.ERel 1, loc),
-                                                 sc " ",
-                                                 (L'.ERel 0, loc),
-                                                 sc ")"]), loc)), loc),
+                                     strcat [sc "(",
+                                             (L'.ERel 1, loc),
+                                             sc " ",
+                                             (L'.ERel 0, loc),
+                                             sc ")"]), loc)), loc),
                  fm)
             end
           | L.EFfi ("Basis", "sql_not") => ((L'.EPrim (Prim.String "NOT"), loc), fm)
@@ -1512,13 +1516,13 @@
                 ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                            (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
                                      (L'.EAbs ("e2", s, s,
-                                               strcat loc [sc "(",
-                                                           (L'.ERel 1, loc),
-                                                           sc " ",
-                                                           (L'.ERel 2, loc),
-                                                           sc " ",
-                                                           (L'.ERel 0, loc),
-                                                           sc ")"]), loc)), loc)), loc),
+                                               strcat [sc "(",
+                                                       (L'.ERel 1, loc),
+                                                       sc " ",
+                                                       (L'.ERel 2, loc),
+                                                       sc " ",
+                                                       (L'.ERel 0, loc),
+                                                       sc ")"]), loc)), loc)), loc),
                  fm)
             end
           | L.EFfi ("Basis", "sql_and") => ((L'.EPrim (Prim.String "AND"), loc), fm)
@@ -1568,13 +1572,13 @@
                 ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                            (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
                                      (L'.EAbs ("e2", s, s,
-                                               strcat loc [sc "((",
-                                                           (L'.ERel 1, loc),
-                                                           sc ") ",
-                                                           (L'.ERel 2, loc),
-                                                           sc " (",
-                                                           (L'.ERel 0, loc),
-                                                           sc "))"]), loc)), loc)), loc),
+                                               strcat [sc "((",
+                                                       (L'.ERel 1, loc),
+                                                       sc ") ",
+                                                       (L'.ERel 2, loc),
+                                                       sc " (",
+                                                       (L'.ERel 0, loc),
+                                                       sc "))"]), loc)), loc)), loc),
                  fm)
             end
 
@@ -1606,10 +1610,10 @@
             in
                 ((L'.EAbs ("c", s, (L'.TFun (s, (L'.TFun (s, s), loc)), loc),
                            (L'.EAbs ("e1", s, (L'.TFun (s, s), loc),
-                                     strcat loc [(L'.ERel 1, loc),
-                                                 sc "(",
-                                                 (L'.ERel 0, loc),
-                                                 sc ")"]), loc)), loc),
+                                     strcat [(L'.ERel 1, loc),
+                                             sc "(",
+                                             (L'.ERel 0, loc),
+                                             sc ")"]), loc)), loc),
                  fm)
             end
 
@@ -1673,9 +1677,9 @@
                 fun sc s = (L'.EPrim (Prim.String s), loc)
             in
                 ((L'.EAbs ("s", s, s,
-                           strcat loc [sc "(",
-                                       (L'.ERel 0, loc),
-                                       sc " IS NULL)"]), loc),
+                           strcat [sc "(",
+                                   (L'.ERel 0, loc),
+                                   sc " IS NULL)"]), loc),
                  fm)
             end
 
@@ -1757,81 +1761,82 @@
                 val (tag, targs) = getTag tag
 
                 val (attrs, fm) = monoExp (env, st, fm) attrs
+                val attrs = case #1 attrs of
+                                L'.ERecord xes => xes
+                              | _ => raise Fail "Non-record attributes!"
 
                 fun tagStart tag =
-                    case #1 attrs of
-                        L'.ERecord xes =>
-                        let
-                            fun lowercaseFirst "" = ""
-                              | lowercaseFirst s = str (Char.toLower (String.sub (s, 0)))
-                                                   ^ String.extract (s, 1, NONE)
+                    let
+                        fun lowercaseFirst "" = ""
+                          | lowercaseFirst s = String.str (Char.toLower (String.sub (s, 0)))
+                                               ^ String.extract (s, 1, NONE)
 
-                            val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc)
-                        in
-                            foldl (fn (("Action", _, _), acc) => acc
-                                    | ((x, e, t), (s, fm)) =>
-                                      case t of
-                                          (L'.TFfi ("Basis", "bool"), _) =>
-                                          let
-                                              val s' = " " ^ lowercaseFirst x
-                                          in
-                                              ((L'.ECase (e,
-                                                          [((L'.PCon (L'.Enum,
-                                                                      L'.PConFfi {mod = "Basis",
-                                                                                  datatyp = "bool",
-                                                                                  con = "True",
-                                                                                  arg = NONE},
-                                                                      NONE), loc),
-                                                            (L'.EStrcat (s,
-                                                                         (L'.EPrim (Prim.String s'), loc)), loc)),
-                                                           ((L'.PCon (L'.Enum,
-                                                                      L'.PConFfi {mod = "Basis",
-                                                                                  datatyp = "bool",
-                                                                                  con = "False",
-                                                                                  arg = NONE},
-                                                                      NONE), loc),
-                                                            s)],
-                                                          {disc = (L'.TFfi ("Basis", "bool"), loc),
-                                                           result = (L'.TFfi ("Basis", "string"), loc)}), loc),
-                                               fm)
-                                          end
-                                        | (L'.TFun _, _) =>
-                                          let
-                                              val s' = " " ^ lowercaseFirst x ^ "='"
-                                          in
-                                              ((L'.EStrcat (s,
-                                                            (L'.EStrcat (
-                                                             (L'.EPrim (Prim.String s'), loc),
-                                                             (L'.EStrcat (
-                                                              (L'.EJavaScript (L'.Attribute, e, NONE), loc),
-                                                              (L'.EPrim (Prim.String "'"), loc)), loc)),
-                                                             loc)), loc),
-                                               fm)
-                                          end
-                                        | _ =>
-                                          let
-                                              val fooify =
-                                                  case x of
-                                                      "Href" => urlifyExp
-                                                    | "Link" => urlifyExp
-                                                    | _ => attrifyExp
+                        val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc)
+                    in
+                        foldl (fn (("Action", _, _), acc) => acc
+                                | (("Source", _, _), acc) => acc
+                                | ((x, e, t), (s, fm)) =>
+                                  case t of
+                                      (L'.TFfi ("Basis", "bool"), _) =>
+                                      let
+                                          val s' = " " ^ lowercaseFirst x
+                                      in
+                                          ((L'.ECase (e,
+                                                      [((L'.PCon (L'.Enum,
+                                                                  L'.PConFfi {mod = "Basis",
+                                                                              datatyp = "bool",
+                                                                              con = "True",
+                                                                              arg = NONE},
+                                                                  NONE), loc),
+                                                        (L'.EStrcat (s,
+                                                                     (L'.EPrim (Prim.String s'), loc)), loc)),
+                                                       ((L'.PCon (L'.Enum,
+                                                                  L'.PConFfi {mod = "Basis",
+                                                                              datatyp = "bool",
+                                                                              con = "False",
+                                                                              arg = NONE},
+                                                                  NONE), loc),
+                                                        s)],
+                                                      {disc = (L'.TFfi ("Basis", "bool"), loc),
+                                                       result = (L'.TFfi ("Basis", "string"), loc)}), loc),
+                                           fm)
+                                      end
+                                    | (L'.TFun _, _) =>
+                                      let
+                                          val s' = " " ^ lowercaseFirst x ^ "='"
+                                      in
+                                          ((L'.EStrcat (s,
+                                                        (L'.EStrcat (
+                                                         (L'.EPrim (Prim.String s'), loc),
+                                                         (L'.EStrcat (
+                                                          (L'.EJavaScript (L'.Attribute, e, NONE), loc),
+                                                          (L'.EPrim (Prim.String "'"), loc)), loc)),
+                                                         loc)), loc),
+                                           fm)
+                                      end
+                                    | _ =>
+                                      let
+                                          val fooify =
+                                              case x of
+                                                  "Href" => urlifyExp
+                                                | "Link" => urlifyExp
+                                                | _ => attrifyExp
 
-                                              val xp = " " ^ lowercaseFirst x ^ "=\""
+                                          val xp = " " ^ lowercaseFirst x ^ "=\""
 
-                                              val (e, fm) = fooify env fm (e, t)
-                                          in
-                                              ((L'.EStrcat (s,
-                                                            (L'.EStrcat ((L'.EPrim (Prim.String xp), loc),
-                                                                         (L'.EStrcat (e,
-                                                                                      (L'.EPrim (Prim.String "\""),
-                                                                                       loc)),
-                                                                          loc)),
-                                                             loc)), loc),
-                                               fm)
-                                          end)
-                                  (s, fm) xes
-                        end
-                      | _ => raise Fail "Non-record attributes!"
+                                          val (e, fm) = fooify env fm (e, t)
+                                      in
+                                          ((L'.EStrcat (s,
+                                                        (L'.EStrcat ((L'.EPrim (Prim.String xp), loc),
+                                                                     (L'.EStrcat (e,
+                                                                                  (L'.EPrim (Prim.String "\""),
+                                                                                   loc)),
+                                                                      loc)),
+                                                         loc)), loc),
+                                           fm)
+                                      end)
+                              (s, fm) attrs
+                    end
 
                 fun input typ =
                     case targs of
@@ -1888,10 +1893,10 @@
                                                          loc)), loc))
 
                   | "dyn" =>
-                    (case #1 attrs of
-                         L'.ERecord [("Signal", (L'.EApp ((L'.EAbs (_, _, _, (L'.ESignalReturn (L'.ERel 0, _), _)), _),
-                                                          e), _), _)] => (e, fm)
-                       | L'.ERecord [("Signal", e, _)] =>
+                    (case attrs of
+                         [("Signal", (L'.EApp ((L'.EAbs (_, _, _, (L'.ESignalReturn (L'.ERel 0, _), _)), _),
+                                               e), _), _)] => (e, fm)
+                       | [("Signal", e, _)] =>
                          ((L'.EStrcat
                                ((L'.EPrim (Prim.String "<script type=\"text/javascript\">dyn("), loc),
                                 (L'.EStrcat ((L'.EJavaScript (L'.Script, e, NONE), loc),
@@ -1904,15 +1909,22 @@
                   | "textbox" =>
                     (case targs of
                          [_, (L.CName name, _)] =>
-                         let
-                             val (ts, fm) = tagStart "input"
-                         in
-                             ((L'.EStrcat (ts,
-                                           (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\"/>")),
-                                            loc)), loc), fm)
-                         end
+                         (case List.find (fn ("Source", _, _) => true | _ => false) attrs of
+                              NONE =>
+                              let
+                                  val (ts, fm) = tagStart "input"
+                              in
+                                  ((L'.EStrcat (ts,
+                                                (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\"/>")),
+                                                 loc)), loc), fm)
+                              end
+                            | SOME (_, src, _) =>
+                              (strcat [str "<script type=\"text/javascript\">inp(\"input\",",
+                                       (L'.EJavaScript (L'.Script, src, NONE), loc),
+                                       str ")</script>"],
+                               fm))
                        | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
-                               raise Fail "No name passed to textarea tag"))
+                               raise Fail "No name passed to textbox tag"))
                   | "password" => input "password"
                   | "textarea" =>
                     (case targs of
@@ -1955,7 +1967,8 @@
                              val (xml, fm) = monoExp (env, st, fm) xml
                          in
                              ((L'.EStrcat ((L'.EStrcat (ts,
-                                                        (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\">")), loc)), loc),
+                                                        (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\">")),
+                                                         loc)), loc),
                                            (L'.EStrcat (xml,
                                                         (L'.EPrim (Prim.String "</select>"),
                                                          loc)), loc)),
@@ -2025,19 +2038,26 @@
                            | _ => findSubmit xml)
                       | _ => NotFound
 
-                val (action, actionT) = case findSubmit xml of
-                    NotFound => raise Fail "No submit found"
+                val (action, fm) = case findSubmit xml of
+                    NotFound => ((L'.EPrim (Prim.String ""), loc), fm)
                   | Error => raise Fail "Not ready for multi-submit lforms yet"
-                  | Found et => et
-
-                val actionT = monoType env actionT
-                val (action, fm) = monoExp (env, st, fm) action
-                val (action, fm) = urlifyExp env fm (action, actionT)
+                  | Found (action, actionT) =>
+                    let
+                        val actionT = monoType env actionT
+                        val (action, fm) = monoExp (env, st, fm) action
+                        val (action, fm) = urlifyExp env fm (action, actionT)
+                    in
+                        ((L'.EStrcat ((L'.EPrim (Prim.String " action=\""), loc),
+                                      (L'.EStrcat (action,
+                                                   (L'.EPrim (Prim.String "\""), loc)), loc)), loc),
+                         fm)
+                    end
+                
                 val (xml, fm) = monoExp (env, st, fm) xml
             in
-                ((L'.EStrcat ((L'.EStrcat ((L'.EPrim (Prim.String "<form action=\""), loc),
+                ((L'.EStrcat ((L'.EStrcat ((L'.EPrim (Prim.String "<form"), loc),
                                            (L'.EStrcat (action,
-                                                        (L'.EPrim (Prim.String "\">"), loc)), loc)), loc),
+                                                        (L'.EPrim (Prim.String ">"), loc)), loc)), loc),
                               (L'.EStrcat (xml,
                                            (L'.EPrim (Prim.String "</form>"), loc)), loc)), loc),
                  fm)