summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/compiler.sig5
-rw-r--r--src/compiler.sml34
-rw-r--r--src/especialize.sml37
-rw-r--r--src/print.sig2
-rw-r--r--src/print.sml2
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)
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-02 14:14:15 +0000