diff src/jscomp.sml @ 594:55829473f6a7

Injected an option
author Adam Chlipala <adamc@hcoop.net>
date Fri, 02 Jan 2009 13:03:22 -0500
parents f277f5faebcd
children 02c8ab9f3e8b
line wrap: on
line diff
--- a/src/jscomp.sml	Fri Jan 02 12:42:39 2009 -0500
+++ b/src/jscomp.sml	Fri Jan 02 13:03:22 2009 -0500
@@ -156,6 +156,12 @@
 
         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 @@
                                                     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 @@
                               | 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 @@
                                                    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