Mercurial > urweb
comparison src/especialize.sml @ 1382:5cb95fb7d4d5
Broaden definition of valueish
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 06 Jan 2011 09:25:15 -0500 |
parents | fd34210bc3e5 |
children | 0af6bd2dd149 |
comparison
equal
deleted
inserted
replaced
1381:bf58ca871c00 | 1382:5cb95fb7d4d5 |
---|---|
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, _) = | 327 fun valueish (all as (e, _)) = |
328 case e of | 328 case e of |
329 EPrim _ => true | 329 EPrim _ => true |
330 | ERel _ => true | 330 | ERel _ => true |
331 | ENamed _ => true | 331 | ENamed _ => true |
332 | ECon (_, _, _, NONE) => true | 332 | ECon (_, _, _, NONE) => true |
335 | EAbs _ => true | 335 | EAbs _ => true |
336 | ECAbs _ => true | 336 | ECAbs _ => true |
337 | EKAbs _ => true | 337 | EKAbs _ => true |
338 | ECApp (e, _) => valueish e | 338 | ECApp (e, _) => valueish e |
339 | EKApp (e, _) => valueish e | 339 | EKApp (e, _) => valueish e |
340 | EApp (e, (ERel _, _)) => | 340 | EApp _ => |
341 let | 341 let |
342 fun valueishf (e, _) = | 342 fun valueishf (e, _) = |
343 case e of | 343 case e of |
344 ENamed _ => true | 344 ENamed _ => true |
345 | EFfi _ => true | |
346 | ECApp (e, _) => valueishf e | |
345 | EApp (e, (ERel _, _)) => valueishf e | 347 | EApp (e, (ERel _, _)) => valueishf e |
348 | EApp (e, (ENamed _, _)) => valueishf e | |
346 | _ => false | 349 | _ => false |
347 in | 350 in |
348 valueishf e | 351 valueishf all |
349 end | 352 end |
350 | ERecord xes => List.all (valueish o #2) xes | 353 | ERecord xes => List.all (valueish o #2) xes |
351 | _ => false | 354 | _ => false |
352 | 355 |
353 val vts = map (fn n => #2 (List.nth (env, n))) (IS.listItems fvs) | 356 val vts = map (fn n => #2 (List.nth (env, n))) (IS.listItems fvs) |
369 ("fxs'", | 372 ("fxs'", |
370 Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs'), | 373 Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs'), |
371 ("b1", p_bool (not fin)), | 374 ("b1", p_bool (not fin)), |
372 ("b2", p_bool (List.all (fn (ERel _, _) => true | 375 ("b2", p_bool (List.all (fn (ERel _, _) => true |
373 | _ => false) fxs')), | 376 | _ => false) fxs')), |
374 ("b2", p_bool (List.exists (not o valueish) fxs')), | 377 ("b3", p_bool (List.exists (not o valueish) fxs')), |
375 ("b3", p_bool (IS.numItems fvs >= length fxs | 378 ("b4", p_bool (IS.numItems fvs >= length fxs |
376 andalso IS.exists (fn n => functionInside (#2 (List.nth (env, n)))) fvs))];*) | 379 andalso IS.exists (fn n => functionInside (#2 (List.nth (env, n)))) fvs))];*) |
377 default ()) | 380 default ()) |
378 else | 381 else |
379 case (KM.find (args, (vts, fxs')), | 382 case (KM.find (args, (vts, fxs')), |
380 SS.member (!mayNotSpec, name) (*orelse IS.member (#specialized st, f)*)) of | 383 SS.member (!mayNotSpec, name) (*orelse IS.member (#specialized st, f)*)) of |