diff src/jscomp.sml @ 579:0094e0242100

Propagated a source change into a dynamic document element
author Adam Chlipala <adamc@hcoop.net>
date Tue, 30 Dec 2008 15:53:04 -0500
parents 1e589a60b86f
children 66463006f893
line wrap: on
line diff
--- a/src/jscomp.sml	Tue Dec 30 11:33:31 2008 -0500
+++ b/src/jscomp.sml	Tue Dec 30 15:53:04 2008 -0500
@@ -35,7 +35,8 @@
 
 val funcs = [(("Basis", "alert"), "alert"),
              (("Basis", "htmlifyString"), "escape"),
-             (("Basis", "new_client_source"), "sc")]
+             (("Basis", "new_client_source"), "sc"),
+             (("Basis", "set_client_source"), "sv")]
 
 structure FM = BinaryMapFn(struct
                            type ord_key = string * string
@@ -94,7 +95,7 @@
       | [x] => x
       | x :: es' => (EStrcat (x, strcat loc es'), loc)
 
-fun jsExp mode outer =
+fun jsExp mode skip outer =
     let
         val len = length outer
 
@@ -126,7 +127,10 @@
                     case #1 t of
                         TSource => strcat [str "s",
                                            (EFfiApp ("Basis", "htmlifyInt", [e]), loc)]
+                      | TRecord [] => str "null"
+                      | TFfi ("Basis", "string") => e
                       | _ => (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 "ERROR")
             in
                 case #1 e of
@@ -154,7 +158,7 @@
                         let
                             val n = n - inner
                         in
-                            (quoteExp (List.nth (outer, n)) (ERel n, loc), st)
+                            (quoteExp (List.nth (outer, n)) (ERel (n - skip), loc), st)
                         end
                   | ENamed _ => raise Fail "Named"
                   | ECon (_, pc, NONE) => (patCon pc, st)
@@ -403,7 +407,7 @@
     U.Decl.foldMapB {typ = fn x => x,
                      exp = fn (env, e, st) =>
                               let
-                                  fun doCode m env orig e =
+                                  fun doCode m skip env orig e =
                                       let
                                           val len = length env
                                           fun str s = (EPrim (Prim.String s), #2 e)
@@ -411,14 +415,14 @@
                                           val locals = List.tabulate
                                                            (varDepth e,
                                                          fn i => str ("var uwr" ^ Int.toString (len + i) ^ ";"))
-                                          val (e, st) = jsExp m env 0 (e, st)
+                                          val (e, st) = jsExp m skip env 0 (e, st)
                                       in
                                           (EJavaScript (m, orig, SOME (strcat (#2 e) (locals @ [e]))), st)
                                       end
                               in
                                   case e of
-                                      EJavaScript (m, orig as (EAbs (_, t, _, e), _), _) => doCode m (t :: env) orig e
-                                    | EJavaScript (m, e, _) => doCode m env e e
+                                      EJavaScript (m, orig as (EAbs (_, t, _, e), _), _) => doCode m 1 (t :: env) orig e
+                                    | EJavaScript (m, e, _) => doCode m 0 env e e
                                     | _ => (e, st)
                               end,
                      decl = fn (_, e, st) => (e, st),