mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 09:23:44 +00:00
89b05266a1
library/array.m:
library/assoc_list.m:
library/bimap.m:
library/bitmap.m:
library/construct.m:
library/deconstruct.m:
library/dir.m:
library/hash_table.m:
library/injection.m:
library/io.stream_db.m:
library/kv_list.m:
library/list.m:
library/map.m:
library/robdd.m:
library/stream.string_writer.m:
library/term_conversion.m:
library/term_to_xml.m:
library/tree234.m:
library/type_desc.m:
library/version_hash_table.m:
For nearly every ordinary function in this directory that can fail in its
primary mode (all of which were semidet functions),
- provide a semidet predicate as an alternative, if it did not
already exist,
- implement the function in terms of the predicate, instead of vice versa,
- mark the semidet function as obsolete in favor of the semidet predicate
version,
- fix all the resulting warnings, and then
- comment out the obsolete pragmas (at least for now).
Note that this diff does not touch the semidet function in the
enum typeclass, or the functions that implement that method
in instances.
NEWS.md:
Announce the new predicates in the (documented) modules of the library.
browser/term_rep.m:
compiler/lp_rational.m:
compiler/mcsolver.m:
compiler/mode_ordering.m:
compiler/mode_robdd.equiv_vars.m:
compiler/mode_robdd.implications.m:
compiler/old_type_constraints.m:
compiler/pickle.m:
compiler/prog_event.m:
compiler/type_ctor_info.m:
compiler/var_table.m:
tests/hard_coded/bitmap_empty.m:
tests/hard_coded/construct_mangle.m:
tests/hard_coded/construct_packed.m:
tests/hard_coded/construct_test.m:
tests/hard_coded/dummy_type_construct.m:
tests/hard_coded/expand.m:
tests/hard_coded/foreign_enum_rtti.m:
tests/hard_coded/subtype_rtti.m:
tests/hard_coded/term_to_univ_test.m:
tests/hard_coded/type_to_term.m:
tests/hard_coded/type_to_term_bug.m:
Stop calling the semidet functions from the library that were temporarily
marked obsolete.
In a few places, add explicit type qualification to avoid warnings
about unresolved polymorphism.
tests/hard_coded/test_injection.exp:
Expect an abort message from the predicate version of a semidet function.
tests/declarative_debugger/ho_2.exp2:
Update this .exp file for a previous commit.
422 lines
14 KiB
Mathematica
422 lines
14 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ts=4 sw=4 et ft=mercury
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Test case for construct, num_functors, type_of and get_functor.
|
|
%
|
|
% Original author: trd
|
|
%
|
|
|
|
:- module construct_test.
|
|
:- interface.
|
|
:- import_module io.
|
|
|
|
:- pred main(io::di, io::uo) is det.
|
|
|
|
:- implementation.
|
|
|
|
:- import_module list.
|
|
:- import_module int.
|
|
:- import_module univ.
|
|
:- import_module maybe.
|
|
:- import_module term.
|
|
:- import_module map.
|
|
:- import_module string.
|
|
:- import_module require.
|
|
:- import_module construct.
|
|
:- import_module type_desc.
|
|
|
|
:- type enum
|
|
---> one
|
|
; two
|
|
; three.
|
|
|
|
:- type fruit
|
|
---> apple(apple_list :: list(int))
|
|
; banana(banana_list :: list(enum)).
|
|
|
|
:- type thingie
|
|
---> foo
|
|
; bar(int)
|
|
; bar(int, int)
|
|
; qux(int)
|
|
; quux(int)
|
|
; quuux(int, int)
|
|
; wombat
|
|
; zoom(int)
|
|
; zap(int, float)
|
|
; zip(int, int)
|
|
; zop(float, float).
|
|
|
|
:- type poly(A, B)
|
|
---> poly_one(A)
|
|
; poly_two(B)
|
|
; poly_three(B, poly3_field2 :: A, poly(B, A))
|
|
; poly_four(A, B).
|
|
|
|
:- type no_tag
|
|
---> qwerty(qwerty_field :: int).
|
|
|
|
:- type dummy
|
|
---> dummy.
|
|
|
|
:- type unboxed_arg
|
|
---> no
|
|
; unboxed_arg(unboxed_struct).
|
|
|
|
:- type unboxed_struct
|
|
---> unboxed_struct(int, int).
|
|
|
|
:- type exist_type
|
|
---> some [T] xyzzy(f21name :: T).
|
|
|
|
% By using nine non-constant functors, we are forcing packed_8
|
|
% and packed_9 to share a primary tag even on 64 bit systems.
|
|
% packed_1 tests the secondary tag absent case in the construct predicate,
|
|
% while and packed_8 tests the secondary tag present case.
|
|
:- type packed(T)
|
|
---> packed_1(int8, uint8, dummy, dummy, int8, uint8, T)
|
|
; some [U] packed_2(dummy, U, int8, uint8, dummy, int8, uint8)
|
|
; packed_3(int)
|
|
; packed_4(int)
|
|
; packed_5(int)
|
|
; packed_6(int)
|
|
; packed_7(int)
|
|
; packed_8(T, dummy, int8, uint8, dummy, dummy, int8, uint8,
|
|
float, int)
|
|
; some [U] packed_9(T, dummy, U, int8, uint8, dummy, int8, uint8).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
main(!IO) :-
|
|
io.write_string("------- TESTING TYPE DESCRIPTIONS -------\n", !IO),
|
|
|
|
describe_functors_in_du_types(!IO),
|
|
describe_functors_in_polymorphic_types(!IO),
|
|
describe_functors_in_builtin_types(!IO),
|
|
describe_functors_in_other_types(!IO),
|
|
|
|
io.write_string("\n------- TESTING CONSTRUCTION OF TERMS -------\n", !IO),
|
|
test_construction(!IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred describe_functors_in_du_types(io::di, io::uo) is det.
|
|
|
|
describe_functors_in_du_types(!IO) :-
|
|
io.write_string("\nTESTING DISCRIMINATED UNIONS\n", !IO),
|
|
|
|
% Test enumerations.
|
|
describe_all_functors_of_type(two, !IO),
|
|
describe_all_functors_of_type(one, !IO),
|
|
describe_all_functors_of_type(three, !IO),
|
|
|
|
% Test simple tags.
|
|
describe_all_functors_of_type(apple([9, 5, 1]), !IO),
|
|
describe_all_functors_of_type(banana([three, one, two]), !IO),
|
|
|
|
% Test complicated tags.
|
|
describe_all_functors_of_type(zop(3.3, 2.03), !IO),
|
|
describe_all_functors_of_type(zip(3, 2), !IO),
|
|
describe_all_functors_of_type(zap(3, -2.111), !IO),
|
|
|
|
% Test complicated constants.
|
|
describe_all_functors_of_type(wombat, !IO),
|
|
describe_all_functors_of_type(foo, !IO).
|
|
|
|
:- pred describe_functors_in_polymorphic_types(io::di, io::uo) is det.
|
|
|
|
describe_functors_in_polymorphic_types(!IO) :-
|
|
io.write_string("\nTESTING POLYMORPHISM\n", !IO),
|
|
describe_all_functors_of_type(poly_three(3.33, 4, poly_one(9.11)), !IO),
|
|
describe_all_functors_of_type(poly_two(3) : poly(dummy, int), !IO),
|
|
describe_all_functors_of_type(poly_one([2399.3]) :
|
|
poly(list(float), dummy), !IO).
|
|
|
|
:- pred describe_functors_in_builtin_types(io::di, io::uo) is det.
|
|
|
|
describe_functors_in_builtin_types(!IO) :-
|
|
io.write_string("\nTESTING BUILTINS\n", !IO),
|
|
|
|
% Test strings.
|
|
describe_all_functors_of_type("", !IO),
|
|
describe_all_functors_of_type("Hello, world\n", !IO),
|
|
describe_all_functors_of_type("Foo%sFoo", !IO),
|
|
describe_all_functors_of_type("""", !IO),
|
|
|
|
% Test characters.
|
|
describe_all_functors_of_type('a', !IO),
|
|
describe_all_functors_of_type('&', !IO),
|
|
|
|
% Test floats.
|
|
describe_all_functors_of_type(3.14159, !IO),
|
|
describe_all_functors_of_type(11.28324983E-22, !IO),
|
|
describe_all_functors_of_type(22.3954899E22, !IO),
|
|
|
|
% Test integers.
|
|
describe_all_functors_of_type(-65, !IO),
|
|
describe_all_functors_of_type(4, !IO),
|
|
|
|
% Test unsigned integers.
|
|
describe_all_functors_of_type(42u, !IO),
|
|
|
|
% Test fixed size integers.
|
|
describe_all_functors_of_type(42i8, !IO),
|
|
describe_all_functors_of_type(42u8, !IO),
|
|
describe_all_functors_of_type(42i16, !IO),
|
|
describe_all_functors_of_type(42u16, !IO),
|
|
describe_all_functors_of_type(42i32, !IO),
|
|
describe_all_functors_of_type(42u32, !IO),
|
|
describe_all_functors_of_type(42i64, !IO),
|
|
describe_all_functors_of_type(42u64, !IO),
|
|
|
|
% Test univ.
|
|
% type_to_univ(["hi! I'm a univ!"], Univ),
|
|
% describe_all_functors_of_type(Univ, !IO),
|
|
|
|
% Test predicates.
|
|
describe_all_functors_of_type(newline, !IO),
|
|
|
|
% Test tuples.
|
|
describe_all_functors_of_type({1, "a", 'a', {4, 'd'}}, !IO),
|
|
|
|
% Test lists.
|
|
describe_all_functors_of_type([1, 2, 3, 4], !IO).
|
|
|
|
:- pred describe_functors_in_other_types(io::di, io::uo) is det.
|
|
|
|
describe_functors_in_other_types(!IO) :-
|
|
io.write_string("\nTESTING OTHER TYPES\n", !IO),
|
|
|
|
term.init_var_supply(VarSupply : var_supply(int)),
|
|
term.create_var(Var, VarSupply, NewVarSupply),
|
|
describe_all_functors_of_type(Var, !IO),
|
|
describe_all_functors_of_type(VarSupply, !IO),
|
|
describe_all_functors_of_type(NewVarSupply, !IO),
|
|
|
|
% Presently, at least, map is an equivalence and an abstract type.
|
|
% Note: testing abstract types is always going to have results
|
|
% that are dependent on the implementation. If someone changes
|
|
% the implementation, the results of this test can change.
|
|
map.init(Map : map(int, int)),
|
|
describe_all_functors_of_type(Map, !IO),
|
|
|
|
% A no tag type.
|
|
describe_all_functors_of_type(qwerty(4), !IO),
|
|
|
|
% A dummy type.
|
|
describe_all_functors_of_type(dummy, !IO),
|
|
|
|
% A functor with a single unboxed argument.
|
|
describe_all_functors_of_type(unboxed_arg(unboxed_struct(12, 34)), !IO),
|
|
|
|
% An existential type.
|
|
ExistVal = 'new xyzzy'(8),
|
|
describe_all_functors_of_type(ExistVal, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred describe_all_functors_of_type(T::in, io::di, io::uo) is det.
|
|
|
|
describe_all_functors_of_type(T, !IO) :-
|
|
io.nl(!IO),
|
|
TypeInfo = type_desc.type_of(T),
|
|
( if NumFunctors = construct.num_functors(TypeInfo) then
|
|
io.format("#functors in this type = %d\n", [i(NumFunctors)], !IO),
|
|
describe_functors_of_type_loop(TypeInfo, 0, NumFunctors, !IO)
|
|
else
|
|
io.format("#functors in this type = %d\n", [i(0)], !IO)
|
|
).
|
|
|
|
:- pred describe_functors_of_type_loop(type_desc.type_desc::in,
|
|
int::in, int::in, io::di, io::uo) is det.
|
|
|
|
describe_functors_of_type_loop(TypeInfo, Cur, NumFunctors, !IO) :-
|
|
( if Cur >= NumFunctors then
|
|
true
|
|
else
|
|
describe_nth_functor_of_type(TypeInfo, Cur, !IO),
|
|
describe_functors_of_type_loop(TypeInfo, Cur + 1, NumFunctors, !IO)
|
|
).
|
|
|
|
:- pred describe_nth_functor_of_type(type_desc.type_desc::in, int::in,
|
|
io::di, io::uo) is det.
|
|
|
|
describe_nth_functor_of_type(TypeInfo, N, !IO) :-
|
|
( if
|
|
% Ordinal = construct.get_functor_ordinal(TypeInfo, N),
|
|
% Lex = construct.get_functor_lex(TypeInfo, Ordinal),
|
|
Lex = construct.get_functor_lex(TypeInfo, N),
|
|
Ordinal = construct.get_functor_ordinal(TypeInfo, Lex),
|
|
construct.get_functor_with_names(TypeInfo, Lex,
|
|
FunctorName, FunctorArity, _ArgTypesList, ArgMaybeNames)
|
|
then
|
|
( if N = Ordinal then
|
|
ArgNames = list.map(name_or_underscore, ArgMaybeNames),
|
|
ArgNamesDesc = join_list(", ", ArgNames),
|
|
FunctorNA = string.format("%s/%d",
|
|
[s(FunctorName), i(FunctorArity)]),
|
|
io.format("%2d - %-14s lex: %2d [%s]\n",
|
|
[i(N), s(FunctorNA), i(Lex), s(ArgNamesDesc)], !IO)
|
|
else
|
|
io.format("N (%d) != Ordinal (%d)\n", [i(N), i(Ordinal)], !IO)
|
|
)
|
|
else
|
|
io.format("%d failed\n", [i(N)], !IO)
|
|
).
|
|
|
|
:- func name_or_underscore(maybe(string)) = string.
|
|
|
|
name_or_underscore(MaybeName) = Str :-
|
|
(
|
|
MaybeName = yes(Name),
|
|
Str = Name
|
|
;
|
|
MaybeName = no,
|
|
Str = "_"
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred newline(io::di, io::uo) is det.
|
|
|
|
newline(!IO) :-
|
|
io.nl( !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred test_construction(io::di, io::uo) is det.
|
|
|
|
test_construction(!IO) :-
|
|
% Valid tests.
|
|
|
|
% Enumerations:
|
|
|
|
test_construct(type_desc.type_of(one),
|
|
"three", [], !IO),
|
|
|
|
type_to_univ([1, 2, 3], NumList),
|
|
test_construct(type_desc.type_of(apple([])),
|
|
"apple", [NumList], !IO),
|
|
|
|
type_to_univ([one, two, three], EnumList),
|
|
test_construct(type_desc.type_of(apple([])),
|
|
"banana", [EnumList], !IO),
|
|
|
|
% Discriminated union:
|
|
% (Simple, complicated and complicated constant tags).
|
|
|
|
type_to_univ(1, One),
|
|
type_to_univ(2.1, TwoPointOne),
|
|
|
|
test_construct(type_desc.type_of(wombat),
|
|
"foo", [], !IO),
|
|
test_construct(type_desc.type_of(wombat),
|
|
"bar", [One], !IO),
|
|
test_construct(type_desc.type_of(wombat),
|
|
"bar", [One, One], !IO),
|
|
test_construct(type_desc.type_of(wombat),
|
|
"qux", [One], !IO),
|
|
test_construct(type_desc.type_of(wombat),
|
|
"quux", [One], !IO),
|
|
test_construct(type_desc.type_of(wombat),
|
|
"quuux", [One, One], !IO),
|
|
test_construct(type_desc.type_of(wombat),
|
|
"wombat", [], !IO),
|
|
test_construct(type_desc.type_of(wombat),
|
|
"zoom", [One], !IO),
|
|
test_construct(type_desc.type_of(wombat),
|
|
"zap", [One, TwoPointOne], !IO),
|
|
test_construct(type_desc.type_of(wombat),
|
|
"zip", [One, One], !IO),
|
|
test_construct(type_desc.type_of(wombat),
|
|
"zop", [TwoPointOne, TwoPointOne], !IO),
|
|
|
|
% No-tag type.
|
|
test_construct(type_desc.type_of(qwerty(7)),
|
|
"qwerty", [One], !IO),
|
|
|
|
% Functor with single unboxed argument.
|
|
type_to_univ(unboxed_struct(12, 34), UnboxedStruct),
|
|
test_construct(type_desc.type_of(_ : unboxed_arg),
|
|
"unboxed_arg", [UnboxedStruct], !IO),
|
|
|
|
type_to_univ("goodbye", Bye),
|
|
|
|
test_construct(type_desc.type_of(poly_four(3, "hello")),
|
|
"poly_one", [One], !IO),
|
|
test_construct(type_desc.type_of(poly_four(3, "hello")),
|
|
"poly_two", [Bye], !IO),
|
|
test_construct(type_desc.type_of(poly_four(3, "hello")),
|
|
"poly_four", [One, Bye], !IO),
|
|
test_construct(type_desc.type_of({1, "two", '3'}),
|
|
"{}", [univ(4), univ("five"), univ('6')], !IO),
|
|
|
|
io.nl(!IO),
|
|
io.write_string("About to construct a tuple\n", !IO),
|
|
Tuple = construct.construct_tuple([NumList, EnumList, One, TwoPointOne]),
|
|
io.write(Tuple, !IO),
|
|
io.nl(!IO),
|
|
|
|
Packed =
|
|
type_desc.type_of(packed_1(0i8, 0u8, dummy, dummy, 0i8, 0u8, "")),
|
|
|
|
test_construct(Packed, "packed_1",
|
|
[univ(-11i8), univ(11u8), univ(dummy), univ(dummy),
|
|
univ(-127i8), univ(255u8), univ("abc")], !IO),
|
|
% We cannot yet construct terms with existentially typed arguments.
|
|
% test_construct(Packed, "packed_2",
|
|
% [univ(dummy), univ(-11i8), univ(-11i8), univ(11u8), univ(dummy),
|
|
% univ(-127i8), univ(255u8)], !IO),
|
|
test_construct(Packed, "packed_8",
|
|
[univ("def"), univ(dummy), univ(-11i8), univ(11u8),
|
|
univ(dummy), univ(dummy), univ(-127i8), univ(255u8),
|
|
univ(1234.567), univ(42)], !IO).
|
|
% We cannot yet construct terms with existentially typed arguments.
|
|
% test_construct(Packed, "packed_9",
|
|
% [univ("def"), univ(dummy), univ(1234.56), univ(-25i8), univ(140u8),
|
|
% univ(dummy), univ(-127i8), univ(255u8)], !IO).
|
|
|
|
:- pred test_construct(type_desc.type_desc::in, string::in,
|
|
list(univ)::in, io::di, io::uo) is det.
|
|
|
|
test_construct(TypeInfo, FunctorName, Args, !IO) :-
|
|
io.nl(!IO),
|
|
list.length(Args, Arity),
|
|
find_functor(TypeInfo, FunctorName, Arity, FunctorNumber),
|
|
io.format("About to construct %s/%d\n", [s(FunctorName), i(Arity)], !IO),
|
|
( if construct.construct(TypeInfo, FunctorNumber, Args, Constructed) then
|
|
io.print(Constructed, !IO),
|
|
io.nl(!IO)
|
|
else
|
|
io.write_string("Construction failed.\n", !IO)
|
|
).
|
|
|
|
:- pred find_functor(type_desc.type_desc::in, string::in, int::in, int::out)
|
|
is det.
|
|
|
|
find_functor(TypeInfo, Functor, Arity, FunctorNumber) :-
|
|
( if N = construct.num_functors(TypeInfo) then
|
|
find_functor_loop(TypeInfo, Functor, Arity, N, FunctorNumber)
|
|
else
|
|
error("unable to find number of functors")
|
|
).
|
|
|
|
:- pred find_functor_loop(type_desc.type_desc::in, string::in, int::in,
|
|
int::in, int::out) is det.
|
|
|
|
find_functor_loop(TypeInfo, Functor, Arity, Num, FunctorNumber) :-
|
|
( if Num < 0 then
|
|
error("unable to find functor")
|
|
else
|
|
( if construct.get_functor(TypeInfo, Num, Functor, Arity, _) then
|
|
FunctorNumber = Num
|
|
else
|
|
find_functor_loop(TypeInfo, Functor, Arity, Num - 1,
|
|
FunctorNumber)
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|