Mercurial > urweb

comparison src/especialize.sml @ 1362:fd34210bc3e5

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