improve code pretty printer

bin/main.ml

@@ -8,7 +8,7 @@ let () =
     let ast = parse "fun f() 3  val x = f() + 1" in
     Logs.debug (fun m -> m "%a" Ast.pp_modl ast);
     let prog = compile ast in
-    Logs.debug (fun m -> m "%a" Code.pp_funct prog.main);
+    Logs.debug (fun m -> Code.dump (m "%s") prog.main);
     let modl = run prog in
     Logs.debug (fun m -> m "%a" Value.pp modl)
   with Error msg -> Logs.err (fun m -> m "%s" msg)

lib/runtime/code.ml

@@ -61,28 +61,30 @@ let instructions b =
   List.rev b.ins_list_rev
 
 let iter_blocks_df f b0 =
-  let stack = ref [ b0 ] in
-  let visited = ref !stack in
+  let queue = ref [ b0 ] in
+  let visited = ref !queue in
   let enqueue b =
     if not (List.memq b !visited) then (
-      stack := b :: !stack;
+      queue := !queue @ [b];
       visited := b :: !visited)
   in
-  let visit b =
-    f b;
-    (* NOTE: only [List.hd b.ins_list_rev] should be a branching instruction, so iterating
-       the whole list is pointless. but just to be safe ... *)
-    List.iter
-      (function
-        | JMP b1 -> enqueue b1
-        | CBR (_, b1, b2) -> enqueue b1; enqueue b2
-        | _ -> ())
-      b.ins_list_rev
+  let rec loop () =
+    match !queue with
+    | [] -> ()
+    | b :: rest ->
+      queue := rest;
+      f b;
+      (* NOTE: only [List.hd b.ins_list_rev] should be a branching instruction, so iterating
+         the whole list is pointless. but just to be safe ... *)
+      List.iter
+        (function
+          | JMP b1 -> enqueue b1
+          | CBR (_, b1, b2) -> enqueue b1; enqueue b2
+          | _ -> ())
+        b.ins_list_rev;
+      loop ()
   in
-  while !stack <> [] do
-    visit (List.hd !stack);
-    stack := List.tl !stack;
-  done
+  loop ()
 
 
 type funct =
@@ -150,33 +152,23 @@ let pp_ins ~label ppf = function
     let l2 = label b2 in
     Fmt.pf ppf "cbr %a, %s, %s" pp_reg a l1 l2
 
-let pp_funct ppf { entry; _ } =
-  let basic_blocks = ref [ entry, "START" ] in
-  let work_list = ref [ entry ] in
-  let label bb =
-    try List.assq bb !basic_blocks
+let dump println fn =
+  let labels = ref [ fn.entry, "ENTRY" ] in
+  let label b =
+    try List.assq b !labels
     with Not_found ->
-      let name = Fmt.str "L%d" (List.length !basic_blocks - 1) in
-      basic_blocks := (bb, name) :: !basic_blocks;
-      work_list := !work_list @ [ bb ];
-      name
+      let n = List.length !labels - 1 in
+      let l = Fmt.str "B%d" n in
+      labels := (b, l) :: !labels; l
   in
-  let rec loop i =
-    match !work_list with
-    | [] -> ()
-    | bb :: rest ->
-      work_list := rest;
-      if i > 0 then Fmt.pf ppf ",";
-      Fmt.pf ppf "%S:[" (label bb);
-      List.iteri
-        (fun i is ->
-           if i > 0 then Fmt.pf ppf ",";
-           let str = Fmt.str "%a" (pp_ins ~label) is in
-           Fmt.pf ppf "%S" str)
-        (instructions bb);
-      Fmt.pf ppf "]";
-      loop (i + 1)
-  in
-  Fmt.pf ppf "{";
-  loop 0;
-  Fmt.pf ppf "}"
+  let pp_ins = pp_ins ~label in
+  iter_blocks_df
+    (fun b ->
+       List.fold_left
+         (fun pfx ins ->
+            println (Fmt.str "%-8s%a" pfx pp_ins ins);
+            "")
+         (label b ^ ":")
+         (instructions b)
+       |> ignore)
+    fn.entry