Mercurial > urweb
diff 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 |
line wrap: on
line diff
--- a/src/especialize.sml Thu Dec 23 18:07:05 2010 -0500 +++ b/src/especialize.sml Fri Dec 24 12:51:46 2010 -0500 @@ -337,11 +337,23 @@ | EKAbs _ => true | ECApp (e, _) => valueish e | EKApp (e, _) => valueish e + | EApp (e, (ERel _, _)) => + let + fun valueishf (e, _) = + case e of + ENamed _ => true + | EApp (e, (ERel _, _)) => valueishf e + | _ => false + in + valueishf e + end | ERecord xes => List.all (valueish o #2) xes | _ => false val vts = map (fn n => #2 (List.nth (env, n))) (IS.listItems fvs) val fxs' = map (squish (IS.listItems fvs)) fxs + + val p_bool = Print.PD.string o Bool.toString in (*Print.prefaces "Func" [("name", Print.PD.string name), ("e", CorePrint.p_exp CoreEnv.empty e), @@ -355,7 +367,13 @@ ((*Print.prefaces "No" [("name", Print.PD.string name), ("f", Print.PD.string (Int.toString f)), ("fxs'", - Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs')];*) + Print.p_list (CorePrint.p_exp CoreEnv.empty) fxs'), + ("b1", p_bool (not fin)), + ("b2", p_bool (List.all (fn (ERel _, _) => true + | _ => false) fxs')), + ("b2", p_bool (List.exists (not o valueish) fxs')), + ("b3", p_bool (IS.numItems fvs >= length fxs + andalso IS.exists (fn n => functionInside (#2 (List.nth (env, n)))) fvs))];*) default ()) else case (KM.find (args, (vts, fxs')), @@ -448,6 +466,7 @@ e' fvs val e' = foldl (fn (arg, e) => (EApp (e, arg), loc)) e' xs + (*val () = Print.prefaces "Brand new" [("e'", CorePrint.p_exp CoreEnv.empty e'), ("e", CorePrint.p_exp CoreEnv.empty e), @@ -496,6 +515,12 @@ case #1 d of DVal (x, n, t, e, s) => let + (*val () = Print.preface ("Visiting", Print.box [Print.PD.string (x ^ "__" ^ Int.toString n), + Print.space, + Print.PD.string ":", + Print.space, + CorePrint.p_con CoreEnv.empty t])*) + val (e, st) = exp ([], e, st) in ((DVal (x, n, t, e, s), #2 d), st) @@ -503,9 +528,13 @@ | DValRec vis => let (*val () = Print.preface ("Visiting", Print.p_list (fn vi => - Print.PD.string (#1 vi ^ "__" - ^ Int.toString - (#2 vi))) + Print.box [Print.PD.string (#1 vi ^ "__" + ^ Int.toString + (#2 vi)), + Print.space, + Print.PD.string ":", + Print.space, + CorePrint.p_con CoreEnv.empty (#3 vi)]) vis)*) val (vis, st) = ListUtil.foldlMap (fn ((x, n, t, e, s), st) =>