From f597f5df711397ca65af11eb61acacbfc3d61027 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 24 Dec 2010 12:51:46 -0500 Subject: Add an extra Especialize pass before Rpcify --- src/compiler.sig | 5 +++++ src/compiler.sml | 34 ++++++++++++++++++++++++++++++++-- src/especialize.sml | 37 +++++++++++++++++++++++++++++++++---- src/print.sig | 2 ++ src/print.sml | 2 ++ 5 files changed, 74 insertions(+), 6 deletions(-) diff --git a/src/compiler.sig b/src/compiler.sig index 971ddf53..a56a679a 100644 --- a/src/compiler.sig +++ b/src/compiler.sig @@ -72,9 +72,12 @@ signature COMPILER = sig 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 @@ signature COMPILER = sig 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 diff --git a/src/compiler.sml b/src/compiler.sml index 67c94d91..0c0a527f 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -133,6 +133,21 @@ fun runPrint (tr : ('src, 'dst) transform) input = 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 @@ fun timePrint (tr : ('src, 'dst) transform) input = 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 shake = { 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 @@ fun compileC {cname, oname, ename, libs, profile, debug, link = link'} = ^ " " ^ #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) = diff --git a/src/especialize.sml b/src/especialize.sml index d089230b..5863e4b5 100644 --- a/src/especialize.sml +++ b/src/especialize.sml @@ -337,11 +337,23 @@ fun specialize' (funcs, specialized) file = | 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 @@ fun specialize' (funcs, specialized) file = ((*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 @@ fun specialize' (funcs, specialized) file = 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 @@ fun specialize' (funcs, specialized) file = 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 @@ fun specialize' (funcs, specialized) file = | 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) => diff --git a/src/print.sig b/src/print.sig index 83c84405..7467e041 100644 --- a/src/print.sig +++ b/src/print.sig @@ -59,4 +59,6 @@ signature PRINT = sig 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 diff --git a/src/print.sml b/src/print.sml index 7329c44d..d4059edf 100644 --- a/src/print.sml +++ b/src/print.sml @@ -32,6 +32,8 @@ structure Print :> PRINT = struct structure SM = TextIOPP structure PD = PPDescFn(SM) +val openOut = SM.openOut + type 'a printer = 'a -> PD.pp_desc fun box ds = PD.hovBox (PD.PPS.Rel 1, ds) -- cgit v1.2.3