Skip to content

Commit 78f2bbf

Browse files
cristianocclaude
cristianoc
and
claude
committed
Decide up front whether a term has any static exit
count_helper created its table on the first static exit and reported None when it never did, which meant threading a lazy accessor through the whole counting walk. A four line predicate answers the same question before counting starts, so the counter goes back to the shape it had and the pass returns its input untouched when there is nothing to rewrite. That predicate names the two nodes Lam_pass_exits rewrites, so a case added there that rewrites anything else has to be added here too or the pass silently stops firing. It says so. subst_helper also hands its term back when a retained catch or an unresolved raise comes through unchanged. The three tests cover what nothing else can. Removing either sharing site, or the removal of a catch nothing raises to, leaves the generated JavaScript byte for byte identical, and each mutation fails exactly one of them: a dead catch is dropped by code generation anyway, so its removal here is invisible to every output fixture we have. Signed-off-by: Cristiano Calcagno <ccrisccris@gmail.com> Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_01W8g8qwBARAcvW9MyuKQq8H
1 parent 2fcd4a4 commit 78f2bbf

4 files changed

Lines changed: 119 additions & 87 deletions

File tree

‎compiler/core/lam_exit_count.ml‎

Lines changed: 75 additions & 78 deletions
Original file line numberDiff line numberDiff line change
@@ -30,8 +30,13 @@ let count_exit (exits : collection) i = Hash_int.find_default exits i 0
3030
let incr_exit (exits : collection) i =
3131
Hash_int.add_or_update exits i 1 ~update:succ
3232

33-
(* [None] when the term holds no static exit at all. A caller that only
34-
rewrites raises and catches can then skip its own traversal. *)
33+
(* Whether [Lam_pass_exits] could rewrite anything here. It names the two
34+
nodes that pass touches, so a new case there that rewrites something else
35+
has to be added here too, or the pass will silently stop firing. *)
36+
let rec has_static_exit (lam : Lambda.t) =
37+
match lam with
38+
| Lstaticraise _ | Lstaticcatch _ -> true
39+
| _ -> Lambda_traverse.shallow_exists has_static_exit lam
3540

3641
(**
3742
This funcition counts how each [exit] is used, it will affect how the following optimizations performed.
@@ -52,79 +57,71 @@ let incr_exit (exits : collection) i =
5257
Since for pattern match, we will test whether it is an integer or block, both have default cases predicate: [sw_consts_full] vs nconsts
5358
*)
5459
let count_helper (lam : Lambda.t) : collection option =
55-
let exits = ref None in
56-
let table () =
57-
match !exits with
58-
| Some tbl -> tbl
59-
| None ->
60-
let tbl : collection = Hash_int.create 17 in
61-
exits := Some tbl;
62-
tbl
63-
in
64-
let rec count (lam : Lambda.t) =
65-
match lam with
66-
| Lstaticraise (i, ls) ->
67-
incr_exit (table ()) i;
68-
Ext_list.iter ls count
69-
| Lstaticcatch (l1, (i, _), l2) ->
70-
(* A catch is work even when nothing raises to it: the pass drops it. *)
71-
let exits = table () in
72-
count l1;
73-
if count_exit exits i > 0 then count l2
74-
| Lstringswitch (l, sw, d) ->
75-
count l;
76-
Ext_list.iter_snd sw count;
77-
Ext_option.iter d count
78-
| Lglobal_module _ | Lvar _ | Lconst _ -> ()
79-
| Lapply {ap_func; ap_args; _} ->
80-
count ap_func;
81-
Ext_list.iter ap_args count
82-
| Lfunction {body} -> count body
83-
| Llet (_, _, l1, l2) ->
84-
count l2;
85-
count l1
86-
| Lletrec (bindings, body) ->
87-
Ext_list.iter_snd bindings count;
88-
count body
89-
| Lprim {args; _} -> List.iter count args
90-
| Lswitch (l, sw) ->
91-
count_default sw;
92-
count l;
93-
Ext_list.iter_snd sw.sw_consts count;
94-
Ext_list.iter_snd sw.sw_blocks count
95-
| Ltrywith (l1, _v, l2) ->
96-
count l1;
97-
count l2
98-
| Lifthenelse (l1, l2, l3) ->
99-
count l1;
100-
count l2;
101-
count l3
102-
| Lsequence (l1, l2) ->
103-
count l1;
104-
count l2
105-
| Lbreak | Lcontinue -> ()
106-
| Lwhile (l1, l2) ->
107-
count l1;
108-
count l2
109-
| Lfor (_, l1, l2, _dir, l3) ->
110-
count l1;
111-
count l2;
112-
count l3
113-
| Lfor_of (_, l1, l2) ->
114-
count l1;
115-
count l2
116-
| Lfor_await_of (_, l1, l2) ->
117-
count l1;
118-
count l2
119-
| Lassign (_, l) -> count l
120-
and count_default sw =
121-
match sw.sw_failaction with
122-
| None -> ()
123-
| Some al ->
124-
if (not sw.sw_consts_full) && not sw.sw_blocks_full then (
125-
count al;
126-
count al)
127-
else count al
128-
in
129-
count lam;
130-
!exits
60+
if not (has_static_exit lam) then None
61+
else
62+
let exits : collection = Hash_int.create 17 in
63+
let rec count (lam : Lambda.t) =
64+
match lam with
65+
| Lstaticraise (i, ls) ->
66+
incr_exit exits i;
67+
Ext_list.iter ls count
68+
| Lstaticcatch (l1, (i, _), l2) ->
69+
count l1;
70+
if count_exit exits i > 0 then count l2
71+
| Lstringswitch (l, sw, d) ->
72+
count l;
73+
Ext_list.iter_snd sw count;
74+
Ext_option.iter d count
75+
| Lglobal_module _ | Lvar _ | Lconst _ -> ()
76+
| Lapply {ap_func; ap_args; _} ->
77+
count ap_func;
78+
Ext_list.iter ap_args count
79+
| Lfunction {body} -> count body
80+
| Llet (_, _, l1, l2) ->
81+
count l2;
82+
count l1
83+
| Lletrec (bindings, body) ->
84+
Ext_list.iter_snd bindings count;
85+
count body
86+
| Lprim {args; _} -> List.iter count args
87+
| Lswitch (l, sw) ->
88+
count_default sw;
89+
count l;
90+
Ext_list.iter_snd sw.sw_consts count;
91+
Ext_list.iter_snd sw.sw_blocks count
92+
| Ltrywith (l1, _v, l2) ->
93+
count l1;
94+
count l2
95+
| Lifthenelse (l1, l2, l3) ->
96+
count l1;
97+
count l2;
98+
count l3
99+
| Lsequence (l1, l2) ->
100+
count l1;
101+
count l2
102+
| Lbreak | Lcontinue -> ()
103+
| Lwhile (l1, l2) ->
104+
count l1;
105+
count l2
106+
| Lfor (_, l1, l2, _dir, l3) ->
107+
count l1;
108+
count l2;
109+
count l3
110+
| Lfor_of (_, l1, l2) ->
111+
count l1;
112+
count l2
113+
| Lfor_await_of (_, l1, l2) ->
114+
count l1;
115+
count l2
116+
| Lassign (_, l) -> count l
117+
and count_default sw =
118+
match sw.sw_failaction with
119+
| None -> ()
120+
| Some al ->
121+
if (not sw.sw_consts_full) && not sw.sw_blocks_full then (
122+
count al;
123+
count al)
124+
else count al
125+
in
126+
count lam;
127+
Some exits

‎compiler/core/lam_pass_exits.ml‎

Lines changed: 12 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -156,7 +156,7 @@ let subst_helper (subst : subst_tbl) (query : int -> int) (lam : Lambda.t) :
156156
Lambda.t =
157157
let rec simplif (lam : Lambda.t) =
158158
match lam with
159-
| Lstaticcatch (l1, (i, xs), l2) -> (
159+
| Lstaticcatch (l1, (i, xs), l2) as original -> (
160160
let i_occur = query i in
161161
match (i_occur, l2) with
162162
| 0, _ -> simplif l1
@@ -168,27 +168,30 @@ let subst_helper (subst : subst_tbl) (query : int -> int) (lam : Lambda.t) :
168168
Hash_int.add subst i (xs, Id (simplif l2));
169169
simplif l1 (* l1 will inline *)
170170
| _ ->
171-
let l2 = simplif l2 in
171+
let l2' = simplif l2 in
172172
(* we only inline when [l2] does not contain bound variables
173173
no need to refresh
174174
*)
175175
let ok_to_inline =
176-
i >= 0 && no_bounded_variables l2
176+
i >= 0 && no_bounded_variables l2'
177177
&&
178-
let lam_size = Lam_analysis.size l2 in
178+
let lam_size = Lam_analysis.size l2' in
179179
(i_occur <= 2 && lam_size < Lam_analysis.exit_inline_size)
180180
|| lam_size < 5
181181
in
182182
if ok_to_inline then (
183-
Hash_int.add subst i (xs, Id l2);
183+
Hash_int.add subst i (xs, Id l2');
184184
simplif l1)
185-
else Lambda.staticcatch (simplif l1) (i, xs) l2)
185+
else
186+
let l1' = simplif l1 in
187+
if l1' == l1 && l2' == l2 then original
188+
else Lambda.staticcatch l1' (i, xs) l2')
186189
| Lstaticraise (i, []) -> (
187190
match Hash_int.find_opt subst i with
188191
| Some (_, handler) -> to_lam handler
189192
| None -> lam)
190193
| Lstaticraise (i, ls) -> (
191-
let ls = Ext_list.map ls simplif in
194+
let ls' = Ext_list.map_sharing ls simplif in
192195
match Hash_int.find_opt subst i with
193196
| Some (xs, handler) ->
194197
let handler = to_lam handler in
@@ -197,9 +200,9 @@ let subst_helper (subst : subst_tbl) (query : int -> int) (lam : Lambda.t) :
197200
Ext_list.fold_right2 xs ys Ident.empty (fun x y t ->
198201
Ident.add x (Lambda.var y) t)
199202
in
200-
Ext_list.fold_right2 ys ls (Lambda_traverse.subst_lambda env handler)
203+
Ext_list.fold_right2 ys ls' (Lambda_traverse.subst_lambda env handler)
201204
(fun y l r -> Lambda.let_ Strict y l r)
202-
| None -> Lambda.staticraise i ls)
205+
| None -> if ls' == ls then lam else Lambda.staticraise i ls')
203206
| _ -> Lambda_traverse.shallow_map_sharing simplif lam
204207
in
205208
simplif lam

‎tests/ounit_tests/ounit_exits_tests.ml‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
open OUnit
2+
3+
let loc = Location.none
4+
5+
let debugger = Lambda.prim ~primitive:Pdebugger ~args:[] loc
6+
7+
let suites =
8+
__FILE__
9+
>::: [
10+
( "shares an unresolved raise with unchanged arguments" >:: fun _ ->
11+
let lam = Lambda.staticraise 1 [Lambda.const (Lambda.const_int 1)] in
12+
assert_bool "the raise is physically unchanged"
13+
(Lam_pass_exits.simplify_exits lam == lam) );
14+
(* A negative exit is never inlined into its raise, and a handler that
15+
is neither a variable nor a constant is not substituted, so this
16+
catch survives the pass and must survive it unrebuilt. *)
17+
( "shares a retained catch" >:: fun _ ->
18+
let lam =
19+
Lambda.staticcatch
20+
(Lambda.staticraise (-1) [])
21+
(-1, [])
22+
(Lambda.seq debugger Lambda.lambda_unit)
23+
in
24+
assert_bool "the catch is physically unchanged"
25+
(Lam_pass_exits.simplify_exits lam == lam) );
26+
( "removes a catch whose exit is unused" >:: fun _ ->
27+
let body = Lambda.const (Lambda.const_int 1) in
28+
let lam = Lambda.staticcatch body (1, []) debugger in
29+
assert_bool "the unused handler is removed"
30+
(Lam_pass_exits.simplify_exits lam == body) );
31+
]

‎tests/ounit_tests/ounit_tests_main.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ let suites =
2121
Ounit_rec_check_tests.suites;
2222
Ounit_lambda_constant_tests.suites;
2323
Ounit_deep_flatten_tests.suites;
24+
Ounit_exits_tests.suites;
2425
Ounit_sroa_tests.suites;
2526
Ounit_ast_mapper0_tests.suites;
2627
Ounit_object_mutability_tests.suites;

0 commit comments

Comments
 (0)