Mercurial > urweb

comparison src/cjrize.sml @ 188:8e9f97508f0d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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)