Mercurial > urweb
comparison src/especialize.sml @ 1362:fd34210bc3e5
Add an extra Especialize pass before Rpcify
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Fri, 24 Dec 2010 12:51:46 -0500 |
parents | ccf1d445b794 |
children | 5cb95fb7d4d5 |
comparison
equal
deleted
inserted
replaced
1361:7a436b6267ab | 1362:fd34210bc3e5 |
---|---|
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 _, _)) => | |
341 let | |
342 fun valueishf (e, _) = | |
343 case e of | |
344 ENamed _ => true | |
345 | EApp (e, (ERel _, _)) => valueishf e | |
346 | _ => false | |
347 in | |
348 valueishf e | |
349 end | |
340 | ERecord xes => List.all (valueish o #2) xes | 350 | ERecord xes => List.all (valueish o #2) xes |
341 | _ => false | 351 | _ => false |
342 | 352 |
343 val vts = map (fn n => #2 (List.nth (env, n))) (IS.listItems fvs) | 353 val vts = map (fn n => #2 (List.nth (env, n))) (IS.listItems fvs) |
344 val fxs' = map (squish (IS.listItems fvs)) fxs | 354 val fxs' = map (squish (IS.listItems fvs)) fxs |
355 | |
356 val p_bool = Print.PD.string o Bool.toString | |
345 in | 357 in |
346 (*Print.prefaces "Func" [("name", Print.PD.string name), | 358 (*Print.prefaces "Func" [("name", Print.PD.string name), |
347 ("e", CorePrint.p_exp CoreEnv.empty e), | 359 ("e", CorePrint.p_exp CoreEnv.empty e), |
348 ("fxs'", Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs')];*) | 360 ("fxs'", Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs')];*) |
349 if not fin | 361 if not fin |
353 orelse (IS.numItems fvs >= length fxs | 365 orelse (IS.numItems fvs >= length fxs |
354 andalso IS.exists (fn n => functionInside (#2 (List.nth (env, n)))) fvs) then | 366 andalso IS.exists (fn n => functionInside (#2 (List.nth (env, n)))) fvs) then |
355 ((*Print.prefaces "No" [("name", Print.PD.string name), | 367 ((*Print.prefaces "No" [("name", Print.PD.string name), |
356 ("f", Print.PD.string (Int.toString f)), | 368 ("f", Print.PD.string (Int.toString f)), |
357 ("fxs'", | 369 ("fxs'", |
358 Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs')];*) | 370 Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs'), |
371 ("b1", p_bool (not fin)), | |
372 ("b2", p_bool (List.all (fn (ERel _, _) => true | |
373 | _ => false) fxs')), | |
374 ("b2", p_bool (List.exists (not o valueish) fxs')), | |
375 ("b3", p_bool (IS.numItems fvs >= length fxs | |
376 andalso IS.exists (fn n => functionInside (#2 (List.nth (env, n)))) fvs))];*) | |
359 default ()) | 377 default ()) |
360 else | 378 else |
361 case (KM.find (args, (vts, fxs')), | 379 case (KM.find (args, (vts, fxs')), |
362 SS.member (!mayNotSpec, name) (*orelse IS.member (#specialized st, f)*)) of | 380 SS.member (!mayNotSpec, name) (*orelse IS.member (#specialized st, f)*)) of |
363 (SOME f', _) => | 381 (SOME f', _) => |
446 val e' = (ENamed f', loc) | 464 val e' = (ENamed f', loc) |
447 val e' = IS.foldr (fn (arg, e) => (EApp (e, (ERel arg, loc)), loc)) | 465 val e' = IS.foldr (fn (arg, e) => (EApp (e, (ERel arg, loc)), loc)) |
448 e' fvs | 466 e' fvs |
449 val e' = foldl (fn (arg, e) => (EApp (e, arg), loc)) | 467 val e' = foldl (fn (arg, e) => (EApp (e, arg), loc)) |
450 e' xs | 468 e' xs |
469 | |
451 (*val () = Print.prefaces "Brand new" | 470 (*val () = Print.prefaces "Brand new" |
452 [("e'", CorePrint.p_exp CoreEnv.empty e'), | 471 [("e'", CorePrint.p_exp CoreEnv.empty e'), |
453 ("e", CorePrint.p_exp CoreEnv.empty e), | 472 ("e", CorePrint.p_exp CoreEnv.empty e), |
454 ("body'", CorePrint.p_exp CoreEnv.empty body')]*) | 473 ("body'", CorePrint.p_exp CoreEnv.empty body')]*) |
455 in | 474 in |
494 (d, st) | 513 (d, st) |
495 else | 514 else |
496 case #1 d of | 515 case #1 d of |
497 DVal (x, n, t, e, s) => | 516 DVal (x, n, t, e, s) => |
498 let | 517 let |
518 (*val () = Print.preface ("Visiting", Print.box [Print.PD.string (x ^ "__" ^ Int.toString n), | |
519 Print.space, | |
520 Print.PD.string ":", | |
521 Print.space, | |
522 CorePrint.p_con CoreEnv.empty t])*) | |
523 | |
499 val (e, st) = exp ([], e, st) | 524 val (e, st) = exp ([], e, st) |
500 in | 525 in |
501 ((DVal (x, n, t, e, s), #2 d), st) | 526 ((DVal (x, n, t, e, s), #2 d), st) |
502 end | 527 end |
503 | DValRec vis => | 528 | DValRec vis => |
504 let | 529 let |
505 (*val () = Print.preface ("Visiting", Print.p_list (fn vi => | 530 (*val () = Print.preface ("Visiting", Print.p_list (fn vi => |
506 Print.PD.string (#1 vi ^ "__" | 531 Print.box [Print.PD.string (#1 vi ^ "__" |
507 ^ Int.toString | 532 ^ Int.toString |
508 (#2 vi))) | 533 (#2 vi)), |
534 Print.space, | |
535 Print.PD.string ":", | |
536 Print.space, | |
537 CorePrint.p_con CoreEnv.empty (#3 vi)]) | |
509 vis)*) | 538 vis)*) |
510 | 539 |
511 val (vis, st) = ListUtil.foldlMap (fn ((x, n, t, e, s), st) => | 540 val (vis, st) = ListUtil.foldlMap (fn ((x, n, t, e, s), st) => |
512 let | 541 let |
513 val () = mayNotSpec := SS.empty | 542 val () = mayNotSpec := SS.empty |