From 476f12674420391e24afd1846e176eabe550d36c Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Sat, 29 Nov 2014 03:37:59 -0500 Subject: Basic field-resolution invalidation. --- src/jscomp.sml | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) (limited to 'src/jscomp.sml') diff --git a/src/jscomp.sml b/src/jscomp.sml index 1a476739..a4ee95f0 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -195,7 +195,7 @@ fun process (file : file) = str loc "}"])], {disc = t, result = s}), loc) val body = (EAbs ("x", t, s, body), loc) - + val st = {decls = ("jsify", n', (TFun (t, s), loc), body, "jsify") :: #decls st, script = #script st, @@ -575,7 +575,7 @@ fun process (file : file) = val e = String.translate (fn #"'" => "\\'" | #"\\" => "\\\\" | ch => String.str ch) e - + val sc = "urfuncs[" ^ Int.toString n ^ "] = {c:\"t\",f:'" ^ e ^ "'};\n" in @@ -799,7 +799,7 @@ fun process (file : file) = | _ => default () in seek (e', [x]) - end + end | ECase (e', pes, _) => let @@ -1030,7 +1030,7 @@ fun process (file : file) = | ERel _ => (e, st) | ENamed _ => (e, st) | ECon (_, _, NONE) => (e, st) - | ECon (dk, pc, SOME e) => + | ECon (dk, pc, SOME e) => let val (e, st) = exp outer (e, st) in @@ -1082,7 +1082,7 @@ fun process (file : file) = in ((EBinop (bi, s, e1, e2), loc), st) end - + | ERecord xets => let val (xets, st) = ListUtil.foldlMap (fn ((x, e, t), st) => @@ -1176,7 +1176,7 @@ fun process (file : file) = ((EClosure (n, es), loc), st) end - | EQuery {exps, tables, state, query, body, initial} => + | EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} => let val row = exps @ map (fn (x, xts) => (x, (TRecord xts, loc))) tables val row = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row @@ -1187,7 +1187,8 @@ fun process (file : file) = val (initial, st) = exp outer (initial, st) in ((EQuery {exps = exps, tables = tables, state = state, - query = query, body = body, initial = initial}, loc), st) + query = query, body = body, initial = initial, + sqlcacheInfo = sqlcacheInfo}, loc), st) end | EDml (e, mode) => let @@ -1257,7 +1258,7 @@ fun process (file : file) = in ((ESignalSource e, loc), st) end - + | EServerCall (e1, t, ef, fm) => let val (e1, st) = exp outer (e1, st) -- cgit v1.2.3 From 68879bbb4bf58e4709c96ba6904071ce5d24a906 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Sun, 13 Sep 2015 17:02:17 -0400 Subject: Make Mono.file a record for readability upon extension. --- src/cjrize.sml | 2 +- src/dbmodecheck.sml | 7 +++---- src/fuse.sml | 8 ++++---- src/iflow.sml | 4 ++-- src/jscomp.sml | 6 +++--- src/mono.sml | 2 +- src/mono_print.sml | 4 ++-- src/mono_reduce.sml | 8 ++++---- src/mono_shake.sml | 11 ++++++----- src/mono_util.sml | 16 ++++++++-------- src/monoize.sml | 2 +- src/name_js.sml | 12 ++++++------ src/pathcheck.sml | 6 +++--- src/scriptcheck.sml | 9 ++++----- src/sigcheck.sml | 8 ++++---- src/sqlcache.sml | 2 +- src/untangle.sml | 4 ++-- 17 files changed, 55 insertions(+), 56 deletions(-) (limited to 'src/jscomp.sml') diff --git a/src/cjrize.sml b/src/cjrize.sml index b20d6d22..870c66be 100644 --- a/src/cjrize.sml +++ b/src/cjrize.sml @@ -701,7 +701,7 @@ fun cifyDecl ((d, loc), sm) = | L.DPolicy _ => (NONE, NONE, sm) | L.DOnError n => (SOME (L'.DOnError n, loc), NONE, sm) -fun cjrize (ds, sideInfo) = +fun cjrize {decls = ds, sideInfo} = let val (dsF, ds, ps, sm) = foldl (fn (d, (dsF, ds, ps, sm)) => let diff --git a/src/dbmodecheck.sml b/src/dbmodecheck.sml index eb416cea..491927c0 100644 --- a/src/dbmodecheck.sml +++ b/src/dbmodecheck.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -31,7 +31,7 @@ open Mono structure IM = IntBinaryMap -fun classify (ds, ps) = +fun classify {decls = ds, sideInfo = ps} = let fun mergeModes (m1, m2) = case (m1, m2) of @@ -79,8 +79,7 @@ fun classify (ds, ps) = val ps = IM.foldli (fn (n, mode, ps) => (n, ServerOnly, mode) :: ps) ps modes in - (ds, ps) + {decls = ds, sideInfo = ps} end end - diff --git a/src/fuse.sml b/src/fuse.sml index 5193e59a..017f79d5 100644 --- a/src/fuse.sml +++ b/src/fuse.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -139,14 +139,14 @@ fun fuse file = in (U.Decl.map {typ = fn x => x, exp = exp, - decl = fn x => x} + decl = fn x => x} d, (funcs, maxName)) end - val (ds, _) = ListUtil.foldlMap doDecl (IM.empty, U.File.maxName file + 1) (#1 file) + val (ds, _) = ListUtil.foldlMap doDecl (IM.empty, U.File.maxName file + 1) (#decls file) in - (ds, #2 file) + {decls = ds, sideInfo = #sideInfo file} end end diff --git a/src/iflow.sml b/src/iflow.sml index b8346baa..6ed7e69d 100644 --- a/src/iflow.sml +++ b/src/iflow.sml @@ -1900,7 +1900,7 @@ fun check (file : file) = val exptd = foldl (fn ((d, _), exptd) => case d of DExport (_, _, n, _, _, _) => IS.add (exptd, n) - | _ => exptd) IS.empty (#1 file) + | _ => exptd) IS.empty (#decls file) fun decl (d, loc) = case d of @@ -2164,7 +2164,7 @@ fun check (file : file) = | _ => () in - app decl (#1 file) + app decl (#decls file) end val check = fn file => diff --git a/src/jscomp.sml b/src/jscomp.sml index e5f7d234..29b11820 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -79,7 +79,7 @@ fun process (file : file) = someTs) someTs dts, nameds) | (_, state) => state) - (IM.empty, IM.empty) (#1 file) + (IM.empty, IM.empty) (#decls file) fun str loc s = (EPrim (Prim.String (Prim.Normal, s)), loc) @@ -1335,7 +1335,7 @@ fun process (file : file) = listInjectors = TM.empty, decoders = IM.empty, maxName = U.File.maxName file + 1} - (#1 file) + (#decls file) val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Settings.libJs (), file = "urweb.js"}) fun lines acc = @@ -1365,7 +1365,7 @@ fun process (file : file) = "" in TextIO.closeIn inf; - ((DJavaScript script, ErrorMsg.dummySpan) :: ds, #2 file) + {decls = (DJavaScript script, ErrorMsg.dummySpan) :: ds, sideInfo = #sideInfo file} end end diff --git a/src/mono.sml b/src/mono.sml index 5185e48c..94c47814 100644 --- a/src/mono.sml +++ b/src/mono.sml @@ -168,6 +168,6 @@ datatype dbmode = | OneQuery | AnyDb -type file = decl list * (int * sidedness * dbmode) list +type file = {decls : decl list, sideInfo : (int * sidedness * dbmode) list} end diff --git a/src/mono_print.sml b/src/mono_print.sml index 0ff51f37..0b5fdadc 100644 --- a/src/mono_print.sml +++ b/src/mono_print.sml @@ -542,12 +542,12 @@ fun p_decl env (dAll as (d, _) : decl) = p_policy env p] | DOnError _ => string "ONERROR" -fun p_file env (file, _) = +fun p_file env (file : file) = let val (pds, _) = ListUtil.foldlMap (fn (d, env) => (p_decl env d, E.declBinds env d)) - env file + env (#decls file) in p_list_sep newline (fn x => x) pds end diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index 61866af7..19c07f12 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -390,7 +390,7 @@ fun reduce' (file : file) = absCounts vis) | _ => (timpures, impures, absCounts) end) - (IS.empty, IS.empty, IM.empty) (#1 file) + (IS.empty, IS.empty, IM.empty) (#decls file) val uses = U.File.fold {typ = fn (_, m) => m, exp = fn (e, m) => @@ -406,7 +406,7 @@ fun reduce' (file : file) = val functionInside' = U.Typ.exists (fn c => case c of TFun _ => true | _ => false) - + fun functionInside t = case #1 t of TFun (t1, t2) => functionInside' t1 orelse functionInside t2 @@ -520,7 +520,7 @@ fun reduce' (file : file) = | ERedirect (e, _) => summarize d e @ [Abort] | EWrite e => summarize d e @ [WritePage] - + | ESeq (e1, e2) => summarize d e1 @ summarize d e2 | ELet (_, _, e1, e2) => summarize d e1 @ summarize (if d = ~1 then ~1 else d + 1) e2 diff --git a/src/mono_shake.sml b/src/mono_shake.sml index 5818fea0..b394af5b 100644 --- a/src/mono_shake.sml +++ b/src/mono_shake.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -60,7 +60,7 @@ fun shake (file : file) = | ((DTask _, _), acc) => acc | ((DPolicy _, _), acc) => acc | ((DOnError _, _), acc) => acc) - (IM.empty, IM.empty) (#1 file) + (IM.empty, IM.empty) (#decls file) fun typ (c, s) = case c of @@ -130,7 +130,7 @@ fun shake (file : file) = usedVars st e1 end | ((DOnError n, _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n)) - | (_, st) => st) (IS.empty, IS.empty) (#1 file) + | (_, st) => st) (IS.empty, IS.empty) (#decls file) val s = {con = page_cs, exp = page_es} @@ -145,7 +145,8 @@ fun shake (file : file) = NONE => raise Fail "MonoShake: Couldn't find 'val'" | SOME (t, e) => shakeExp s e) s page_es in - (List.filter (fn (DDatatype dts, _) => List.exists (fn (_, n, _) => IS.member (#con s, n)) dts + {decls = + List.filter (fn (DDatatype dts, _) => List.exists (fn (_, n, _) => IS.member (#con s, n)) dts | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n) | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis | (DExport _, _) => true @@ -158,7 +159,7 @@ fun shake (file : file) = | (DStyle _, _) => true | (DTask _, _) => true | (DPolicy _, _) => true - | (DOnError _, _) => true) (#1 file), #2 file) + | (DOnError _, _) => true) (#decls file), sideInfo = #sideInfo file} end end diff --git a/src/mono_util.sml b/src/mono_util.sml index ba10ad32..64aeb318 100644 --- a/src/mono_util.sml +++ b/src/mono_util.sml @@ -695,9 +695,9 @@ fun mapfoldB (all as {bind, ...}) = let val mfd = Decl.mapfoldB all - fun mff ctx (ds, ps) = - case ds of - nil => S.return2 (nil, ps) + fun mff ctx (file : file) = + case #decls file of + nil => S.return2 {decls = nil, sideInfo = #sideInfo file} | d :: ds' => S.bind2 (mfd ctx d, fn d' => @@ -736,9 +736,9 @@ fun mapfoldB (all as {bind, ...}) = | DPolicy _ => ctx | DOnError _ => ctx in - S.map2 (mff ctx' (ds', ps), - fn (ds', _) => - (d' :: ds', ps)) + S.map2 (mff ctx' {decls = ds', sideInfo = #sideInfo file}, + fn {decls = ds', ...} => + {decls = d' :: ds', sideInfo = #sideInfo file}) end) in mff @@ -791,7 +791,7 @@ fun maxName (f : file) = | DStyle _ => count | DTask _ => count | DPolicy _ => count - | DOnError _ => count) 0 (#1 f) + | DOnError _ => count) 0 (#decls f) fun appLoc f (fl : file) = let @@ -822,7 +822,7 @@ fun appLoc f (fl : file) = | PolUpdate e1 => eal e1 | PolSequence e1 => eal e1 in - app appl (#1 fl) + app appl (#decls fl) end end diff --git a/src/monoize.sml b/src/monoize.sml index d8c4d276..d0b93c50 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -4786,7 +4786,7 @@ fun monoize env file = pvars := RM.empty; pvarDefs := []; pvarOldDefs := []; - (rev ds, []) + {decls = rev ds, sideInfo = []} end end diff --git a/src/name_js.sml b/src/name_js.sml index f10e5938..b838d1d3 100644 --- a/src/name_js.sml +++ b/src/name_js.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -92,7 +92,7 @@ fun rewrite file = | DValRec vis => foldl (fn ((_, n, _, _, _), dontName) => IS.add (dontName, n)) dontName vis | _ => dontName else - dontName) IS.empty (#1 file) + dontName) IS.empty (#decls file) val (ds, _) = ListUtil.foldlMapConcat (fn (d, nextName) => let @@ -126,9 +126,9 @@ fun rewrite file = val vs = freeVars e' val vs = IS.listItems vs - + val x = "script" ^ Int.toString nextName - + val un = (TRecord [], loc) val s = (TFfi ("Basis", "string"), loc) val base = (TFun (un, s), loc) @@ -165,9 +165,9 @@ fun rewrite file = DValRec vis => [(DValRec (vis @ newDs), #2 d)] | _ => List.revAppend (map (fn vi => (DVal vi, #2 d)) newDs, [d]), nextName) - end) (U.File.maxName file + 1) (#1 file) + end) (U.File.maxName file + 1) (#decls file) in - (ds, #2 file) + {decls = ds, sideInfo = #sideInfo file} end end diff --git a/src/pathcheck.sml b/src/pathcheck.sml index 3533032e..2de3b544 100644 --- a/src/pathcheck.sml +++ b/src/pathcheck.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -68,7 +68,7 @@ fun checkDecl ((d, loc), (funcs, rels, cookies, styles)) = in case d of DExport (_, s, _, _, _, _) => doFunc s - + | DTable (s, _, pe, ce) => let fun constraints (e, rels) = @@ -110,6 +110,6 @@ fun checkDecl ((d, loc), (funcs, rels, cookies, styles)) = | _ => (funcs, rels, cookies, styles) end -fun check (ds, _) = ignore (foldl checkDecl (SS.empty, SS.empty, SS.empty, SS.empty) ds) +fun check (file : file) = ignore (foldl checkDecl (SS.empty, SS.empty, SS.empty, SS.empty) (#decls file)) end diff --git a/src/scriptcheck.sml b/src/scriptcheck.sml index 0d30ebcb..d1e893dd 100644 --- a/src/scriptcheck.sml +++ b/src/scriptcheck.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -91,7 +91,7 @@ fun dump (r : rpcmap) = dump r')) m; print "\n") -fun classify (ds, ps) = +fun classify {decls = ds, sideInfo = ps} = let val proto = Settings.currentProtocol () @@ -100,7 +100,7 @@ fun classify (ds, ps) = fun hasClient {basis, rpcs, funcs, push} = MonoUtil.Exp.exists {typ = fn _ => false, exp = fn ERecv _ => push - | EFfiApp ("Basis", x, _) => SS.member (basis, x) + | EFfiApp ("Basis", x, _) => SS.member (basis, x) | EJavaScript _ => not push | ENamed n => IS.member (funcs, n) | EServerCall (e, _, _, _) => @@ -175,8 +175,7 @@ fun classify (ds, ps) = else ServerOnly, AnyDb)) (IS.listItems all_ids) in - (ds, ps) + {decls = ds, sideInfo = ps} end end - diff --git a/src/sigcheck.sml b/src/sigcheck.sml index a6ed7653..35302bae 100644 --- a/src/sigcheck.sml +++ b/src/sigcheck.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -32,7 +32,7 @@ open Mono structure IS = IntBinarySet structure E = ErrorMsg -fun check (ds, sl) = +fun check (file : file) = let fun isSiggy siggers = MonoUtil.Decl.exists {typ = fn _ => false, @@ -89,9 +89,9 @@ fun check (ds, sl) = (sigify sigdecs d, (siggers, sigdecs)) | _ => (sigify sigdecs d, (siggers, sigdecs)) - val (ds, _) = ListUtil.foldlMap doDecl (IS.empty, IS.empty) ds + val (ds, _) = ListUtil.foldlMap doDecl (IS.empty, IS.empty) (#decls file) in - (ds, sl) + {decls = ds, sideInfo = #sideInfo file} end end diff --git a/src/sqlcache.sml b/src/sqlcache.sml index 8efe999c..40081351 100644 --- a/src/sqlcache.sml +++ b/src/sqlcache.sml @@ -101,7 +101,7 @@ fun effectful (effs : IS.set) = end (* TODO: test this. *) -fun effectfulDecls (decls, _) = +fun effectfulDecls ({decls, ...} : file) = let fun doVal ((_, name, _, e, _), effs) = if effectful effs MonoEnv.empty e diff --git a/src/untangle.sml b/src/untangle.sml index bcb90ed6..8ed9c8f6 100644 --- a/src/untangle.sml +++ b/src/untangle.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -208,7 +208,7 @@ fun untangle (file : file) = end | _ => [dAll] in - (ListUtil.mapConcat decl (#1 file), #2 file) + {decls = ListUtil.mapConcat decl (#decls file), sideInfo = #sideInfo file} end end -- cgit v1.2.3 From 3e42cccfaef1157ca14cd102959b867c996503a9 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Mon, 21 Sep 2015 10:16:55 -0400 Subject: Revert to revision 2222. --- src/cjrize.sml | 2 +- src/dbmodecheck.sml | 7 ++++--- src/fuse.sml | 8 ++++---- src/iflow.sml | 4 ++-- src/jscomp.sml | 6 +++--- src/mono.sml | 2 +- src/mono_print.sml | 4 ++-- src/mono_reduce.sml | 8 ++++---- src/mono_shake.sml | 11 +++++------ src/mono_util.sml | 16 ++++++++-------- src/monoize.sml | 2 +- src/name_js.sml | 12 ++++++------ src/pathcheck.sml | 6 +++--- src/scriptcheck.sml | 9 +++++---- src/sigcheck.sml | 8 ++++---- src/sqlcache.sml | 2 +- src/untangle.sml | 4 ++-- 17 files changed, 56 insertions(+), 55 deletions(-) (limited to 'src/jscomp.sml') diff --git a/src/cjrize.sml b/src/cjrize.sml index 870c66be..b20d6d22 100644 --- a/src/cjrize.sml +++ b/src/cjrize.sml @@ -701,7 +701,7 @@ fun cifyDecl ((d, loc), sm) = | L.DPolicy _ => (NONE, NONE, sm) | L.DOnError n => (SOME (L'.DOnError n, loc), NONE, sm) -fun cjrize {decls = ds, sideInfo} = +fun cjrize (ds, sideInfo) = let val (dsF, ds, ps, sm) = foldl (fn (d, (dsF, ds, ps, sm)) => let diff --git a/src/dbmodecheck.sml b/src/dbmodecheck.sml index 491927c0..eb416cea 100644 --- a/src/dbmodecheck.sml +++ b/src/dbmodecheck.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -31,7 +31,7 @@ open Mono structure IM = IntBinaryMap -fun classify {decls = ds, sideInfo = ps} = +fun classify (ds, ps) = let fun mergeModes (m1, m2) = case (m1, m2) of @@ -79,7 +79,8 @@ fun classify {decls = ds, sideInfo = ps} = val ps = IM.foldli (fn (n, mode, ps) => (n, ServerOnly, mode) :: ps) ps modes in - {decls = ds, sideInfo = ps} + (ds, ps) end end + diff --git a/src/fuse.sml b/src/fuse.sml index 017f79d5..5193e59a 100644 --- a/src/fuse.sml +++ b/src/fuse.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -139,14 +139,14 @@ fun fuse file = in (U.Decl.map {typ = fn x => x, exp = exp, - decl = fn x => x} + decl = fn x => x} d, (funcs, maxName)) end - val (ds, _) = ListUtil.foldlMap doDecl (IM.empty, U.File.maxName file + 1) (#decls file) + val (ds, _) = ListUtil.foldlMap doDecl (IM.empty, U.File.maxName file + 1) (#1 file) in - {decls = ds, sideInfo = #sideInfo file} + (ds, #2 file) end end diff --git a/src/iflow.sml b/src/iflow.sml index 6ed7e69d..b8346baa 100644 --- a/src/iflow.sml +++ b/src/iflow.sml @@ -1900,7 +1900,7 @@ fun check (file : file) = val exptd = foldl (fn ((d, _), exptd) => case d of DExport (_, _, n, _, _, _) => IS.add (exptd, n) - | _ => exptd) IS.empty (#decls file) + | _ => exptd) IS.empty (#1 file) fun decl (d, loc) = case d of @@ -2164,7 +2164,7 @@ fun check (file : file) = | _ => () in - app decl (#decls file) + app decl (#1 file) end val check = fn file => diff --git a/src/jscomp.sml b/src/jscomp.sml index 29b11820..e5f7d234 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -79,7 +79,7 @@ fun process (file : file) = someTs) someTs dts, nameds) | (_, state) => state) - (IM.empty, IM.empty) (#decls file) + (IM.empty, IM.empty) (#1 file) fun str loc s = (EPrim (Prim.String (Prim.Normal, s)), loc) @@ -1335,7 +1335,7 @@ fun process (file : file) = listInjectors = TM.empty, decoders = IM.empty, maxName = U.File.maxName file + 1} - (#decls file) + (#1 file) val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Settings.libJs (), file = "urweb.js"}) fun lines acc = @@ -1365,7 +1365,7 @@ fun process (file : file) = "" in TextIO.closeIn inf; - {decls = (DJavaScript script, ErrorMsg.dummySpan) :: ds, sideInfo = #sideInfo file} + ((DJavaScript script, ErrorMsg.dummySpan) :: ds, #2 file) end end diff --git a/src/mono.sml b/src/mono.sml index 94c47814..5185e48c 100644 --- a/src/mono.sml +++ b/src/mono.sml @@ -168,6 +168,6 @@ datatype dbmode = | OneQuery | AnyDb -type file = {decls : decl list, sideInfo : (int * sidedness * dbmode) list} +type file = decl list * (int * sidedness * dbmode) list end diff --git a/src/mono_print.sml b/src/mono_print.sml index 0b5fdadc..0ff51f37 100644 --- a/src/mono_print.sml +++ b/src/mono_print.sml @@ -542,12 +542,12 @@ fun p_decl env (dAll as (d, _) : decl) = p_policy env p] | DOnError _ => string "ONERROR" -fun p_file env (file : file) = +fun p_file env (file, _) = let val (pds, _) = ListUtil.foldlMap (fn (d, env) => (p_decl env d, E.declBinds env d)) - env (#decls file) + env file in p_list_sep newline (fn x => x) pds end diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index 19c07f12..61866af7 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -390,7 +390,7 @@ fun reduce' (file : file) = absCounts vis) | _ => (timpures, impures, absCounts) end) - (IS.empty, IS.empty, IM.empty) (#decls file) + (IS.empty, IS.empty, IM.empty) (#1 file) val uses = U.File.fold {typ = fn (_, m) => m, exp = fn (e, m) => @@ -406,7 +406,7 @@ fun reduce' (file : file) = val functionInside' = U.Typ.exists (fn c => case c of TFun _ => true | _ => false) - + fun functionInside t = case #1 t of TFun (t1, t2) => functionInside' t1 orelse functionInside t2 @@ -520,7 +520,7 @@ fun reduce' (file : file) = | ERedirect (e, _) => summarize d e @ [Abort] | EWrite e => summarize d e @ [WritePage] - + | ESeq (e1, e2) => summarize d e1 @ summarize d e2 | ELet (_, _, e1, e2) => summarize d e1 @ summarize (if d = ~1 then ~1 else d + 1) e2 diff --git a/src/mono_shake.sml b/src/mono_shake.sml index b394af5b..5818fea0 100644 --- a/src/mono_shake.sml +++ b/src/mono_shake.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -60,7 +60,7 @@ fun shake (file : file) = | ((DTask _, _), acc) => acc | ((DPolicy _, _), acc) => acc | ((DOnError _, _), acc) => acc) - (IM.empty, IM.empty) (#decls file) + (IM.empty, IM.empty) (#1 file) fun typ (c, s) = case c of @@ -130,7 +130,7 @@ fun shake (file : file) = usedVars st e1 end | ((DOnError n, _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n)) - | (_, st) => st) (IS.empty, IS.empty) (#decls file) + | (_, st) => st) (IS.empty, IS.empty) (#1 file) val s = {con = page_cs, exp = page_es} @@ -145,8 +145,7 @@ fun shake (file : file) = NONE => raise Fail "MonoShake: Couldn't find 'val'" | SOME (t, e) => shakeExp s e) s page_es in - {decls = - List.filter (fn (DDatatype dts, _) => List.exists (fn (_, n, _) => IS.member (#con s, n)) dts + (List.filter (fn (DDatatype dts, _) => List.exists (fn (_, n, _) => IS.member (#con s, n)) dts | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n) | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis | (DExport _, _) => true @@ -159,7 +158,7 @@ fun shake (file : file) = | (DStyle _, _) => true | (DTask _, _) => true | (DPolicy _, _) => true - | (DOnError _, _) => true) (#decls file), sideInfo = #sideInfo file} + | (DOnError _, _) => true) (#1 file), #2 file) end end diff --git a/src/mono_util.sml b/src/mono_util.sml index 64aeb318..ba10ad32 100644 --- a/src/mono_util.sml +++ b/src/mono_util.sml @@ -695,9 +695,9 @@ fun mapfoldB (all as {bind, ...}) = let val mfd = Decl.mapfoldB all - fun mff ctx (file : file) = - case #decls file of - nil => S.return2 {decls = nil, sideInfo = #sideInfo file} + fun mff ctx (ds, ps) = + case ds of + nil => S.return2 (nil, ps) | d :: ds' => S.bind2 (mfd ctx d, fn d' => @@ -736,9 +736,9 @@ fun mapfoldB (all as {bind, ...}) = | DPolicy _ => ctx | DOnError _ => ctx in - S.map2 (mff ctx' {decls = ds', sideInfo = #sideInfo file}, - fn {decls = ds', ...} => - {decls = d' :: ds', sideInfo = #sideInfo file}) + S.map2 (mff ctx' (ds', ps), + fn (ds', _) => + (d' :: ds', ps)) end) in mff @@ -791,7 +791,7 @@ fun maxName (f : file) = | DStyle _ => count | DTask _ => count | DPolicy _ => count - | DOnError _ => count) 0 (#decls f) + | DOnError _ => count) 0 (#1 f) fun appLoc f (fl : file) = let @@ -822,7 +822,7 @@ fun appLoc f (fl : file) = | PolUpdate e1 => eal e1 | PolSequence e1 => eal e1 in - app appl (#decls fl) + app appl (#1 fl) end end diff --git a/src/monoize.sml b/src/monoize.sml index d0b93c50..d8c4d276 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -4786,7 +4786,7 @@ fun monoize env file = pvars := RM.empty; pvarDefs := []; pvarOldDefs := []; - {decls = rev ds, sideInfo = []} + (rev ds, []) end end diff --git a/src/name_js.sml b/src/name_js.sml index b838d1d3..f10e5938 100644 --- a/src/name_js.sml +++ b/src/name_js.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -92,7 +92,7 @@ fun rewrite file = | DValRec vis => foldl (fn ((_, n, _, _, _), dontName) => IS.add (dontName, n)) dontName vis | _ => dontName else - dontName) IS.empty (#decls file) + dontName) IS.empty (#1 file) val (ds, _) = ListUtil.foldlMapConcat (fn (d, nextName) => let @@ -126,9 +126,9 @@ fun rewrite file = val vs = freeVars e' val vs = IS.listItems vs - + val x = "script" ^ Int.toString nextName - + val un = (TRecord [], loc) val s = (TFfi ("Basis", "string"), loc) val base = (TFun (un, s), loc) @@ -165,9 +165,9 @@ fun rewrite file = DValRec vis => [(DValRec (vis @ newDs), #2 d)] | _ => List.revAppend (map (fn vi => (DVal vi, #2 d)) newDs, [d]), nextName) - end) (U.File.maxName file + 1) (#decls file) + end) (U.File.maxName file + 1) (#1 file) in - {decls = ds, sideInfo = #sideInfo file} + (ds, #2 file) end end diff --git a/src/pathcheck.sml b/src/pathcheck.sml index 2de3b544..3533032e 100644 --- a/src/pathcheck.sml +++ b/src/pathcheck.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -68,7 +68,7 @@ fun checkDecl ((d, loc), (funcs, rels, cookies, styles)) = in case d of DExport (_, s, _, _, _, _) => doFunc s - + | DTable (s, _, pe, ce) => let fun constraints (e, rels) = @@ -110,6 +110,6 @@ fun checkDecl ((d, loc), (funcs, rels, cookies, styles)) = | _ => (funcs, rels, cookies, styles) end -fun check (file : file) = ignore (foldl checkDecl (SS.empty, SS.empty, SS.empty, SS.empty) (#decls file)) +fun check (ds, _) = ignore (foldl checkDecl (SS.empty, SS.empty, SS.empty, SS.empty) ds) end diff --git a/src/scriptcheck.sml b/src/scriptcheck.sml index d1e893dd..0d30ebcb 100644 --- a/src/scriptcheck.sml +++ b/src/scriptcheck.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -91,7 +91,7 @@ fun dump (r : rpcmap) = dump r')) m; print "\n") -fun classify {decls = ds, sideInfo = ps} = +fun classify (ds, ps) = let val proto = Settings.currentProtocol () @@ -100,7 +100,7 @@ fun classify {decls = ds, sideInfo = ps} = fun hasClient {basis, rpcs, funcs, push} = MonoUtil.Exp.exists {typ = fn _ => false, exp = fn ERecv _ => push - | EFfiApp ("Basis", x, _) => SS.member (basis, x) + | EFfiApp ("Basis", x, _) => SS.member (basis, x) | EJavaScript _ => not push | ENamed n => IS.member (funcs, n) | EServerCall (e, _, _, _) => @@ -175,7 +175,8 @@ fun classify {decls = ds, sideInfo = ps} = else ServerOnly, AnyDb)) (IS.listItems all_ids) in - {decls = ds, sideInfo = ps} + (ds, ps) end end + diff --git a/src/sigcheck.sml b/src/sigcheck.sml index 35302bae..a6ed7653 100644 --- a/src/sigcheck.sml +++ b/src/sigcheck.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -32,7 +32,7 @@ open Mono structure IS = IntBinarySet structure E = ErrorMsg -fun check (file : file) = +fun check (ds, sl) = let fun isSiggy siggers = MonoUtil.Decl.exists {typ = fn _ => false, @@ -89,9 +89,9 @@ fun check (file : file) = (sigify sigdecs d, (siggers, sigdecs)) | _ => (sigify sigdecs d, (siggers, sigdecs)) - val (ds, _) = ListUtil.foldlMap doDecl (IS.empty, IS.empty) (#decls file) + val (ds, _) = ListUtil.foldlMap doDecl (IS.empty, IS.empty) ds in - {decls = ds, sideInfo = #sideInfo file} + (ds, sl) end end diff --git a/src/sqlcache.sml b/src/sqlcache.sml index 40081351..8efe999c 100644 --- a/src/sqlcache.sml +++ b/src/sqlcache.sml @@ -101,7 +101,7 @@ fun effectful (effs : IS.set) = end (* TODO: test this. *) -fun effectfulDecls ({decls, ...} : file) = +fun effectfulDecls (decls, _) = let fun doVal ((_, name, _, e, _), effs) = if effectful effs MonoEnv.empty e diff --git a/src/untangle.sml b/src/untangle.sml index 8ed9c8f6..bcb90ed6 100644 --- a/src/untangle.sml +++ b/src/untangle.sml @@ -16,7 +16,7 @@ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN @@ -208,7 +208,7 @@ fun untangle (file : file) = end | _ => [dAll] in - {decls = ListUtil.mapConcat decl (#decls file), sideInfo = #sideInfo file} + (ListUtil.mapConcat decl (#1 file), #2 file) end end -- cgit v1.2.3 From 97115c5f804824c024a0c08c288889d29f743e64 Mon Sep 17 00:00:00 2001 From: Ziv Scully Date: Mon, 21 Sep 2015 16:45:59 -0400 Subject: Use new refactored urlification in Sqlcache. --- src/cjrize.sml | 2 +- src/iflow.sml | 10 ++++------ src/jscomp.sml | 5 ++--- src/mono.sml | 3 +-- src/mono_opt.sml | 11 ++++------- src/mono_print.sml | 2 +- src/mono_util.sml | 22 +++++++++------------- src/monoize.sig | 2 -- src/monoize.sml | 14 +------------- src/sqlcache.sml | 11 ++++------- 10 files changed, 27 insertions(+), 55 deletions(-) (limited to 'src/jscomp.sml') diff --git a/src/cjrize.sml b/src/cjrize.sml index b20d6d22..5f6ae4d8 100644 --- a/src/cjrize.sml +++ b/src/cjrize.sml @@ -431,7 +431,7 @@ fun cifyExp (eAll as (e, loc), sm) = | L.EClosure _ => (ErrorMsg.errorAt loc "Nested closure remains in code generation"; (dummye, sm)) - | L.EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} => + | L.EQuery {exps, tables, state, query, body, initial} => let val (exps', sm) = ListUtil.foldlMap (fn ((x, t), sm) => let diff --git a/src/iflow.sml b/src/iflow.sml index b8346baa..f68d8f72 100644 --- a/src/iflow.sml +++ b/src/iflow.sml @@ -1870,15 +1870,14 @@ val namer = MonoUtil.File.map {typ = fn t => t, case e of EDml (e, fm) => nameSubexps (fn (_, e') => (EDml (e', fm), #2 e)) e - | EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} => + | EQuery {exps, tables, state, query, body, initial} => nameSubexps (fn (liftBy, e') => (EQuery {exps = exps, tables = tables, state = state, query = e', body = mliftExpInExp liftBy 2 body, - initial = mliftExpInExp liftBy 0 initial, - sqlcacheInfo = sqlcacheInfo}, + initial = mliftExpInExp liftBy 0 initial}, #2 query)) query | _ => e, decl = fn d => d} @@ -2071,12 +2070,11 @@ fun check (file : file) = | ESeq (e1, e2) => (ESeq (doExp env e1, doExp env e2), loc) | ELet (x, t, e1, e2) => (ELet (x, t, doExp env e1, doExp (Unknown :: env) e2), loc) | EClosure (n, es) => (EClosure (n, map (doExp env) es), loc) - | EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} => + | EQuery {exps, tables, state, query, body, initial} => (EQuery {exps = exps, tables = tables, state = state, query = doExp env query, body = doExp (Unknown :: Unknown :: env) body, - initial = doExp env initial, - sqlcacheInfo = sqlcacheInfo}, loc) + initial = doExp env initial}, loc) | EDml (e1, mode) => (case parse dml e1 of NONE => () diff --git a/src/jscomp.sml b/src/jscomp.sml index e5f7d234..4c6bf0a9 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -1178,7 +1178,7 @@ fun process (file : file) = ((EClosure (n, es), loc), st) end - | EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} => + | EQuery {exps, tables, state, query, body, initial} => let val row = exps @ map (fn (x, xts) => (x, (TRecord xts, loc))) tables val row = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row @@ -1189,8 +1189,7 @@ fun process (file : file) = val (initial, st) = exp outer (initial, st) in ((EQuery {exps = exps, tables = tables, state = state, - query = query, body = body, initial = initial, - sqlcacheInfo = sqlcacheInfo}, loc), st) + query = query, body = body, initial = initial}, loc), st) end | EDml (e, mode) => let diff --git a/src/mono.sml b/src/mono.sml index 5185e48c..b05c3dcc 100644 --- a/src/mono.sml +++ b/src/mono.sml @@ -107,8 +107,7 @@ datatype exp' = state : typ, query : exp, (* exp of string type containing sql query *) body : exp, - initial : exp, - sqlcacheInfo : exp } + initial : exp } | EDml of exp * failure_mode | ENextval of exp | ESetval of exp * exp diff --git a/src/mono_opt.sml b/src/mono_opt.sml index f4cd6895..186f6c62 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -405,20 +405,18 @@ fun exp e = initial = (EPrim (Prim.String (k, "")), _), body = (EStrcat ((EPrim (Prim.String (_, s)), _), (EStrcat ((ERel 0, _), - e'), _)), _), - sqlcacheInfo}, loc) => + e'), _)), _)}, loc) => if (case k of Prim.Normal => s = "" | Prim.Html => CharVector.all Char.isSpace s) then EQuery {exps = exps, tables = tables, query = query, state = (TRecord [], loc), initial = (ERecord [], loc), - body = (optExp (EWrite e', loc), loc), - sqlcacheInfo = Monoize.urlifiedUnit} + body = (optExp (EWrite e', loc), loc)} else e | EWrite (EQuery {exps, tables, state, query, initial = (EPrim (Prim.String (_, "")), _), - body, sqlcacheInfo}, loc) => + body}, loc) => let fun passLets (depth, (e', _), lets) = case e' of @@ -433,8 +431,7 @@ fun exp e = EQuery {exps = exps, tables = tables, query = query, state = (TRecord [], loc), initial = (ERecord [], loc), - body = body, - sqlcacheInfo = Monoize.urlifiedUnit} + body = body} end else e diff --git a/src/mono_print.sml b/src/mono_print.sml index 0ff51f37..3e498d2c 100644 --- a/src/mono_print.sml +++ b/src/mono_print.sml @@ -310,7 +310,7 @@ fun p_exp' par env (e, _) = p_exp env e]) es, string ")"] - | EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} => + | EQuery {exps, tables, state, query, body, initial} => box [string "query[", p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) exps, string "] [", diff --git a/src/mono_util.sml b/src/mono_util.sml index ba10ad32..5d7eb164 100644 --- a/src/mono_util.sml +++ b/src/mono_util.sml @@ -314,7 +314,7 @@ fun mapfoldB {typ = fc, exp = fe, bind} = fn es' => (EClosure (n, es'), loc)) - | EQuery {exps, tables, state, query, body, initial, sqlcacheInfo} => + | EQuery {exps, tables, state, query, body, initial} => S.bind2 (ListUtil.mapfold (fn (x, t) => S.map2 (mft t, fn t' => (x, t'))) exps, @@ -335,19 +335,15 @@ fun mapfoldB {typ = fc, exp = fe, bind} = body, fn body' => (* ASK: is this the right thing to do? *) - S.bind2 (mfe ctx initial, + S.map2 (mfe ctx initial, fn initial' => - S.map2 (mfe (bind (ctx, RelE ("queryResult", dummyt))) - sqlcacheInfo, - fn sqlcacheInfo' => - (EQuery {exps = exps', - tables = tables', - state = state', - query = query', - body = body', - initial = initial', - sqlcacheInfo = sqlcacheInfo}, - loc)))))))) + (EQuery {exps = exps', + tables = tables', + state = state', + query = query', + body = body', + initial = initial'}, + loc))))))) | EDml (e, fm) => S.map2 (mfe ctx e, diff --git a/src/monoize.sig b/src/monoize.sig index 549bf6ee..951db01b 100644 --- a/src/monoize.sig +++ b/src/monoize.sig @@ -31,6 +31,4 @@ signature MONOIZE = sig val liftExpInExp : int -> Mono.exp -> Mono.exp - val urlifiedUnit : Mono.exp - end diff --git a/src/monoize.sml b/src/monoize.sml index f92d7511..8f6b298d 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -395,16 +395,6 @@ fun fooifyExp fk env = val attrifyExp = fooifyExp MonoFooify.Attr val urlifyExp = fooifyExp MonoFooify.Url -val urlifiedUnit = - let - val loc = ErrorMsg.dummySpan - (* Urlifies [ERel 0] to match the [sqlcacheInfo] field of [EQuery]s. *) - val (urlified, _) = urlifyExp CoreEnv.empty (Fm.empty 0) - ((L'.ERel 0, loc), (L'.TRecord [], loc)) - in - urlified - end - datatype 'a failable_search = Found of 'a | NotFound @@ -1687,14 +1677,12 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L'.ERel 1, loc)), loc), (L'.ERel 0, loc)), loc), (L'.ERecord [], loc)), loc) - val (urlifiedRel0, fm) = urlifyExp env fm ((L'.ERel 0, loc), state) val body = (L'.EQuery {exps = exps, tables = tables, state = state, query = (L'.ERel 3, loc), body = body', - initial = (L'.ERel 1, loc), - sqlcacheInfo = urlifiedRel0}, + initial = (L'.ERel 1, loc)}, loc) in ((L'.EAbs ("q", s, (L'.TFun (ft, (L'.TFun (state, (L'.TFun (un, state), loc)), loc)), loc), diff --git a/src/sqlcache.sml b/src/sqlcache.sml index 8efe999c..6b4216ea 100644 --- a/src/sqlcache.sml +++ b/src/sqlcache.sml @@ -493,16 +493,16 @@ fun incRels inc = bind = fn (bound, MonoUtil.Exp.RelE _) => bound + 1 | (bound, _) => bound} 0 -fun cacheWrap (query, i, urlifiedRel0, resultTyp, args) = +fun cacheWrap (env, query, i, resultTyp, args) = let val () = ffiInfo := {index = i, params = length args} :: !ffiInfo val loc = dummyLoc + val rel0 = (ERel 0, loc) (* We ensure before this step that all arguments aren't effectful. by turning them into local variables as needed. *) val argsInc = map (incRels 1) args val check = (check (i, args), dummyLoc) - val store = (store (i, argsInc, urlifiedRel0), dummyLoc) - val rel0 = (ERel 0, loc) + val store = (store (i, argsInc, MonoFooify.urlify env (rel0, resultTyp)), dummyLoc) in ECase (check, [((PNone stringTyp, loc), @@ -563,8 +563,6 @@ fun addChecking file = let fun doExp env (queryInfo as (tableToIndices, indexToQueryNumArgs, index)) = fn e' as EQuery {query = origQueryText, - (* ASK: could this get messed up by inlining? *) - sqlcacheInfo = urlifiedRel0, state = resultTyp, initial, body, tables, exps} => let @@ -572,7 +570,6 @@ fun addChecking file = (* Increment once for each new variable just made. *) val queryExp = incRels numArgs (EQuery {query = newQueryText, - sqlcacheInfo = urlifiedRel0, state = resultTyp, initial = initial, body = body, @@ -599,7 +596,7 @@ fun addChecking file = (* Ziv misses Haskell's do notation.... *) guard (safe 0 queryText andalso safe 0 initial andalso safe 2 body) ( bind (Sql.parse Sql.query queryText) (fn queryParsed => - SOME (wrapLets (cacheWrap (queryExp, index, urlifiedRel0, resultTyp, args)), + SOME (wrapLets (cacheWrap (env, queryExp, index, resultTyp, args)), (SS.foldr (fn (tab, qi) => SIMM.insert (qi, tab, index)) tableToIndices (tablesQuery queryParsed), -- cgit v1.2.3