Compiler: add formatter to printing functions

Author: hhugo

compiler/lib/code.ml

@@ -583,16 +583,16 @@ module Print = struct
     | Instr of instr
     | Last of last
 
-  let block annot pc block =
-    Format.eprintf "==== %d (%a) ====@." pc var_list block.params;
+  let block f annot pc block =
+    Format.fprintf f "==== %d (%a) ====@." pc var_list block.params;
     List.iter block.body ~f:(fun i ->
-        Format.eprintf " %s %a@." (annot pc (Instr i)) instr i);
-    Format.eprintf " %s %a@." (annot pc (Last block.branch)) last block.branch;
-    Format.eprintf "@."
+        Format.fprintf f " %s %a@." (annot pc (Instr i)) instr i);
+    Format.fprintf f " %s %a@." (annot pc (Last block.branch)) last block.branch;
+    Format.fprintf f "@."
 
-  let program annot { start; blocks; _ } =
-    Format.eprintf "Entry point: %d@.@." start;
-    Addr.Map.iter (block annot) blocks
+  let program f annot { start; blocks; _ } =
+    Format.fprintf f "Entry point: %d@.@." start;
+    Addr.Map.iter (block f annot) blocks
 end
 
 (****)

compiler/lib/code.mli

@@ -252,9 +252,10 @@ module Print : sig
 
   val instr : Format.formatter -> instr -> unit
 
-  val block : (Addr.Map.key -> xinstr -> string) -> int -> block -> unit
+  val block :
+    Format.formatter -> (Addr.Map.key -> xinstr -> string) -> int -> block -> unit
 
-  val program : (Addr.Map.key -> xinstr -> string) -> program -> unit
+  val program : Format.formatter -> (Addr.Map.key -> xinstr -> string) -> program -> unit
 
   val last : Format.formatter -> last -> unit
 

compiler/lib/deadcode.ml

@@ -290,7 +290,7 @@ let f ({ blocks; _ } as p : Code.program) =
     }
   in
   mark_reachable st p.start;
-  if debug () then Print.program (fun pc xi -> annot st pc xi) p;
+  if debug () then Print.program Format.err_formatter (fun pc xi -> annot st pc xi) p;
   let all_blocks = blocks in
   let blocks =
     Addr.Map.fold

compiler/lib/driver.ml

@@ -141,7 +141,7 @@ let exact_calls profile ~deadcode_sentinal p =
   | `Cps | `Double_translation -> p
 
 let print p =
-  if debug () then Code.Print.program (fun _ _ -> "") p;
+  if debug () then Code.Print.program Format.err_formatter (fun _ _ -> "") p;
   p
 
 let rec loop max name round i (p : 'a) : 'a =

compiler/lib/effects.ml

@@ -754,13 +754,13 @@ let subst_bound_in_blocks blocks s =
       if debug ()
       then (
         debug_print "@[<v>block before first subst: @,";
-        Code.Print.block (fun _ _ -> "") pc block;
+        Code.Print.block Format.err_formatter (fun _ _ -> "") pc block;
         debug_print "@]");
       let res = Subst.Including_Binders.block s block in
       if debug ()
       then (
         debug_print "@[<v>block after first subst: @,";
-        Code.Print.block (fun _ _ -> "") pc res;
+        Code.Print.block Format.err_formatter (fun _ _ -> "") pc res;
         debug_print "@]");
       res)
     blocks
@@ -861,6 +861,7 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p =
               if Addr.Set.mem pc blocks_to_transform then Format.eprintf "CPS@.";
               let block = Addr.Map.find pc blocks in
               Code.Print.block
+                Format.err_formatter
                 (fun _ xi -> Partial_cps_analysis.annot cps_needed xi)
                 pc
                 block)
@@ -1129,7 +1130,7 @@ let f ~flow_info ~live_vars p =
         Var.Set.iter (fun v -> debug_print "%s,@ " (Var.to_string v)) cps_needed;
         debug_print "@]@,@]";
         debug_print "@[<v>After lambda lifting...@,";
-        Code.Print.program (fun _ _ -> "") p;
+        Code.Print.program Format.err_formatter (fun _ _ -> "") p;
         debug_print "@]");
       p, cps_needed)
     else
@@ -1143,6 +1144,6 @@ let f ~flow_info ~live_vars p =
   if debug ()
   then (
     debug_print "@[<v>After CPS transform:@,";
-    Code.Print.program (fun _ _ -> "") p;
+    Code.Print.program Format.err_formatter (fun _ _ -> "") p;
     debug_print "@]");
   p, trampolined_calls, in_cps

compiler/lib/global_deadcode.ml

@@ -573,14 +573,14 @@ let f p ~deadcode_sentinal global_info =
   if debug ()
   then (
     Format.eprintf "Before Zeroing:@.";
-    Code.Print.program (fun _ _ -> "") p;
+    Code.Print.program Format.err_formatter (fun _ _ -> "") p;
     Print.print_uses uses;
     Print.print_live_tbl live_table);
   (* Zero out dead fields *)
   let p = zero p deadcode_sentinal live_table in
   if debug ()
   then (
     Format.eprintf "After Zeroing:@.";
-    Code.Print.program (fun _ _ -> "") p);
+    Code.Print.program Format.err_formatter (fun _ _ -> "") p);
   if times () then Format.eprintf "  global dead code elim.: %a@." Timer.print t;
   p

compiler/lib/lambda_lifting_simple.ml

@@ -358,7 +358,7 @@ let f ~to_lift program =
   if debug ()
   then (
     Format.eprintf "@[<v>Program before lambda lifting:@,";
-    Code.Print.program (fun _ _ -> "") program;
+    Code.Print.program Format.err_formatter (fun _ _ -> "") program;
     Format.eprintf "@]");
   let t = Timer.make () in
   let program, liftings = lift ~to_lift ~pc:program.start program in