diff --git a/compiler/typecheck_error_util.m b/compiler/typecheck_error_util.m index caeb11697..602629b20 100644 --- a/compiler/typecheck_error_util.m +++ b/compiler/typecheck_error_util.m @@ -116,6 +116,21 @@ % :- pred identical_types(mer_type::in, mer_type::in) is semidet. +%---------------------------------------------------------------------------% + + % delete_identical_qualifications(TypeA0, TypeB0, TypeA, TypeB): + % + % Where defined_types in TypeA0 and TypeB0 occur in the same positions + % with identical module qualifications, delete those qualifications. + % Keep every other part of those types unchanged. Return the resulting + % types as TypeA and TypeB. + % + % NOTE The resulting types are NOT usable for ANY purpose other than + % conversion into diagnostic text. + % +:- pred delete_identical_qualifications(mer_type::in, mer_type::in, + mer_type::out, mer_type::out) is det. + %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% @@ -129,7 +144,9 @@ :- import_module parse_tree.prog_type_unify. :- import_module parse_tree.var_db. +:- import_module assoc_list. :- import_module map. +:- import_module pair. :- import_module require. :- import_module term. :- import_module varset. @@ -437,6 +454,123 @@ identical_types(Type1, Type2) :- type_unify(Type1, Type2, [], TypeSubst0, TypeSubst), TypeSubst = TypeSubst0. +%---------------------------------------------------------------------------% + +delete_identical_qualifications(TypeA0, TypeB0, TypeA, TypeB) :- + ( + ( TypeA0 = builtin_type(_) + ; TypeA0 = type_variable(_TypeVar, _Kind) + ), + TypeA = TypeA0, + TypeB = TypeB0 + ; + TypeA0 = defined_type(SymNameA0, ArgTypesA0, Kind), + ( if + TypeB0 = defined_type(SymNameB0, ArgTypesB0, Kind), + maybe_from_corresponding_lists(ArgTypesA0, ArgTypesB0, + ArgTypesAB0) + then + ( + SymNameA0 = unqualified(_NameA), + SymNameB0 = unqualified(_NameB), + SymNameA = SymNameA0, + SymNameB = SymNameB0 + ; + SymNameA0 = unqualified(_NameA), + SymNameB0 = qualified(_ModuleNameB, _NameB), + SymNameA = SymNameA0, + SymNameB = SymNameB0 + ; + SymNameA0 = qualified(_ModuleNameA, _NameA), + SymNameB0 = unqualified(_NameB), + SymNameA = SymNameA0, + SymNameB = SymNameB0 + ; + SymNameA0 = qualified(ModuleNameA, NameA), + SymNameB0 = qualified(ModuleNameB, NameB), + ( if ModuleNameA = ModuleNameB then + SymNameA = unqualified(NameA), + SymNameB = unqualified(NameB) + else + SymNameA = SymNameA0, + SymNameB = SymNameB0 + ) + ), + delete_identical_qualifications_al(ArgTypesAB0, ArgTypesAB), + keys_and_values(ArgTypesAB, ArgTypesA, ArgTypesB), + TypeA = defined_type(SymNameA, ArgTypesA, Kind), + TypeB = defined_type(SymNameB, ArgTypesB, Kind) + else + TypeA = TypeA0, + TypeB = TypeB0 + ) + ; + TypeA0 = tuple_type(ArgTypesA0, Kind), + ( if + TypeB0 = tuple_type(ArgTypesB0, Kind), + maybe_from_corresponding_lists(ArgTypesA0, ArgTypesB0, + ArgTypesAB0) + then + delete_identical_qualifications_al(ArgTypesAB0, ArgTypesAB), + keys_and_values(ArgTypesAB, ArgTypesA, ArgTypesB), + TypeA = tuple_type(ArgTypesA, Kind), + TypeB = tuple_type(ArgTypesB, Kind) + else + TypeA = TypeA0, + TypeB = TypeB0 + ) + ; + TypeA0 = higher_order_type(PoF, ArgTypesA0, HOInstInfoA, Purity), + ( if + TypeB0 = higher_order_type(PoF, ArgTypesB0, HOInstInfoB, Purity), + maybe_from_corresponding_lists(ArgTypesA0, ArgTypesB0, + ArgTypesAB0) + then + delete_identical_qualifications_al(ArgTypesAB0, ArgTypesAB), + keys_and_values(ArgTypesAB, ArgTypesA, ArgTypesB), + TypeA = higher_order_type(PoF, ArgTypesA, HOInstInfoA, Purity), + TypeB = higher_order_type(PoF, ArgTypesB, HOInstInfoB, Purity) + else + TypeA = TypeA0, + TypeB = TypeB0 + ) + ; + TypeA0 = apply_n_type(TVar, ArgTypesA0, Kind), + ( if + TypeB0 = apply_n_type(TVar, ArgTypesB0, Kind), + maybe_from_corresponding_lists(ArgTypesA0, ArgTypesB0, + ArgTypesAB0) + then + delete_identical_qualifications_al(ArgTypesAB0, ArgTypesAB), + keys_and_values(ArgTypesAB, ArgTypesA, ArgTypesB), + TypeA = apply_n_type(TVar, ArgTypesA, Kind), + TypeB = apply_n_type(TVar, ArgTypesB, Kind) + else + TypeA = TypeA0, + TypeB = TypeB0 + ) + ; + TypeA0 = kinded_type(SubTypeA0, Kind), + ( if TypeB0 = kinded_type(SubTypeB0, Kind) then + delete_identical_qualifications(SubTypeA0, SubTypeB0, + SubTypeA, SubTypeB), + TypeA = kinded_type(SubTypeA, Kind), + TypeB = kinded_type(SubTypeB, Kind) + else + TypeA = TypeA0, + TypeB = TypeB0 + ) + ). + +:- pred delete_identical_qualifications_al(assoc_list(mer_type, mer_type)::in, + assoc_list(mer_type, mer_type)::out) is det. + +delete_identical_qualifications_al([], []). +delete_identical_qualifications_al([TypeA0 - TypeB0 | TypesAB0], + [TypeA - TypeB | TypesAB]) :- + delete_identical_qualifications(TypeA0, TypeB0, TypeA, TypeB), + delete_identical_qualifications_al(TypesAB0, TypesAB). + %---------------------------------------------------------------------------% :- end_module check_hlds.typecheck_error_util. %---------------------------------------------------------------------------% diff --git a/compiler/typecheck_errors.m b/compiler/typecheck_errors.m index cc6ac4c62..e5a64c9fb 100644 --- a/compiler/typecheck_errors.m +++ b/compiler/typecheck_errors.m @@ -178,7 +178,7 @@ wrap_quote(Str) = [quote(Str)]. %---------------------------------------------------------------------------% report_invalid_coerce_from_to(ClauseContext, Context, FromVar, TVarSet, - FromType, ToType, Fails0) = Spec :- + FromType0, ToType0, Fails0) = Spec :- % XXX TYPECHECK_ERRORS % This code can generate some less-than-helpful diagnostics. % @@ -191,6 +191,8 @@ report_invalid_coerce_from_to(ClauseContext, Context, FromVar, TVarSet, InClauseForPieces = in_clause_for_pieces(ClauseContext), VarSet = ClauseContext ^ tecc_varset, FromVarStr = mercury_var_to_name_only_vs(VarSet, FromVar), + + delete_identical_qualifications(FromType0, ToType0, FromType, ToType), FromTypeStr = mercury_type_to_string(TVarSet, print_num_only, FromType), ToTypeStr = mercury_type_to_string(TVarSet, print_num_only, ToType), diff --git a/tests/invalid/coerce_type_error.err_exp b/tests/invalid/coerce_type_error.err_exp index 736967a39..65a321665 100644 --- a/tests/invalid/coerce_type_error.err_exp +++ b/tests/invalid/coerce_type_error.err_exp @@ -1,21 +1,17 @@ coerce_type_error.m:045: In clause for predicate `bad_unrelated'/2: -coerce_type_error.m:045: error: cannot coerce `X' from -coerce_type_error.m:045: `coerce_type_error.orange_non_fruit' to -coerce_type_error.m:045: `coerce_type_error.citrus'. +coerce_type_error.m:045: error: cannot coerce `X' from `orange_non_fruit' to +coerce_type_error.m:045: `citrus'. coerce_type_error.m:045: The base type constructor of the coerce-from type is coerce_type_error.m:045: `orange_non_fruit'/0, while for the coerce-to type coerce_type_error.m:045: it is `fruit'/0. coerce_type_error.m:070: In clause for predicate `bad_phantom'/2: -coerce_type_error.m:070: error: cannot coerce `X' from -coerce_type_error.m:070: `coerce_type_error.phantom(int)' to -coerce_type_error.m:070: `coerce_type_error.phantom(float)'. +coerce_type_error.m:070: error: cannot coerce `X' from `phantom(int)' to +coerce_type_error.m:070: `phantom(float)'. coerce_type_error.m:070: Builtin types such as int and float cannot be either coerce_type_error.m:070: coerced from, or coerced to. coerce_type_error.m:091: In clause for predicate `bad_higher_order'/2: -coerce_type_error.m:091: error: cannot coerce `X' from -coerce_type_error.m:091: `coerce_type_error.wrap_ho(coerce_type_error.citrus)' -coerce_type_error.m:091: to -coerce_type_error.m:091: `coerce_type_error.wrap_ho(coerce_type_error.fruit)'. +coerce_type_error.m:091: error: cannot coerce `X' from `wrap_ho(citrus)' to +coerce_type_error.m:091: `wrap_ho(fruit)'. coerce_type_error.m:091: The only parameter of the type constructor coerce_type_error.m:091: `wrap_ho'/1 must be invariant (meaning that it must coerce_type_error.m:091: be bound to the same type in the coerced-from and @@ -23,10 +19,8 @@ coerce_type_error.m:091: coerced-to types) because it occurs in the type of coerce_type_error.m:091: the first argument of the `wrap_ho'/1 data coerce_type_error.m:091: constructor, which is a higher order type. coerce_type_error.m:106: In clause for predicate `bad_foreign_type'/2: -coerce_type_error.m:106: error: cannot coerce `X' from -coerce_type_error.m:106: `coerce_type_error.wrap_ft(coerce_type_error.citrus)' -coerce_type_error.m:106: to -coerce_type_error.m:106: `coerce_type_error.wrap_ft(coerce_type_error.fruit)'. +coerce_type_error.m:106: error: cannot coerce `X' from `wrap_ft(citrus)' to +coerce_type_error.m:106: `wrap_ft(fruit)'. coerce_type_error.m:106: The only parameter of the type constructor coerce_type_error.m:106: `wrap_ft'/1 must be invariant (meaning that it must coerce_type_error.m:106: be bound to the same type in the coerced-from and @@ -34,10 +28,8 @@ coerce_type_error.m:106: coerced-to types) because it occurs in the type of coerce_type_error.m:106: the first argument of the `wrap_ft'/1 data coerce_type_error.m:106: constructor, which is a foreign type. coerce_type_error.m:118: In clause for predicate `bad_abs_type'/2: -coerce_type_error.m:118: error: cannot coerce `X' from -coerce_type_error.m:118: `coerce_type_error.wrap_abs(coerce_type_error.citrus)' -coerce_type_error.m:118: to -coerce_type_error.m:118: `coerce_type_error.wrap_abs(coerce_type_error.fruit)'. +coerce_type_error.m:118: error: cannot coerce `X' from `wrap_abs(citrus)' to +coerce_type_error.m:118: `wrap_abs(fruit)'. coerce_type_error.m:118: The only parameter of the type constructor coerce_type_error.m:118: `wrap_abs'/1 must be invariant (meaning that it must coerce_type_error.m:118: be bound to the same type in the coerced-from and @@ -45,17 +37,14 @@ coerce_type_error.m:118: coerced-to types) because it occurs in the type of coerce_type_error.m:118: the first argument of the `wrap_abs'/1 data coerce_type_error.m:118: constructor, which is an abstract type. coerce_type_error.m:125: In clause for predicate `non_subtypes'/2: -coerce_type_error.m:125: error: cannot coerce `Fruits' from -coerce_type_error.m:125: `list.list(coerce_type_error.fruit)' to -coerce_type_error.m:125: `list.list(coerce_type_error.orange_non_fruit)'. +coerce_type_error.m:125: error: cannot coerce `Fruits' from `list(fruit)' to +coerce_type_error.m:125: `list(orange_non_fruit)'. coerce_type_error.m:125: `coerce_type_error.fruit'/0 is not a subtype. coerce_type_error.m:125: `coerce_type_error.orange_non_fruit'/0 is not a coerce_type_error.m:125: subtype. coerce_type_error.m:135: In clause for predicate `nested_du_type'/2: coerce_type_error.m:135: error: cannot coerce `OoMCitrus' from -coerce_type_error.m:135: `one_or_more.one_or_more(coerce_type_error.citrus)' -coerce_type_error.m:135: to -coerce_type_error.m:135: `one_or_more.one_or_more(coerce_type_error.fruit)'. +coerce_type_error.m:135: `one_or_more(citrus)' to `one_or_more(fruit)'. coerce_type_error.m:135: The only parameter of the type constructor coerce_type_error.m:135: `one_or_more'/1 must be invariant (meaning that it coerce_type_error.m:135: must be bound to the same type in the coerced-from diff --git a/tests/invalid/coerce_typecheck_eqv.err_exp b/tests/invalid/coerce_typecheck_eqv.err_exp index 8f2b2f8f5..6542293fe 100644 --- a/tests/invalid/coerce_typecheck_eqv.err_exp +++ b/tests/invalid/coerce_typecheck_eqv.err_exp @@ -1,8 +1,6 @@ coerce_typecheck_eqv.m:039: In clause for predicate `test2'/2: -coerce_typecheck_eqv.m:039: error: cannot coerce `X' from -coerce_typecheck_eqv.m:039: `coerce_typecheck_eqv.bad(coerce_typecheck_eqv.citrus)' -coerce_typecheck_eqv.m:039: to -coerce_typecheck_eqv.m:039: `coerce_typecheck_eqv.bad(coerce_typecheck_eqv.fruit)'. +coerce_typecheck_eqv.m:039: error: cannot coerce `X' from `bad(citrus)' to +coerce_typecheck_eqv.m:039: `bad(fruit)'. coerce_typecheck_eqv.m:039: The only parameter of the type constructor coerce_typecheck_eqv.m:039: `bad'/1 must be invariant (meaning that it must coerce_typecheck_eqv.m:039: be bound to the same type in the coerced-from and diff --git a/tests/invalid/coerce_unify_tvars.err_exp b/tests/invalid/coerce_unify_tvars.err_exp index b5b3ccc44..a9b4ba2d8 100644 --- a/tests/invalid/coerce_unify_tvars.err_exp +++ b/tests/invalid/coerce_unify_tvars.err_exp @@ -1,6 +1,6 @@ coerce_unify_tvars.m:063: In clause for predicate `head_type_params'/2: -coerce_unify_tvars.m:063: error: cannot coerce `X' from `list.list(V_1)' to -coerce_unify_tvars.m:063: `list.list(V_2)'. +coerce_unify_tvars.m:063: error: cannot coerce `X' from `list(V_1)' to +coerce_unify_tvars.m:063: `list(V_2)'. coerce_unify_tvars.m:063: Unconstrained type variables such as V_1 and V_2 coerce_unify_tvars.m:063: cannot be either coerced from, or coerced to, coerce_unify_tvars.m:063: because they are not known either to be equal to