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,14 +61,18 @@ let instructions b =
   List.rev b.ins_list_rev
 
 let iter_blocks_df f b0 =
-  let stack = ref [ b0 ] in
+  let queue = ref [ b0 ] in
-  let visited = ref !stack 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 =
+  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 ... *)
@@ -77,12 +81,10 @@ let iter_blocks_df f b0 =
           | JMP b1 -> enqueue b1
           | CBR (_, b1, b2) -> enqueue b1; enqueue b2
           | _ -> ())
-      b.ins_list_rev
+        b.ins_list_rev;
+      loop ()
   in
-  while !stack <> [] do
+  loop ()
-    visit (List.hd !stack);
-    stack := List.tl !stack;
-  done
 
 
 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 dump println fn =
-  let basic_blocks = ref [ entry, "START" ] in
+  let labels = ref [ fn.entry, "ENTRY" ] in
-  let work_list = ref [ entry ] in
+  let label b =
-  let label bb =
+    try List.assq b !labels
-    try List.assq bb !basic_blocks
     with Not_found ->
-      let name = Fmt.str "L%d" (List.length !basic_blocks - 1) in
+      let n = List.length !labels - 1 in
-      basic_blocks := (bb, name) :: !basic_blocks;
+      let l = Fmt.str "B%d" n in
-      work_list := !work_list @ [ bb ];
+      labels := (b, l) :: !labels; l
-      name
   in
-  let rec loop i =
+  let pp_ins = pp_ins ~label in
-    match !work_list with
+  iter_blocks_df
-    | [] -> ()
+    (fun b ->
-    | bb :: rest ->
+       List.fold_left
-      work_list := rest;
+         (fun pfx ins ->
-      if i > 0 then Fmt.pf ppf ",";
+            println (Fmt.str "%-8s%a" pfx pp_ins ins);
-      Fmt.pf ppf "%S:[" (label bb);
+            "")
-      List.iteri
+         (label b ^ ":")
-        (fun i is ->
+         (instructions b)
-           if i > 0 then Fmt.pf ppf ",";
+       |> ignore)
-           let str = Fmt.str "%a" (pp_ins ~label) is in
+    fn.entry
-           Fmt.pf ppf "%S" str)
-        (instructions bb);
-      Fmt.pf ppf "]";
-      loop (i + 1)
-  in
-  Fmt.pf ppf "{";
-  loop 0;
-  Fmt.pf ppf "}"