Skip to content
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.

Sign up for GitHub

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

Generalize deep_occur to deep_occur_list #1503

Merged
merged 2 commits into from
Jun 20, 2023
Merged

Generalize deep_occur to deep_occur_list #1503

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
ff1be5c
Generalize deep_occur to deep_occur_list
rtjoa Jun 15, 2023
13d9664
Factor out deep_occur_rec to avoid extra list cell
rtjoa Jun 15, 2023
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
17 changes: 11 additions & 6 deletions ocaml/typing/ctype.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2521,18 +2521,23 @@ let unexpanded_diff ~got ~expected =

(**** Unification ****)

(* Return whether [t0] occurs in [ty]. Objects are also traversed. *)
let deep_occur t0 ty =
(* Return whether [t0] occurs in any type in [tyl]. Objects are also traversed. *)
let deep_occur_list t0 tyl =
let rec occur_rec ty =
if get_level ty >= get_level t0 && try_mark_node ty then begin
if eq_type ty t0 then raise Occur;
iter_type_expr occur_rec ty
end
in
try
occur_rec ty; unmark_type ty; false
List.iter occur_rec tyl;
List.iter unmark_type tyl;
false
with Occur ->
unmark_type ty; true
List.iter unmark_type tyl;
true

let deep_occur t0 ty = deep_occur_list t0 [ty]
ccasin marked this conversation as resolved.
Show resolved Hide resolved

let gadt_equations_level = ref None

Expand Down Expand Up @@ -5280,7 +5285,7 @@ let rec build_subtype env (visited : transient_expr list)
(* Fix PR#4505: do not set ty to Tvar when it appears in tl1,
as this occurrence might break the occur check.
XXX not clear whether this correct anyway... *)
if List.exists (deep_occur ty) tl1 then raise Not_found;
if deep_occur_list ty tl1 then raise Not_found;
set_type_desc ty
(Tvar { name = None;
layout = Layout.value
Expand Down Expand Up @@ -5838,7 +5843,7 @@ let rec normalize_type_rec visited ty =
begin match !nm with
| None -> ()
| Some (n, v :: l) ->
if deep_occur ty (newgenty (Ttuple l)) then
if deep_occur_list ty l then
(* The abbreviation may be hiding something, so remove it *)
set_name nm None
else
Expand Down
4 changes: 4 additions & 0 deletions ocaml/typing/ctype.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -264,7 +264,11 @@ val filter_method: Env.t -> string -> type_expr -> type_expr
(* A special case of unification (with {m : 'a; 'b}). Raises
[Filter_method_failed] instead of [Unify]. *)
val occur_in: Env.t -> type_expr -> type_expr -> bool
val deep_occur_list: type_expr -> type_expr list -> bool
(* Check whether a type occurs structurally within any type from
a list of types. *)
val deep_occur: type_expr -> type_expr -> bool
(* Check whether a type occurs structurally within another. *)
val moregeneral: Env.t -> bool -> type_expr -> type_expr -> unit
(* Check if the first type scheme is more general than the second. *)
val is_moregeneral: Env.t -> bool -> type_expr -> type_expr -> bool
Expand Down
2 changes: 1 addition & 1 deletion ocaml/typing/printtyp.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1693,7 +1693,7 @@ let rec prepare_class_type params = function
let row = Btype.self_type_row cty in
if List.memq (proxy row) !visited_objects
|| not (List.for_all is_Tvar params)
|| List.exists (deep_occur row) tyl
|| deep_occur_list row tyl
then prepare_class_type params cty
else List.iter prepare_type tyl
| Cty_signature sign ->
Expand Down