diff options
author | 2009-01-02 13:03:22 -0500 | |
---|---|---|
committer | 2009-01-02 13:03:22 -0500 | |
commit | c3b07501b5b2eeac8a88b7ded6a081e95b99d406 (patch) | |
tree | fe408da7de890226e6247a4446ecf1f155e2ed82 | |
parent | 93cd18e71b9c57650914ec11bb9a19e9befe7eda (diff) |
Injected an option
-rw-r--r-- | src/jscomp.sml | 44 | ||||
-rw-r--r-- | tests/jsinj.ur | 10 |
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> |