Mercurial > urweb
comparison src/mono_shake.sml @ 1535:27190faa36a3
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'" |