diff options
| -rw-r--r-- | src/jscomp.sml | 83 | ||||
| -rw-r--r-- | tests/jsinj.ur | 8 |
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> |