Mercurial > urweb
changeset 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 | 7a436b6267ab |
| children | 7dd8a6704265 |
| files | src/compiler.sig src/compiler.sml src/especialize.sml src/print.sig src/print.sml |
| diffstat | 5 files changed, 74 insertions(+), 6 deletions(-) [+] |
line wrap: on
line diff
--- a/src/compiler.sig Thu Dec 23 18:07:05 2010 -0500 +++ b/src/compiler.sig Fri Dec 24 12:51:46 2010 -0500 @@ -72,9 +72,12 @@ val check : ('src, 'dst) transform -> 'src -> unit val run : ('src, 'dst) transform -> 'src -> 'dst option val runPrint : ('src, 'dst) transform -> 'src -> unit + val runPrintToFile : ('src, 'dst) transform -> 'src -> string -> unit val time : ('src, 'dst) transform -> 'src -> unit val timePrint : ('src, 'dst) transform -> 'src -> unit + val runPrintCoreFuncs : ('src, Core.file) transform -> 'src -> unit + val parseUr : (string, Source.file) phase val parseUrs : (string, Source.sgn_item list) phase val parseUrp : (string, job) phase @@ -122,6 +125,8 @@ val toCorify : (string, Core.file) transform val toCore_untangle : (string, Core.file) transform val toShake1 : (string, Core.file) transform + val toEspecialize1' : (string, Core.file) transform + val toShake1' : (string, Core.file) transform val toRpcify : (string, Core.file) transform val toCore_untangle2 : (string, Core.file) transform val toShake2 : (string, Core.file) transform
--- a/src/compiler.sml Thu Dec 23 18:07:05 2010 -0500 +++ b/src/compiler.sml Fri Dec 24 12:51:46 2010 -0500 @@ -133,6 +133,21 @@ Print.print (#print tr v); print "\n")) +fun runPrintToFile (tr : ('src, 'dst) transform) input fname = + (ErrorMsg.resetErrors (); + case #func tr input of + NONE => print "Failure\n" + | SOME v => + let + val outf = TextIO.openOut fname + val str = Print.openOut {dst = outf, wid = 80} + in + print "Success\n"; + Print.fprint str (#print tr v); + Print.PD.PPS.closeStream str; + TextIO.closeOut outf + end) + fun time (tr : ('src, 'dst) transform) input = let val (_, pmap) = #time tr (input, []) @@ -159,6 +174,18 @@ print "\n") end +fun runPrintCoreFuncs (tr : ('src, Core.file) transform) input = + (ErrorMsg.resetErrors (); + case #func tr input of + NONE => print "Failure\n" + | SOME file => + (print "Success\n"; + app (fn (d, _) => + case d of + Core.DVal (x, _, t, _, _) => Print.preface(x, CorePrint.p_con CoreEnv.empty t) + | Core.DValRec xts => app (fn (x, _, t, _, _) => Print.preface(x, CorePrint.p_con CoreEnv.empty t)) xts + | _ => ()) file)) + val parseUrs = {func = fn filename => let val fname = OS.FileSys.tmpName () @@ -1060,12 +1087,15 @@ val toShake1 = transform shake "shake1" o toCore_untangle +val toEspecialize1' = transform especialize "especialize1'" o toShake1 +val toShake1' = transform shake "shake1'" o toEspecialize1' + val rpcify = { func = Rpcify.frob, print = CorePrint.p_file CoreEnv.empty } -val toRpcify = transform rpcify "rpcify" o toShake1 +val toRpcify = transform rpcify "rpcify" o toShake1' val toCore_untangle2 = transform core_untangle "core_untangle2" o toRpcify val toShake2 = transform shake "shake2" o toCore_untangle2 @@ -1264,7 +1294,7 @@ ^ " " ^ #compile proto ^ " -c " ^ cname ^ " -o " ^ oname - val link = "gcc -Werror -O3 -lm -pthread " ^ Config.gccArgs ^ " " ^ libs ^ " " ^ lib ^ " " ^ mhash ^ " " ^ oname + val link = "gcc -Werror -O3 -lm -lcrypt -pthread " ^ Config.gccArgs ^ " " ^ libs ^ " " ^ lib ^ " " ^ mhash ^ " " ^ oname ^ " -o " ^ ename val (compile, link) =
--- 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) =>
--- a/src/print.sig Thu Dec 23 18:07:05 2010 -0500 +++ b/src/print.sig Fri Dec 24 12:51:46 2010 -0500 @@ -59,4 +59,6 @@ val fprefaces' : PD.PPS.stream -> (string * PD.pp_desc) list -> unit val prefaces' : (string * PD.pp_desc) list -> unit val eprefaces' : (string * PD.pp_desc) list -> unit + + val openOut : {dst : TextIO.outstream, wid : int} -> PD.PPS.stream end