From 5b54ae6f4d5896428cdab7b213471498fa8a0b8a Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Fri, 2 Jan 2009 12:42:39 -0500
Subject: Injected a record

---
 src/jscomp.sml | 83 ++++++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 57 insertions(+), 26 deletions(-)

(limited to 'src')

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
-- 
cgit v1.2.3