Multiple arguments to web functions

6 files changed, 49 insertions, 21 deletions

diff --git a/src/cjr.sml b/src/cjr.sml
index c262e326..363fa762 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -57,7 +57,7 @@ withtype exp = exp' located
 datatype decl' =
          DStruct of int * (string * typ) list
        | DVal of string * int * typ * exp
-       | DFun of string * int * string * typ * typ * exp
+       | DFun of string * int * (string * typ) list * typ * exp
 
 withtype decl = decl' located
 
diff --git a/src/cjr_env.sml b/src/cjr_env.sml
index 686c99b1..bad365a5 100644
--- a/src/cjr_env.sml
+++ b/src/cjr_env.sml
@@ -119,7 +119,12 @@ fun lookupStruct (env : env) n =
 fun declBinds env (d, loc) =
     case d of
         DVal (x, n, t, _) => pushENamed env x n t
-      | DFun (fx, n, _, dom, ran, _) => pushENamed env fx n (TFun (dom, ran), loc)
+      | DFun (fx, n, args, ran, _) =>
+        let
+            val t = foldl (fn ((_, arg), t) => (TFun (arg, t), loc)) ran args
+        in
+            pushENamed env fx n t
+        end
       | DStruct (n, xts) => pushStruct env n xts
 
 end
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index a3796686..991315e5 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -149,19 +149,22 @@ fun p_decl env ((d, _) : decl) =
              space,
              p_exp env e,
              string ";"]
-      | DFun (fx, n, x, dom, ran, e) =>
+      | DFun (fx, n, args, ran, e) =>
         let
-            val env' = E.pushERel env x dom
+            val nargs = length args
+            val env' = foldl (fn ((x, dom), env) => E.pushERel env x dom) env args
         in
             box [string "static",
                  space,
                  p_typ env ran,
                  space,
                  string ("__lwn_" ^ fx ^ "_" ^ Int.toString n),
-                 string "(lw_context ctx, ",
-                 p_typ env dom,
-                 space,
-                 p_rel env' 0,
+                 string "(",
+                 p_list_sep (box [string ",", space]) (fn x => x)
+                            (string "lw_context ctx" :: ListUtil.mapi (fn (i, (_, dom)) =>
+                                                                   box [p_typ env dom,
+                                                                        space,
+                                                                        p_rel env' (nargs - i - 1)]) args),
                  string ")",
                  space,
                  string "{",
diff --git a/src/cjrize.sml b/src/cjrize.sml
index e14f7db1..dcbfbce3 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -165,16 +165,27 @@ fun cifyDecl ((d, loc), sm) =
             val (t, sm) = cifyTyp (t, sm)
 
             val (d, sm) = case #1 t of
-                              L'.TFun (dom, ran) =>
-                              (case #1 e of
-                                   L.EAbs (ax, _, _, e) =>
-                                   let
-                                       val (e, sm) = cifyExp (e, sm)
-                                   in
-                                       (L'.DFun (x, n, ax, dom, ran, e), sm)
-                                   end
-                                 | _ => (ErrorMsg.errorAt loc "Function isn't explicit at code generation";
-                                         (L'.DVal ("", 0, t, (L'.EPrim (Prim.Int 0), ErrorMsg.dummySpan)), sm)))
+                              L'.TFun _ =>
+                              let
+                                  fun unravel (tAll as (t, _), eAll as (e, _)) =
+                                      case (t, e) of
+                                          (L'.TFun (dom, ran), L.EAbs (ax, _, _, e)) =>
+                                          let
+                                              val (args, t, e) = unravel (ran, e)
+                                          in
+                                              ((ax, dom) :: args, t, e)
+                                          end
+                                        | (L'.TFun _, _) =>
+                                          (ErrorMsg.errorAt loc "Function isn't explicit at code generation";
+                                           ([], tAll, eAll))
+                                        | _ => ([], tAll, eAll)
+
+                                  val (args, ran, e) = unravel (t, e)
+                                  val (e, sm) = cifyExp (e, sm)
+                              in
+                                  (L'.DFun (x, n, args, ran, e), sm)
+                              end
+
                             | _ =>
                               let
                                   val (e, sm) = cifyExp (e, sm)
diff --git a/src/monoize.sml b/src/monoize.sml
index b5d9099f..b314d1d6 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -98,9 +98,10 @@ fun fooifyExp name env =
                         case (args, ft) of
                             ([], _) => e
                           | (arg :: args, (L'.TFun (t, ft), _)) =>
-                            (L'.EStrcat (e,
-                                         (L'.EStrcat ((L'.EPrim (Prim.String "/"), loc),
-                                                      fooify (arg, t)), loc)), loc)
+                            attrify (args, ft,
+                                     (L'.EStrcat (e,
+                                                  (L'.EStrcat ((L'.EPrim (Prim.String "/"), loc),
+                                                               fooify (arg, t)), loc)), loc))
                           | _ => (E.errorAt loc "Type mismatch encoding attribute";
                                   e)
                 in
diff --git a/tests/plink2.lac b/tests/plink2.lac
new file mode 100644
index 00000000..22cd9094
--- /dev/null
+++ b/tests/plink2.lac
@@ -0,0 +1,8 @@
+val pA = fn size1 => fn size2 => <html><body>
+        <font size={size1}>Hello</font> <font size={size2}>World!</font>
+</body></html>
+
+val main = fn () => <html><body>
+        <li> <a link={pA 5 10}>Size 5</a></li>
+        <li> <a link={pA 10 5}>Size 10</a></li>
+</body></html>