Mercurial > urweb

comparison src/specialize.sml @ 847:0f7e2cca6d9b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
<dyn> inside <table>; fix Specialize bug with datatype decls generating other mutually-recursive datatype decls
author Adam Chlipala <adamc@hcoop.net>
date Sat, 13 Jun 2009 14:29:36 -0400
parents 0d30e6338c65
children 20a364c4a6dc
comparison
equal deleted inserted replaced
846:0d30e6338c65 847:0f7e2cca6d9b
244 let 244 let
245 fun doDecl (d, st) = 245 fun doDecl (d, st) =
246 let 246 let
247 (*val () = Print.preface ("decl:", CorePrint.p_decl CoreEnv.empty all)*) 247 (*val () = Print.preface ("decl:", CorePrint.p_decl CoreEnv.empty all)*)
248 val (d, st) = specDecl st d 248 val (d, st) = specDecl st d
249
250 val ds =
251 case #decls st of
252 [] => []
253 | dts => [(DDatatype dts, #2 d)]
254 in 249 in
255 case #1 d of 250 case #1 d of
256 DDatatype dts => 251 DDatatype dts =>
257 (rev (d :: ds), 252 ((case #decls st of
253 [] => [d]
254 | dts' => [(DDatatype (dts' @ dts), #2 d)]),
258 {count = #count st, 255 {count = #count st,
259 datatypes = foldl (fn ((x, n, xs, xnts), dts) => 256 datatypes = foldl (fn ((x, n, xs, xnts), dts) =>
260 IM.insert (dts, n, 257 IM.insert (dts, n,
261 {name = x, 258 {name = x,
262 params = length xs, 259 params = length xs,
268 IM.insert (constructors, n', n)) 265 IM.insert (constructors, n', n))
269 cs xnts) 266 cs xnts)
270 (#constructors st) dts, 267 (#constructors st) dts,
271 decls = []}) 268 decls = []})
272 | _ => 269 | _ =>
273 (rev (d :: ds), 270 (case #decls st of
271 [] => [d]
272 | dts => [(DDatatype dts, #2 d), d],
274 {count = #count st, 273 {count = #count st,
275 datatypes = #datatypes st, 274 datatypes = #datatypes st,
276 constructors = #constructors st, 275 constructors = #constructors st,
277 decls = []}) 276 decls = []})
278 end 277 end
284 decls = []} file 283 decls = []} file
285 in 284 in
286 ds 285 ds
287 end 286 end
288 287
289
290 end 288 end