summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-01-02 13:03:22 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-01-02 13:03:22 -0500
commit06334cca38dfb430071426e79c98c685b7d53a8c (patch)
treefe408da7de890226e6247a4446ecf1f155e2ed82
parent5b54ae6f4d5896428cdab7b213471498fa8a0b8a (diff)
Injected an option
-rw-r--r--src/jscomp.sml44
-rw-r--r--tests/jsinj.ur10
2 files changed, 43 insertions, 11 deletions
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 44012a4f..270dedf8 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -156,6 +156,12 @@ fun process file =
fun str loc s = (EPrim (Prim.String s), loc)
+ fun isNullable (t, _) =
+ case t of
+ TOption _ => true
+ | TRecord [] => true
+ | _ => false
+
fun quoteExp loc (t : typ) (e, st) =
case #1 t of
TSource => (strcat loc [str loc "s",
@@ -207,6 +213,23 @@ fun process file =
result = (TFfi ("Basis", "string"), loc)}), loc),
st)
+ | TOption t =>
+ let
+ val (e', st) = quoteExp loc t ((ERel 0, loc), st)
+ in
+ ((ECase (e,
+ [((PNone t, loc),
+ str loc "null"),
+ ((PSome (t, (PVar ("x", t), loc)), loc),
+ if isNullable t then
+ strcat loc [str loc "{v:", e', str loc "}"]
+ else
+ e')],
+ {disc = (TOption t, loc),
+ result = (TFfi ("Basis", "string"), loc)}), loc),
+ st)
+ end
+
| _ => (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 loc "ERROR", st))
@@ -228,12 +251,6 @@ fun process file =
| PConFfi {mod = "Basis", con = "False", ...} => str "false"
| PConFfi {con, ...} => str ("\"_" ^ con ^ "\"")
- fun isNullable (t, _) =
- case t of
- TOption _ => true
- | TRecord [] => true
- | _ => false
-
fun unsupported s =
(EM.errorAt loc (s ^ " in code to be compiled to JavaScript[2]");
(str "ERROR", st))
@@ -320,11 +337,16 @@ fun process file =
str ":",
succ,
str ")"]
- | PSome (_, p) => strcat [str ("(d" ^ Int.toString depth ^ "?"),
- jsPat depth inner p succ fail,
- str ":",
- fail,
- str ")"]
+ | PSome (t, p) => strcat (str ("(d" ^ Int.toString depth ^ "?")
+ :: (if isNullable t then
+ [str ("d" ^ Int.toString depth
+ ^ "=d" ^ Int.toString depth ^ ".v")]
+ else
+ [])
+ @ [jsPat depth inner p succ fail,
+ str ":",
+ fail,
+ str ")"])
fun deStrcat (e, _) =
case e of
diff --git a/tests/jsinj.ur b/tests/jsinj.ur
index d9e09fb5..632a2839 100644
--- a/tests/jsinj.ur
+++ b/tests/jsinj.ur
@@ -8,6 +8,7 @@ cookie float : float
cookie string : string
cookie bool : bool
cookie pair : int * float
+cookie option : option int
fun main () : transaction page =
n <- getCookie int;
@@ -30,6 +31,10 @@ fun main () : transaction page =
p <- return (getOpt p (1, 2.3));
sp <- source (4, 5.6);
+ o <- getCookie option;
+ o <- return (getOpt o (Some 1));
+ op <- source None;
+
return <xml><body>
<dyn signal={n <- signal sn; return <xml>{[n]}</xml>}/>
<a onclick={set sn n}>CHANGE</a><br/>
@@ -45,4 +50,9 @@ fun main () : transaction page =
<dyn signal={p <- signal sp; return <xml>{[p.1]}, {[p.2]}</xml>}/>
<a onclick={set sp p}>CHANGE</a><br/>
+
+ <dyn signal={o <- signal op; case o of
+ None => return <xml>None</xml>
+ | Some x => return <xml>{[x]}</xml>}/>
+ <a onclick={set op o}>CHANGE</a><br/>
</body></xml>