Skip to content

Commit c1eecf6

Browse files
authored
flambda-backend: Generalize deep_occur to deep_occur_list (#1503)
* Generalize deep_occur to deep_occur_list * Factor out deep_occur_rec to avoid extra list cell
1 parent 1a17a8b commit c1eecf6

File tree

3 files changed

+28
-12
lines changed

3 files changed

+28
-12
lines changed

typing/ctype.ml

Lines changed: 23 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -2527,18 +2527,30 @@ let unexpanded_diff ~got ~expected =
25272527

25282528
(**** Unification ****)
25292529

2530-
(* Return whether [t0] occurs in [ty]. Objects are also traversed. *)
2530+
let rec deep_occur_rec t0 ty =
2531+
if get_level ty >= get_level t0 && try_mark_node ty then begin
2532+
if eq_type ty t0 then raise Occur;
2533+
iter_type_expr (deep_occur_rec t0) ty
2534+
end
2535+
2536+
(* Return whether [t0] occurs in any type in [tyl]. Objects are also traversed. *)
2537+
let deep_occur_list t0 tyl =
2538+
try
2539+
List.iter (deep_occur_rec t0) tyl;
2540+
List.iter unmark_type tyl;
2541+
false
2542+
with Occur ->
2543+
List.iter unmark_type tyl;
2544+
true
2545+
25312546
let deep_occur t0 ty =
2532-
let rec occur_rec ty =
2533-
if get_level ty >= get_level t0 && try_mark_node ty then begin
2534-
if eq_type ty t0 then raise Occur;
2535-
iter_type_expr occur_rec ty
2536-
end
2537-
in
25382547
try
2539-
occur_rec ty; unmark_type ty; false
2548+
deep_occur_rec t0 ty;
2549+
unmark_type ty;
2550+
false
25402551
with Occur ->
2541-
unmark_type ty; true
2552+
unmark_type ty;
2553+
true
25422554

25432555
let gadt_equations_level = ref None
25442556

@@ -5286,7 +5298,7 @@ let rec build_subtype env (visited : transient_expr list)
52865298
(* Fix PR#4505: do not set ty to Tvar when it appears in tl1,
52875299
as this occurrence might break the occur check.
52885300
XXX not clear whether this correct anyway... *)
5289-
if List.exists (deep_occur ty) tl1 then raise Not_found;
5301+
if deep_occur_list ty tl1 then raise Not_found;
52905302
set_type_desc ty
52915303
(Tvar { name = None;
52925304
layout = Layout.value
@@ -5844,7 +5856,7 @@ let rec normalize_type_rec visited ty =
58445856
begin match !nm with
58455857
| None -> ()
58465858
| Some (n, v :: l) ->
5847-
if deep_occur ty (newgenty (Ttuple l)) then
5859+
if deep_occur_list ty l then
58485860
(* The abbreviation may be hiding something, so remove it *)
58495861
set_name nm None
58505862
else

typing/ctype.mli

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -264,7 +264,11 @@ val filter_method: Env.t -> string -> type_expr -> type_expr
264264
(* A special case of unification (with {m : 'a; 'b}). Raises
265265
[Filter_method_failed] instead of [Unify]. *)
266266
val occur_in: Env.t -> type_expr -> type_expr -> bool
267+
val deep_occur_list: type_expr -> type_expr list -> bool
268+
(* Check whether a type occurs structurally within any type from
269+
a list of types. *)
267270
val deep_occur: type_expr -> type_expr -> bool
271+
(* Check whether a type occurs structurally within another. *)
268272
val moregeneral: Env.t -> bool -> type_expr -> type_expr -> unit
269273
(* Check if the first type scheme is more general than the second. *)
270274
val is_moregeneral: Env.t -> bool -> type_expr -> type_expr -> bool

typing/printtyp.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1691,7 +1691,7 @@ let rec prepare_class_type params = function
16911691
let row = Btype.self_type_row cty in
16921692
if List.memq (proxy row) !visited_objects
16931693
|| not (List.for_all is_Tvar params)
1694-
|| List.exists (deep_occur row) tyl
1694+
|| deep_occur_list row tyl
16951695
then prepare_class_type params cty
16961696
else List.iter prepare_type tyl
16971697
| Cty_signature sign ->

0 commit comments

Comments
 (0)