summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/jscomp.sml83
-rw-r--r--tests/jsinj.ur8
2 files changed, 65 insertions, 26 deletions
diff --git a/src/jscomp.sml b/src/jscomp.sml
index d7017a47..44012a4f 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -156,33 +156,60 @@ fun process file =
fun str loc s = (EPrim (Prim.String s), loc)
- fun quoteExp loc (t : typ) e =
+ fun quoteExp loc (t : typ) (e, st) =
case #1 t of
- TSource => strcat loc [str loc "s",
- (EFfiApp ("Basis", "htmlifyInt", [e]), loc)]
- | TRecord [] => str loc "null"
-
- | TFfi ("Basis", "string") => (EFfiApp ("Basis", "jsifyString", [e]), loc)
- | TFfi ("Basis", "int") => (EFfiApp ("Basis", "htmlifyInt", [e]), loc)
- | TFfi ("Basis", "float") => (EFfiApp ("Basis", "htmlifyFloat", [e]), loc)
-
- | TFfi ("Basis", "bool") => (ECase (e,
- [((PCon (Enum, PConFfi {mod = "Basis",
- datatyp = "bool",
- con = "True",
- arg = NONE}, NONE), loc),
- str loc "true"),
- ((PCon (Enum, PConFfi {mod = "Basis",
- datatyp = "bool",
- con = "False",
- arg = NONE}, NONE), loc),
- str loc "false")],
- {disc = (TFfi ("Basis", "bool"), loc),
- result = (TFfi ("Basis", "string"), loc)}), loc)
+ TSource => (strcat loc [str loc "s",
+ (EFfiApp ("Basis", "htmlifyInt", [e]), loc)], st)
+
+ | TRecord [] => (str loc "null", st)
+ | TRecord [(x, t)] =>
+ let
+ val (e, st) = quoteExp loc t ((EField (e, x), loc), st)
+ in
+ (strcat loc [str loc ("{_" ^ x ^ ":"),
+ e,
+ str loc "}"], st)
+ end
+ | TRecord ((x, t) :: xts) =>
+ let
+ val (e', st) = quoteExp loc t ((EField (e, x), loc), st)
+ val (es, st) = ListUtil.foldlMap
+ (fn ((x, t), st) =>
+ let
+ val (e, st) = quoteExp loc t ((EField (e, x), loc), st)
+ in
+ (strcat loc [str loc (",_" ^ x ^ ":"), e], st)
+ end)
+ st xts
+ in
+ (strcat loc (str loc ("{_" ^ x ^ ":")
+ :: e'
+ :: es
+ @ [str loc "}"]), st)
+ end
+
+ | TFfi ("Basis", "string") => ((EFfiApp ("Basis", "jsifyString", [e]), loc), st)
+ | TFfi ("Basis", "int") => ((EFfiApp ("Basis", "htmlifyInt", [e]), loc), st)
+ | TFfi ("Basis", "float") => ((EFfiApp ("Basis", "htmlifyFloat", [e]), loc), st)
+
+ | TFfi ("Basis", "bool") => ((ECase (e,
+ [((PCon (Enum, PConFfi {mod = "Basis",
+ datatyp = "bool",
+ con = "True",
+ arg = NONE}, NONE), loc),
+ str loc "true"),
+ ((PCon (Enum, PConFfi {mod = "Basis",
+ datatyp = "bool",
+ con = "False",
+ arg = NONE}, NONE), loc),
+ str loc "false")],
+ {disc = (TFfi ("Basis", "bool"), loc),
+ result = (TFfi ("Basis", "string"), loc)}), loc),
+ st)
| _ => (EM.errorAt loc "Don't know how to embed type in JavaScript";
Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)];
- str loc "ERROR")
+ (str loc "ERROR", st))
fun jsExp mode skip outer =
let
@@ -318,7 +345,7 @@ fun process file =
let
val n = n - inner
in
- (quoteExp (List.nth (outer, n)) (ERel (n - skip), loc), st)
+ quoteExp (List.nth (outer, n)) ((ERel (n - skip), loc), st)
end
| ENamed n =>
@@ -507,8 +534,12 @@ fun process file =
| ECase (e', pes, {result, ...}) =>
if closedUpto inner e andalso List.all (fn (_, e) => closedUpto inner e) pes then
- ((ELet ("js", result, e, quoteExp result (ERel 0, loc)), loc),
- st)
+ let
+ val (e', st) = quoteExp result ((ERel 0, loc), st)
+ in
+ ((ELet ("js", result, e, e'), loc),
+ st)
+ end
else
let
val plen = length pes
diff --git a/tests/jsinj.ur b/tests/jsinj.ur
index bd416720..d9e09fb5 100644
--- a/tests/jsinj.ur
+++ b/tests/jsinj.ur
@@ -7,6 +7,7 @@ cookie int : int
cookie float : float
cookie string : string
cookie bool : bool
+cookie pair : int * float
fun main () : transaction page =
n <- getCookie int;
@@ -25,6 +26,10 @@ fun main () : transaction page =
b <- return (getOpt b True);
sb <- source False;
+ p <- getCookie pair;
+ p <- return (getOpt p (1, 2.3));
+ sp <- source (4, 5.6);
+
return <xml><body>
<dyn signal={n <- signal sn; return <xml>{[n]}</xml>}/>
<a onclick={set sn n}>CHANGE</a><br/>
@@ -37,4 +42,7 @@ fun main () : transaction page =
<dyn signal={b <- signal sb; return <xml>{[b]}</xml>}/>
<a onclick={set sb b}>CHANGE</a><br/>
+
+ <dyn signal={p <- signal sp; return <xml>{[p.1]}, {[p.2]}</xml>}/>
+ <a onclick={set sp p}>CHANGE</a><br/>
</body></xml>