changeset 1845:c1e3805e604e

Make Scriptcheck catch more script/message-passing uses, and move the phase earlier in compilation
author Adam Chlipala <adam@chlipala.net>
date Fri, 15 Mar 2013 16:09:55 -0400 (2013-03-15)
parents 2c5e6f78560c
children bcae365efa85
files src/cjr.sml src/cjrize.sml src/compiler.sig src/compiler.sml src/fuse.sml src/iflow.sml src/jscomp.sml src/mono.sml src/mono_print.sml src/mono_reduce.sml src/mono_shake.sml src/mono_util.sml src/monoize.sml src/name_js.sml src/pathcheck.sml src/scriptcheck.sig src/scriptcheck.sml src/untangle.sml
diffstat 18 files changed, 118 insertions(+), 183 deletions(-) [+]
line wrap: on
line diff
--- a/src/cjr.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/cjr.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -128,10 +128,7 @@
 
 withtype decl = decl' located
 
-datatype sidedness =
-         ServerOnly
-       | ServerAndPull
-       | ServerAndPullAndPush
+datatype sidedness = datatype Mono.sidedness
 
 datatype effect = datatype Export.effect
 datatype export_kind = datatype Export.export_kind
--- a/src/cjrize.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/cjrize.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -694,7 +694,7 @@
       | L.DPolicy _ => (NONE, NONE, sm)
       | L.DOnError n => (SOME (L'.DOnError n, loc), NONE, sm)
 
-fun cjrize ds =
+fun cjrize (ds, sideInfo) =
     let
         val (dsF, ds, ps, sm) = foldl (fn (d, (dsF, ds, ps, sm)) =>
                                           let
@@ -722,6 +722,13 @@
                                               (dsF, ds, ps, Sm.clearDeclares sm)
                                           end)
                                       ([], [], [], Sm.empty) ds
+
+        val sideInfo = foldl (fn ((n, mode), mp) => IM.insert (mp, n, mode)) IM.empty sideInfo
+
+        val ps = map (fn (ek, s, n, ts, t, _, b) =>
+                         (ek, s, n, ts, t,
+                          getOpt (IM.find (sideInfo, n), L'.ServerOnly),
+                          b)) ps
     in
         (List.revAppend (dsF, rev ds),
          ps)
--- a/src/compiler.sig	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/compiler.sig	Fri Mar 15 16:09:55 2013 -0400
@@ -116,12 +116,12 @@
     val mono_shake : (Mono.file, Mono.file) phase
     val iflow : (Mono.file, Mono.file) phase
     val namejs : (Mono.file, Mono.file) phase
+    val scriptcheck : (Mono.file, Mono.file) phase
     val jscomp : (Mono.file, Mono.file) phase
     val fuse : (Mono.file, Mono.file) phase
     val pathcheck : (Mono.file, Mono.file) phase
     val sidecheck : (Mono.file, Mono.file) phase
     val cjrize : (Mono.file, Cjr.file) phase
-    val scriptcheck : (Cjr.file, Cjr.file) phase
     val prepare : (Cjr.file, Cjr.file) phase
     val checknest : (Cjr.file, Cjr.file) phase
     val sqlify : (Mono.file, Cjr.file) phase
@@ -170,6 +170,7 @@
     val toIflow : (string, Mono.file) transform
     val toNamejs : (string, Mono.file) transform
     val toNamejs_untangle : (string, Mono.file) transform
+    val toScriptcheck : (string, Mono.file) transform
     val toJscomp : (string, Mono.file) transform
     val toMono_opt3 : (string, Mono.file) transform
     val toFuse : (string, Mono.file) transform
@@ -184,7 +185,6 @@
     val toPathcheck : (string, Mono.file) transform
     val toSidecheck : (string, Mono.file) transform
     val toCjrize : (string, Cjr.file) transform
-    val toScriptcheck : (string, Cjr.file) transform
     val toPrepare : (string, Cjr.file) transform
     val toChecknest : (string, Cjr.file) transform
     val toSqlify : (string, Cjr.file) transform
--- a/src/compiler.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/compiler.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -1363,12 +1363,19 @@
 
 val toNamejs_untangle = transform untangle "namejs_untangle" o toNamejs
 
+val scriptcheck = {
+    func = ScriptCheck.classify,
+    print = MonoPrint.p_file MonoEnv.empty
+}
+
+val toScriptcheck = transform scriptcheck "scriptcheck" o toNamejs_untangle
+
 val jscomp = {
     func = JsComp.process,
     print = MonoPrint.p_file MonoEnv.empty
 }
 
-val toJscomp = transform jscomp "jscomp" o toNamejs_untangle
+val toJscomp = transform jscomp "jscomp" o toScriptcheck
 
 val toMono_opt3 = transform mono_opt "mono_opt3" o toJscomp
 
@@ -1410,19 +1417,12 @@
 
 val toCjrize = transform cjrize "cjrize" o toSidecheck
 
-val scriptcheck = {
-    func = ScriptCheck.classify,
-    print = CjrPrint.p_file CjrEnv.empty
-}
-
-val toScriptcheck = transform scriptcheck "scriptcheck" o toCjrize
-
 val prepare = {
     func = Prepare.prepare,
     print = CjrPrint.p_file CjrEnv.empty
 }
 
-val toPrepare = transform prepare "prepare" o toScriptcheck
+val toPrepare = transform prepare "prepare" o toCjrize
 
 val checknest = {
     func = fn f => if #supportsNestedPrepared (Settings.currentDbms ()) then f else Checknest.annotate f,
--- a/src/fuse.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/fuse.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -144,9 +144,9 @@
                  (funcs, maxName))
             end
 
-        val (file, _) = ListUtil.foldlMap doDecl (IM.empty, U.File.maxName file + 1) file
+        val (ds, _) = ListUtil.foldlMap doDecl (IM.empty, U.File.maxName file + 1) (#1 file)
     in
-        file
+        (ds, #2 file)
     end
 
 end
--- a/src/iflow.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/iflow.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -1795,7 +1795,7 @@
 
 datatype var_source = Input of int | SubInput of int | Unknown
 
-fun check file =
+fun check (file : file) =
     let
         val () = (St.reset ();
                   rfuns := IM.empty)
@@ -1810,7 +1810,7 @@
         val exptd = foldl (fn ((d, _), exptd) =>
                               case d of
                                   DExport (_, _, n, _, _, _) => IS.add (exptd, n)
-                                | _ => exptd) IS.empty file
+                                | _ => exptd) IS.empty (#1 file)
 
         fun decl (d, loc) =
             case d of
@@ -2071,7 +2071,7 @@
                                         
               | _ => ()
     in
-        app decl file
+        app decl (#1 file)
     end
 
 val check = fn file =>
--- a/src/jscomp.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/jscomp.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -61,7 +61,7 @@
 
 fun inString {needle, haystack} = String.isSubstring needle haystack
 
-fun process file =
+fun process (file : file) =
     let
         val (someTs, nameds) =
             foldl (fn ((DVal (_, n, t, e, _), _), (someTs, nameds)) => (someTs, IM.insert (nameds, n, e))
@@ -77,7 +77,7 @@
                                      someTs) someTs dts,
                        nameds)
                     | (_, state) => state)
-                  (IM.empty, IM.empty) file
+                  (IM.empty, IM.empty) (#1 file)
 
         fun str loc s = (EPrim (Prim.String s), loc)
 
@@ -1304,7 +1304,7 @@
                         listInjectors = TM.empty,
                         decoders = IM.empty,
                         maxName = U.File.maxName file + 1}
-                       file
+                       (#1 file)
 
         val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Settings.libJs (), file = "urweb.js"})
         fun lines acc =
@@ -1334,7 +1334,7 @@
                 ""
     in
         TextIO.closeIn inf;
-        (DJavaScript script, ErrorMsg.dummySpan) :: ds
+        ((DJavaScript script, ErrorMsg.dummySpan) :: ds, #2 file)
     end
 
 end
--- a/src/mono.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/mono.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -157,6 +157,11 @@
 
 withtype decl = decl' located
 
-type file = decl list
+datatype sidedness =
+         ServerOnly
+       | ServerAndPull
+       | ServerAndPullAndPush
+
+type file = decl list * (int * sidedness) list
 
 end
--- a/src/mono_print.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/mono_print.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -530,7 +530,7 @@
                           p_policy env p]
       | DOnError _ => string "ONERROR"
                           
-fun p_file env file =
+fun p_file env (file, _) =
     let
         val (pds, _) = ListUtil.foldlMap (fn (d, env) =>
                                              (p_decl env d,
--- a/src/mono_reduce.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/mono_reduce.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -308,7 +308,7 @@
                                              U.Exp.RelE _ => n + 1
                                            | _ => n} 0
 
-fun reduce file =
+fun reduce (file : file) =
     let
         val (timpures, impures, absCounts) =
             foldl (fn ((d, _), (timpures, impures, absCounts)) =>
@@ -366,7 +366,7 @@
                                      absCounts vis)
                             | _ => (timpures, impures, absCounts)
                       end)
-                  (IS.empty, IS.empty, IM.empty) file
+                  (IS.empty, IS.empty, IM.empty) (#1 file)
 
         val uses = U.File.fold {typ = fn (_, m) => m,
                                 exp = fn (e, m) =>
--- a/src/mono_shake.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/mono_shake.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -41,7 +41,7 @@
      exp : IS.set
 }
 
-fun shake file =
+fun shake (file : file) =
     let
         val (cdef, edef) = foldl (fn ((DDatatype dts, _), (cdef, edef)) =>
                                      (foldl (fn ((_, n, xncs), cdef) => IM.insert (cdef, n, xncs)) cdef dts, edef)
@@ -60,7 +60,7 @@
                                    | ((DTask _, _), acc) => acc
                                    | ((DPolicy _, _), acc) => acc
                                    | ((DOnError _, _), acc) => acc)
-                                 (IM.empty, IM.empty) file
+                                 (IM.empty, IM.empty) (#1 file)
 
         fun typ (c, s) =
             case c of
@@ -130,7 +130,7 @@
                         usedVars st e1
                     end
                   | ((DOnError n, _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n))
-                  | (_, st) => st) (IS.empty, IS.empty) file
+                  | (_, st) => st) (IS.empty, IS.empty) (#1 file)
 
         val s = {con = page_cs, exp = page_es}
 
@@ -145,20 +145,20 @@
                                  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
-                      | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n)
-                      | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis
-                      | (DExport _, _) => true
-                      | (DTable _, _) => true
-                      | (DSequence _, _) => true
-                      | (DView _, _) => true
-                      | (DDatabase _, _) => true
-                      | (DJavaScript _, _) => true
-                      | (DCookie _, _) => true
-                      | (DStyle _, _) => true
-                      | (DTask _, _) => true
-                      | (DPolicy _, _) => true
-                      | (DOnError _, _) => true) file
+        (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
+                       | (DTable _, _) => true
+                       | (DSequence _, _) => true
+                       | (DView _, _) => true
+                       | (DDatabase _, _) => true
+                       | (DJavaScript _, _) => true
+                       | (DCookie _, _) => true
+                       | (DStyle _, _) => true
+                       | (DTask _, _) => true
+                       | (DPolicy _, _) => true
+                       | (DOnError _, _) => true) (#1 file), #2 file)
     end
 
 end
--- a/src/mono_util.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/mono_util.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -664,9 +664,9 @@
     let
         val mfd = Decl.mapfoldB all
 
-        fun mff ctx ds =
+        fun mff ctx (ds, ps) =
             case ds of
-                nil => S.return2 nil
+                nil => S.return2 (nil, ps)
               | d :: ds' =>
                 S.bind2 (mfd ctx d,
                          fn d' =>
@@ -705,9 +705,9 @@
                                       | DPolicy _ => ctx
                                       | DOnError _ => ctx
                             in
-                                S.map2 (mff ctx' ds',
-                                     fn ds' =>
-                                        d' :: ds')
+                                S.map2 (mff ctx' (ds', ps),
+                                     fn (ds', _) =>
+                                        (d' :: ds', ps))
                             end)
     in
         mff
@@ -741,27 +741,28 @@
         S.Continue (_, s) => s
       | S.Return _ => raise Fail "MonoUtil.File.fold: Impossible"
 
-val maxName = foldl (fn ((d, _) : decl, count) =>
-                        case d of
-                            DDatatype dts =>
-                            foldl (fn ((_, n, ns), count) =>
-                                      foldl (fn ((_, n', _), m) => Int.max (n', m))
-                                            (Int.max (n, count)) ns) count dts
-                          | DVal (_, n, _, _, _) => Int.max (n, count)
-                          | DValRec vis => foldl (fn ((_, n, _, _, _), count) => Int.max (n, count)) count vis
-                          | DExport _ => count
-                          | DTable _ => count
-                          | DSequence _ => count
-                          | DView _ => count
-                          | DDatabase _ => count
-                          | DJavaScript _ => count
-                          | DCookie _ => count
-                          | DStyle _ => count
-                          | DTask _ => count
-                          | DPolicy _ => count
-                          | DOnError _ => count) 0
+fun maxName (f : file) =
+    foldl (fn ((d, _) : decl, count) =>
+              case d of
+                  DDatatype dts =>
+                  foldl (fn ((_, n, ns), count) =>
+                            foldl (fn ((_, n', _), m) => Int.max (n', m))
+                                  (Int.max (n, count)) ns) count dts
+                | DVal (_, n, _, _, _) => Int.max (n, count)
+                | DValRec vis => foldl (fn ((_, n, _, _, _), count) => Int.max (n, count)) count vis
+                | DExport _ => count
+                | DTable _ => count
+                | DSequence _ => count
+                | DView _ => count
+                | DDatabase _ => count
+                | DJavaScript _ => count
+                | DCookie _ => count
+                | DStyle _ => count
+                | DTask _ => count
+                | DPolicy _ => count
+                | DOnError _ => count) 0 (#1 f)
 
-fun appLoc f =
+fun appLoc f (fl : file) =
     let
         val eal = Exp.appLoc f
 
@@ -790,7 +791,7 @@
               | PolUpdate e1 => eal e1
               | PolSequence e1 => eal e1
     in
-        app appl
+        app appl (#1 fl)
     end
 
 end
--- a/src/monoize.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/monoize.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -4656,7 +4656,7 @@
         pvars := RM.empty;
         pvarDefs := [];
         pvarOldDefs := [];
-        rev ds
+        (rev ds, [])
     end
 
 end
--- a/src/name_js.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/name_js.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -72,7 +72,7 @@
 
 fun rewrite file =
     let
-        val (file, _) = ListUtil.foldlMapConcat (fn (d, nextName) =>
+        val (ds, _) = ListUtil.foldlMapConcat (fn (d, nextName) =>
                                                     let
                                                         val (d, (nextName, newDs)) =
                                                             U.Decl.foldMapB {typ = fn x => x,
@@ -143,9 +143,9 @@
                                                                       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) file
+                                                    end) (U.File.maxName file + 1) (#1 file)
     in
-        file
+        (ds, #2 file)
     end
 
 end
--- a/src/pathcheck.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/pathcheck.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -110,6 +110,6 @@
           | _ => (funcs, rels, cookies, styles)
     end
 
-fun check ds = ignore (foldl checkDecl (SS.empty, SS.empty, SS.empty, SS.empty) ds)
+fun check (ds, _) = ignore (foldl checkDecl (SS.empty, SS.empty, SS.empty, SS.empty) ds)
 
 end
--- a/src/scriptcheck.sig	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/scriptcheck.sig	Fri Mar 15 16:09:55 2013 -0400
@@ -27,6 +27,6 @@
 
 signature SCRIPT_CHECK = sig
 
-    val classify : Cjr.file -> Cjr.file
+    val classify : Mono.file -> Mono.file
 
 end
--- a/src/scriptcheck.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/scriptcheck.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -27,7 +27,7 @@
 
 structure ScriptCheck :> SCRIPT_CHECK = struct
 
-open Cjr
+open Mono
 
 structure SS = BinarySetFn(struct
                            type ord_key = string
@@ -35,98 +35,31 @@
                            end)
 structure IS = IntBinarySet
 
-val pullBasis = SS.addList (SS.empty,
-                            ["new_client_source",
-                             "get_client_source",
-                             "set_client_source"])
-
 val pushBasis = SS.addList (SS.empty,
                             ["new_channel",
                              "self"])
 
-val events = ["abort",
-              "blur",
-              "change",
-              "click",
-              "dblclick",
-              "error",
-              "focus",
-              "keydown",
-              "keypress",
-              "keyup",
-              "load",
-              "mousedown",
-              "mousemove",
-              "mouseout",
-              "mouseover",
-              "mouseup",
-              "reset",
-              "resize",
-              "select",
-              "submit",
-              "unload"]
-                
-val scriptWords = "<script"
-                   :: map (fn s => " on" ^ s ^ "='") events
-
-val pushWords = ["rv("]
-
 fun classify (ds, ps) =
     let
         val proto = Settings.currentProtocol ()
 
         fun inString {needle, haystack} = String.isSubstring needle haystack
 
-        fun hasClient {basis, words, onload} csids =
-            let
-                fun hasClient e =
-                    case #1 e of
-                        EPrim (Prim.String s) => List.exists (fn n => inString {needle = n, haystack = s}) words
-                      | EPrim _ => false
-                      | ERel _ => false
-                      | ENamed n => IS.member (csids, n)
-                      | ECon (_, _, NONE) => false
-                      | ECon (_, _, SOME e) => hasClient e
-                      | ENone _ => false
-                      | ESome (_, e) => hasClient e
-                      | EFfi ("Basis", x) => SS.member (basis, x)
-                      | EFfi _ => false
-                      | EFfiApp ("Basis", "maybe_onload",
-                                 [((EFfiApp ("Basis", "strcat", all as [_, ((EPrim (Prim.String s), _), _)]), _), _)]) =>
-                        List.exists (hasClient o #1) all
-                        orelse (onload andalso size s > 0)
-                      | EFfiApp ("Basis", x, es) => SS.member (basis, x)
-                                                    orelse List.exists (hasClient o #1) es
-                      | EFfiApp (_, _, es) => List.exists (hasClient o #1) es
-                      | EApp (e, es) => hasClient e orelse List.exists hasClient es
-                      | EUnop (_, e) => hasClient e
-                      | EBinop (_, e1, e2) => hasClient e1 orelse hasClient e2
-                      | ERecord (_, xes) => List.exists (hasClient o #2) xes
-                      | EField (e, _) => hasClient e
-                      | ECase (e, pes, _) => hasClient e orelse List.exists (hasClient o #2) pes
-                      | EError (e, _) => hasClient e
-                      | EReturnBlob {blob = e1, mimeType = e2, ...} => hasClient e1 orelse hasClient e2
-                      | ERedirect (e, _) => hasClient e
-                      | EWrite e => hasClient e
-                      | ESeq (e1, e2) => hasClient e1 orelse hasClient e2
-                      | ELet (_, _, e1, e2) => hasClient e1 orelse hasClient e2
-                      | EQuery {query, body, initial, ...} => hasClient query orelse hasClient body
-                                                              orelse hasClient initial
-                      | EDml {dml, ...} => hasClient dml
-                      | ENextval {seq, ...} => hasClient seq
-                      | ESetval {seq, count, ...} => hasClient seq orelse hasClient count
-                      | EUnurlify (e, _, _) => hasClient e
-            in
-                hasClient
-            end
+        fun hasClient {basis, funcs, push} =
+            MonoUtil.Exp.exists {typ = fn _ => false,
+                                 exp = fn ERecv _ => push
+                                        | EFfiApp ("Basis", x, _) => SS.member (basis, x) 
+                                        | EJavaScript _ => not push
+                                        | ENamed n => IS.member (funcs, n)
+                                        | _ => false}
 
         fun decl ((d, _), (pull_ids, push_ids)) =
             let
-                val hasClientPull = hasClient {basis = pullBasis, words = scriptWords, onload = true} pull_ids
-                val hasClientPush = hasClient {basis = pushBasis, words = pushWords, onload = false} push_ids
+                val hasClientPull = hasClient {basis = SS.empty, funcs = pull_ids, push = false}
+                val hasClientPush = hasClient {basis = pushBasis, funcs = push_ids, push = true}
             in
                 case d of
-                    DVal (_, n, _, e) => (if hasClientPull e then
+                    DVal (_, n, _, e, _) => (if hasClientPull e then
                                              IS.add (pull_ids, n)
                                           else
                                               pull_ids,
@@ -134,20 +67,12 @@
                                               IS.add (push_ids, n)
                                           else
                                               push_ids)
-                  | DFun (_, n, _, _, e) => (if hasClientPull e then
-                                                 IS.add (pull_ids, n)
-                                             else
-                                                 pull_ids,
-                                             if hasClientPush e then
-                                                 IS.add (push_ids, n)
-                                             else
-                                                 push_ids)
-                  | DFunRec xes => (if List.exists (fn (_, _, _, _, e) => hasClientPull e) xes then
+                  | DValRec xes => (if List.exists (fn (_, _, _, e, _) => hasClientPull e) xes then
                                        foldl (fn ((_, n, _, _, _), pull_ids) => IS.add (pull_ids, n))
                                              pull_ids xes
                                     else
                                         pull_ids,
-                                    if List.exists (fn (_, _, _, _, e) => hasClientPush e) xes then
+                                    if List.exists (fn (_, _, _, e, _) => hasClientPush e) xes then
                                         foldl (fn ((_, n, _, _, _), push_ids) => IS.add (push_ids, n))
                                               push_ids xes
                                     else
@@ -159,21 +84,21 @@
 
         val foundBad = ref false
 
-        val ps = map (fn (ek, x, n, ts, t, _, b) =>
-                         (ek, x, n, ts, t,
-                          if IS.member (push_ids, n) then
-                              (if not (#persistent proto) andalso not (!foundBad) then
-                                   (foundBad := true;
-                                    ErrorMsg.error ("This program needs server push, but the current protocol ("
-                                                    ^ #name proto ^ ") doesn't support that."))
-                               else
-                                   ();
-                               ServerAndPullAndPush)
-                          else if IS.member (pull_ids, n) then
-                              ServerAndPull
-                          else
-                              ServerOnly,
-                          b)) ps
+        val all_ids = IS.union (pull_ids, push_ids)
+
+        val ps = map (fn n =>
+                         (n, if IS.member (push_ids, n) then
+                                 (if not (#persistent proto) andalso not (!foundBad) then
+                                      (foundBad := true;
+                                       ErrorMsg.error ("This program needs server push, but the current protocol ("
+                                                       ^ #name proto ^ ") doesn't support that."))
+                                  else
+                                      ();
+                                  ServerAndPullAndPush)
+                             else if IS.member (pull_ids, n) then
+                                 ServerAndPull
+                             else
+                                 ServerOnly)) (IS.listItems all_ids)
     in
         (ds, ps)
     end
--- a/src/untangle.sml	Tue Mar 12 16:21:20 2013 -0400
+++ b/src/untangle.sml	Fri Mar 15 16:09:55 2013 -0400
@@ -43,7 +43,7 @@
 
       | _ => s
 
-fun untangle file =
+fun untangle (file : file) =
     let
         fun decl (dAll as (d, loc)) =
             case d of
@@ -208,7 +208,7 @@
                 end
               | _ => [dAll]
     in
-        ListUtil.mapConcat decl file
+        (ListUtil.mapConcat decl (#1 file), #2 file)
     end
 
 end