changeset 144:f0d3402184d1

Simple forms work
author Adam Chlipala <adamc@hcoop.net>
date Tue, 22 Jul 2008 15:12:20 -0400
parents 4b9c2bd6157c
children b1b33f7cf555
files include/lacweb.h src/c/driver.c src/c/lacweb.c src/cjr.sml src/cjr_print.sml src/cjrize.sml src/core.sml src/core_print.sig src/core_print.sml src/corify.sml src/mono.sml src/mono_print.sml src/mono_shake.sml src/mono_util.sml src/monoize.sml src/shake.sml src/tag.sml tests/form2.lac tests/form3.lac tests/link.lac tests/plink.lac
diffstat 21 files changed, 546 insertions(+), 152 deletions(-) [+]
line wrap: on
line diff
--- a/include/lacweb.h	Sun Jul 20 13:30:19 2008 -0400
+++ b/include/lacweb.h	Tue Jul 22 15:12:20 2008 -0400
@@ -12,6 +12,9 @@
 void *lw_malloc(lw_context, size_t);
 int lw_send(lw_context, int sock);
 
+void lw_set_input(lw_context, char *name, char *value);
+char *lw_get_input(lw_context, int name);
+
 void lw_write(lw_context, const char*);
 
 
--- a/src/c/driver.c	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/c/driver.c	Tue Jul 22 15:12:20 2008 -0400
@@ -86,9 +86,11 @@
       *back = 0;
     
       if (s = strstr(buf, "\r\n\r\n")) {
-        char *cmd, *path;
+        char *cmd, *path, *inputs;
 
         *s = 0;
+
+        printf("Read: %s\n", buf);
       
         if (!(s = strstr(buf, "\r\n"))) {
           fprintf(stderr, "No newline in buf\n");
@@ -114,9 +116,33 @@
           break;
         }
 
+        if (inputs = strchr(path, '?')) {
+          char *name, *value;
+          *inputs++ = 0;
+
+          while (*inputs) {
+            name = inputs;
+            if (value = strchr(inputs, '=')) {
+              *value++ = 0;
+              if (inputs = strchr(value, '&'))
+                *inputs++ = 0;
+              else
+                inputs = strchr(value, 0);
+              lw_set_input(ctx, name, value);
+            }
+            else if (inputs = strchr(value, '&')) {
+              *inputs++ = 0;
+              lw_set_input(ctx, name, "");
+            }
+            else {
+              inputs = strchr(value, 0);
+              lw_set_input(ctx, name, "");
+            }
+          }
+        }
+
         printf("Serving URI %s....\n", path);
 
-        ctx = lw_init(1024, 1024);
         lw_write (ctx, "HTTP/1.1 200 OK\r\n");
         lw_write(ctx, "Content-type: text/html\r\n\r\n");
         lw_write(ctx, "<html>");
--- a/src/c/lacweb.c	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/c/lacweb.c	Tue Jul 22 15:12:20 2008 -0400
@@ -11,8 +11,11 @@
 struct lw_context {
   char *page, *page_front, *page_back;
   char *heap, *heap_front, *heap_back;
+  char **inputs;
 };
 
+extern int lw_inputs_len;
+
 lw_context lw_init(size_t page_len, size_t heap_len) {
   lw_context ctx = malloc(sizeof(struct lw_context));
 
@@ -22,18 +25,45 @@
   ctx->heap_front = ctx->heap = malloc(heap_len);
   ctx->heap_back = ctx->heap_front + heap_len;
 
+  ctx->inputs = calloc(lw_inputs_len, sizeof(char *));
+
   return ctx;
 }
 
 void lw_free(lw_context ctx) {
   free(ctx->page);
   free(ctx->heap);
+  free(ctx->inputs);
   free(ctx);
 }
 
 void lw_reset(lw_context ctx) {
   ctx->page_front = ctx->page;
   ctx->heap_front = ctx->heap;
+  memset(ctx->inputs, 0, lw_inputs_len * sizeof(char *));
+}
+
+int lw_input_num(char*);
+
+void lw_set_input(lw_context ctx, char *name, char *value) {
+  int n = lw_input_num(name);
+
+  if (n < 0) {
+    printf("Bad input name");
+    exit(1);
+  }
+
+  assert(n < lw_inputs_len);
+  ctx->inputs[n] = value;
+
+  printf("[%d] %s = %s\n", n, name, value);
+}
+
+char *lw_get_input(lw_context ctx, int n) {
+  assert(n >= 0);
+  assert(n < lw_inputs_len);
+  printf("[%d] = %s\n", n, ctx->inputs[n]);
+  return ctx->inputs[n];
 }
 
 static void lw_check_heap(lw_context ctx, size_t extra) {
@@ -294,14 +324,20 @@
 }
 
 
-lw_Basis_int lw_unurlifyInt(char **s) {
-  char *new_s = strchr(*s, '/');
-  int r;
+static char *lw_unurlify_advance(char *s) {
+  char *new_s = strchr(s, '/');
 
   if (new_s)
     *new_s++ = 0;
   else
-    new_s = strchr(*s, 0);
+    new_s = strchr(s, 0);
+
+  return new_s;
+}
+
+lw_Basis_int lw_unurlifyInt(char **s) {
+  char *new_s = lw_unurlify_advance(*s);
+  int r;
 
   r = atoi(*s);
   *s = new_s;
@@ -309,34 +345,19 @@
 }
 
 lw_Basis_float lw_unurlifyFloat(char **s) {
-  char *new_s = strchr(*s, '/');
+  char *new_s = lw_unurlify_advance(*s);
   int r;
 
-  if (new_s)
-    *new_s++ = 0;
-  else
-    new_s = strchr(*s, 0);
-
   r = atof(*s);
   *s = new_s;
   return r;
 }
 
-lw_Basis_string lw_unurlifyString(lw_context ctx, char **s) {
-  char *new_s = strchr(*s, '/');
-  char *r, *s1, *s2;
-  int len, n;
+static lw_Basis_string lw_unurlifyString_to(char *r, char *s) {
+  char *s1, *s2;
+  int n;
 
-  if (new_s)
-    *new_s++ = 0;
-  else
-    new_s = strchr(*s, 0);
-
-  len = strlen(*s);
-  lw_check_heap(ctx, len + 1);
-
-  r = ctx->heap_front;
-  for (s1 = r, s2 = *s; *s2; ++s1, ++s2) {
+  for (s1 = r, s2 = s; *s2; ++s1, ++s2) {
     char c = *s2;
 
     switch (c) {
@@ -344,7 +365,7 @@
       *s1 = ' ';
       break;
     case '%':
-      assert(s2 + 2 < new_s);
+      assert(s2[1] != 0 && s2[2] != 0);
       sscanf(s2+1, "%02X", &n);
       *s1 = n;
       s2 += 2;
@@ -354,7 +375,19 @@
     }
   }
   *s1++ = 0;
-  ctx->heap_front = s1;
+  return s1;
+}
+
+lw_Basis_string lw_unurlifyString(lw_context ctx, char **s) {
+  char *new_s = lw_unurlify_advance(*s);
+  char *r, *s1, *s2;
+  int len, n;
+
+  len = strlen(*s);
+  lw_check_heap(ctx, len + 1);
+
+  r = ctx->heap_front;
+  ctx->heap_front = lw_unurlifyString_to(ctx->heap_front, *s);
   *s = new_s;
   return r;
 }
--- a/src/cjr.sml	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/cjr.sml	Tue Jul 22 15:12:20 2008 -0400
@@ -62,6 +62,6 @@
 
 withtype decl = decl' located
 
-type file = decl list * (string * int * typ list) list
+type file = decl list * (Core.export_kind * string * int * typ list) list
 
 end
--- a/src/cjr_print.sml	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/cjr_print.sml	Tue Jul 22 15:12:20 2008 -0400
@@ -37,6 +37,20 @@
 structure E = CjrEnv
 structure EM = ErrorMsg
 
+structure SK = struct
+type ord_key = string
+val compare = String.compare
+end
+
+structure SS = BinarySetFn(SK)
+structure SM = BinaryMapFn(SK)
+structure IS = IntBinarySet
+
+structure CM = BinaryMapFn(struct
+                           type ord_key = char
+                           val compare = Char.compare
+                           end)
+
 val debug = ref false
 
 val dummyTyp = (TNamed 0, ErrorMsg.dummySpan)
@@ -208,90 +222,11 @@
                  newline]
         end
 
-fun unurlify env (t, loc) =
-    case t of
-        TFfi ("Basis", "int") => string "lw_unurlifyInt(&request)"
-      | TFfi ("Basis", "float") => string "lw_unurlifyFloat(&request)"
-      | TFfi ("Basis", "string") => string "lw_unurlifyString(ctx, &request)"
+datatype 'a search =
+         Found of 'a
+       | NotFound
+       | Error
 
-      | TRecord 0 => string "lw_unit_v"
-      | TRecord i =>
-        let
-            val xts = E.lookupStruct env i
-        in
-            box [string "({",
-                 newline,
-                 box (map (fn (x, t) =>
-                              box [p_typ env t,
-                                   space,
-                                   string x,
-                                   space,
-                                   string "=",
-                                   space,
-                                   unurlify env t,
-                                   string ";",
-                                   newline]) xts),
-                 string "struct",
-                 space,
-                 string "__lws_",
-                 string (Int.toString i),
-                 space,
-                 string "__lw_tmp",
-                 space,
-                 string "=",
-                 space,
-                 string "{",
-                 space,
-                 p_list_sep (box [string ",", space]) (fn (x, _) => string x) xts,
-                 space,
-                 string "};",
-                 newline,
-                 string "__lw_tmp;",
-                 newline,
-                 string "})"]
-        end
-
-      | _ => (ErrorMsg.errorAt loc "Unable to choose a URL decoding function";
-              space)
-
-fun p_page env (s, n, ts) =
-    box [string "if (!strncmp(request, \"",
-         string (String.toString s),
-         string "\", ",
-         string (Int.toString (size s)),
-         string ")) {",
-         newline,
-         string "request += ",
-         string (Int.toString (size s)),
-         string ";",
-         newline,
-         string "if (*request == '/') ++request;",
-         newline,
-         box [string "{",
-              newline,
-              box (ListUtil.mapi (fn (i, t) => box [p_typ env t,
-                                                    space,
-                                                    string "arg",
-                                                    string (Int.toString i),
-                                                    space,
-                                                    string "=",
-                                                    space,
-                                                    unurlify env t,
-                                                    string ";",
-                                                    newline]) ts),
-              p_enamed env n,
-              string "(",
-              p_list_sep (box [string ",", space])
-                         (fn x => x)
-                         (string "ctx" :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts),
-              string ");",
-              newline,
-              string "return;",
-              newline,
-              string "}",
-              newline,
-              string "}"]
-        ]
 
 fun p_file env (ds, ps) =
     let
@@ -299,13 +234,318 @@
                                              (p_decl env d,
                                               E.declBinds env d))
                              env ds
-        val pds' = map (p_page env) ps
+
+        val fields = foldl (fn ((ek, _, _, ts), fields) =>
+                               case ek of
+                                   Core.Link => fields
+                                 | Core.Action =>
+                                   case List.last ts of
+                                       (TRecord i, _) =>
+                                       let
+                                           val xts = E.lookupStruct env i
+                                           val xtsSet = SS.addList (SS.empty, map #1 xts)
+                                       in
+                                           foldl (fn ((x, _), fields) =>
+                                                     let
+                                                         val xtsSet' = Option.getOpt (SM.find (fields, x), SS.empty)
+                                                     in
+                                                         SM.insert (fields, x, SS.union (SS.delete (xtsSet, x),
+                                                                                         xtsSet'))
+                                                     end) fields xts
+                                       end
+                                     | _ => raise Fail "CjrPrint: Last argument of action isn't record")
+                     SM.empty ps
+
+        val fnums = SM.foldli (fn (x, xs, fnums) =>
+                                  let
+                                      val unusable = SS.foldl (fn (x', unusable) =>
+                                                                  case SM.find (fnums, x') of
+                                                                      NONE => unusable
+                                                                    | SOME n => IS.add (unusable, n))
+                                                     IS.empty xs
+
+                                      fun findAvailable n =
+                                          if IS.member (unusable, n) then
+                                              findAvailable (n + 1)
+                                          else
+                                              n
+                                  in
+                                      SM.insert (fnums, x, findAvailable 0)
+                                  end)
+                    SM.empty fields
+
+        fun makeSwitch (fnums, i) =
+            case SM.foldl (fn (n, NotFound) => Found n
+                            | (n, Error) => Error
+                            | (n, Found n') => if n = n' then
+                                                  Found n'
+                                               else
+                                                   Error) NotFound fnums of
+                NotFound => box [string "return",
+                                 space,
+                                 string "-1;"]
+              | Found n => box [string "return",
+                                space,
+                                string (Int.toString n),
+                                string ";"]
+              | Error =>
+                let
+                    val cmap = SM.foldli (fn (x, n, cmap) =>
+                                             let
+                                                 val ch = if i < size x then
+                                                              String.sub (x, i)
+                                                          else
+                                                              chr 0
+
+                                                 val fnums = case CM.find (cmap, ch) of
+                                                                 NONE => SM.empty
+                                                               | SOME fnums => fnums
+                                                 val fnums = SM.insert (fnums, x, n)
+                                             in
+                                                 CM.insert (cmap, ch, fnums)
+                                             end)
+                               CM.empty fnums
+
+                    val cmap = CM.listItemsi cmap
+                in
+                    case cmap of
+                        [(_, fnums)] =>
+                        box [string "if",
+                             space,
+                             string "(name[",
+                             string (Int.toString i),
+                             string "]",
+                             space,
+                             string "==",
+                             space,
+                             string "0)",
+                             space,
+                             string "return",
+                             space,
+                             string "-1;",
+                             newline,
+                             makeSwitch (fnums, i+1)]
+                      | _ =>
+                        box [string "switch",
+                             space,
+                             string "(name[",
+                             string (Int.toString i),
+                             string "])",
+                             space,
+                             string "{",
+                             newline,
+                             box (map (fn (ch, fnums) =>
+                                          box [string "case",
+                                               space,
+                                               if ch = chr 0 then
+                                                   string "0:"
+                                               else
+                                                   box [string "'",
+                                                        string (Char.toString ch),
+                                                        string "':"],
+                                               newline,
+                                               makeSwitch (fnums, i+1),
+                                               newline]) cmap),
+                             string "default:",
+                             newline,
+                             string "return",
+                             space,
+                             string "-1;",
+                             newline,
+                             string "}"]
+                end
+
+        fun unurlify (t, loc) =
+            case t of
+                TFfi ("Basis", "int") => string "lw_unurlifyInt(&request)"
+              | TFfi ("Basis", "float") => string "lw_unurlifyFloat(&request)"
+              | TFfi ("Basis", "string") => string "lw_unurlifyString(ctx, &request)"
+
+              | TRecord 0 => string "lw_unit_v"
+              | TRecord i =>
+                let
+                    val xts = E.lookupStruct env i
+                in
+                    box [string "({",
+                         newline,
+                         box (map (fn (x, t) =>
+                                      box [p_typ env t,
+                                           space,
+                                           string x,
+                                           space,
+                                           string "=",
+                                           space,
+                                           unurlify t,
+                                           string ";",
+                                           newline]) xts),
+                         string "struct",
+                         space,
+                         string "__lws_",
+                         string (Int.toString i),
+                         space,
+                         string "__lw_tmp",
+                         space,
+                         string "=",
+                         space,
+                         string "{",
+                         space,
+                         p_list_sep (box [string ",", space]) (fn (x, _) => string x) xts,
+                         space,
+                         string "};",
+                         newline,
+                         string "__lw_tmp;",
+                         newline,
+                         string "})"]
+                end
+
+              | _ => (ErrorMsg.errorAt loc "Unable to choose a URL decoding function";
+                      space)
+
+
+        fun p_page (ek, s, n, ts) =
+            let
+                val (ts, defInputs, inputsVar) =
+                    case ek of
+                        Core.Link => (ts, string "", string "")
+                      | Core.Action =>
+                        case List.last ts of
+                            (TRecord i, _) =>
+                            let
+                                val xts = E.lookupStruct env i
+                            in
+                                (List.drop (ts, 1),
+                                 box [box (map (fn (x, t) => box [p_typ env t,
+                                                                  space,
+                                                                  string "lw_input_",
+                                                                  string x,
+                                                                  string ";",
+                                                                  newline]) xts),
+                                      newline,
+                                      box (map (fn (x, t) =>
+                                                   let
+                                                       val n = case SM.find (fnums, x) of
+                                                                   NONE => raise Fail "CjrPrint: Can't find in fnums"
+                                                                 | SOME n => n
+                                                   in
+                                                       box [string "request = lw_get_input(ctx, ",
+                                                            string (Int.toString n),
+                                                            string ");",
+                                                            newline,
+                                                            string "if (request == NULL) {",
+                                                            newline,
+                                                            box [string "printf(\"Missing input ",
+                                                                 string x,
+                                                                 string "\\n\");",
+                                                                 newline,
+                                                                 string "exit(1);"],
+                                                            newline,
+                                                            string "}",
+                                                            newline,
+                                                            string "lw_input_",
+                                                            string x,
+                                                            space,
+                                                            string "=",
+                                                            space,
+                                                            unurlify t,
+                                                            string ";",
+                                                            newline]
+                                                   end) xts),
+                                      string "struct __lws_",
+                                      string (Int.toString i),
+                                      space,
+                                      string "lw_inputs",
+                                      space,
+                                      string "= {",
+                                      newline,
+                                      box (map (fn (x, _) => box [string "lw_input_",
+                                                                  string x,
+                                                                  string ",",
+                                                                  newline]) xts),
+                                      string "};",
+                                      newline],
+                                 box [string ",",
+                                      space,
+                                      string "lw_inputs"])
+                            end
+
+                          | _ => raise Fail "CjrPrint: Last argument to an action isn't a record"
+            in
+                box [string "if (!strncmp(request, \"",
+                     string (String.toString s),
+                     string "\", ",
+                     string (Int.toString (size s)),
+                     string ")) {",
+                     newline,
+                     string "request += ",
+                     string (Int.toString (size s)),
+                     string ";",
+                     newline,
+                     string "if (*request == '/') ++request;",
+                     newline,
+                     box [string "{",
+                          newline,
+                          box (ListUtil.mapi (fn (i, t) => box [p_typ env t,
+                                                                space,
+                                                                string "arg",
+                                                                string (Int.toString i),
+                                                                space,
+                                                                string "=",
+                                                                space,
+                                                                unurlify t,
+                                                                string ";",
+                                                                newline]) ts),
+                          defInputs,
+                          p_enamed env n,
+                          string "(",
+                          p_list_sep (box [string ",", space])
+                                     (fn x => x)
+                                     (string "ctx" :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts),
+                          inputsVar,
+                          string ");",
+                          newline,
+                          string "return;",
+                          newline,
+                          string "}",
+                          newline,
+                          string "}"]
+                    ]
+            end
+
+        val pds' = map p_page ps
     in
-        box [string "#include \"lacweb.h\"",
+        box [string "#include <stdio.h>",
+             newline,
+             string "#include <stdlib.h>",
+             newline,
+             newline,
+             string "#include \"lacweb.h\"",
              newline,
              newline,
              p_list_sep newline (fn x => x) pds,
              newline,
+             string "int lw_inputs_len = ",
+             string (Int.toString (SM.foldl Int.max 0 fnums + 1)),
+             string ";",
+             newline,
+             newline,
+             string "int lw_input_num(char *name) {",
+             newline,
+             string "if",
+             space,
+             string "(name[0]",
+             space,
+             string "==",
+             space,
+             string "0)",
+             space,
+             string "return",
+             space,
+             string "-1;",
+             newline,
+             makeSwitch (fnums, 0),
+             string "}",
+             newline,
+             newline,
              string "void lw_handle(lw_context ctx, char *request) {",
              newline,
              p_list_sep newline (fn x => x) pds',
--- a/src/cjrize.sml	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/cjrize.sml	Tue Jul 22 15:12:20 2008 -0400
@@ -225,11 +225,11 @@
             (SOME (L'.DFunRec vis, loc), NONE, sm)
         end        
 
-      | L.DExport (s, n, ts) =>
+      | L.DExport (ek, s, n, ts) =>
         let
             val (ts, sm) = ListUtil.foldlMap cifyTyp sm ts
         in
-            (NONE, SOME ("/" ^ s, n, ts), sm)
+            (NONE, SOME (ek, "/" ^ s, n, ts), sm)
         end
 
 fun cjrize ds =
--- a/src/core.sml	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/core.sml	Tue Jul 22 15:12:20 2008 -0400
@@ -80,11 +80,15 @@
 
 withtype exp = exp' located
 
+datatype export_kind =
+         Link
+       | Action
+
 datatype decl' =
          DCon of string * int * kind * con
        | DVal of string * int * con * exp * string
        | DValRec of (string * int * con * exp * string) list
-       | DExport of int
+       | DExport of export_kind * int
 
 withtype decl = decl' located
 
--- a/src/core_print.sig	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/core_print.sig	Tue Jul 22 15:12:20 2008 -0400
@@ -33,6 +33,7 @@
     val p_exp : CoreEnv.env -> Core.exp Print.printer
     val p_decl : CoreEnv.env -> Core.decl Print.printer
     val p_file : CoreEnv.env -> Core.file Print.printer
+    val p_export_kind : Core.export_kind Print.printer
 
     val debug : bool ref
 end
--- a/src/core_print.sml	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/core_print.sml	Tue Jul 22 15:12:20 2008 -0400
@@ -264,6 +264,11 @@
              p_exp env e]
     end
 
+fun p_export_kind ck =
+    case ck of
+        Link => string "link"
+      | Action => string "action"
+
 fun p_decl env (dAll as (d, _) : decl) =
     case d of
         DCon (x, n, k, c) =>
@@ -300,9 +305,15 @@
                  space,
                  p_list_sep (box [newline, string "and", space]) (p_vali env) vis]
         end
-      | DExport n => box [string "export",
-                          space,
-                          p_enamed env n]
+      | DExport (ek, n) => box [string "export",
+                                space,
+                                p_export_kind ek,
+                                space,
+                                p_enamed env n,
+                                space,
+                                string "as",
+                                space,
+                                p_con env (#2 (E.lookupENamed env n))]
 
 fun p_file env file =
     let
--- a/src/corify.sml	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/corify.sml	Tue Jul 22 15:12:20 2008 -0400
@@ -496,7 +496,7 @@
                                                     e), loc) :: wds,
                                            (fn st =>
                                                case #1 (corifyExp st (L.EModProj (en, [], "wrap_" ^ s), loc)) of
-                                                   L'.ENamed n => (L'.DExport n, loc)
+                                                   L'.ENamed n => (L'.DExport (L'.Link, n), loc)
                                                  | _ => raise Fail "Corify: Value to export didn't corify properly")
                                            :: eds)
                                       end
--- a/src/mono.sml	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/mono.sml	Tue Jul 22 15:12:20 2008 -0400
@@ -62,7 +62,7 @@
 datatype decl' =
          DVal of string * int * typ * exp * string
        | DValRec of (string * int * typ * exp * string) list
-       | DExport of string * int * typ list
+       | DExport of Core.export_kind * string * int * typ list
 
 withtype decl = decl' located
 
--- a/src/mono_print.sml	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/mono_print.sml	Tue Jul 22 15:12:20 2008 -0400
@@ -178,17 +178,19 @@
                  p_list_sep (box [newline, string "and", space]) (p_vali env) vis]
         end
 
-      | DExport (s, n, ts) => box [string "export",
-                                   space,
-                                   p_enamed env n,
-                                   space,
-                                   string "as",
-                                   space,
-                                   string s,
-                                   p_list_sep (string "") (fn t => box [space,
-                                                                        string "(",
-                                                                        p_typ env t,
-                                                                        string ")"]) ts]
+      | DExport (ek, s, n, ts) => box [string "export",
+                                       space,
+                                       CorePrint.p_export_kind ek,
+                                       space,
+                                       p_enamed env n,
+                                       space,
+                                       string "as",
+                                       space,
+                                       string s,
+                                       p_list_sep (string "") (fn t => box [space,
+                                                                            string "(",
+                                                                            p_typ env t,
+                                                                            string ")"]) ts]
                           
 fun p_file env file =
     let
--- a/src/mono_shake.sml	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/mono_shake.sml	Tue Jul 22 15:12:20 2008 -0400
@@ -44,7 +44,7 @@
 fun shake file =
     let
         val page_es = List.foldl
-                          (fn ((DExport (_, n, _), _), page_es) => n :: page_es
+                          (fn ((DExport (_, _, n, _), _), page_es) => n :: page_es
                             | (_, page_es) => page_es) [] file
 
         val (cdef, edef) = foldl (fn ((DVal (_, n, t, e, _), _), (cdef, edef)) => (cdef, IM.insert (edef, n, (t, e)))
--- a/src/mono_util.sml	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/mono_util.sml	Tue Jul 22 15:12:20 2008 -0400
@@ -266,10 +266,10 @@
                 S.map2 (ListUtil.mapfold (mfvi ctx) vis,
                      fn vis' =>
                         (DValRec vis', loc))
-              | DExport (s, n, ts) =>
+              | DExport (ek, s, n, ts) =>
                 S.map2 (ListUtil.mapfold mft ts,
                         fn ts' =>
-                           (DExport (s, n, ts'), loc))
+                           (DExport (ek, s, n, ts'), loc))
 
         and mfvi ctx (x, n, t, e, s) =
             S.bind2 (mft t,
--- a/src/monoize.sml	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/monoize.sml	Tue Jul 22 15:12:20 2008 -0400
@@ -383,7 +383,7 @@
                 SOME (env,
                       (L'.DValRec (map (fn (x, n, t, e, s) => (x, n, monoType env t, monoExp env e, s)) vis), loc))
             end
-          | L.DExport n =>
+          | L.DExport (ek, n) =>
             let
                 val (_, t, _, s) = Env.lookupENamed env n
 
@@ -394,7 +394,7 @@
 
                 val ts = map (monoType env) (unwind t)
             in
-                SOME (env, (L'.DExport (s, n, ts), loc))
+                SOME (env, (L'.DExport (ek, s, n, ts), loc))
             end
     end
 
--- a/src/shake.sml	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/shake.sml	Tue Jul 22 15:12:20 2008 -0400
@@ -44,7 +44,7 @@
 fun shake file =
     let
         val page_es = List.foldl
-                          (fn ((DExport n, _), page_es) => n :: page_es
+                          (fn ((DExport (_, n), _), page_es) => n :: page_es
                             | (_, page_es) => page_es) [] file
 
         val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, c), edef)
--- a/src/tag.sml	Sun Jul 20 13:30:19 2008 -0400
+++ b/src/tag.sml	Tue Jul 22 15:12:20 2008 -0400
@@ -66,7 +66,7 @@
                  val (xets, s) =
                      ListUtil.foldlMap (fn ((x, e, t), (count, tags, byTag, newTags)) =>
                                            let
-                                               fun tagIt newAttr =
+                                               fun tagIt (ek, newAttr) =
                                                    let
                                                        fun unravel (e, _) =
                                                            case e of
@@ -88,20 +88,25 @@
                                                            case IM.find (tags, f) of
                                                                NONE =>
                                                                (count, count + 1, IM.insert (tags, f, count),
-                                                                (f, count) :: newTags)
+                                                                (ek, f, count) :: newTags)
                                                              | SOME cn => (cn, count, tags, newTags)
                                                                           
                                                        val (_, _, _, s) = E.lookupENamed env f
 
                                                        val byTag = case SM.find (byTag, s) of
-                                                                       NONE => SM.insert (byTag, s, f)
-                                                                     | SOME f' =>
+                                                                       NONE => SM.insert (byTag, s, (ek, f))
+                                                                     | SOME (ek', f') =>
                                                                        (if f = f' then
                                                                             ()
                                                                         else
                                                                             ErrorMsg.errorAt loc 
                                                                                              ("Duplicate HTTP tag "
                                                                                               ^ s);
+                                                                        if ek = ek' then
+                                                                            ()
+                                                                        else
+                                                                            ErrorMsg.errorAt loc 
+                                                                                             "Function needed as both a link and a form ";
                                                                         byTag)
 
                                                        val e = (EClosure (cn, args), loc)
@@ -112,8 +117,8 @@
                                                    end
                                            in
                                                case x of
-                                                   (CName "Link", _) => tagIt "Href"
-                                                 | (CName "Action", _) => tagIt "Action"
+                                                   (CName "Link", _) => tagIt (Link, "Href")
+                                                 | (CName "Action", _) => tagIt (Action, "Action")
                                                  | _ => ((x, e, t), (count, tags, byTag, newTags))
                                            end)
                      s xets
@@ -154,13 +159,18 @@
 
         fun doDecl (d as (d', loc), (env, count, tags, byTag)) =
             case d' of
-                DExport n =>
+                DExport (ek, n) =>
                 let
                     val (_, _, _, s) = E.lookupENamed env n
                 in
                     case SM.find (byTag, s) of
                         NONE => ([d], (env, count, tags, byTag))
-                      | SOME n' => ([], (env, count, tags, byTag))
+                      | SOME (ek', n') =>
+                        (if ek = ek' then
+                             ()
+                         else
+                             ErrorMsg.errorAt loc "Function needed for both a link and a form";
+                         ([], (env, count, tags, byTag)))
                 end
               | _ =>
                 let
@@ -179,7 +189,7 @@
                     val env = env'
 
                     val newDs = map
-                                    (fn (f, cn) =>
+                                    (fn (ek, f, cn) =>
                                         let
                                             fun unravel (all as (t, _)) =
                                                 case t of
@@ -225,7 +235,7 @@
                                                     end
                                         in
                                             (("wrap_" ^ fnam, cn, t, abs, tag),
-                                             (DExport cn, loc))
+                                             (DExport (ek, cn), loc))
                                         end) newTags
 
                     val (newVals, newExports) = ListPair.unzip newDs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/form2.lac	Tue Jul 22 15:12:20 2008 -0400
@@ -0,0 +1,25 @@
+val handler1 = fn r => <html><body>
+        <li> Name: {cdata r.Nam}</li>
+        <li> Word: {cdata r.Word}</li>
+</body></html>
+
+val handler2 = fn r => <html><body>
+        <li> Name: {cdata r.Nam}</li>
+        <li> Ward: {cdata r.Ward}</li>
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <lform>
+                Name: <textbox{#Nam} /><br/>
+                Word: <textbox{#Word} /><br/>
+
+                <submit action={handler1}/>
+        </lform>
+
+        <lform>
+                Name: <textbox{#Nam} /><br/>
+                Word: <textbox{#Ward} /><br/>
+
+                <submit action={handler2}/>
+        </lform>
+</body></html>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/form3.lac	Tue Jul 22 15:12:20 2008 -0400
@@ -0,0 +1,39 @@
+val handler1 = fn r => <html><body>
+        <li> Name: {cdata r.Nam}</li>
+        <li> Word: {cdata r.Word}</li>
+</body></html>
+
+val handler2 = fn r => <html><body>
+        <li> Name: {cdata r.Nam}</li>
+        <li> Ward: {cdata r.Ward}</li>
+</body></html>
+
+val handler3 = fn r => <html><body>
+        <li> Name: {cdata r.Nam}</li>
+        <li> Ward: {cdata r.Ward}</li>
+        <li> Words: {cdata r.Words}</li>
+</body></html>
+
+val main : unit -> page = fn () => <html><body>
+        <lform>
+                Name: <textbox{#Nam} /><br/>
+                Word: <textbox{#Word} /><br/>
+
+                <submit action={handler1}/>
+        </lform>
+
+        <lform>
+                Name: <textbox{#Nam} /><br/>
+                Word: <textbox{#Ward} /><br/>
+
+                <submit action={handler2}/>
+        </lform>
+
+        <lform>
+                Name: <textbox{#Nam} /><br/>
+                Ward: <textbox{#Ward} /><br/>
+                Words: <textbox{#Words} /><br/>
+
+                <submit action={handler3}/>
+        </lform>
+</body></html>
--- a/tests/link.lac	Sun Jul 20 13:30:19 2008 -0400
+++ b/tests/link.lac	Tue Jul 22 15:12:20 2008 -0400
@@ -1,7 +1,7 @@
-val ancillary : {} -> xhtml = fn () => <html>
+val ancillary = fn () => <html>
         Welcome to the ancillary page!
 </html>
 
-val main : {} -> xhtml = fn () => <html><body>
+val main : unit -> page = fn () => <html><body>
         <a link={ancillary ()}>Enter the unknown!</a>
 </body></html>
--- a/tests/plink.lac	Sun Jul 20 13:30:19 2008 -0400
+++ b/tests/plink.lac	Tue Jul 22 15:12:20 2008 -0400
@@ -2,7 +2,7 @@
         <font size={size}>Hello World!</font>
 </body></html>
 
-val main = fn () => <html><body>
+val main : unit -> page = fn () => <html><body>
         <li> <a link={pA 5}>Size 5</a></li>
         <li> <a link={pA 10}>Size 10</a></li>
 </body></html>