Mercurial > urweb

comparison src/mono_shake.sml @ 1535:27190faa36a3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Handle case where shakeExp can remove datatype.
author Karn Kallio <kkallio@eka>
date Sat, 13 Aug 2011 00:07:28 -0430
parents b4480a56cab7
children cbacd38d4ec2
comparison
equal deleted inserted replaced
1534:89d7b1c3199a 1535:27190faa36a3
41 exp : IS.set 41 exp : IS.set
42 } 42 }
43 43
44 fun shake file = 44 fun shake file =
45 let 45 let
46 val usedVars = U.Exp.fold {typ = fn (c, st as (cs, es)) =>
47 case c of
48 TDatatype (n, _) => (IS.add (cs, n), es)
49 | _ => st,
50 exp = fn (e, st as (cs, es)) =>
51 case e of
52 ENamed n => (cs, IS.add (es, n))
53 | _ => st}
54
55 val (page_cs, page_es) =
56 List.foldl
57 (fn ((DExport (_, _, n, _, _, _), _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n))
58 | ((DDatabase {expunge = n1, initialize = n2, ...}, _), (page_cs, page_es)) =>
59 (page_cs, IS.addList (page_es, [n1, n2]))
60 | ((DTask (e1, e2), _), st) => usedVars (usedVars st e2) e1
61 | ((DView (_, _, e), _), st) => usedVars st e
62 | ((DPolicy pol, _), st) =>
63 let
64 val e1 = case pol of
65 PolClient e1 => e1
66 | PolInsert e1 => e1
67 | PolDelete e1 => e1
68 | PolUpdate e1 => e1
69 | PolSequence e1 => e1
70 in
71 usedVars st e1
72 end
73 | ((DOnError n, _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n))
74 | (_, st) => st) (IS.empty, IS.empty) file
75
76 val (cdef, edef) = foldl (fn ((DDatatype dts, _), (cdef, edef)) => 46 val (cdef, edef) = foldl (fn ((DDatatype dts, _), (cdef, edef)) =>
77 (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)
78 | ((DVal (_, n, t, e, _), _), (cdef, edef)) => 48 | ((DVal (_, n, t, e, _), _), (cdef, edef)) =>
79 (cdef, IM.insert (edef, n, (t, e))) 49 (cdef, IM.insert (edef, n, (t, e)))
80 | ((DValRec vis, _), (cdef, edef)) => 50 | ((DValRec vis, _), (cdef, edef)) =>
130 end 100 end
131 | _ => s 101 | _ => s
132 102
133 and shakeExp s = U.Exp.fold {typ = typ, exp = exp} s 103 and shakeExp s = U.Exp.fold {typ = typ, exp = exp} s
134 104
105 (*
106 val usedVars = U.Exp.fold {typ = fn (c, st as (cs, es)) =>
107 case c of
108 TDatatype (n, _) => (IS.add (cs, n), es)
109 | _ => st,
110 exp = fn (e, st as (cs, es)) =>
111 case e of
112 ENamed n => (cs, IS.add (es, n))
113 | _ => st}
114 *)
115
116 fun usedVars (cs, es) e =
117 let
118 val {con = cs', exp = es'} = shakeExp {con = cs, exp = es} e
119 in
120 (cs', es')
121 end
122
123 val (page_cs, page_es) =
124 List.foldl
125 (fn ((DExport (_, _, n, _, _, _), _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n))
126 | ((DDatabase {expunge = n1, initialize = n2, ...}, _), (page_cs, page_es)) =>
127 (page_cs, IS.addList (page_es, [n1, n2]))
128 | ((DTask (e1, e2), _), st) => usedVars (usedVars st e2) e1
129 | ((DView (_, _, e), _), st) => usedVars st e
130 | ((DPolicy pol, _), st) =>
131 let
132 val e1 = case pol of
133 PolClient e1 => e1
134 | PolInsert e1 => e1
135 | PolDelete e1 => e1
136 | PolUpdate e1 => e1
137 | PolSequence e1 => e1
138 in
139 usedVars st e1
140 end
141 | ((DOnError n, _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n))
142 | (_, st) => st) (IS.empty, IS.empty) file
143
135 val s = {con = page_cs, exp = page_es} 144 val s = {con = page_cs, exp = page_es}
136 145
137 val s = IS.foldl (fn (n, s) => 146 val s = IS.foldl (fn (n, s) =>
138 case IM.find (cdef, n) of 147 case IM.find (cdef, n) of
139 NONE => raise Fail "MonoShake: Couldn't find 'datatype'" 148 NONE => raise Fail "MonoShake: Couldn't find 'datatype'"