@@ -880,30 +880,29 @@ let add_definition t (name : Name_in_binding_pos.t) kind =
880
880
end ;
881
881
add_symbol_definition t sym)
882
882
883
- let invariant_for_alias aliases name ty =
883
+ let invariant_for_alias ( t :t ) name ty =
884
884
(* Check that no canonical element gets an [Equals] type *)
885
885
if ! Clflags. flambda_invariant_checks || true then begin
886
886
match Type_grammar. get_alias_exn ty with
887
887
| exception Not_found -> ()
888
888
| alias ->
889
889
assert (not (Simple. equal alias (Simple. name name)));
890
890
let canonical =
891
- Aliases. get_canonical_ignoring_name_mode aliases name
891
+ Aliases. get_canonical_ignoring_name_mode ( aliases t) name
892
892
in
893
893
if Simple. equal canonical (Simple. name name) then
894
894
Misc. fatal_errorf
895
895
" There is about to be an [Equals] equation on canonical name %a@\n equation: %a@\n @."
896
896
Name. print name Type_grammar. print ty
897
897
end
898
898
899
- let invariant_for_aliases t =
900
- let aliases = aliases t in
899
+ let invariant_for_aliases (t :t ) =
901
900
Name.Map. iter (fun name (ty , _ , _ ) ->
902
- invariant_for_alias aliases name ty
901
+ invariant_for_alias t name ty
903
902
) (names_to_types t)
904
903
905
- let invariant_for_new_equation t aliases name ty =
906
- invariant_for_alias aliases name ty;
904
+ let invariant_for_new_equation ( t :t ) name ty =
905
+ invariant_for_alias t name ty;
907
906
if ! Clflags. flambda_invariant_checks then begin
908
907
(* CR mshinwell: This should check that precision is not decreasing. *)
909
908
let defined_names =
@@ -925,15 +924,15 @@ let invariant_for_new_equation t aliases name ty =
925
924
end
926
925
end
927
926
928
- let rec add_equation0 t name ty =
927
+ let rec add_equation0 ( t :t ) name ty =
929
928
if ! Clflags.Flambda.Debug. concrete_types_only_on_canonicals then begin
930
929
let is_concrete =
931
930
match Type_grammar. get_alias_exn ty with
932
931
| exception Not_found -> true
933
932
| _ -> false
934
933
in
935
934
if is_concrete then begin
936
- let canonical = Aliases. get_canonical_ignoring_name_mode aliases name in
935
+ let canonical = Aliases. get_canonical_ignoring_name_mode ( aliases t) name in
937
936
if not (Simple. equal canonical (Simple. name name)) then begin
938
937
Misc. fatal_errorf " Trying to add equation giving concrete type on %a \
939
938
which is not canonical (its canonical is %a): %a"
@@ -943,7 +942,7 @@ let rec add_equation0 t name ty =
943
942
end
944
943
end
945
944
end ;
946
- invariant_for_new_equation t aliases name ty;
945
+ invariant_for_new_equation t name ty;
947
946
let level =
948
947
Typing_env_level. add_or_replace_equation
949
948
(One_level. level t.current_level) name ty
@@ -1049,7 +1048,7 @@ and add_equation t name ty =
1049
1048
let ty =
1050
1049
Type_grammar. alias_type_of kind canonical_element
1051
1050
in
1052
- alias_of , t, ty
1051
+ alias_of_demoted_element , t, ty
1053
1052
in
1054
1053
(* Beware: if we're about to add the equation on a name which is different
1055
1054
from the one that the caller passed in, then we need to make sure that the
@@ -1077,14 +1076,6 @@ and add_equation t name ty =
1077
1076
in
1078
1077
Simple. pattern_match simple ~name ~const: (fun _ -> ty, t)
1079
1078
in
1080
- let ty =
1081
- match rec_info with
1082
- | None -> ty
1083
- | Some rec_info ->
1084
- match Type_grammar. apply_rec_info ty rec_info with
1085
- | Bottom -> Type_grammar. bottom (Type_grammar. kind ty)
1086
- | Ok ty -> ty
1087
- in
1088
1079
let [@ inline always] name name = add_equation0 t name ty in
1089
1080
Simple. pattern_match simple ~name ~const: (fun _ -> t)
1090
1081
0 commit comments