Mercurial > urweb

comparison src/shake.sml @ 1060:6f4f8b9c5023

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix a Shake bug that led to missing some cons
author Adam Chlipala <adamc@hcoop.net>
date Tue, 08 Dec 2009 09:33:08 -0500
parents dfe34fad749d
children 3bc726a822fb
comparison
equal deleted inserted replaced
1059:03a81e26e5fe 1060:6f4f8b9c5023
42 } 42 }
43 43
44 val dummyt = (TRecord (CRecord ((KType, ErrorMsg.dummySpan), []), ErrorMsg.dummySpan), ErrorMsg.dummySpan) 44 val dummyt = (TRecord (CRecord ((KType, ErrorMsg.dummySpan), []), ErrorMsg.dummySpan), ErrorMsg.dummySpan)
45 val dummye = (EPrim (Prim.String ""), ErrorMsg.dummySpan) 45 val dummye = (EPrim (Prim.String ""), ErrorMsg.dummySpan)
46 46
47 fun tupleC cs = (CTuple cs, ErrorMsg.dummySpan)
48 fun tupleE es = (ERecord (map (fn e => (dummyt, e, dummyt)) es), ErrorMsg.dummySpan)
49
47 fun shake file = 50 fun shake file =
48 let 51 let
52 val usedVarsC = U.Con.fold {kind = fn (_, st) => st,
53 con = fn (c, cs) =>
54 case c of
55 CNamed n => IS.add (cs, n)
56 | _ => cs}
57
49 val usedVars = U.Exp.fold {kind = fn (_, st) => st, 58 val usedVars = U.Exp.fold {kind = fn (_, st) => st,
50 con = fn (c, st as (es, cs)) => 59 con = fn (c, st as (es, cs)) =>
51 case c of 60 case c of
52 CNamed n => (es, IS.add (cs, n)) 61 CNamed n => (es, IS.add (cs, n))
53 | _ => st, 62 | _ => st,
54 exp = fn (e, st as (es, cs)) => 63 exp = fn (e, st as (es, cs)) =>
55 case e of 64 case e of
56 ENamed n => (IS.add (es, n), cs) 65 ENamed n => (IS.add (es, n), cs)
57 | _ => st} 66 | _ => st}
58 67
59 val (usedE, usedC, table_cs) = 68 val (usedE, usedC) =
60 List.foldl 69 List.foldl
61 (fn ((DExport (_, n), _), (usedE, usedC, table_cs)) => (IS.add (usedE, n), usedE, table_cs) 70 (fn ((DExport (_, n), _), (usedE, usedC)) => (IS.add (usedE, n), usedE)
62 | ((DTable (_, _, c, _, pe, _, ce, _), _), (usedE, usedC, table_cs)) => 71 | ((DTable (_, _, c, _, pe, pc, ce, cc), _), (usedE, usedC)) =>
63 let 72 let
73 val usedC = usedVarsC usedC c
74 val usedC = usedVarsC usedC pc
75 val usedC = usedVarsC usedC cc
76
64 val (usedE, usedC) = usedVars (usedE, usedC) pe 77 val (usedE, usedC) = usedVars (usedE, usedC) pe
65 val (usedE, usedC) = usedVars (usedE, usedC) ce 78 val (usedE, usedC) = usedVars (usedE, usedC) ce
66 in 79 in
67 (usedE, usedC, c :: table_cs) 80 (usedE, usedC)
68 end 81 end
69 | (_, acc) => acc) (IS.empty, IS.empty, []) file 82 | (_, acc) => acc) (IS.empty, IS.empty) file
70 83
71 val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, [c]), edef) 84 val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, [c]), edef)
72 | ((DDatatype dts, _), (cdef, edef)) => 85 | ((DDatatype dts, _), (cdef, edef)) =>
73 (foldl (fn ((_, n, _, xncs), cdef) => 86 (foldl (fn ((_, n, _, xncs), cdef) =>
74 IM.insert (cdef, n, List.mapPartial #3 xncs)) cdef dts, edef) 87 IM.insert (cdef, n, List.mapPartial #3 xncs)) cdef dts, edef)
79 in 92 in
80 (cdef, foldl (fn ((_, n, t, e, _), edef) => 93 (cdef, foldl (fn ((_, n, t, e, _), edef) =>
81 IM.insert (edef, n, (all_ns, t, e))) edef vis) 94 IM.insert (edef, n, (all_ns, t, e))) edef vis)
82 end 95 end
83 | ((DExport _, _), acc) => acc 96 | ((DExport _, _), acc) => acc
84 | ((DTable (_, n, c, _, _, _, _, _), _), (cdef, edef)) => 97 | ((DTable (_, n, c, _, e1, c1, e2, c2), _), (cdef, edef)) =>
85 (cdef, IM.insert (edef, n, ([], c, dummye))) 98 (cdef, IM.insert (edef, n, ([], tupleC [c, c1, c2], tupleE [e1, e2])))
86 | ((DSequence (_, n, _), _), (cdef, edef)) => 99 | ((DSequence (_, n, _), _), (cdef, edef)) =>
87 (cdef, IM.insert (edef, n, ([], dummyt, dummye))) 100 (cdef, IM.insert (edef, n, ([], dummyt, dummye)))
88 | ((DView (_, n, _, _, c), _), (cdef, edef)) => 101 | ((DView (_, n, _, _, c), _), (cdef, edef)) =>
89 (cdef, IM.insert (edef, n, ([], c, dummye))) 102 (cdef, IM.insert (edef, n, ([], c, dummye)))
90 | ((DDatabase _, _), acc) => acc 103 | ((DDatabase _, _), acc) => acc
153 val s = shakeExp (shakeCon s t) e 166 val s = shakeExp (shakeCon s t) e
154 in 167 in
155 foldl (fn (n, s) => exp (ENamed n, s)) s ns 168 foldl (fn (n, s) => exp (ENamed n, s)) s ns
156 end) s usedE 169 end) s usedE
157 170
158 val s = foldl (fn (c, s) => shakeCon s c) s table_cs 171 val s = IS.foldl (fn (n, s) =>
172 case IM.find (cdef, n) of
173 NONE => raise Fail "Shake: Couldn't find 'con'"
174 | SOME cs => foldl (fn (c, s) => shakeCon s c) s cs) s usedC
159 in 175 in
160 List.filter (fn (DCon (_, n, _, _), _) => IS.member (#con s, n) 176 List.filter (fn (DCon (_, n, _, _), _) => IS.member (#con s, n)
161 | (DDatatype dts, _) => List.exists (fn (_, n, _, _) => IS.member (#con s, n)) dts 177 | (DDatatype dts, _) => List.exists (fn (_, n, _, _) => IS.member (#con s, n)) dts
162 | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n) 178 | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n)
163 | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis 179 | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis