Mercurial > urweb
changeset 584:101eb0058136
Used an option as a source
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 01 Jan 2009 10:49:42 -0500 |
| parents | 1fd4c041634e |
| children | 35471f067980 |
| files | jslib/urweb.js src/jscomp.sml tests/stypes.ur |
| diffstat | 3 files changed, 92 insertions(+), 18 deletions(-) [+] |
line wrap: on
line diff
--- 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") }
--- 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
--- 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>