improve code pretty printer
This commit is contained in:
parent
dd27dc04d2
commit
a3f92e5621
|
@ -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)
|
||||
|
|
|
@ -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 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 =
|
||||
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
|
||||
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
|
||||
|
|
Loading…
Reference in New Issue