Corify FFI datatypes properly; eliminate nested JavaScript markers

3 files changed, 62 insertions, 28 deletions

diff --git a/src/corify.sml b/src/corify.sml
index 6793cd32..a4979790 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -824,6 +824,9 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) =
                                            ListUtil.foldlMap
                                                (fn ((x, n, xs, xnts), (ds', st, cmap, conmap)) =>
                                                    let
+                                                       val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc))
+                                                                      k xs
+
                                                        val dk = ElabUtil.classifyDatatype xnts
                                                        val (st, n') = St.bindCon st x n
                                                        val (xnts, (ds', st, cmap, conmap)) =
@@ -885,12 +888,14 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) =
                                                                        ((x', n, to),
                                                                         (d :: ds', st, cmap, conmap))
                                                                    end) (ds', st, cmap, conmap) xnts
+
+                                                       val d = (L'.DCon (x, n', k', (L'.CFfi (m, x), loc)), loc)
                                                    in
-                                                       ((x, n', xs, xnts), (ds', st, cmap, conmap))
+                                                       ((x, n', xs, xnts), (d :: ds', st, cmap, conmap))
                                                    end)
                                            ([], st, cmap, conmap) dts
                                    in
-                                       (ds' @ (L'.DDatatype dts, loc) :: ds,
+                                       (List.revAppend (ds', ds),
                                         cmap,
                                         conmap,
                                         st,
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 2f55d2da..65a81ea8 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -168,6 +168,21 @@ val compact =
                           case b of
                               U.Exp.RelE _ => inner+1
                             | _ => inner}
+
+val desourceify' =
+    U.Exp.map {typ = fn t => t,
+               exp = fn e =>
+                        case e of
+                            EJavaScript (_, e, _) => #1 e
+                          | _ => e}
+    
+val desourceify =
+    U.File.map {typ = fn t => t,
+                exp = fn e =>
+                         case e of
+                             EJavaScript (m, e, eo) => EJavaScript (m, desourceify' e, eo)
+                           | _ => e,
+                decl = fn d => d}
     
 fun process file =
     let
@@ -251,16 +266,19 @@ fun process file =
                 let
                     val (e', st) = quoteExp loc t ((ERel 0, loc), st)
                 in
-                    ((ECase (e,
-                             [((PNone t, loc),
-                               str loc "null"),
-                              ((PSome (t, (PVar ("x", t), loc)), loc),
-                               if isNullable t then
-                                   strcat loc [str loc "{v:", e', str loc "}"]
-                               else
-                                   e')],
-                             {disc = (TOption t, loc),
-                              result = (TFfi ("Basis", "string"), loc)}), loc),
+                    (case #1 e' of
+                        EPrim (Prim.String "ERROR") => raise Fail "UHOH"
+                      | _ =>
+                        (ECase (e,
+                                [((PNone t, loc),
+                                  str loc "null"),
+                                 ((PSome (t, (PVar ("x", t), loc)), loc),
+                                  if isNullable t then
+                                      strcat loc [str loc "{v:", e', str loc "}"]
+                                  else
+                                      e')],
+                                {disc = (TOption t, loc),
+                                 result = (TFfi ("Basis", "string"), loc)}), loc),
                      st)
                 end
 
@@ -578,7 +596,8 @@ fun process file =
                                                   ^ (if isNullable t then
                                                          ".v,"
                                                      else
-                                                         "")),
+                                                         "")
+                                                  ^ ","),
                                              jsPat (depth+1) inner p succ fail,
                                              str "):",
                                              fail,
@@ -657,13 +676,9 @@ fun process file =
                                 (str ("_" ^ var n), st)
                             else
                                 let
-                                    (*val () = Print.prefaces "ERel"
-                                             [("n", Print.PD.string (Int.toString n)),
-                                              ("inner", Print.PD.string (Int.toString inner)),
-                                              ("eq", MonoPrint.p_exp MonoEnv.empty
-                                                                     (#1 (quoteExp (List.nth (outer, n - inner))
-                                                                                   ((ERel (n - inner), loc), st))))]*)
                                     val n = n - inner
+                                    (*val () = Print.prefaces "quote" [("t", MonoPrint.p_typ MonoEnv.empty
+                                                                           (List.nth (outer, n)))]*)
                                 in
                                     quoteExp (List.nth (outer, n)) ((ERel n, loc), st)
                                 end
@@ -1083,7 +1098,7 @@ fun process file =
             U.Decl.foldMapB {typ = fn x => x,
                              exp = fn (env, e, st) =>
                                       let
-                                          fun doCode m env orig e =
+                                          fun doCode m env e =
                                               let
                                                   val len = length env
                                                   fun str s = (EPrim (Prim.String s), #2 e)
@@ -1093,16 +1108,32 @@ fun process file =
                                                                  fn i => str ("var _" ^ Int.toString (len + i) ^ ";"))
                                                   val old = e
                                                   val (e, st) = jsExp m env 0 (e, st)
+                                                  val e =
+                                                      case locals of
+                                                          [] => e
+                                                        | _ =>
+                                                          strcat (#2 e) (str "(function(){"
+                                                                         :: locals
+                                                                         @ [str "return ",
+                                                                            e,
+                                                                            str "}())"])
                                               in
                                                   (*Print.prefaces "jsify" [("old", MonoPrint.p_exp MonoEnv.empty old),
                                                                           ("new", MonoPrint.p_exp MonoEnv.empty e)];*)
-                                                  (EJavaScript (m, orig, SOME (strcat (#2 e) (locals @ [e]))), st)
+                                                  (EJavaScript (m, old, SOME e), st)
                                               end
                                       in
                                           case e of
-                                              EJavaScript (m, orig, NONE) =>
+                                              (*EJavaScript (m as Source t, orig, NONE) =>
+                                              let
+                                                  val loc = #2 orig
+                                                  val (e, st) = doCode m (t :: env) (ERel 0, loc)
+                                              in
+                                                  (ELet ("x", t, orig, (e, loc)), st)
+                                              end
+                                            |*) EJavaScript (m, orig, NONE) =>
                                               (foundJavaScript := true;
-                                               doCode m env orig orig)
+                                               doCode m env orig)
                                             | _ => (e, st)
                                       end,
                              decl = fn (_, e, st) => (e, st),
@@ -1132,7 +1163,7 @@ fun process file =
                         listInjectors = TM.empty,
                         decoders = IM.empty,
                         maxName = U.File.maxName file + 1}
-                       file
+                       (desourceify file)
 
         val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"})
         fun lines acc =
diff --git a/src/monoize.sml b/src/monoize.sml
index 50bd04e8..8ced53bb 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2538,9 +2538,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
 
                   | "dyn" =>
                     (case attrs of
-                         [("Signal", (L'.EApp ((L'.EAbs (_, _, _, (L'.ESignalReturn (L'.ERel 0, _), _)), _),
+                         (*[("Signal", (L'.EApp ((L'.EAbs (_, _, _, (L'.ESignalReturn (L'.ERel 0, _), _)), _),
                                                e), _), _)] => (e, fm)
-                       | [("Signal", e, _)] =>
+                       |*) [("Signal", e, _)] =>
                          ((L'.EStrcat
                                ((L'.EPrim (Prim.String "<span><script type=\"text/javascript\">dyn("), loc),
                                 (L'.EStrcat ((L'.EJavaScript (L'.Script, e, NONE), loc),
@@ -3188,8 +3188,6 @@ datatype expungable = Client | Channel
 
 fun monoize env file =
     let
-
-
         (* Calculate which exported functions need cookie signature protection *)
         val rcook = foldl (fn ((d, _), rcook) =>
                               case d of