Mercurial > urweb
diff src/jscomp.sml @ 813:7b380e2b9e68
Corify FFI datatypes properly; eliminate nested JavaScript markers
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 17 May 2009 13:25:57 -0400 |
parents | c1f8963ebb18 |
children | 493f44759879 |
line wrap: on
line diff
--- a/src/jscomp.sml Sat May 16 18:09:14 2009 -0400 +++ b/src/jscomp.sml Sun May 17 13:25:57 2009 -0400 @@ -168,6 +168,21 @@ case b of U.Exp.RelE _ => inner+1 | _ => inner} + +val desourceify' = + U.Exp.map {typ = fn t => t, + exp = fn e => + case e of + EJavaScript (_, e, _) => #1 e + | _ => e} + +val desourceify = + U.File.map {typ = fn t => t, + exp = fn e => + case e of + EJavaScript (m, e, eo) => EJavaScript (m, desourceify' e, eo) + | _ => e, + decl = fn d => d} fun process file = let @@ -251,16 +266,19 @@ 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), + (case #1 e' of + EPrim (Prim.String "ERROR") => raise Fail "UHOH" + | _ => + (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 @@ -578,7 +596,8 @@ ^ (if isNullable t then ".v," else - "")), + "") + ^ ","), jsPat (depth+1) inner p succ fail, str "):", fail, @@ -657,13 +676,9 @@ (str ("_" ^ var n), st) else let - (*val () = Print.prefaces "ERel" - [("n", Print.PD.string (Int.toString n)), - ("inner", Print.PD.string (Int.toString inner)), - ("eq", MonoPrint.p_exp MonoEnv.empty - (#1 (quoteExp (List.nth (outer, n - inner)) - ((ERel (n - inner), loc), st))))]*) val n = n - inner + (*val () = Print.prefaces "quote" [("t", MonoPrint.p_typ MonoEnv.empty + (List.nth (outer, n)))]*) in quoteExp (List.nth (outer, n)) ((ERel n, loc), st) end @@ -1083,7 +1098,7 @@ U.Decl.foldMapB {typ = fn x => x, exp = fn (env, e, st) => let - fun doCode m env orig e = + fun doCode m env e = let val len = length env fun str s = (EPrim (Prim.String s), #2 e) @@ -1093,16 +1108,32 @@ fn i => str ("var _" ^ Int.toString (len + i) ^ ";")) val old = e val (e, st) = jsExp m env 0 (e, st) + val e = + case locals of + [] => e + | _ => + strcat (#2 e) (str "(function(){" + :: locals + @ [str "return ", + e, + str "}())"]) in (*Print.prefaces "jsify" [("old", MonoPrint.p_exp MonoEnv.empty old), ("new", MonoPrint.p_exp MonoEnv.empty e)];*) - (EJavaScript (m, orig, SOME (strcat (#2 e) (locals @ [e]))), st) + (EJavaScript (m, old, SOME e), st) end in case e of - EJavaScript (m, orig, NONE) => + (*EJavaScript (m as Source t, orig, NONE) => + let + val loc = #2 orig + val (e, st) = doCode m (t :: env) (ERel 0, loc) + in + (ELet ("x", t, orig, (e, loc)), st) + end + |*) EJavaScript (m, orig, NONE) => (foundJavaScript := true; - doCode m env orig orig) + doCode m env orig) | _ => (e, st) end, decl = fn (_, e, st) => (e, st), @@ -1132,7 +1163,7 @@ listInjectors = TM.empty, decoders = IM.empty, maxName = U.File.maxName file + 1} - file + (desourceify file) val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.libJs, file = "urweb.js"}) fun lines acc =