Add an extra Especialize pass before Rpcify

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)