diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-01-01 11:04:09 -0500 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-01-01 11:04:09 -0500 |
| commit | 5311577e153580fc5dce3671b47cc49bdfd8e1e9 (patch) | |
| tree | a5d174cb097382c951b69390af2fe978a3c35b68 | |
| parent | fdcba593de74be15f49d299084829613dda90463 (diff) | |
Reactive record pattern
| -rw-r--r-- | jslib/urweb.js | 2 | ||||
| -rw-r--r-- | src/jscomp.sml | 23 | ||||
| -rw-r--r-- | tests/stypes.ur | 6 |
3 files changed, 19 insertions, 12 deletions
diff --git a/jslib/urweb.js b/jslib/urweb.js index fec37d1b..904e27e8 100644 --- a/jslib/urweb.js +++ b/jslib/urweb.js @@ -2,7 +2,7 @@ function cons(v, ls) { return { n : ls, v : v }; } function callAll(ls) { - for (; ls; ls = ls.next) + for (; ls; ls = ls.n) ls.v(); } diff --git a/src/jscomp.sml b/src/jscomp.sml index 91ec56a7..ef27dba9 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -154,13 +154,13 @@ fun jsExp mode skip outer = ^ "\"") | _ => str (Prim.toString p) - fun jsPat inner (p, _) succ fail = + fun jsPat depth inner (p, _) succ fail = case p of PWild => succ - | PVar _ => strcat [str ("(_" ^ Int.toString (len + inner) ^ "=d,"), + | PVar _ => strcat [str ("(_" ^ Int.toString (len + inner) ^ "=d" ^ Int.toString depth ^ ","), succ, str ")"] - | PPrim p => strcat [str "(d==", + | PPrim p => strcat [str ("(d" ^ Int.toString depth ^ "=="), jsPrim p, str "?", succ, @@ -173,18 +173,21 @@ fun jsExp mode skip outer = val (_, succ) = foldl (fn ((x, p, _), (inner, succ)) => (inner + E.patBindsN p, - jsPat inner p succ fail)) + strcat [str ("(d" ^ Int.toString (depth+1) ^ "=d" + ^ Int.toString depth ^ "._" ^ x ^ ","), + jsPat (depth+1) inner p succ fail, + str ")"])) (inner, succ) xps in succ end - | PNone _ => strcat [str "(d?", + | PNone _ => strcat [str ("(d" ^ Int.toString depth ^ "?"), fail, str ":", succ, str ")"] - | PSome (_, p) => strcat [str "(d?", - jsPat inner p succ fail, + | PSome (_, p) => strcat [str ("(d" ^ Int.toString depth ^ "?"), + jsPat depth inner p succ fail, str ":", fail, str ")"] @@ -285,7 +288,7 @@ fun jsExp mode skip outer = let val locals = List.tabulate (varDepth e, - fn i => str ("var _" ^ Int.toString (len + inner + i) ^ ";")) + fn i => str ("var _" ^ Int.toString (len + inner + i + 1) ^ ";")) val (e, st) = jsE (inner + 1) (e, st) in (strcat (str ("function(_" @@ -369,7 +372,7 @@ fun jsExp mode skip outer = str "pf()" else str ("c" ^ Int.toString (i+1) ^ "()") - val c = jsPat inner p e fail + val c = jsPat 0 inner p e fail in (strcat [str ("c" ^ Int.toString i ^ "=function(){return "), c, @@ -382,7 +385,7 @@ fun jsExp mode skip outer = in (strcat (str "(" :: List.revAppend (cases, - [str "d=", + [str "d0=", e, str ",c0())"])), st) end diff --git a/tests/stypes.ur b/tests/stypes.ur index 1ac70834..08de343f 100644 --- a/tests/stypes.ur +++ b/tests/stypes.ur @@ -10,7 +10,11 @@ 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={p <- signal sBoth; return <xml>{[p.1]}, {[p.2]}</xml>}/>; + <dyn signal={p <- signal sBoth; case p of + (7, _) => return <xml>Initial</xml> + | (fst, snd) => return <xml>{[fst]}, {[snd]}</xml>}/> + <a onclick={set sBoth (8, 100.001)}>Change</a><br/> <dyn signal={o <- signal sOpt; case o of None => return <xml>None</xml> |