diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-04-16 13:47:20 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-04-16 13:47:20 -0400 |
| commit | c4ddce15e08c0b2f26f7ff773b87654fc5f92938 (patch) | |
| tree | d0d08dc15edc8e7dc1f916a592160f8c9e561bd2 /src | |
| parent | b6fef1cc8832978bd9673df1a968d06d42bc2eb0 (diff) | |
Some client-side error handling
Diffstat (limited to 'src')
| -rw-r--r-- | src/jscomp.sml | 11 | ||||
| -rw-r--r-- | src/mono_reduce.sml | 8 | ||||
| -rw-r--r-- | src/mono_util.sml | 28 |
3 files changed, 38 insertions, 9 deletions
diff --git a/src/jscomp.sml b/src/jscomp.sml index d7a74fab..f839a67d 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -53,7 +53,11 @@ val funcs = [(("Basis", "alert"), "alert"), (("Basis", "strcat"), "cat"), (("Basis", "intToString"), "ts"), (("Basis", "floatToString"), "ts"), - (("Basis", "onError"), "onError")] + (("Basis", "onError"), "onError"), + (("Basis", "onFail"), "onFail"), + (("Basis", "onConnectFail"), "onConnectFail"), + (("Basis", "onDisconnect"), "onDisconnect"), + (("Basis", "onServerError"), "onServerError")] structure FM = BinaryMapFn(struct type ord_key = string * string @@ -764,6 +768,11 @@ fun process file = end | EBinop (s, e1, e2) => let + val s = + case s of + "!strcmp" => "==" + | _ => s + val (e1, st) = jsE inner (e1, st) val (e2, st) = jsE inner (e2, st) in diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index 19140b81..4c337e14 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -62,6 +62,10 @@ fun impure (e, _) = | EFfiApp ("Basis", "subscribe", _) => true | EFfiApp ("Basis", "send", _) => true | EFfiApp ("Basis", "onError", _) => true + | EFfiApp ("Basis", "onFail", _) => true + | EFfiApp ("Basis", "onConnectFail", _) => true + | EFfiApp ("Basis", "onDisconnect", _) => true + | EFfiApp ("Basis", "onServerError", _) => true | EFfiApp _ => false | EApp ((EFfi _, _), _) => false | EApp _ => true @@ -287,6 +291,10 @@ fun reduce file = | EFfiApp ("Basis", "subscribe", es) => ffi es | EFfiApp ("Basis", "send", es) => ffi es | EFfiApp ("Basis", "onError", es) => ffi es + | EFfiApp ("Basis", "onFail", es) => ffi es + | EFfiApp ("Basis", "onConnectFail", es) => ffi es + | EFfiApp ("Basis", "onDisconnect", es) => ffi es + | EFfiApp ("Basis", "onServerError", es) => ffi es | EFfiApp (_, _, es) => List.concat (map (summarize d) es) | EApp ((EFfi _, _), e) => summarize d e | EApp _ => diff --git a/src/mono_util.sml b/src/mono_util.sml index 238f65d3..c7309df4 100644 --- a/src/mono_util.sml +++ b/src/mono_util.sml @@ -325,15 +325,19 @@ fun mapfoldB {typ = fc, exp = fe, bind} = fn t' => (EUnurlify (e', t'), loc))) | EJavaScript (m, e, NONE) => - S.map2 (mfe ctx e, - fn e' => - (EJavaScript (m, e', NONE), loc)) + S.bind2 (mfmode ctx m, + fn m' => + S.map2 (mfe ctx e, + fn e' => + (EJavaScript (m', e', NONE), loc))) | EJavaScript (m, e, SOME e2) => - S.bind2 (mfe ctx e, - fn e' => - S.map2 (mfe ctx e2, - fn e2' => - (EJavaScript (m, e', SOME e2'), loc))) + S.bind2 (mfmode ctx m, + fn m' => + S.bind2 (mfe ctx e, + fn e' => + S.map2 (mfe ctx e2, + fn e2' => + (EJavaScript (m, e', SOME e2'), loc)))) | ESignalReturn e => S.map2 (mfe ctx e, @@ -372,6 +376,14 @@ fun mapfoldB {typ = fc, exp = fe, bind} = S.map2 (mfe ctx ek, fn ek' => (ESleep (s', ek'), loc))) + + and mfmode ctx mode = + case mode of + Attribute => S.return2 mode + | Script => S.return2 mode + | Source t => + S.map2 (mft t, + fn t' => Source t') in mfe end |