[m-rev.] for review: Handle tuple_cons when modechecking coerce.
Peter Wang
novalazy at gmail.com
Tue Jul 9 14:33:09 AEST 2024
compiler/modecheck_coerce.m:
Handle tuple_cons cons_id when modechecking coerce instead of
throwing an exception.
tests/invalid/Mmakefile:
tests/invalid/coerce_tuple.err_exp:
tests/invalid/coerce_tuple.m:
Add test case.
diff --git a/compiler/modecheck_coerce.m b/compiler/modecheck_coerce.m
index c97cf3514..cf9fc2b8a 100644
--- a/compiler/modecheck_coerce.m
+++ b/compiler/modecheck_coerce.m
@@ -512,13 +512,19 @@ modecheck_coerce_from_bound_make_bound_functor_not_existq(ModuleInfo, TVarSet,
% all such errors (mostly because it may not be *invoked* on every inst
% that should be checked).
(
- ConsIdX = du_data_ctor(DuCtorX),
- get_bound_functor_cons_and_arg_types(ModuleInfo, TypeX, TypeY,
- DuCtorX, DuCtorY, GetArgTypesRes),
- ConsIdY = du_data_ctor(DuCtorY),
(
- GetArgTypesRes = arg_types(ArgTypesX, ArgTypesY, Arity),
- get_ctor_existq_tvars_det(ModuleInfo, TypeX, DuCtorX,
+ ConsIdX = du_data_ctor(DuCtorX),
+ get_bound_functor_cons_and_arg_types(ModuleInfo, TypeX, TypeY,
+ DuCtorX, DuCtorY, GetConsArgsResult),
+ ConsIdY = du_data_ctor(DuCtorY)
+ ;
+ ConsIdX = tuple_cons(ConsArity),
+ get_tuple_cons_arg_types(TypeX, TypeY, ConsArity,
+ GetConsArgsResult),
+ ConsIdY = tuple_cons(ConsArity)
+ ),
+ (
+ GetConsArgsResult = cons_args(ArgTypesX, ArgTypesY, Arity,
ConsExistQTVars, NumExtraArgs),
% Separate out insts for type_infos and type_class_infos from
% actual constructor arguments.
@@ -548,16 +554,12 @@ modecheck_coerce_from_bound_make_bound_functor_not_existq(ModuleInfo, TVarSet,
MaybeBoundInstY = bioe_cons_id_error(ConsIdError)
)
;
- GetArgTypesRes = bad_cons_id_for_input_type,
+ GetConsArgsResult = bad_cons_id_for_input_type,
MaybeBoundInstY = bioe_cons_id_error(bad_cons_id_input(ConsIdX))
;
- GetArgTypesRes = bad_cons_id_for_result_type,
+ GetConsArgsResult = bad_cons_id_for_result_type,
MaybeBoundInstY = bioe_cons_id_error(bad_cons_id_result(ConsIdY))
)
- ;
- ConsIdX = tuple_cons(_Arity),
- % XXX tuple_cons actually does occur.
- sorry($pred, "tuple_cons")
;
( ConsIdX = some_int_const(_)
; ConsIdX = float_const(_)
@@ -577,7 +579,13 @@ modecheck_coerce_from_bound_make_bound_functor_not_existq(ModuleInfo, TVarSet,
).
:- type get_arg_types_result
- ---> arg_types(list(mer_type), list(mer_type), int)
+ ---> cons_args(
+ arg_types_x :: list(mer_type),
+ arg_types_y :: list(mer_type),
+ arity :: int,
+ cons_existq_tvars :: existq_tvars,
+ num_extra_args :: int
+ )
; bad_cons_id_for_input_type
; bad_cons_id_for_result_type.
@@ -607,7 +615,10 @@ get_bound_functor_cons_and_arg_types(ModuleInfo, TypeX, TypeY,
list.length(ArgTypesX, Arity),
list.length(ArgTypesY, Arity)
then
- Result = arg_types(ArgTypesX, ArgTypesY, Arity)
+ get_ctor_existq_tvars_det(ModuleInfo, TypeX, DuCtorX,
+ ConsExistQTVars, NumExtraArgs),
+ Result = cons_args(ArgTypesX, ArgTypesY, Arity,
+ ConsExistQTVars, NumExtraArgs)
else
unexpected($pred, "arg types length mismatch")
)
@@ -618,19 +629,9 @@ get_bound_functor_cons_and_arg_types(ModuleInfo, TypeX, TypeY,
Result = bad_cons_id_for_input_type
)
;
- TypeX = tuple_type(ArgTypesX, _),
- ( if
- DuCtorX = du_ctor(unqualified("{}"), Arity, _),
- list.length(ArgTypesX, Arity)
- then
- ( if
- TypeY = tuple_type(ArgTypesY, _),
- list.length(ArgTypesY, Arity)
- then
- Result = arg_types(ArgTypesX, ArgTypesY, Arity)
- else
- unexpected($pred, "tuple type mismatch")
- )
+ TypeX = tuple_type(_, _),
+ ( if DuCtorX = du_ctor(unqualified("{}"), Arity, _) then
+ get_tuple_cons_arg_types(TypeX, TypeY, Arity, Result)
else
Result = bad_cons_id_for_input_type
)
@@ -644,7 +645,10 @@ get_bound_functor_cons_and_arg_types(ModuleInfo, TypeX, TypeY,
( if Arity = 0 then
ArgTypesX = [],
ArgTypesY = [],
- Result = arg_types(ArgTypesX, ArgTypesY, Arity)
+ ConsExistQTVars = [],
+ NumExtraArgs = 0,
+ Result = cons_args(ArgTypesX, ArgTypesY, Arity,
+ ConsExistQTVars, NumExtraArgs)
else
Result = bad_cons_id_for_input_type
)
@@ -671,6 +675,29 @@ get_bound_functor_cons_and_arg_types(ModuleInfo, TypeX, TypeY,
Result = bad_cons_id_for_input_type
).
+:- pred get_tuple_cons_arg_types(mer_type::in, mer_type::in, int::in,
+ get_arg_types_result::out) is det.
+
+get_tuple_cons_arg_types(TypeX, TypeY, Arity, Result) :-
+ ( if
+ TypeX = tuple_type(ArgTypesX, _),
+ list.length(ArgTypesX, Arity)
+ then
+ ( if
+ TypeY = tuple_type(ArgTypesY, _),
+ list.length(ArgTypesY, Arity)
+ then
+ ConsExistQTVars = [],
+ NumExtraArgs = 0,
+ Result = cons_args(ArgTypesX, ArgTypesY, Arity,
+ ConsExistQTVars, NumExtraArgs)
+ else
+ unexpected($pred, "tuple type mismatch")
+ )
+ else
+ Result = bad_cons_id_for_input_type
+ ).
+
:- pred modecheck_coerce_from_bound_make_bound_functor_arg_insts(
module_info::in, tvarset::in, is_live::in, rev_term_path::in,
expanded_insts::in, cons_id::in, existq_tvars::in,
diff --git a/tests/invalid/Mmakefile b/tests/invalid/Mmakefile
index 3ee003d5b..98f55e4a2 100644
--- a/tests/invalid/Mmakefile
+++ b/tests/invalid/Mmakefile
@@ -130,6 +130,7 @@ BORING_SINGLEMODULE_PROGS = \
coerce_recursive_type \
coerce_same_var \
coerce_syntax \
+ coerce_tuple \
coerce_type_error \
coerce_unify_tvars \
coerce_uniq \
diff --git a/tests/invalid/coerce_tuple.err_exp b/tests/invalid/coerce_tuple.err_exp
new file mode 100644
index 000000000..af29bc9c3
--- /dev/null
+++ b/tests/invalid/coerce_tuple.err_exp
@@ -0,0 +1,16 @@
+coerce_tuple.m:031: In clause for `bad1':
+coerce_tuple.m:031: in coerce expression:
+coerce_tuple.m:031: mode error: cannot convert the [38;5;87mcoerced term[39;49m from type
+coerce_tuple.m:031: `coerce_tuple.basket(coerce_tuple.fruit)' to
+coerce_tuple.m:031: `coerce_tuple.basket(coerce_tuple.citrus)' because it has
+coerce_tuple.m:031: instantiatedness [38;5;203m`unique',[39;49m and
+coerce_tuple.m:031: [38;5;203m`coerce_tuple.basket(coerce_tuple.fruit)'[39;49m is not a
+coerce_tuple.m:031: subtype of `coerce_tuple.basket(coerce_tuple.citrus)'.
+coerce_tuple.m:037: In clause for `bad2':
+coerce_tuple.m:037: in coerce expression:
+coerce_tuple.m:037: mode error: cannot convert the [38;5;87mcoerced term[39;49m from type
+coerce_tuple.m:037: `coerce_tuple.basket(coerce_tuple.fruit)' to
+coerce_tuple.m:037: `coerce_tuple.citrus_basket' because it has
+coerce_tuple.m:037: instantiatedness [38;5;203m`unique',[39;49m and
+coerce_tuple.m:037: [38;5;203m`coerce_tuple.basket(coerce_tuple.fruit)'[39;49m is not a
+coerce_tuple.m:037: subtype of `coerce_tuple.citrus_basket'.
diff --git a/tests/invalid/coerce_tuple.m b/tests/invalid/coerce_tuple.m
new file mode 100644
index 000000000..8d0fae21d
--- /dev/null
+++ b/tests/invalid/coerce_tuple.m
@@ -0,0 +1,55 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+
+:- module coerce_tuple.
+:- interface.
+
+:- type fruit
+ ---> apple
+ ; orange
+ ; lemon.
+
+:- type citrus =< fruit
+ ---> orange
+ ; lemon.
+
+:- type basket(T)
+ ---> basket({int, string}, {T, T}).
+
+:- type citrus_basket =< basket(fruit)
+ ---> basket({int, string}, {citrus, citrus}).
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pred bad1 is det.
+
+bad1 :-
+ X = basket({1, "two"}, {lemon, apple}),
+ coerce(X) = _ : basket(citrus).
+
+:- pred bad2 is det.
+
+bad2 :-
+ X = basket({1, "two"}, {lemon, apple}),
+ coerce(X) = _ : citrus_basket.
+
+:- pred ok3 is det.
+
+ok3 :-
+ X = basket({1, "two"}, {orange, lemon : fruit}),
+ coerce(X) = _ : basket(citrus).
+
+:- pred ok4 is det.
+
+ok4 :-
+ X = basket({1, "two"}, {orange, lemon}) : citrus_basket,
+ coerce(X) = _ : basket(fruit).
+
+:- pred ok5 is det.
+
+ok5 :-
+ X = basket({1, "two"}, {orange, lemon}) : citrus_basket,
+ coerce(X) = _ : basket(citrus).
--
2.44.0
More information about the reviews
mailing list