Mercurial > urweb
diff src/mono_shake.sml @ 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 |
parents | 218e2a9a53d0 |
children | 25874084bf1f |
line wrap: on
line diff
--- 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