# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1230824982 18000
# Node ID 101eb0058136f2556c137a1a756b5ab010313d10
# Parent  1fd4c041634e02b93e04a9f3b74b919057323e19
Used an option as a source

diff -r 1fd4c041634e -r 101eb0058136 jslib/urweb.js
--- a/jslib/urweb.js	Thu Jan 01 10:18:20 2009 -0500
+++ b/jslib/urweb.js	Thu Jan 01 10:49:42 2009 -0500
@@ -42,3 +42,4 @@
 }
 
 function ts(x) { return x.toString() }
+function pf() { alert("Pattern match failure") }
diff -r 1fd4c041634e -r 101eb0058136 src/jscomp.sml
--- a/src/jscomp.sml	Thu Jan 01 10:18:20 2009 -0500
+++ b/src/jscomp.sml	Thu Jan 01 10:49:42 2009 -0500
@@ -133,25 +133,64 @@
                       | _ => (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")
+
+                fun jsPrim p =
+                    case p of
+                        Prim.String s =>
+                        str ("\""
+                             ^ String.translate (fn #"'" =>
+                                                    if mode = Attribute then
+                                                        "\\047"
+                                                    else
+                                                        "'"
+                                                  | #"\"" => "\\\""
+                                                  | #"<" =>
+                                                    if mode = Script then
+                                                        "<"
+                                                    else
+                                                        "\\074"
+                                                  | #"\\" => "\\\\"
+                                                  | ch => String.str ch) s
+                             ^ "\"")
+                      | _ => str (Prim.toString p)
+
+                fun jsPat inner (p, _) succ fail =
+                    case p of
+                        PWild => succ
+                      | PVar _ => strcat [str ("(_" ^ Int.toString (len + inner) ^ "=d,"),
+                                          succ,
+                                          str ")"]
+                      | PPrim p => strcat [str "(d==",
+                                           jsPrim p,
+                                           str "?",
+                                           succ,
+                                           str ":",
+                                           fail,
+                                           str ")"]
+                      | PCon _ => raise Fail "jsPat: PCon"
+                      | PRecord xps =>
+                        let
+                            val (_, succ) = foldl
+                                            (fn ((x, p, _), (inner, succ)) =>
+                                                (inner + E.patBindsN p,
+                                                 jsPat inner p succ fail))
+                                            (inner, succ) xps
+                        in
+                            succ
+                        end
+                      | PNone _ => strcat [str "(d?",
+                                           fail,
+                                           str ":",
+                                           succ,
+                                           str ")"]
+                      | PSome (_, p) => strcat [str "(d?",
+                                                jsPat inner p succ fail,
+                                                str ":",
+                                                fail,
+                                                str ")"]
             in
                 case #1 e of
-                    EPrim (Prim.String s) =>
-                    (str ("\""
-                          ^ String.translate (fn #"'" =>
-                                                 if mode = Attribute then
-                                                     "\\047"
-                                                 else
-                                                     "'"
-                                               | #"\"" => "\\\""
-                                               | #"<" =>
-                                                 if mode = Script then
-                                                     "<"
-                                                 else
-                                                     "\\074"
-                                               | #"\\" => "\\\\"
-                                               | ch => String.str ch) s
-                          ^ "\""), st)
-                  | EPrim p => (str (Prim.toString p), st)
+                    EPrim p => (jsPrim p, st)
                   | ERel n =>
                     if n < inner then
                         (str ("_" ^ var n), st)
@@ -317,7 +356,36 @@
                                  str ("._" ^ x)], st)
                     end
 
-                  | ECase _ => raise Fail "Jscomp: ECase"
+                  | ECase (e, pes, _) =>
+                    let
+                        val plen = length pes
+
+                        val (cases, st) = ListUtil.foldliMap
+                                              (fn (i, (p, e), st) =>
+                                                  let
+                                                      val (e, st) = jsE (inner + E.patBindsN p) (e, st)
+                                                      val fail =
+                                                          if i = plen - 1 then
+                                                              str "pf()"
+                                                          else
+                                                              str ("c" ^ Int.toString (i+1) ^ "()")
+                                                      val c = jsPat inner p e fail
+                                                  in
+                                                      (strcat [str ("c" ^ Int.toString i ^ "=function(){return "),
+                                                               c,
+                                                               str "},"],
+                                                       st)
+                                                  end)
+                                              st pes
+
+                        val (e, st) = jsE inner (e, st)
+                    in
+                        (strcat (str "("
+                                 :: List.revAppend (cases,
+                                                    [str "d=",
+                                                     e,
+                                                     str ",c0())"])), st)
+                    end
 
                   | EStrcat (e1, e2) =>
                     let
diff -r 1fd4c041634e -r 101eb0058136 tests/stypes.ur
--- a/tests/stypes.ur	Thu Jan 01 10:18:20 2009 -0500
+++ b/tests/stypes.ur	Thu Jan 01 10:49:42 2009 -0500
@@ -11,4 +11,9 @@
       <dyn signal={n <- signal sFloat; return <xml>{[n + 1.0]}</xml>}/> <a onclick={set sFloat 4.56}>Change</a><br/>
 
       <dyn signal={p <- signal sBoth; return <xml>{[p.1]}, {[p.2]}</xml>}/> <a onclick={set sBoth (8, 100.001)}>Change</a><br/>
+
+      <dyn signal={o <- signal sOpt; case o of
+                                         None => return <xml>None</xml>
+                                       | Some n => return <xml>{[n]}</xml>}/>
+        <a onclick={set sOpt (Some 7)}>Change</a><br/>
     </body></xml>