Mercurial > urweb

comparison src/especialize.sml @ 1355:ccf1d445b794

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Hopeful fix to stop Especialize infinite looping
author Adam Chlipala <adam@chlipala.net>
date Tue, 21 Dec 2010 13:57:12 -0500
parents 6c2e565adca6
children fd34210bc3e5
comparison
equal deleted inserted replaced
1354:1b286f2309bc 1355:ccf1d445b794
322 end 322 end
323 | _ => (rev fxs, xs, fvs, fin) 323 | _ => (rev fxs, xs, fvs, fin)
324 324
325 val (fxs, xs, fvs, fin) = findSplit true (xs, typ, [], IS.empty, false) 325 val (fxs, xs, fvs, fin) = findSplit true (xs, typ, [], IS.empty, false)
326 326
327 fun valueish (e, _) =
328 case e of
329 EPrim _ => true
330 | ERel _ => true
331 | ENamed _ => true
332 | ECon (_, _, _, NONE) => true
333 | ECon (_, _, _, SOME e) => valueish e
334 | EFfi (_, _) => true
335 | EAbs _ => true
336 | ECAbs _ => true
337 | EKAbs _ => true
338 | ECApp (e, _) => valueish e
339 | EKApp (e, _) => valueish e
340 | ERecord xes => List.all (valueish o #2) xes
341 | _ => false
342
327 val vts = map (fn n => #2 (List.nth (env, n))) (IS.listItems fvs) 343 val vts = map (fn n => #2 (List.nth (env, n))) (IS.listItems fvs)
328 val fxs' = map (squish (IS.listItems fvs)) fxs 344 val fxs' = map (squish (IS.listItems fvs)) fxs
329 in 345 in
330 (*Print.preface ("fxs'", Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs');*) 346 (*Print.prefaces "Func" [("name", Print.PD.string name),
347 ("e", CorePrint.p_exp CoreEnv.empty e),
348 ("fxs'", Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs')];*)
331 if not fin 349 if not fin
332 orelse List.all (fn (ERel _, _) => true 350 orelse List.all (fn (ERel _, _) => true
333 | _ => false) fxs' 351 | _ => false) fxs'
352 orelse List.exists (not o valueish) fxs'
334 orelse (IS.numItems fvs >= length fxs 353 orelse (IS.numItems fvs >= length fxs
335 andalso IS.exists (fn n => functionInside (#2 (List.nth (env, n)))) fvs) then 354 andalso IS.exists (fn n => functionInside (#2 (List.nth (env, n)))) fvs) then
336 ((*Print.prefaces "No" [("name", Print.PD.string name), 355 ((*Print.prefaces "No" [("name", Print.PD.string name),
337 ("f", Print.PD.string (Int.toString f)), 356 ("f", Print.PD.string (Int.toString f)),
338 ("fxs'", 357 ("fxs'",