mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-20 11:54:02 +00:00
Code Issues Projects Releases Wiki Activity
Files
bb885a080760cf6cfdd76e3cc579da48c19cf41c
mercury/tests/hard_coded/construct.m
Simon Taylor 46a8da81cb Implement builtin tuple types, similar to those in Haskell. 
Estimated hours taken: 30

Implement builtin tuple types, similar to those in Haskell.

Tuples are constructed and deconstructed using
the syntax X = {Arg1, Arg2, ...}.
Tuples have type `{Arg1, Arg2, ...}'.

Unary tuples (X = {Arg}) do work, unlike in Haskell. The rationale
for this is that it is useful to be able to construct unary tuples
to be passed to a polymorphic predicate which uses std_util__deconstruct
to deal with a tuple of any arity. Since this is probably the only
use for unary tuples, it's not really worth the effort of treating
them as no_tag types, so we don't.

The type-infos for tuples have the same structure as for higher-order
types. There is a single type_ctor_info for tuples, and the arity
is placed before the argument type_infos.

library/parser.m:
	Change the way '{}/N' terms are parsed, so that the parsed
	representation is consistent with the way other functors
	are represented (previously the arguments were left as
	unparsed ','/2 terms). This avoids special case code
	in prog_io__parse_qualified_term, term__term_to_type
	and term__type_to_term.

compiler/prog_io_dcg.m:
compiler/prog_io_util.m:
	Handle the new structure of '{}/N' terms when parsing DCG escapes
	by converting the argument list back into a single ','/2 term.

compiler/module_qual.m:
	Treat tuples as a builtin type.

compiler/typecheck.m:
	Typecheck tuple constructors.

compiler/mode_util.m:
	Propagate types into tuple bound insts.

compiler/type_util.m:
	Add type_is_tuple/2 and type_id_is_tuple/1 to identify tuple types.
	Add tuples to the list of types which are not atomic types.

	Handle tuple types in `type_constructors' and
	`get_cons_id_arg_types' and `switch_type_num_functors'.

compiler/tabling.m:
	Handle tabling of tuples.

compiler/term_util.m:
	Handle tuples in the code to compute functor norms.

compiler/magic_util.m:
compiler/rl.m:
compiler/rl_key.m:
	Handle tuple types in the Aditi back end.

compiler/mercury_to_mercury.m:
library/io.m:
library/term_io.m:
	Handle output of '{}/N' terms.

compiler/higher_order.m:
compiler/simplify.m:
	Don't specialize complicated unifications of tuple
	types into calls to a specific unification procedure --
	even if the procedure were implemented, it probably
	wouldn't be that much more efficient.

compiler/unify_proc.m:
	Generate unification procedures for complicated unifications
	of tuples (other than in-in unifications). These are generated
	lazily as required.

compiler/make_hlds.m:
	Export add_special_pred for use by unify_proc.m.

compiler/polymorphism.m:
	Export polymorphism__process_pred for use by unify_proc.m.

compiler/bytecode_gen.m:
compiler/code_util.m:
compiler/ml_code_util.m:
	Handle unify procedure names and tags for tuple types.

compiler/mlds_to_c.m:
	Output tuple types as MR_Tuple.

compiler/ml_unify_gen.m:
	Compute the field types for tuples.

compiler/polymorphism.m:
compiler/pseudo_type_info.m:
	Treat tuple type_infos in a similar way to higher-order type_infos.

compiler/hlds_data.m:
	Document how cons_ids for tuple types are represented.

compiler/switch_gen.m:
compiler/table_gen.m:
	Add tuple types to switches on type_util__builtin_type.

compiler/llds_out.m:
util/mdemangle.c:
profiler/demangle.m:
	Transform items named "{}" to "f_tuple" when mangling symbols.

library/builtin.m:
	Define the type_ctor_info used for tuples.

library/private_builtin.m:
	Add `builtin_unify_tuple/2' and `builtin_compare_tuple/3',
	both of which abort. All comparisons and in-in unifications
	of tuples are performed by the generic unification functions
	in runtime/mercury_ho_call.c and runtime/mercury.c.

library/std_util.m:
	Implement the various RTTI functions for tuples.

	Encode tuple `TypeCtorDesc's in a similar way to that
	used for higher-order types. This has the consequence that the limit
	on the arity of higher-order types is now MAX_VIRTUAL_REG,
	rather than 2*MAX_VIRTUAL_REG.

	Avoid calling MR_GC_free for the type-info vector returned
	from ML_expand() for tuples because unlike the vectors
	for du types, it is not copied.

runtime/mercury_type_info.h:
	Add macros for extracting fields from tuple type-infos.
	These just call the macros for extracting fields from higher-order
	type-infos.

	Add a macro MR_type_ctor_rep_is_variable_arity(), which
	returns TRUE for tuples and higher-order types.

	The distinction between higher-order and first-order types
	is now misnamed -- the distinction is really between fixed arity
	types and builtin variable arity types. I'm not sure whether
	it's worth renaming everything.

runtime/mercury.h:
runtime/mercury.c:
	Define unification and comparison of tuples in
	high-level code grades.

runtime/mercury_deep_copy_body.h:
runtime/mercury_make_type_info_body.h:
runtime/mercury_tabling.c:
runtime/mercury_unify_compare_body.h:
	Handle tuple types in code which traverses data using RTTI.

tests/hard_coded/construct.{m,exp}:
tests/hard_coded/expand.{m,exp}:
	Test RTTI functions from std_util.m applied to tuples.

tests/hard_coded/tuple_test.{m,exp}:
	Test unification, comparison, term_to_type etc. applied to tuples.

tests/hard_coded/deep_copy.{m,exp}:
	Test deep copy of tuples.

tests/hard_coded/typeclasses/tuple_instance.{m,exp}:
	Test instance declarations for tuples.

tests/tabling/expand_tuple.{m,exp}:
	Test tabling of tuples.

tests/hard_coded/write.m:
	Add some module qualifications for code which uses
	`{}/1' constructors which are not tuples.

tests/invalid/errors2.{m,err_exp,err_exp2}:
	Test handling of tuples in type errors messages.

NEWS:
doc/reference_manual.texi:
w3/news/newsdb.inc:
	Document tuples.

doc/transition_guide.texi:
	Document the change to the parsing of '{}/N' terms.
2000-09-18 11:53:19 +00:00

289 lines
7.3 KiB
Mathematica
Raw Blame History

% Test case for construct, num_functors, type_of and get_functor.
%
% Author: trd
:- module construct.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
:- import_module list, int, std_util, term, map, string, require.
:- pred test_builtins(io__state::di, io__state::uo) is det.
:- pred test_discriminated(io__state::di, io__state::uo) is det.
:- pred test_polymorphism(io__state::di, io__state::uo) is det.
:- pred test_other(io__state::di, io__state::uo) is det.
:- pred test_construct(io__state::di, io__state::uo) is det.
:- pred newline(io__state::di, io__state::uo) is det.
:- pred test_num_functors(type_desc::in, io__state::di, io__state::uo) is det.
:- pred test_nth_functor(type_desc::in, io__state::di, io__state::uo) is det.
:- pred test_all(T::in, io__state::di, io__state::uo) is det.
:- type enum ---> one ; two ; three.
:- type fruit ---> apple(list(int))
; banana(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, A, poly(B, A));
poly_four(A, B).
:- type no_tag ---> qwerty(int).
%----------------------------------------------------------------------------%
main -->
test_discriminated,
test_polymorphism,
test_builtins,
test_other,
test_construct.
%----------------------------------------------------------------------------%
test_construct -->
% Valid tests.
% Enumerations:
test_construct_2(type_of(one), "three", 0, []),
{ type_to_univ([1, 2, 3], NumList) },
test_construct_2(type_of(apple([])), "apple", 1, [NumList]),
{ type_to_univ([one, two, three], EnumList) },
test_construct_2(type_of(apple([])), "banana", 1, [EnumList]),
% Discriminated union:
% (Simple, complicated and complicated constant tags).
{ type_to_univ(1, One) },
{ type_to_univ(2.1, TwoPointOne) },
test_construct_2(type_of(wombat), "foo", 0, []),
test_construct_2(type_of(wombat), "bar", 1, [One]),
test_construct_2(type_of(wombat), "bar", 2, [One, One]),
test_construct_2(type_of(wombat), "qux", 1, [One]),
test_construct_2(type_of(wombat), "quux", 1, [One]),
test_construct_2(type_of(wombat), "quuux", 2, [One, One]),
test_construct_2(type_of(wombat), "wombat", 0, []),
test_construct_2(type_of(wombat), "zoom", 1, [One]),
test_construct_2(type_of(wombat), "zap", 2, [One, TwoPointOne]),
test_construct_2(type_of(wombat), "zip", 2, [One, One]),
test_construct_2(type_of(wombat), "zop", 2, [TwoPointOne, TwoPointOne]),
% No-tag type:
test_construct_2(type_of(qwerty(7)), "qwerty", 1, [One]),
{ type_to_univ("goodbye", Bye) },
test_construct_2(type_of(poly_four(3, "hello")), "poly_one", 1, [One]),
test_construct_2(type_of(poly_four(3, "hello")), "poly_two", 1, [Bye]),
test_construct_2(type_of(poly_four(3, "hello")), "poly_four", 2,
[One, Bye]),
test_construct_2(type_of({1, "two", '3'}), "{}", 3,
[univ(4), univ("five"), univ('6')]),
io__write_string("About to call construct_tuple\n"),
{ Tuple = construct_tuple([NumList, EnumList, One, TwoPointOne]) },
io__write_string("Constructed tuple: "),
io__write(Tuple),
io__nl.
:- pred test_construct_2(type_desc::in, string::in, int::in, list(univ)::in,
io__state::di, io__state::uo) is det.
test_construct_2(TypeInfo, FunctorName, Arity, Args) -->
{ find_functor(TypeInfo, FunctorName, Arity, FunctorNumber) },
io__write_string("About to construct "),
io__write_string(FunctorName),
io__write_string("/"),
io__write_int(Arity),
newline,
(
{ Constructed = construct(TypeInfo, FunctorNumber, Args) }
->
io__write_string("Constructed: "),
io__print(Constructed),
newline
;
io__write_string("Construction failed.\n")
).
:- pred find_functor(type_desc::in, string::in, int::in, int::out) is det.
find_functor(TypeInfo, Functor, Arity, FunctorNumber) :-
N = num_functors(TypeInfo),
find_functor2(TypeInfo, Functor, Arity, N, FunctorNumber).
:- pred find_functor2(type_desc::in, string::in, int::in, int::in,
int::out) is det.
find_functor2(TypeInfo, Functor, Arity, Num, FunctorNumber) :-
(
Num < 0
->
error("unable to find functor")
;
(
get_functor(TypeInfo, Num, Functor, Arity, _List)
->
FunctorNumber = Num
;
find_functor2(TypeInfo, Functor, Arity, Num - 1,
FunctorNumber)
)
).
%----------------------------------------------------------------------------%
test_all(T) -->
{ TypeInfo = type_of(T) },
test_num_functors(TypeInfo),
test_nth_functor(TypeInfo), newline.
test_num_functors(TypeInfo) -->
{ N = num_functors(TypeInfo) },
io__write_int(N),
io__write_string(" functors in this type"),
newline.
test_nth_functor(TypeInfo) -->
{ N = num_functors(TypeInfo) },
test_all_functors(TypeInfo, N - 1).
:- pred test_all_functors(type_desc::in, int::in,
io__state::di, io__state::uo) is det.
test_all_functors(TypeInfo, N) -->
(
{ N < 0 }
->
[]
;
io__write_int(N),
(
{ get_functor(TypeInfo, N, Name, Arity, _List) }
->
io__write_string(" - "),
io__write_string(Name),
io__write_string("/"),
io__write_int(Arity),
newline
;
io__write_string(" failed "),
newline
),
test_all_functors(TypeInfo, N - 1)
).
%----------------------------------------------------------------------------%
test_discriminated -->
io__write_string("TESTING DISCRIMINATED UNIONS\n"),
% test enumerations
test_all(two), newline,
test_all(one), newline,
test_all(three), newline,
% test simple tags
test_all(apple([9,5,1])), newline,
test_all(banana([three, one, two])), newline,
% test complicated tags
test_all(zop(3.3, 2.03)), newline,
test_all(zip(3, 2)), newline,
test_all(zap(3, -2.111)), newline,
% test complicated constant
test_all(wombat), newline,
test_all(foo), newline,
newline.
test_polymorphism -->
io__write_string("TESTING POLYMORPHISM\n"),
test_all(poly_three(3.33, 4, poly_one(9.11))), newline,
test_all(poly_two(3)), newline,
test_all(poly_one([2399.3])), newline,
newline.
test_builtins -->
io__write_string("TESTING BUILTINS\n"),
% test strings
test_all(""), newline,
test_all("Hello, world\n"), newline,
test_all("Foo%sFoo"), newline,
test_all(""""), newline,
% test characters
test_all('a'), newline,
test_all('&'), newline,
% test floats
test_all(3.14159), newline,
test_all(11.28324983E-22), newline,
test_all(22.3954899E22), newline,
% test integers
test_all(-65), newline,
test_all(4), newline,
% test univ.
%{ type_to_univ(["hi! I'm a univ!"], Univ) },
% test_all(Univ), newline,
% test predicates
test_all(newline), newline,
% test tuples
test_all({1, "a", 'a', {4, 'd'}}), newline,
newline.
% 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.
test_other -->
io__write_string("TESTING OTHER TYPES\n"),
{ term__init_var_supply(VarSupply) },
{ term__create_var(VarSupply, Var, NewVarSupply) },
test_all(Var), newline,
test_all(VarSupply), newline,
test_all(NewVarSupply), newline,
% presently, at least, map is an equivalence and
% an abstract type.
{ map__init(Map) },
test_all(Map), newline,
% a no tag type
test_all(qwerty(4)), newline,
newline.
newline -->
io__write_char('\n').
Reference in New Issue View Git Blame Copy Permalink