mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 17:33:38 +00:00
d013421326
The modechecking for coerce did not take into account existentially typed arguments in the term being coerced. There are two main changes: 1. If the input (sub)term being coerced has an existential type, the result must have the same type. Therefore, we can use the inst approximating the input (sub)term for the result. 2. Each existentially quantified type variable or existential class constraint on a data constructor adds a type_info or type_class_info to the resulting heap cell. Internally, the inst for that cell will include insts for those extra arguments, which the modechecker for coerce will need to be aware of. Fixes GitHub issue #132 compiler/modecheck_coerce.m: As above. doc/reference_manual.texi: Account for existential types in the description of how modechecking of coerce works. tests/hard_coded/Mmakefile: tests/hard_coded/coerce_existq.exp: tests/hard_coded/coerce_existq.m: Add test case.
117 lines
3.1 KiB
Mathematica
117 lines
3.1 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ts=4 sw=4 et ft=mercury
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module coerce_existq.
|
|
:- interface.
|
|
|
|
:- import_module io.
|
|
|
|
:- pred main(io::di, io::uo) is det.
|
|
|
|
:- implementation.
|
|
|
|
:- import_module deconstruct.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module string.
|
|
:- import_module type_desc.
|
|
|
|
:- type foo
|
|
---> foo(int)
|
|
; foo2.
|
|
|
|
:- type maybe_box
|
|
---> some [A, B, C, D] box(foo, A, B, C, D) => (tc(B), tc(C))
|
|
; none.
|
|
|
|
:- type box =< maybe_box
|
|
---> some [X3, X2, X1, X0] box(foo, X3, X2, X1, X0) => (tc(X2), tc(X1)).
|
|
|
|
:- typeclass tc(T) where [
|
|
func reverse(T) = string
|
|
].
|
|
:- instance tc(float) where [
|
|
reverse(X) = reverse_string(string.from_float(X))
|
|
].
|
|
:- instance tc(string) where [
|
|
reverse(X) = reverse_string(X)
|
|
].
|
|
|
|
:- func reverse_string(string) = string.
|
|
|
|
reverse_string(S) =
|
|
string.from_char_list(list.reverse(string.to_char_list(S))).
|
|
|
|
main(!IO) :-
|
|
Zero = foo(0),
|
|
A0 = 'new box'(Zero, 1, "two", 3.333, {"four", 5}) : maybe_box,
|
|
A = coerce(A0),
|
|
print_box(A, !IO),
|
|
call_methods(A, !IO),
|
|
|
|
% Same but with 'ground' arguments, instead of bound.
|
|
Int = string.det_to_int("1"),
|
|
Str = reverse_string("owt"),
|
|
B0 = 'new box'(Zero, Int, Str, 3.333, {"four", 5}) : maybe_box,
|
|
B = coerce(B0),
|
|
print_box(B, !IO),
|
|
call_methods(B, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred print_box(box::in, io::di, io::uo) is det.
|
|
|
|
print_box(X, !IO) :-
|
|
deconstruct(X, do_not_allow, _Functor, Arity, _Args),
|
|
io.print_line(X, !IO),
|
|
print_args(X, 0, Arity, !IO),
|
|
io.nl(!IO).
|
|
|
|
:- pred print_args(T::in, int::in, int::in, io::di, io::uo) is det.
|
|
|
|
print_args(X, Index, Arity, !IO) :-
|
|
( if Index < Arity then
|
|
( if arg(X, do_not_allow, Index, Arg) then
|
|
TypeDesc = type_of(Arg),
|
|
io.format(" arg %d: ", [i(Index + 1)], !IO),
|
|
print_type_desc(TypeDesc, !IO),
|
|
io.nl(!IO)
|
|
else
|
|
io.print_line("deconstruct failed", !IO)
|
|
),
|
|
print_args(X, Index + 1, Arity, !IO)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred print_type_desc(type_desc::in, io::di, io::uo) is det.
|
|
|
|
print_type_desc(TypeDesc, !IO) :-
|
|
type_ctor_and_args(TypeDesc, TypeCtor, TypeArgs),
|
|
type_ctor_name_and_arity(TypeCtor, _ModuleName, TypeCtorName,
|
|
_TypeCtorArity),
|
|
io.write_string(TypeCtorName, !IO),
|
|
(
|
|
TypeArgs = []
|
|
;
|
|
TypeArgs = [_ | _],
|
|
io.write_string("(", !IO),
|
|
io.write_list(TypeArgs, ", ", print_type_desc, !IO),
|
|
io.write_string(")", !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred call_methods(box::in, io::di, io::uo) is det.
|
|
|
|
call_methods(X, !IO) :-
|
|
X = box(_Foo, _A, B, C, _D),
|
|
io.write_string("Calling methods: ", !IO),
|
|
io.write_string(reverse(B), !IO),
|
|
io.write_string(", ", !IO),
|
|
io.write_string(reverse(C), !IO),
|
|
io.write_string("\n\n", !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|