Mercurial > urweb
changeset 595:02c8ab9f3e8b
Injected an enumeration
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 08 Jan 2009 09:57:45 -0500 |
| parents | 55829473f6a7 |
| children | d1ec54288b1a |
| files | src/jscomp.sml tests/jsinj.ur |
| diffstat | 2 files changed, 87 insertions(+), 14 deletions(-) [+] |
line wrap: on
line diff
--- a/src/jscomp.sml Fri Jan 02 13:03:22 2009 -0500 +++ b/src/jscomp.sml Thu Jan 08 09:57:45 2009 -0500 @@ -58,7 +58,9 @@ type state = { decls : decl list, script : string list, - included : IS.set + included : IS.set, + injectors : int IM.map, + maxName : int } fun varDepth (e, _) = @@ -147,12 +149,13 @@ fun process file = let - val nameds = foldl (fn ((DVal (_, n, t, e, _), _), nameds) => IM.insert (nameds, n, e) - | ((DValRec vis, _), nameds) => - foldl (fn ((_, n, _, e, _), nameds) => IM.insert (nameds, n, e)) - nameds vis - | (_, nameds) => nameds) - IM.empty file + val nameds = + foldl (fn ((DVal (_, n, t, e, _), _), nameds) => IM.insert (nameds, n, e) + | ((DValRec vis, _), nameds) => + foldl (fn ((_, n, _, e, _), nameds) => IM.insert (nameds, n, e)) + nameds vis + | (_, state) => state) + IM.empty file fun str loc s = (EPrim (Prim.String s), loc) @@ -230,6 +233,50 @@ st) end + | TDatatype (n, ref (dk, cs)) => + (case IM.find (#injectors st, n) of + SOME n' => ((EApp ((ENamed n', loc), e), loc), st) + | NONE => + let + val dk = ElabUtil.classifyDatatype cs + + val n' = #maxName st + val st = {decls = #decls st, + script = #script st, + included = #included st, + injectors = IM.insert (#injectors st, n, n'), + maxName = n' + 1} + + val (pes, st) = ListUtil.foldlMap + (fn ((_, cn, NONE), st) => + (((PCon (dk, PConVar cn, NONE), loc), + str loc (Int.toString cn)), + st) + | ((_, cn, SOME t), st) => + let + val (e, st) = quoteExp loc t ((ERel 0, loc), st) + in + (((PCon (dk, PConVar cn, SOME (PVar ("x", t), loc)), loc), + e), + st) + end) + st cs + + val s = (TFfi ("Basis", "string"), loc) + val body = (ECase ((ERel 0, loc), pes, + {disc = t, result = s}), loc) + val body = (EAbs ("x", t, s, body), loc) + + val st = {decls = (DValRec [("jsify", n', (TFun (t, s), loc), + body, "jsify")], loc) :: #decls st, + script = #script st, + included = #included st, + injectors = #injectors st, + maxName = #maxName st} + in + ((EApp ((ENamed n', loc), e), 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)) @@ -382,7 +429,9 @@ let val st = {decls = #decls st, script = #script st, - included = IS.add (#included st, n)} + included = IS.add (#included st, n), + injectors = #injectors st, + maxName = #maxName st} val (e, st) = jsExp mode skip [] 0 (e, st) val e = deStrcat e @@ -391,7 +440,9 @@ in {decls = #decls st, script = sc :: #script st, - included = #included st} + included = #included st, + injectors = #injectors st, + maxName = #maxName st} end in (str ("_n" ^ Int.toString n), st) @@ -717,13 +768,17 @@ (List.revAppend (#decls st, [d]), {decls = [], script = #script st, - included = #included st}) + included = #included st, + injectors = #injectors st, + maxName = #maxName st}) end val (ds, st) = ListUtil.foldlMapConcat doDecl {decls = [], script = [], - included = IS.empty} + included = IS.empty, + injectors = IM.empty, + maxName = U.File.maxName file + 1} file val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"})
--- a/tests/jsinj.ur Fri Jan 02 13:03:22 2009 -0500 +++ b/tests/jsinj.ur Thu Jan 08 09:57:45 2009 -0500 @@ -3,12 +3,23 @@ None => v | Some x => x +datatype color = Red | White | Blue + +fun colorToString c = + case c of + Red => "R" + | White => "W" + | Blue => "B" + +val show_color = mkShow colorToString + cookie int : int cookie float : float cookie string : string cookie bool : bool cookie pair : int * float cookie option : option int +cookie color : color fun main () : transaction page = n <- getCookie int; @@ -33,7 +44,11 @@ o <- getCookie option; o <- return (getOpt o (Some 1)); - op <- source None; + so <- source None; + + c <- getCookie color; + c <- return (getOpt c White); + sc <- source Blue; return <xml><body> <dyn signal={n <- signal sn; return <xml>{[n]}</xml>}/> @@ -51,8 +66,11 @@ <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 + <dyn signal={o <- signal so; case o of None => return <xml>None</xml> | Some x => return <xml>{[x]}</xml>}/> - <a onclick={set op o}>CHANGE</a><br/> + <a onclick={set so o}>CHANGE</a><br/> + + <dyn signal={c <- signal sc; return <xml>{[c]}</xml>}/> + <a onclick={set sc c}>CHANGE</a><br/> </body></xml>