diff options
author | 2009-01-01 10:49:42 -0500 | |
---|---|---|
committer | 2009-01-01 10:49:42 -0500 | |
commit | 914c437ab2251be982c4c19f659589360bf41a59 (patch) | |
tree | 153e0b43138171ab20f686aff9c6612f62729f4a | |
parent | bad5b1a5635b3db83b4178c200e9a83d49ffc2d7 (diff) |
Used an option as a source
-rw-r--r-- | jslib/urweb.js | 1 | ||||
-rw-r--r-- | src/jscomp.sml | 104 | ||||
-rw-r--r-- | tests/stypes.ur | 5 |
3 files changed, 92 insertions, 18 deletions
diff --git a/jslib/urweb.js b/jslib/urweb.js index e661a739..fec37d1b 100644 --- a/jslib/urweb.js +++ b/jslib/urweb.js @@ -42,3 +42,4 @@ function dyn(s) { } function ts(x) { return x.toString() } +function pf() { alert("Pattern match failure") } diff --git a/src/jscomp.sml b/src/jscomp.sml index c6299f83..91ec56a7 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -133,25 +133,64 @@ fun jsExp mode skip outer = | _ => (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 @@ fun jsExp mode skip outer = 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 --git a/tests/stypes.ur b/tests/stypes.ur index 4d918a91..1ac70834 100644 --- a/tests/stypes.ur +++ b/tests/stypes.ur @@ -11,4 +11,9 @@ fun main () : transaction page = <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> |