iitalics
/
spice
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

improve code pretty printer

This commit is contained in:
tali 2023-12-13 16:59:54 -05:00
parent dd27dc04d2
commit a3f92e5621
2 changed files with 38 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bin/main.ml
View File

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

82
lib/runtime/code.ml
View File

@ -61,28 +61,30 @@ let instructions b =
List.rev b.ins_list_rev List.rev b.ins_list_rev
let iter_blocks_df f b0 = 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 = let enqueue b =
if not (List.memq b !visited) then ( if not (List.memq b !visited) then (
stack := b :: !stack; queue := !queue @ [b];
visited := b :: !visited) visited := b :: !visited)
in in
let visit b = let rec loop () =
f b; match !queue with
(* 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 ... *) | b :: rest ->
List.iter queue := rest;
(function f b;
| JMP b1 -> enqueue b1 (* NOTE: only [List.hd b.ins_list_rev] should be a branching instruction, so iterating
| CBR (_, b1, b2) -> enqueue b1; enqueue b2 the whole list is pointless. but just to be safe ... *)
| _ -> ()) List.iter
b.ins_list_rev (function
| JMP b1 -> enqueue b1
| CBR (_, b1, b2) -> enqueue b1; enqueue b2
| _ -> ())
b.ins_list_rev;
loop ()
in in
while !stack <> [] do loop ()
visit (List.hd !stack);
stack := List.tl !stack;
done
type funct = type funct =
@ -150,33 +152,23 @@ let pp_ins ~label ppf = function
let l2 = label b2 in let l2 = label b2 in
Fmt.pf ppf "cbr %a, %s, %s" pp_reg a l1 l2 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 -> 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 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 "}"