Injected an option

2 files changed, 43 insertions, 11 deletions

diff --git a/src/jscomp.sml b/src/jscomp.sml
index 44012a4f..270dedf8 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -156,6 +156,12 @@ fun process file =
 
         fun str loc s = (EPrim (Prim.String s), loc)
 
+        fun isNullable (t, _) =
+            case t of
+                TOption _ => true
+              | TRecord [] => true
+              | _ => false
+
         fun quoteExp loc (t : typ) (e, st) =
             case #1 t of
                 TSource => (strcat loc [str loc "s",
@@ -207,6 +213,23 @@ fun process file =
                                                     result = (TFfi ("Basis", "string"), loc)}), loc),
                                            st)
 
+              | TOption t =>
+                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),
+                     st)
+                end
+
               | _ => (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", st))
@@ -228,12 +251,6 @@ fun process file =
                               | PConFfi {mod = "Basis", con = "False", ...} => str "false"
                               | PConFfi {con, ...} => str ("\"_" ^ con ^ "\"")
 
-                        fun isNullable (t, _) =
-                            case t of
-                                TOption _ => true
-                              | TRecord [] => true
-                              | _ => false
-
                         fun unsupported s =
                             (EM.errorAt loc (s ^ " in code to be compiled to JavaScript[2]");
                              (str "ERROR", st))
@@ -320,11 +337,16 @@ fun process file =
                                                    str ":",
                                                    succ,
                                                    str ")"]
-                              | PSome (_, p) => strcat [str ("(d" ^ Int.toString depth ^ "?"),
-                                                        jsPat depth inner p succ fail,
-                                                        str ":",
-                                                        fail,
-                                                        str ")"]
+                              | PSome (t, p) => strcat (str ("(d" ^ Int.toString depth ^ "?")
+                                                        :: (if isNullable t then
+                                                                [str ("d" ^ Int.toString depth
+                                                                      ^ "=d" ^ Int.toString depth ^ ".v")]
+                                                            else
+                                                                [])
+                                                        @ [jsPat depth inner p succ fail,
+                                                           str ":",
+                                                           fail,
+                                                           str ")"])
 
                         fun deStrcat (e, _) =
                             case e of
diff --git a/tests/jsinj.ur b/tests/jsinj.ur
index d9e09fb5..632a2839 100644
--- a/tests/jsinj.ur
+++ b/tests/jsinj.ur
@@ -8,6 +8,7 @@ cookie float : float
 cookie string : string
 cookie bool : bool
 cookie pair : int * float
+cookie option : option int
 
 fun main () : transaction page =
     n <- getCookie int;
@@ -30,6 +31,10 @@ fun main () : transaction page =
     p <- return (getOpt p (1, 2.3));
     sp <- source (4, 5.6);
 
+    o <- getCookie option;
+    o <- return (getOpt o (Some 1));
+    op <- source None;
+
     return <xml><body>
       <dyn signal={n <- signal sn; return <xml>{[n]}</xml>}/>
       <a onclick={set sn n}>CHANGE</a><br/>
@@ -45,4 +50,9 @@ fun main () : transaction page =
 
       <dyn signal={p <- signal sp; return <xml>{[p.1]}, {[p.2]}</xml>}/>
       <a onclick={set sp p}>CHANGE</a><br/>
+
+      <dyn signal={o <- signal op; case o of
+                                       None => return <xml>None</xml>
+                                     | Some x => return <xml>{[x]}</xml>}/>
+      <a onclick={set op o}>CHANGE</a><br/>
     </body></xml>