Mercurial > urweb
diff src/jscomp.sml @ 593:f277f5faebcd
Injected a record
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Fri, 02 Jan 2009 12:42:39 -0500 |
parents | a8be5a2068a5 |
children | 55829473f6a7 |
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