From abb3bffd224cb7bdbbbc1461643a8e58fb03ed8f Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 4 Apr 2009 12:54:39 -0400 Subject: Fix overzealous Marshalcheck; garbage-collect string-embedded closures when no dyns are active --- lib/js/urweb.js | 84 ++++++++++++++++++++++++++++++++++++++-------------- src/compiler.sig | 4 +-- src/compiler.sml | 18 +++++------ src/jscomp.sml | 8 ++--- src/marshalcheck.sml | 3 +- 5 files changed, 79 insertions(+), 38 deletions(-) diff --git a/lib/js/urweb.js b/lib/js/urweb.js index 4a447a5b..fe996833 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -1,3 +1,5 @@ +// Lists + function cons(v, ls) { return { next : ls, data : v }; } @@ -18,6 +20,43 @@ function union(ls1, ls2) { } +// Embedding closures in XML strings + +function cat(s1, s2) { + if (s1.length && s2.length) + return s1 + s2; + else + return {_1: s1, _2: s2}; +} + +var closures = []; + +function newClosure(f) { + var n = closures.length; + closures[n] = f; + return n; +} + +function cr(n) { + return closures[n](); +} + +function flatten(tr) { + if (tr.length) + return tr; + else if (tr._1) + return cs(tr._1) + cs(tr._2); + else + return "cr(" + newClosure(tr) + ")"; +} + +function clearClosures() { + closures = []; +} + + +// Dynamic tree management + function populate(node) { var s = node.signal; var oldSources = node.sources; @@ -85,7 +124,7 @@ var thisScript = null; function runScripts(node) { var savedScript = thisScript; - var scripts = node.getElementsByTagName("script"), scriptsCopy = {}; + var scripts = node.getElementsByTagName("script"), scriptsCopy = []; var len = scripts.length; for (var i = 0; i < len; ++i) scriptsCopy[i] = scripts[i]; @@ -98,12 +137,18 @@ function runScripts(node) { } +// Dynamic tree entry points + +var dynDepth = 0; + function dyn(s) { var x = document.createElement("span"); x.dead = false; x.signal = s; x.sources = null; x.recreate = function(v) { + ++dynDepth; + var spans = x.getElementsByTagName("span"); for (var i = 0; i < spans.length; ++i) { var span = spans[i]; @@ -114,6 +159,9 @@ function dyn(s) { x.innerHTML = v; runScripts(x); + + if (--dynDepth == 0) + clearClosures(); }; populate(x); addNode(x); @@ -131,6 +179,9 @@ function inp(t, s) { return x; } + +// Basic string operations + function eh(x) { return x.split("&").join("&").split("<").join("<").split(">").join(">"); } @@ -154,10 +205,17 @@ function pfl(s) { throw "Can't parse float: " + s; } -function cat(s1, s2) { - return s1 + s2; +function uf(s) { + return escape(s).replace(new RegExp ("/", "g"), "%2F"); } +function uu(s) { + return unescape(s).replace(new RegExp ("\\+", "g"), " "); +} + + +// Error handling + function whine(msg) { alert(msg); throw msg; @@ -167,18 +225,8 @@ function pf() { whine("Pattern match failure"); } -var closures = []; - -function ca(f) { - var n = closures.length; - closures[n] = f; - return n; -} - -function cr(n) { - return closures[n](); -} +// Remote calls var client_id = 0; var client_pass = 0; @@ -364,11 +412,3 @@ function rv(chn, parse, k) { k(parse(msg))(null); } } - -function uf(s) { - return escape(s).replace(new RegExp ("/", "g"), "%2F"); -} - -function uu(s) { - return unescape(s).replace(new RegExp ("\\+", "g"), " "); -} diff --git a/src/compiler.sig b/src/compiler.sig index d932c906..94dac67a 100644 --- a/src/compiler.sig +++ b/src/compiler.sig @@ -69,10 +69,10 @@ signature COMPILER = sig val shake : (Core.file, Core.file) phase val rpcify : (Core.file, Core.file) phase val tag : (Core.file, Core.file) phase - val marshalcheck : (Core.file, Core.file) phase val reduce : (Core.file, Core.file) phase val unpoly : (Core.file, Core.file) phase val specialize : (Core.file, Core.file) phase + val marshalcheck : (Core.file, Core.file) phase val monoize : (Core.file, Mono.file) phase val mono_opt : (Mono.file, Mono.file) phase val untangle : (Mono.file, Mono.file) phase @@ -100,11 +100,11 @@ signature COMPILER = sig val toCore_untangle2 : (string, Core.file) transform val toShake2 : (string, Core.file) transform val toTag : (string, Core.file) transform - val toMarshalcheck : (string, Core.file) transform val toReduce : (string, Core.file) transform val toUnpoly : (string, Core.file) transform val toSpecialize : (string, Core.file) transform val toShake3 : (string, Core.file) transform + val toMarshalcheck : (string, Core.file) transform val toMonoize : (string, Mono.file) transform val toMono_opt1 : (string, Mono.file) transform val toUntangle : (string, Mono.file) transform diff --git a/src/compiler.sml b/src/compiler.sml index 0eb8cb0f..6a43d94e 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -475,19 +475,12 @@ val tag = { val toTag = transform tag "tag" o toCore_untangle2 -val marshalcheck = { - func = (fn file => (MarshalCheck.check file; file)), - print = CorePrint.p_file CoreEnv.empty -} - -val toMarshalcheck = transform marshalcheck "marshalcheck" o toTag - val reduce = { func = Reduce.reduce, print = CorePrint.p_file CoreEnv.empty } -val toReduce = transform reduce "reduce" o toMarshalcheck +val toReduce = transform reduce "reduce" o toTag val unpoly = { func = Unpoly.unpoly, @@ -505,12 +498,19 @@ val toSpecialize = transform specialize "specialize" o toUnpoly val toShake3 = transform shake "shake3" o toSpecialize +val marshalcheck = { + func = (fn file => (MarshalCheck.check file; file)), + print = CorePrint.p_file CoreEnv.empty +} + +val toMarshalcheck = transform marshalcheck "marshalcheck" o toShake3 + val monoize = { func = Monoize.monoize CoreEnv.empty, print = MonoPrint.p_file MonoEnv.empty } -val toMonoize = transform monoize "monoize" o toShake3 +val toMonoize = transform monoize "monoize" o toMarshalcheck val mono_opt = { func = MonoOpt.optimize, diff --git a/src/jscomp.sml b/src/jscomp.sml index 934b9945..1409a0cb 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -891,9 +891,9 @@ fun process file = | EJavaScript (Source _, _, SOME _) => (e, st) | EJavaScript (_, _, SOME e) => - (strcat [str "\"cr(\"+ca(function(){return ", + (strcat [str "function(){return ", e, - str "})+\")\""], + str "}"], st) | EClosure _ => unsupported "EClosure" @@ -905,9 +905,9 @@ fun process file = let val (e, st) = jsE inner (e, st) in - (strcat [str "\"cr(\"+ca(function(){return ", + (strcat [str "function(){return ", e, - str "})+\")\""], + str "}"], st) end diff --git a/src/marshalcheck.sml b/src/marshalcheck.sml index 2cce607b..c48fd14f 100644 --- a/src/marshalcheck.sml +++ b/src/marshalcheck.sml @@ -58,7 +58,8 @@ val clientToServer = [("Basis", "int"), ("Basis", "string"), ("Basis", "time"), ("Basis", "unit"), - ("Basis", "option")] + ("Basis", "option"), + ("Basis", "bool")] val clientToServer = PS.addList (PS.empty, clientToServer) -- cgit v1.2.3