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') 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