Mercurial > urweb
comparison src/shake.sml @ 1062:3bc726a822fb
Shake bug fix; pattern reduction in ReduceLocal
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 08 Dec 2009 11:45:19 -0500 |
parents | 6f4f8b9c5023 |
children | b2311dfb3158 |
comparison
equal
deleted
inserted
replaced
1061:e8a35d710ab9 | 1062:3bc726a822fb |
---|---|
65 ENamed n => (IS.add (es, n), cs) | 65 ENamed n => (IS.add (es, n), cs) |
66 | _ => st} | 66 | _ => st} |
67 | 67 |
68 val (usedE, usedC) = | 68 val (usedE, usedC) = |
69 List.foldl | 69 List.foldl |
70 (fn ((DExport (_, n), _), (usedE, usedC)) => (IS.add (usedE, n), usedE) | 70 (fn ((DExport (_, n), _), (usedE, usedC)) => (IS.add (usedE, n), usedC) |
71 | ((DTable (_, _, c, _, pe, pc, ce, cc), _), (usedE, usedC)) => | 71 | ((DTable (_, _, c, _, pe, pc, ce, cc), _), (usedE, usedC)) => |
72 let | 72 let |
73 val usedC = usedVarsC usedC c | 73 val usedC = usedVarsC usedC c |
74 val usedC = usedVarsC usedC pc | 74 val usedC = usedVarsC usedC pc |
75 val usedC = usedVarsC usedC cc | 75 val usedC = usedVarsC usedC cc |
168 foldl (fn (n, s) => exp (ENamed n, s)) s ns | 168 foldl (fn (n, s) => exp (ENamed n, s)) s ns |
169 end) s usedE | 169 end) s usedE |
170 | 170 |
171 val s = IS.foldl (fn (n, s) => | 171 val s = IS.foldl (fn (n, s) => |
172 case IM.find (cdef, n) of | 172 case IM.find (cdef, n) of |
173 NONE => raise Fail "Shake: Couldn't find 'con'" | 173 NONE => raise Fail ("Shake: Couldn't find 'con' " ^ Int.toString n) |
174 | SOME cs => foldl (fn (c, s) => shakeCon s c) s cs) s usedC | 174 | SOME cs => foldl (fn (c, s) => shakeCon s c) s cs) s usedC |
175 in | 175 in |
176 List.filter (fn (DCon (_, n, _, _), _) => IS.member (#con s, n) | 176 List.filter (fn (DCon (_, n, _, _), _) => IS.member (#con s, n) |
177 | (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 |
178 | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n) | 178 | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n) |