The unpac monorepo manager self-hosting as a monorepo using unpac
Merge pull request #14197 from gasche/ocamlprof-unreachable-clauses
ocamlprof: do not instrument unreachable clauses
authored by
Gabriel Scherer
and committed by
GitHub
16e0bea3
afc8eb8d
+18
-4
+3
Changes
+3
Changes
···
1009
1009
modules, polymorphic fields or methods, and constrained type parameters.
1010
1010
(Florian Angeletti, review by Gabriel Scherer)
1011
1011
1012
+
- #14196, #14197: ocamlprof: do not instrument unreachable clauses
1013
+
(Gabriel Scherer, review by Nicolás Ojeda Bär, report by Ali Caglayan)
1014
+
1012
1015
OCaml 5.3.0 (8 January 2025)
1013
1016
----------------------------
1014
1017
+15
-4
tools/ocamlprof.ml
+15
-4
tools/ocamlprof.ml
···
154
154
let rec rewrite_patexp_list iflag l =
155
155
rewrite_exp_list iflag (List.map (fun x -> x.pvb_expr) l)
156
156
157
+
and rewrite_case_body iflag rhs =
158
+
match rhs.pexp_desc with
159
+
| Pexp_unreachable -> ()
160
+
| _ -> rewrite_exp iflag rhs
161
+
157
162
and rewrite_cases iflag l =
158
163
List.iter
159
164
(fun pc ->
···
161
166
| None -> ()
162
167
| Some g -> rewrite_exp iflag g
163
168
end;
164
-
rewrite_exp iflag pc.pc_rhs
169
+
rewrite_case_body iflag pc.pc_rhs
165
170
)
166
171
l
167
172
···
313
318
(function
314
319
| {guard=Some scond; rhs=sbody} ->
315
320
insert_profile rw_exp scond;
316
-
insert_profile rw_exp sbody;
321
+
rewrite_annotate_rhs sbody
317
322
| {rhs={pexp_desc = Pexp_constraint(sbody, _)}} (* let f x : t = e *)
318
-
-> insert_profile rw_exp sbody
319
-
| {rhs=sexp} -> insert_profile rw_exp sexp)
323
+
-> rewrite_annotate_rhs sbody
324
+
| {rhs=sexp} -> rewrite_annotate_rhs sexp
325
+
)
320
326
l
327
+
328
+
and rewrite_annotate_rhs rhs =
329
+
match rhs.pexp_desc with
330
+
| Pexp_unreachable -> ()
331
+
| _ -> insert_profile rw_exp rhs
321
332
322
333
and rewrite_function iflag = function
323
334
| [{guard=None;