Mercurial > urweb
comparison src/cjrize.sml @ 188:8e9f97508f0d
Datatype representation optimization
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 03 Aug 2008 19:49:21 -0400 |
parents | 88d46972de53 |
children | 890a61991263 |
comparison
equal
deleted
inserted
replaced
187:fb6ed259f5bd | 188:8e9f97508f0d |
---|---|
82 sm xts | 82 sm xts |
83 val (sm, si) = Sm.find (sm, old_xts, xts) | 83 val (sm, si) = Sm.find (sm, old_xts, xts) |
84 in | 84 in |
85 ((L'.TRecord si, loc), sm) | 85 ((L'.TRecord si, loc), sm) |
86 end | 86 end |
87 | L.TDatatype (n, xncs) => | 87 | L.TDatatype (dk, n, xncs) => |
88 let | 88 let |
89 val (xncs, sm) = ListUtil.foldlMap (fn ((x, n, to), sm) => | 89 val (xncs, sm) = ListUtil.foldlMap (fn ((x, n, to), sm) => |
90 case to of | 90 case to of |
91 NONE => ((x, n, NONE), sm) | 91 NONE => ((x, n, NONE), sm) |
92 | SOME t => | 92 | SOME t => |
95 in | 95 in |
96 ((x, n, SOME t), sm) | 96 ((x, n, SOME t), sm) |
97 end) | 97 end) |
98 sm xncs | 98 sm xncs |
99 in | 99 in |
100 ((L'.TDatatype (n, xncs), loc), sm) | 100 ((L'.TDatatype (dk, n, xncs), loc), sm) |
101 end | 101 end |
102 | L.TFfi mx => ((L'.TFfi mx, loc), sm) | 102 | L.TFfi mx => ((L'.TFfi mx, loc), sm) |
103 | 103 |
104 val dummye = (L'.EPrim (Prim.Int 0), ErrorMsg.dummySpan) | 104 val dummye = (L'.EPrim (Prim.Int 0), ErrorMsg.dummySpan) |
105 | 105 |
129 val (t, sm) = cifyTyp (t, sm) | 129 val (t, sm) = cifyTyp (t, sm) |
130 in | 130 in |
131 ((L'.PVar (x, t), loc), sm) | 131 ((L'.PVar (x, t), loc), sm) |
132 end | 132 end |
133 | L.PPrim p => ((L'.PPrim p, loc), sm) | 133 | L.PPrim p => ((L'.PPrim p, loc), sm) |
134 | L.PCon (pc, NONE) => | 134 | L.PCon (dk, pc, NONE) => |
135 let | 135 let |
136 val (pc, sm) = cifyPatCon (pc, sm) | 136 val (pc, sm) = cifyPatCon (pc, sm) |
137 in | 137 in |
138 ((L'.PCon (pc, NONE), loc), sm) | 138 ((L'.PCon (dk, pc, NONE), loc), sm) |
139 end | 139 end |
140 | L.PCon (pc, SOME p) => | 140 | L.PCon (dk, pc, SOME p) => |
141 let | 141 let |
142 val (pc, sm) = cifyPatCon (pc, sm) | 142 val (pc, sm) = cifyPatCon (pc, sm) |
143 val (p, sm) = cifyPat (p, sm) | 143 val (p, sm) = cifyPat (p, sm) |
144 in | 144 in |
145 ((L'.PCon (pc, SOME p), loc), sm) | 145 ((L'.PCon (dk, pc, SOME p), loc), sm) |
146 end | 146 end |
147 | L.PRecord xps => | 147 | L.PRecord xps => |
148 let | 148 let |
149 val (xps, sm) = ListUtil.foldlMap (fn ((x, p, t), sm) => | 149 val (xps, sm) = ListUtil.foldlMap (fn ((x, p, t), sm) => |
150 let | 150 let |
160 fun cifyExp ((e, loc), sm) = | 160 fun cifyExp ((e, loc), sm) = |
161 case e of | 161 case e of |
162 L.EPrim p => ((L'.EPrim p, loc), sm) | 162 L.EPrim p => ((L'.EPrim p, loc), sm) |
163 | L.ERel n => ((L'.ERel n, loc), sm) | 163 | L.ERel n => ((L'.ERel n, loc), sm) |
164 | L.ENamed n => ((L'.ENamed n, loc), sm) | 164 | L.ENamed n => ((L'.ENamed n, loc), sm) |
165 | L.ECon (pc, eo) => | 165 | L.ECon (dk, pc, eo) => |
166 let | 166 let |
167 val (eo, sm) = | 167 val (eo, sm) = |
168 case eo of | 168 case eo of |
169 NONE => (NONE, sm) | 169 NONE => (NONE, sm) |
170 | SOME e => | 170 | SOME e => |
173 in | 173 in |
174 (SOME e, sm) | 174 (SOME e, sm) |
175 end | 175 end |
176 val (pc, sm) = cifyPatCon (pc, sm) | 176 val (pc, sm) = cifyPatCon (pc, sm) |
177 in | 177 in |
178 ((L'.ECon (pc, eo), loc), sm) | 178 ((L'.ECon (dk, pc, eo), loc), sm) |
179 end | 179 end |
180 | L.EFfi mx => ((L'.EFfi mx, loc), sm) | 180 | L.EFfi mx => ((L'.EFfi mx, loc), sm) |
181 | L.EFfiApp (m, x, es) => | 181 | L.EFfiApp (m, x, es) => |
182 let | 182 let |
183 val (es, sm) = ListUtil.foldlMap cifyExp sm es | 183 val (es, sm) = ListUtil.foldlMap cifyExp sm es |
266 | 266 |
267 fun cifyDecl ((d, loc), sm) = | 267 fun cifyDecl ((d, loc), sm) = |
268 case d of | 268 case d of |
269 L.DDatatype (x, n, xncs) => | 269 L.DDatatype (x, n, xncs) => |
270 let | 270 let |
271 val dk = MonoUtil.classifyDatatype xncs | |
271 val (xncs, sm) = ListUtil.foldlMap (fn ((x, n, to), sm) => | 272 val (xncs, sm) = ListUtil.foldlMap (fn ((x, n, to), sm) => |
272 case to of | 273 case to of |
273 NONE => ((x, n, NONE), sm) | 274 NONE => ((x, n, NONE), sm) |
274 | SOME t => | 275 | SOME t => |
275 let | 276 let |
276 val (t, sm) = cifyTyp (t, sm) | 277 val (t, sm) = cifyTyp (t, sm) |
277 in | 278 in |
278 ((x, n, SOME t), sm) | 279 ((x, n, SOME t), sm) |
279 end) sm xncs | 280 end) sm xncs |
280 in | 281 in |
281 (SOME (L'.DDatatype (x, n, xncs), loc), NONE, sm) | 282 (SOME (L'.DDatatype (dk, x, n, xncs), loc), NONE, sm) |
282 end | 283 end |
283 | 284 |
284 | L.DVal (x, n, t, e, _) => | 285 | L.DVal (x, n, t, e, _) => |
285 let | 286 let |
286 val (t, sm) = cifyTyp (t, sm) | 287 val (t, sm) = cifyTyp (t, sm) |