Mercurial > urweb

comparison src/mono_shake.sml @ 1845:c1e3805e604e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
1844:2c5e6f78560c 1845:c1e3805e604e
39 type free = { 39 type free = {
40 con : IS.set, 40 con : IS.set,
41 exp : IS.set 41 exp : IS.set
42 } 42 }
43 43
44 fun shake file = 44 fun shake (file : file) =
45 let 45 let
46 val (cdef, edef) = foldl (fn ((DDatatype dts, _), (cdef, edef)) => 46 val (cdef, edef) = foldl (fn ((DDatatype dts, _), (cdef, edef)) =>
47 (foldl (fn ((_, n, xncs), cdef) => IM.insert (cdef, n, xncs)) cdef dts, edef) 47 (foldl (fn ((_, n, xncs), cdef) => IM.insert (cdef, n, xncs)) cdef dts, edef)
48 | ((DVal (_, n, t, e, _), _), (cdef, edef)) => 48 | ((DVal (_, n, t, e, _), _), (cdef, edef)) =>
49 (cdef, IM.insert (edef, n, (t, e))) 49 (cdef, IM.insert (edef, n, (t, e)))
58 | ((DCookie _, _), acc) => acc 58 | ((DCookie _, _), acc) => acc
59 | ((DStyle _, _), acc) => acc 59 | ((DStyle _, _), acc) => acc
60 | ((DTask _, _), acc) => acc 60 | ((DTask _, _), acc) => acc
61 | ((DPolicy _, _), acc) => acc 61 | ((DPolicy _, _), acc) => acc
62 | ((DOnError _, _), acc) => acc) 62 | ((DOnError _, _), acc) => acc)
63 (IM.empty, IM.empty) file 63 (IM.empty, IM.empty) (#1 file)
64 64
65 fun typ (c, s) = 65 fun typ (c, s) =
66 case c of 66 case c of
67 TDatatype (n, _) => 67 TDatatype (n, _) =>
68 if IS.member (#con s, n) then 68 if IS.member (#con s, n) then
128 | PolSequence e1 => e1 128 | PolSequence e1 => e1
129 in 129 in
130 usedVars st e1 130 usedVars st e1
131 end 131 end
132 | ((DOnError n, _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n)) 132 | ((DOnError n, _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n))
133 | (_, st) => st) (IS.empty, IS.empty) file 133 | (_, st) => st) (IS.empty, IS.empty) (#1 file)
134 134
135 val s = {con = page_cs, exp = page_es} 135 val s = {con = page_cs, exp = page_es}
136 136
137 val s = IS.foldl (fn (n, s) => 137 val s = IS.foldl (fn (n, s) =>
138 case IM.find (cdef, n) of 138 case IM.find (cdef, n) of
143 val s = IS.foldl (fn (n, s) => 143 val s = IS.foldl (fn (n, s) =>
144 case IM.find (edef, n) of 144 case IM.find (edef, n) of
145 NONE => raise Fail "MonoShake: Couldn't find 'val'" 145 NONE => raise Fail "MonoShake: Couldn't find 'val'"
146 | SOME (t, e) => shakeExp s e) s page_es 146 | SOME (t, e) => shakeExp s e) s page_es
147 in 147 in
148 List.filter (fn (DDatatype dts, _) => List.exists (fn (_, n, _) => IS.member (#con s, n)) dts 148 (List.filter (fn (DDatatype dts, _) => List.exists (fn (_, n, _) => IS.member (#con s, n)) dts
149 | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n) 149 | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n)
150 | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis 150 | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis
151 | (DExport _, _) => true 151 | (DExport _, _) => true
152 | (DTable _, _) => true 152 | (DTable _, _) => true
153 | (DSequence _, _) => true 153 | (DSequence _, _) => true
154 | (DView _, _) => true 154 | (DView _, _) => true
155 | (DDatabase _, _) => true 155 | (DDatabase _, _) => true
156 | (DJavaScript _, _) => true 156 | (DJavaScript _, _) => true
157 | (DCookie _, _) => true 157 | (DCookie _, _) => true
158 | (DStyle _, _) => true 158 | (DStyle _, _) => true
159 | (DTask _, _) => true 159 | (DTask _, _) => true
160 | (DPolicy _, _) => true 160 | (DPolicy _, _) => true
161 | (DOnError _, _) => true) file 161 | (DOnError _, _) => true) (#1 file), #2 file)
162 end 162 end
163 163
164 end 164 end