# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1244387598 14400
# Node ID 44c2c089ca15f2a793451def0e2aaf40f7ba393e
# Parent  e4a02e4fa35c61a6fdb4f136fac8ef0d79754875
Start of Option; Basis.current; fix missed cases in Jscomp.isNullable

diff -r e4a02e4fa35c -r 44c2c089ca15 lib/js/urweb.js
--- a/lib/js/urweb.js	Sat Jun 06 15:29:34 2009 -0400
+++ b/lib/js/urweb.js	Sun Jun 07 11:13:18 2009 -0400
@@ -210,6 +210,9 @@
     return {sources : union(xr.sources, yr.sources), data : yr.data};
   };
 }
+function scur(s) {
+  return s().data;
+}
 
 function lastParent() {
   var pos = document;
diff -r e4a02e4fa35c -r 44c2c089ca15 lib/ur/basis.urs
--- a/lib/ur/basis.urs	Sat Jun 06 15:29:34 2009 -0400
+++ b/lib/ur/basis.urs	Sun Jun 07 11:13:18 2009 -0400
@@ -107,6 +107,7 @@
 con signal :: Type -> Type
 val signal_monad : monad signal
 val signal : t ::: Type -> source t -> signal t
+val current : t ::: Type -> signal t -> transaction t
 
 
 (** HTTP operations *)
diff -r e4a02e4fa35c -r 44c2c089ca15 lib/ur/option.ur
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/ur/option.ur	Sun Jun 07 11:13:18 2009 -0400
@@ -0,0 +1,6 @@
+datatype t = datatype Basis.option
+
+fun isSome [a] x =
+    case x of
+        None => False
+      | Some _ => True
diff -r e4a02e4fa35c -r 44c2c089ca15 lib/ur/option.urs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/ur/option.urs	Sun Jun 07 11:13:18 2009 -0400
@@ -0,0 +1,3 @@
+datatype t = datatype Basis.option
+
+val isSome : a ::: Type -> t a -> bool
diff -r e4a02e4fa35c -r 44c2c089ca15 src/jscomp.sml
--- a/src/jscomp.sml	Sat Jun 06 15:29:34 2009 -0400
+++ b/src/jscomp.sml	Sun Jun 07 11:13:18 2009 -0400
@@ -194,6 +194,8 @@
         fun isNullable (t, _) =
             case t of
                 TOption _ => true
+              | TList _ => true
+              | TDatatype (_, ref (Option, _)) => true
               | TRecord [] => true
               | _ => false
 
diff -r e4a02e4fa35c -r 44c2c089ca15 src/mono_print.sml
--- a/src/mono_print.sml	Sat Jun 06 15:29:34 2009 -0400
+++ b/src/mono_print.sml	Sun Jun 07 11:13:18 2009 -0400
@@ -55,9 +55,14 @@
                                             space,
                                             p_typ env t]) xcs,
                             string "}"]
-      | TDatatype (n, _) =>
+      | TDatatype (n, ref (dk, _)) =>
         ((if !debug then
-              string (#1 (E.lookupDatatype env n) ^ "__" ^ Int.toString n)
+              string (#1 (E.lookupDatatype env n) ^ "__" ^ Int.toString n  ^ "["
+                      ^ (case dk of
+                             Option => "Option"
+                           | Enum => "Enum"
+                           | Default => "Default")
+                      ^ "]")
           else
               string (#1 (E.lookupDatatype env n)))
          handle E.UnboundNamed _ => string ("UNBOUND_DATATYPE_" ^ Int.toString n))
diff -r e4a02e4fa35c -r 44c2c089ca15 src/monoize.sml
--- a/src/monoize.sml	Sat Jun 06 15:29:34 2009 -0400
+++ b/src/monoize.sml	Sun Jun 07 11:13:18 2009 -0400
@@ -1245,6 +1245,18 @@
                                       loc)), loc)), loc),
                  fm)
             end
+          | L.ECApp ((L.EFfi ("Basis", "current"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("src", (L'.TSource, loc),
+                           (L'.TFun ((L'.TRecord [], loc), t), loc),
+                           (L'.EAbs ("_", (L'.TRecord [], loc), t,
+                                     (L'.EFfiApp ("Basis", "current",
+                                                  [(L'.ERel 1, loc)]),
+                                      loc)), loc)), loc),
+                 fm)
+            end
 
           | L.EFfiApp ("Basis", "spawn", [e]) =>
             let
diff -r e4a02e4fa35c -r 44c2c089ca15 src/settings.sml
--- a/src/settings.sml	Sat Jun 06 15:29:34 2009 -0400
+++ b/src/settings.sml	Sun Jun 07 11:13:18 2009 -0400
@@ -98,6 +98,7 @@
 
 val clientBase = basis ["get",
                         "set",
+                        "current",
                         "alert",
                         "recv",
                         "sleep",
@@ -125,6 +126,7 @@
 
 val jsFuncsBase = basisM [("alert", "alert"),
                           ("get_client_source", "sg"),
+                          ("current", "scur"),
                           ("htmlifyBool", "bs"),
                           ("htmlifyFloat", "ts"),
                           ("htmlifyInt", "ts"),