Mercurial > urweb
changeset 593:f277f5faebcd
Injected a record
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Fri, 02 Jan 2009 12:42:39 -0500 |
| parents | a8be5a2068a5 |
| children | 55829473f6a7 |
| files | src/jscomp.sml tests/jsinj.ur |
| diffstat | 2 files changed, 63 insertions(+), 24 deletions(-) [+] |
line wrap: on
line diff
--- a/src/jscomp.sml Thu Jan 01 16:11:42 2009 -0500 +++ b/src/jscomp.sml Fri Jan 02 12:42:39 2009 -0500 @@ -156,33 +156,60 @@ 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" + TSource => (strcat loc [str loc "s", + (EFfiApp ("Basis", "htmlifyInt", [e]), loc)], st) - | TFfi ("Basis", "string") => (EFfiApp ("Basis", "jsifyString", [e]), loc) - | TFfi ("Basis", "int") => (EFfiApp ("Basis", "htmlifyInt", [e]), loc) - | TFfi ("Basis", "float") => (EFfiApp ("Basis", "htmlifyFloat", [e]), loc) + | 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", "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) + | 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 @@ 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 @@ | 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
--- a/tests/jsinj.ur Thu Jan 01 16:11:42 2009 -0500 +++ b/tests/jsinj.ur Fri Jan 02 12:42:39 2009 -0500 @@ -7,6 +7,7 @@ cookie float : float cookie string : string cookie bool : bool +cookie pair : int * float fun main () : transaction page = n <- getCookie int; @@ -25,6 +26,10 @@ 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 @@ <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>