Mercurial > urweb

comparison src/shake.sml @ 704:70cbdcf5989b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
UNIQUE constraints
author Adam Chlipala <adamc@hcoop.net>
date Tue, 07 Apr 2009 12:24:31 -0400
parents 56aaa1941dad
children e6706a1df013
comparison
equal deleted inserted replaced
703:a5d8b470d7ca 704:70cbdcf5989b
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 shake file = 47 fun shake file =
48 let 48 let
49 val (page_es, table_cs) = 49 val usedVars = U.Exp.fold {kind = fn (_, st) => st,
50 con = fn (c, st as (es, cs)) =>
51 case c of
52 CNamed n => (es, IS.add (cs, n))
53 | _ => st,
54 exp = fn (e, st as (es, cs)) =>
55 case e of
56 ENamed n => (IS.add (es, n), cs)
57 | _ => st}
58
59 val (usedE, usedC, table_cs) =
50 List.foldl 60 List.foldl
51 (fn ((DExport (_, n), _), (page_es, table_cs)) => (n :: page_es, table_cs) 61 (fn ((DExport (_, n), _), (usedE, usedC, table_cs)) => (IS.add (usedE, n), usedE, table_cs)
52 | ((DTable (_, _, c, _), _), (page_es, table_cs)) => (page_es, c :: table_cs) 62 | ((DTable (_, _, c, _, e), _), (usedE, usedC, table_cs)) =>
53 | (_, acc) => acc) ([], []) file 63 let
64 val (usedE, usedC) = usedVars (usedE, usedC) e
65 in
66 (usedE, usedC, c :: table_cs)
67 end
68 | (_, acc) => acc) (IS.empty, IS.empty, []) file
54 69
55 val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, [c]), edef) 70 val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, [c]), edef)
56 | ((DDatatype (_, n, _, xncs), _), (cdef, edef)) => 71 | ((DDatatype (_, n, _, xncs), _), (cdef, edef)) =>
57 (IM.insert (cdef, n, List.mapPartial #3 xncs), edef) 72 (IM.insert (cdef, n, List.mapPartial #3 xncs), edef)
58 | ((DVal (_, n, t, e, _), _), (cdef, edef)) => (cdef, IM.insert (edef, n, ([], t, e))) 73 | ((DVal (_, n, t, e, _), _), (cdef, edef)) => (cdef, IM.insert (edef, n, ([], t, e)))
62 in 77 in
63 (cdef, foldl (fn ((_, n, t, e, _), edef) => 78 (cdef, foldl (fn ((_, n, t, e, _), edef) =>
64 IM.insert (edef, n, (all_ns, t, e))) edef vis) 79 IM.insert (edef, n, (all_ns, t, e))) edef vis)
65 end 80 end
66 | ((DExport _, _), acc) => acc 81 | ((DExport _, _), acc) => acc
67 | ((DTable (_, n, c, _), _), (cdef, edef)) => 82 | ((DTable (_, n, c, _, _), _), (cdef, edef)) =>
68 (cdef, IM.insert (edef, n, ([], c, dummye))) 83 (cdef, IM.insert (edef, n, ([], c, dummye)))
69 | ((DSequence (_, n, _), _), (cdef, edef)) => 84 | ((DSequence (_, n, _), _), (cdef, edef)) =>
70 (cdef, IM.insert (edef, n, ([], dummyt, dummye))) 85 (cdef, IM.insert (edef, n, ([], dummyt, dummye)))
71 | ((DDatabase _, _), acc) => acc 86 | ((DDatabase _, _), acc) => acc
72 | ((DCookie (_, n, c, _), _), (cdef, edef)) => 87 | ((DCookie (_, n, c, _), _), (cdef, edef)) =>
120 | _ => s 135 | _ => s
121 end 136 end
122 137
123 and shakeExp s = U.Exp.fold {kind = kind, con = con, exp = exp} s 138 and shakeExp s = U.Exp.fold {kind = kind, con = con, exp = exp} s
124 139
125 val s = {con = IS.empty, exp = IS.addList (IS.empty, page_es)} 140 val s = {con = usedC, exp = usedE}
126 141
127 val s = foldl (fn (n, s) => 142 val s = IS.foldl (fn (n, s) =>
128 case IM.find (edef, n) of 143 case IM.find (edef, n) of
129 NONE => raise Fail "Shake: Couldn't find 'val'" 144 NONE => raise Fail "Shake: Couldn't find 'val'"
130 | SOME (ns, t, e) => 145 | SOME (ns, t, e) =>
131 let 146 let
132 val s = shakeExp (shakeCon s t) e 147 val s = shakeExp (shakeCon s t) e
133 in 148 in
134 foldl (fn (n, s) => exp (ENamed n, s)) s ns 149 foldl (fn (n, s) => exp (ENamed n, s)) s ns
135 end) s page_es 150 end) s usedE
136 151
137 val s = foldl (fn (c, s) => shakeCon s c) s table_cs 152 val s = foldl (fn (c, s) => shakeCon s c) s table_cs
138 in 153 in
139 List.filter (fn (DCon (_, n, _, _), _) => IS.member (#con s, n) 154 List.filter (fn (DCon (_, n, _, _), _) => IS.member (#con s, n)
140 | (DDatatype (_, n, _, _), _) => IS.member (#con s, n) 155 | (DDatatype (_, n, _, _), _) => IS.member (#con s, n)