summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-07-13 20:24:05 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-07-13 20:24:05 -0400
commitcf6caf0383daf8cb576edf5c1f0f736d2f4c85bd (patch)
tree5ddacbdd84964c107c03a631bf221d4fb9072691
parent811a3831805bf7a87ed3a64156f4ac6f6246edb9 (diff)
Multiple arguments to web functions
-rw-r--r--src/cjr.sml2
-rw-r--r--src/cjr_env.sml7
-rw-r--r--src/cjr_print.sml15
-rw-r--r--src/cjrize.sml31
-rw-r--r--src/monoize.sml7
-rw-r--r--tests/plink2.lac8
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>