Skip to content

Compiler: Merge blocks #1967

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
May 6, 2025
Merged
Show file tree
Hide file tree
Changes from 3 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
95 changes: 95 additions & 0 deletions compiler/lib/deadcode.ml
Original file line number Diff line number Diff line change
Expand Up @@ -227,6 +227,101 @@ let empty_body b =
| [] | [ Event _ ] -> true
| _ -> false

let merge_blocks p =
let previous_p = p in
let t = Timer.make () in
let preds = Array.make p.free_pc 0 in
let assigned = ref Var.Set.empty in
let merged = ref 0 in
let subst =
let nv = Var.count () in
Array.init nv ~f:(fun i -> Var.of_idx i)
in
let () =
let mark_cont (pc', _) = preds.(pc') <- preds.(pc') + 1 in
Addr.Map.iter
(fun _ { body; branch; _ } ->
List.iter body ~f:(function
| Let (_, Closure (_, cont, _)) -> mark_cont cont
| Assign (x, _) -> assigned := Var.Set.add x !assigned
| _ -> ());
match branch with
| Branch cont -> mark_cont cont
| Cond (_, cont1, cont2) ->
mark_cont cont1;
mark_cont cont2
| Switch (_, a1) -> Array.iter ~f:mark_cont a1
| Pushtrap (cont1, _, cont2) ->
mark_cont cont1;
mark_cont cont2
| Poptrap cont -> mark_cont cont
| Return _ | Raise _ | Stop -> ())
p.blocks
in
let p =
let visited = BitSet.create' p.free_pc in
let rec process_branch pc blocks =
let block = Addr.Map.find pc blocks in
match block.branch with
| Branch (pc_, args) when preds.(pc_) = 1 ->
let to_inline = Addr.Map.find pc_ blocks in
if List.exists to_inline.params ~f:(fun x -> Var.Set.mem x !assigned)
then block, blocks
else (
incr merged;
let to_inline, blocks = process_branch pc_ blocks in
List.iter2 args to_inline.params ~f:(fun arg param ->
Code.Var.propagate_name param arg;
subst.(Code.Var.idx param) <- arg);
let block =
{ params = block.params
; branch = to_inline.branch
; body =
(let[@tail_mod_cons] rec aux = function
| [ (Event _ as ev) ] -> (
match to_inline.body with
| Event _ :: _ -> to_inline.body
| _ -> ev :: to_inline.body)
| [] -> to_inline.body
| x :: rest -> x :: aux rest
in
aux block.body)
}
in
let blocks = Addr.Map.remove pc_ blocks in
let blocks = Addr.Map.add pc block blocks in
block, blocks)
| _ -> block, blocks
in
let rec traverse pc blocks =
if BitSet.mem visited pc
then blocks
else
let () = BitSet.set visited pc in
let _block, blocks = process_branch pc blocks in
Code.fold_children blocks pc traverse blocks
in
let blocks =
Code.fold_closures p (fun _ _ (pc, _) _ blocks -> traverse pc blocks) p.blocks
in
{ p with blocks }
in
let p =
if !merged = 0
then p
else
let rec rename x =
let y = subst.(Code.Var.idx x) in
if Code.Var.equal x y then y else rename y
in
Subst.Excluding_Binders.program rename p
in
if times () then Format.eprintf " merge block: %a@." Timer.print t;
if stats () then Format.eprintf "Stats - merge block: merged %d@." !merged;
if debug_stats ()
then Code.check_updates ~name:"merge block" previous_p p ~updates:!merged;
p

let remove_empty_blocks st (p : Code.program) : Code.program =
let shortcuts = Hashtbl.create 16 in
let rec resolve_rec visited ((pc, args) as cont) =
Expand Down
2 changes: 2 additions & 0 deletions compiler/lib/deadcode.mli
Original file line number Diff line number Diff line change
Expand Up @@ -24,3 +24,5 @@ type variable_uses =
val f : Code.program -> Code.program * variable_uses

val remove_unused_blocks : Code.program -> Code.program

val merge_blocks : Code.program -> Code.program
5 changes: 3 additions & 2 deletions compiler/lib/driver.ml
Original file line number Diff line number Diff line change
Expand Up @@ -51,8 +51,9 @@ let deadcode' p =
Deadcode.f p

let deadcode p =
let r, _ = deadcode' p in
r
let p, _ = deadcode' p in
let p = Deadcode.merge_blocks p in
p

let inline p =
if Config.Flag.inline () && Config.Flag.deadcode ()
Expand Down
7 changes: 4 additions & 3 deletions compiler/tests-compiler/gh1768.ml
Original file line number Diff line number Diff line change
Expand Up @@ -54,8 +54,7 @@ let () =
dummy = 0,
global_data = runtime.caml_get_global_data(),
Assert_failure = global_data.Assert_failure,
_a_ = [0, caml_string_of_jsbytes("test.ml"), 4, 27],
_b_ = [0, caml_string_of_jsbytes("test.ml"), 8, 2];
_a_ = [0, caml_string_of_jsbytes("test.ml"), 4, 27];
function h(x){x[1] = function(x, y){return x + y | 0;};}
function f(param){
return [0,
Expand All @@ -66,11 +65,13 @@ let () =
var x = f();
function g(param){return caml_call1(x[1], 7);}
h(x);
var _b_ = [0, caml_string_of_jsbytes("test.ml"), 8, 2];
if(10 !== caml_call1(g(), 3))
throw caml_maybe_attach_backtrace([0, Assert_failure, _b_], 1);
var Test = [0];
runtime.caml_register_global(3, Test, "Test");
return;
}
(globalThis));
//end |}]
//end
|}]
9 changes: 5 additions & 4 deletions compiler/tests-compiler/lambda_lifting.ml
Original file line number Diff line number Diff line change
Expand Up @@ -25,14 +25,15 @@ Printf.printf "%d\n" (f 3)
var
runtime = globalThis.jsoo_runtime,
global_data = runtime.caml_get_global_data(),
Stdlib_Printf = global_data.Stdlib__Printf,
_e_ =
[0, [4, 0, 0, 0, [12, 10, 0]], runtime.caml_string_of_jsbytes("%d\n")];
Stdlib_Printf = global_data.Stdlib__Printf;
function h(x, y){function h(z){return (x + y | 0) + z | 0;} return h;}
function g(x){function g(y){var h$0 = h(x, y); return h$0(7);} return g;}
function f(x){var g$0 = g(x); return g$0(5);}
var _d_ = f(3);
runtime.caml_callback(Stdlib_Printf[2], [_e_, _d_]);
runtime.caml_callback
(Stdlib_Printf[2],
[[0, [4, 0, 0, 0, [12, 10, 0]], runtime.caml_string_of_jsbytes("%d\n")],
_d_]);
var Test = [0];
runtime.caml_register_global(2, Test, "Test");
return;
Expand Down
84 changes: 41 additions & 43 deletions compiler/tests-full/stdlib.cma.expected.js
Original file line number Diff line number Diff line change
Expand Up @@ -5976,7 +5976,7 @@
var max = /*<<bytes.ml:740:2>>*/ caml_ml_bytes_length(b) - 1 | 0, i = 0;
for(;;){
/*<<bytes.ml:683:4>>*/ if(max < i) /*<<bytes.ml:683:20>>*/ return 1;
var match = /*<<bytes.ml:683:4>>*/ caml_bytes_unsafe_get(b, i);
var match = /*<<bytes.ml:685:26>>*/ caml_bytes_unsafe_get(b, i);
a:
{
/*<<bytes.ml:685:35>>*/ if(224 <= match){
Expand Down Expand Up @@ -19916,9 +19916,9 @@
return caml_trampoline_return
(parse_char_set_content, [0, _aG_, end_ind]) /*<<camlinternalFormat.ml:2771:58>>*/ ;
var
counter$2 =
counter$0 =
/*<<camlinternalFormat.ml:2763:19>>*/ counter + 1 | 0;
return parse_char_set_content(counter$2, _aG_, end_ind) /*<<camlinternalFormat.ml:2771:58>>*/ ;
return parse_char_set_content(counter$0, _aG_, end_ind) /*<<camlinternalFormat.ml:2771:58>>*/ ;
}
}
/*<<camlinternalFormat.ml:2766:8>>*/ if(37 === c)
Expand Down Expand Up @@ -19963,9 +19963,9 @@
return caml_trampoline_return
(parse_char_set_content, [0, _aH_, end_ind]) /*<<camlinternalFormat.ml:2771:58>>*/ ;
var
counter$1 =
counter$2 =
/*<<camlinternalFormat.ml:2785:26>>*/ counter + 1 | 0;
return parse_char_set_content(counter$1, _aH_, end_ind) /*<<camlinternalFormat.ml:2771:58>>*/ ;
return parse_char_set_content(counter$2, _aH_, end_ind) /*<<camlinternalFormat.ml:2771:58>>*/ ;
}
/*<<camlinternalFormat.ml:2776:25>>*/ if(93 === c$1){
/*<<camlinternalFormat.ml:2721:6>>*/ add_in_char_set
Expand All @@ -19980,9 +19980,9 @@
return caml_trampoline_return
(parse_char_set_content, [0, _aI_, end_ind]) /*<<camlinternalFormat.ml:2771:58>>*/ ;
var
counter$0 =
counter$1 =
/*<<camlinternalFormat.ml:2790:22>>*/ counter + 1 | 0;
return parse_char_set_content(counter$0, _aI_, end_ind) /*<<camlinternalFormat.ml:2771:58>>*/ ;
return parse_char_set_content(counter$1, _aI_, end_ind) /*<<camlinternalFormat.ml:2771:58>>*/ ;
},
parse_char_set_after_char =
/*<<camlinternalFormat.ml:2736:4>>*/ function
Expand Down Expand Up @@ -22412,7 +22412,7 @@
/*<<printexc.ml:352:9>>*/ caml_call1(Stdlib[103], 0);
}
catch(exn){}
/*<<printexc.ml:352:4>>*/ try{
/*<<printexc.ml:353:4>>*/ try{
var
_z_ =
/*<<printexc.ml:354:6>>*/ caml_call2
Expand Down Expand Up @@ -25089,7 +25089,7 @@
old_trav = /*<<hashtbl.ml:196:17>>*/ ongoing_traversal(h);
/*<<hashtbl.ml:197:2>>*/ if(1 - old_trav)
/*<<hashtbl.ml:197:23>>*/ flip_ongoing_traversal(h);
/*<<hashtbl.ml:197:2>>*/ try{
/*<<hashtbl.ml:198:2>>*/ try{
var _P_ = d.length - 2 | 0, _O_ = 0;
if(_P_ >= 0){
var i = _O_;
Expand Down Expand Up @@ -29244,7 +29244,16 @@
(width$1, ib) /*<<scanf.ml:697:49>>*/ ;
case 4:
/*<<scanf.ml:696:20>>*/ return scan_decimal_digit_plus(width$1, ib) /*<<scanf.ml:697:49>>*/ ;
case 2:
case 0:
/*<<scanf.ml:634:22>>*/ return scan_digit_plus
(cst_binary, is_binary_digit, width$1, ib) /*<<scanf.ml:697:49>>*/ ;
case 3:
/*<<scanf.ml:641:21>>*/ return scan_digit_plus
(cst_octal, is_octal_digit, width$1, ib) /*<<scanf.ml:697:49>>*/ ;
case 5:
/*<<scanf.ml:648:27>>*/ return scan_digit_plus
(cst_hexadecimal, is_hexa_digit, width$1, ib) /*<<scanf.ml:697:49>>*/ ;
default:
var
width$0 = /*<<scanf.ml:686:14>>*/ scan_sign(width$1, ib),
c = /*<<scanf.ml:671:8>>*/ checked_peek_char(ib);
Expand Down Expand Up @@ -29283,15 +29292,6 @@
ib) /*<<scanf.ml:697:49>>*/ ;
}
/*<<scanf.ml:681:11>>*/ return scan_decimal_digit_star(width, ib) /*<<scanf.ml:697:49>>*/ ;
case 0:
/*<<scanf.ml:634:22>>*/ return scan_digit_plus
(cst_binary, is_binary_digit, width$1, ib) /*<<scanf.ml:697:49>>*/ ;
case 3:
/*<<scanf.ml:641:21>>*/ return scan_digit_plus
(cst_octal, is_octal_digit, width$1, ib) /*<<scanf.ml:697:49>>*/ ;
default:
/*<<scanf.ml:648:27>>*/ return scan_digit_plus
(cst_hexadecimal, is_hexa_digit, width$1, ib) /*<<scanf.ml:697:49>>*/ ;
}
}
function scan_fractional_part(width, ib){
Expand Down Expand Up @@ -29688,12 +29688,13 @@
: c /*<<scanf.ml:998:3>>*/ ;
}
function scan_backslash_char(width, ib){
var c0 = /*<<scanf.ml:1001:31>>*/ check_next_char(cst_a_Char, width, ib);
var
c$1 = /*<<scanf.ml:1001:31>>*/ check_next_char(cst_a_Char, width, ib);
a:
{
/*<<scanf.ml:1005:41>>*/ if(40 <= c0){
if(58 > c0){
if(48 > c0) break a;
/*<<scanf.ml:1005:41>>*/ if(40 <= c$1){
if(58 > c$1){
if(48 > c$1) break a;
var
get_digit$0 =
/*<<scanf.ml:1009:4>>*/ function(param){
Expand All @@ -29705,7 +29706,7 @@
c1$0 = /*<<scanf.ml:1015:13>>*/ get_digit$0(0),
c2$0 = /*<<scanf.ml:1016:13>>*/ get_digit$0(0),
c =
/*<<scanf.ml:956:34>>*/ ((100 * (c0 - 48 | 0) | 0)
/*<<scanf.ml:956:34>>*/ ((100 * (c$1 - 48 | 0) | 0)
+ (10 * (c1$0 - 48 | 0) | 0)
| 0)
+ (c2$0 - 48 | 0)
Expand All @@ -29720,11 +29721,11 @@
_ab_ =
/*<<scanf.ml:962:60>>*/ bad_input
( /*<<scanf.ml:961:6>>*/ caml_call4
(Stdlib_Printf[4], _l_, c0, c1$0, c2$0));
(Stdlib_Printf[4], _l_, c$1, c1$0, c2$0));
}
/*<<scanf.ml:1017:71>>*/ return store_char(width - 2 | 0, ib, _ab_) /*<<scanf.ml:1028:22>>*/ ;
}
var switcher = /*<<scanf.ml:1005:41>>*/ c0 - 92 | 0;
var switcher = /*<<scanf.ml:1005:41>>*/ c$1 - 92 | 0;
if(28 < switcher >>> 0) break a;
switch(switcher){
case 28:
Expand Down Expand Up @@ -29772,33 +29773,31 @@
default: break a;
}
}
else if(34 !== c0 && 39 > c0) break a;
/*<<scanf.ml:942:25>>*/ if(110 <= c0)
if(117 <= c0)
var _$_ = c0;
else if(34 !== c$1 && 39 > c$1) break a;
/*<<scanf.ml:942:25>>*/ if(110 <= c$1)
if(117 <= c$1)
var _$_ = c$1;
else
switch(c0 - 110 | 0){
switch(c$1 - 110 | 0){
case 0:
var _$_ = /*<<scanf.ml:943:11>>*/ 10; break;
case 4:
var _$_ = /*<<scanf.ml:944:11>>*/ 13; break;
case 6:
var _$_ = /*<<scanf.ml:946:11>>*/ 9; break;
default: var _$_ = /*<<scanf.ml:942:25>>*/ c0;
default: var _$_ = /*<<scanf.ml:942:25>>*/ c$1;
}
else
var _$_ = 98 === c0 ? 8 : c0;
var _$_ = 98 === c$1 ? 8 : c$1;
/*<<scanf.ml:1007:55>>*/ return store_char(width, ib, _$_) /*<<scanf.ml:1028:22>>*/ ;
}
/*<<scanf.ml:1028:4>>*/ return bad_input_escape(c0) /*<<scanf.ml:1028:22>>*/ ;
/*<<scanf.ml:1028:4>>*/ return bad_input_escape(c$1) /*<<scanf.ml:1028:22>>*/ ;
}
function scan_caml_string(width, ib){
function find_stop$0(counter, width){
var width$0 = /*<<scanf.ml:1063:10>>*/ width;
var width$0 = /*<<scanf.ml:1002:33>>*/ width;
for(;;){
var
c =
/*<<scanf.ml:1002:33>>*/ check_next_char(cst_a_String, width$0, ib);
var c = check_next_char(cst_a_String, width$0, ib);
/*<<scanf.ml:1063:45>>*/ if(34 === c)
/*<<scanf.ml:1064:14>>*/ return ignore_char(width$0, ib) /*<<scanf.ml:1066:53>>*/ ;
/*<<scanf.ml:1063:45>>*/ if(92 === c){
Expand Down Expand Up @@ -29839,14 +29838,13 @@
}
}
function find_stop(width){
/*<<scanf.ml:1063:10>>*/ return /*<<?>>*/ caml_trampoline
( /*<<scanf.ml:1063:10>>*/ find_stop$0(0, width)) /*<<scanf.ml:1066:53>>*/ ;
/*<<scanf.ml:1002:33>>*/ return /*<<?>>*/ caml_trampoline
( /*<<scanf.ml:1002:33>>*/ find_stop$0(0, width)) /*<<scanf.ml:1066:53>>*/ ;
}
function skip_spaces(counter, width){
var width$0 = /*<<scanf.ml:1080:10>>*/ width;
var width$0 = /*<<scanf.ml:1002:33>>*/ width;
for(;;){
/*<<scanf.ml:1002:33>>*/ if
(32 !== check_next_char(cst_a_String, width$0, ib)){
if(32 !== check_next_char(cst_a_String, width$0, ib)){
/*<<scanf.ml:1082:11>>*/ if(counter >= 50)
return caml_trampoline_return(find_stop$0, [0, width$0]) /*<<scanf.ml:1082:26>>*/ ;
var counter$0 = /*<<scanf.ml:1082:11>>*/ counter + 1 | 0;
Expand Down
Loading