mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-17 06:47:17 +00:00
Code Issues Projects Releases Wiki Activity

Move the RTTI-related parts of std_util.m to three new modules in the standard

Browse Source 
Estimated hours taken: 8
Branches: main

Move the RTTI-related parts of std_util.m to three new modules in the standard
library, and (in the case of embedded C code) to new modules in the runtime.
The main reason for this is to allow a reorganization of some of the
RTTi-related functionality without breaking backward compatibility. However,
the new arrangement should also be easier to maintain.

Use a separate type_ctor_rep for functions, to distinguish them from predicates
for RTTI code. (At one point, I thought this could avoid the need for the
change to the initialization files mentioned below. It can't, but it is a good
idea in any case.)

library/std_util.m:
	Remove the functionality moved to the new modules, and replace them
	with type equivalences and forwarding code. There are no changes in
	the meanings of the user-visible predicates, with two exceptions.

	- First, the true, equivalence-expanded names of what used to be
	  std_util:type_desc and std_util:type_ctor_desc are now
	  type_desc:type_desc and type_desc: type_ctor_desc.
	- Second, deconstructing a function term now yields
	  "<<function>>" instead of "<<predicate>>".

	The intention is that the RTTI predicates in std_util.m will continue
	to work in a backwards-compatible manner for the near future, i.e. as
	the new modules are updated, the code in std_util will be updated to
	maintain the same functionality, modulo improvements such as avoiding
	unwanted exceptions. When the RTTI functionality in the other modules
	has stabilised, the RTTI predicates in std_util.m should be marked
	obsolete.

	The exported but non-documented functionality of std_util has been
	moved to one of the new modules without forwarding code, with one
	of the moved predicates being turned into the function it should have
	been in the first place.

library/construct.m:
library/deconstruct.m:
library/type_desc.m:
	Three new modules for the code moved from std_util.m.

library/library.m:
compiler/modules.m:
	Record the names of the three new library modules.

runtime/mercury.[ch]:
compiler/mlds_to_il.m:
	Record that type_desc is now in type_desc.m, not std_util.m.

compiler/static_term.m:
	Import the deconstruct module, since we are using its undocumented
	facilities.

runtime/Mmakefile:
	Mention the two new modules.

runtime/mercury_construct.[ch]:
runtime/mercury_type_desc.[ch]:
	Two new modules holding the C functions that used to be in foreign_code
	in std_util, now using MR_ instead of ML_ prefixes, and being more
	consistent about indentation.

runtime/mercury_type_info.h:
	Add a new type_ctor_rep for functions, separate from predicates.
	(It reuses the EQUIV_VAR type_ctor_rep, which hasn't been used
	in ages.)

	Use type_ctor_reps to distinguish between the type_ctor_infos of
	pred/0 and func/0. However, to create higher order typeinfos, we
	still need to know the addresses of the type_ctor_infos for
	pred/0 and func/0, and we still need to know the address of the
	type_ctor_info for tuples to create typeinfos for tuples. Since
	these three type_ctor_infos are defined in the library,
	we cannot access them directly from the runtime. We therefore need
	to access them indirectly in the usual manner, via address_of
	variables initialized by mkinit-generated code.

library/builtin.m:
library/private_builtin.m:
library/rtti_implementation.m:
runtime/mercury.c:
runtime/mercury_mcpp.{h,cpp}:
java/TypeCtorRep.java:
	Updates to accommondate the new function type_ctor_rep.

runtime/mercury_type_info.[ch]:
	Add some functions from foreign_code in std_util that fit in best here.

runtime/mercury_ml_expand_body.h:
runtime/mercury_tabling.h:
runtime/mercury_unify_compare_body.h:
	Delete the code for handling EQUIV_VAR, and add code for handling
	functions.

runtime/mercury_init.h:
runtime/mercury_wrapper.[ch]:
	Add three variables holding the address of the type_ctor_infos
	representing functions, predicates and tuples.

util/mkinit.c:
	Fill in these three variables.

tests/general/accumulator/construct.{m,exp}:
tests/general/accumulator/deconstruct.{m,exp}:
tests/hard_coded/construct.{m,exp}:
	Rename these tests by adding a _test at the ends of their names,
	in order to avoid collisions with the names of the new standard library
	modules. The test cases have not changed, with the exception of the :-
	module declaration of course.

tests/general/accumulator/Mmakefile:
tests/general/accumulator/INTRODUCED:
tests/hard_coded/Mmakefile:
	Record the name changes.

tests/hard_coded/existential_float.exp:
	Updated the expected output to reflect that deconstructions now print
	"<<function>>" instead of "<<predicate>>" when appropriate.

tests/hard_coded/higher_order_type_manip.exp:
	Updated the expected output to reflect the new name of what used to be
	std_util:type_desc.

trace/mercury_trace_browse.c:
trace/mercury_trace_external.c:
trace/mercury_trace_help.c:
	#include type_desc.h instead of std_util.h, since the C functions
	we want to call are now defined there.

trace/mercury_trace_vars.c:
	Update to account for the movement of type_desc from std_util to
	type_desc, and ensure that we don't refer to any type_ctor_infos
	in MLDS grades.
This commit is contained in:
Zoltan Somogyi
2002-01-30 05:09:13 +00:00
parent f11cf0fad3
commit 2b559ad054
47 changed files with 3291 additions and 2665 deletions
Download Patch File Download Diff File Expand all files Collapse all files

598
library/construct.m Normal file
View File

@@ -0,0 +1,598 @@
%-----------------------------------------------------------------------------%
% Copyright (C) 2002 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%-----------------------------------------------------------------------------%
% File: construct.m.
% Main author: zs.
% Stability: low.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- module construct.
:- interface.
:- import_module std_util, list, type_desc.
% num_functors(TypeInfo)
%
% Returns the number of different functors for the top-level
% type constructor of the type specified by TypeInfo, or -1
% if the type is not a discriminated union type.
%
% The functors of a discriminated union type are numbered from
% zero to N-1, where N is the value returned by num_functors.
% The functors are numbered in lexicographic order. If two
% functors have the same name, the one with the lower arity
% will have the lower number.
%
:- func num_functors(type_desc__type_desc) = int.
% get_functor(Type, FunctorNumber, FunctorName, Arity, ArgTypes)
%
% Binds FunctorName and Arity to the name and arity of functor number
% FunctorNumber for the specified type, and binds ArgTypes to the
% type_descs for the types of the arguments of that functor.
% Fails if the type is not a discriminated union type, or if
% FunctorNumber is out of range.
%
:- pred get_functor(type_desc__type_desc::in, int::in, string::out, int::out,
list(type_desc__type_desc)::out) is semidet.
% get_functor(Type, FunctorNumber, FunctorName, Arity, ArgTypes,
% ArgNames)
%
% Binds FunctorName and Arity to the name and arity of functor number
% FunctorNumber for the specified type, ArgTypes to the type_descs
% for the types of the arguments of that functor, and ArgNames to the
% field name of each functor argument, if any. Fails if the type is
% not a discriminated union type, or if FunctorNumber is out of range.
%
:- pred get_functor(type_desc__type_desc::in, int::in, string::out, int::out,
list(type_desc__type_desc)::out, list(maybe(string))::out)
is semidet.
% get_functor_ordinal(Type, I, Ordinal)
%
% Returns Ordinal, where Ordinal is the position in declaration order
% for the specified type of the function symbol that is in position I
% in lexicographic order. Fails if the type is not a discriminated
% union type, or if I is out of range.
:- pred get_functor_ordinal(type_desc__type_desc::in, int::in, int::out)
is semidet.
% construct(TypeInfo, I, Args) = Term
%
% Returns a term of the type specified by TypeInfo whose functor
% is functor number I of the type given by TypeInfo, and whose
% arguments are given by Args. Fails if the type is not a
% discriminated union type, or if I is out of range, or if the
% number of arguments supplied doesn't match the arity of the selected
% functor, or if the types of the arguments do not match
% the expected argument types of that functor.
%
:- func construct(type_desc__type_desc, int, list(univ)) = univ.
:- mode construct(in, in, in) = out is semidet.
% construct_tuple(Args) = Term
%
% Returns a tuple whose arguments are given by Args.
:- func construct_tuple(list(univ)) = univ.
%-----------------------------------------------------------------------------%
:- implementation.
:- pragma foreign_decl("C", "
#include ""mercury_type_desc.h""
#include ""mercury_construct.h""
").
:- pragma foreign_proc("C",
num_functors(TypeInfo::in) = (Functors::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
MR_save_transient_registers();
Functors = MR_get_num_functors((MR_TypeInfo) TypeInfo);
MR_restore_transient_registers();
}").
:- pragma foreign_proc("C",
get_functor(TypeDesc::in, FunctorNumber::in, FunctorName::out,
Arity::out, TypeInfoList::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
MR_TypeInfo type_info;
MR_Construct_Info construct_info;
int arity;
bool success;
type_info = (MR_TypeInfo) TypeDesc;
/*
** Get information for this functor number and
** store in construct_info. If this is a discriminated union
** type and if the functor number is in range, we
** succeed.
*/
MR_save_transient_registers();
success = MR_get_functors_check_range(FunctorNumber,
type_info, &construct_info);
MR_restore_transient_registers();
/*
** Get the functor name and arity, construct the list
** of type_infos for arguments.
*/
if (success) {
MR_make_aligned_string(FunctorName, (MR_String) (MR_Word)
construct_info.functor_name);
arity = construct_info.arity;
Arity = arity;
if (MR_TYPE_CTOR_INFO_IS_TUPLE(
MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info)))
{
MR_save_transient_registers();
TypeInfoList = MR_type_params_vector_to_list(Arity,
MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info));
MR_restore_transient_registers();
} else {
MR_save_transient_registers();
TypeInfoList = MR_pseudo_type_info_vector_to_type_info_list(
arity,
MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
construct_info.arg_pseudo_type_infos);
MR_restore_transient_registers();
}
}
SUCCESS_INDICATOR = success;
}").
get_functor(TypeDesc, I, Functor, Arity, TypeInfoList, ArgNameList) :-
get_functor_2(TypeDesc, I, Functor, Arity, TypeInfoList, ArgNameList0),
ArgNameList = map(null_to_no, ArgNameList0).
:- func null_to_no(string) = maybe(string).
null_to_no(S) = ( if null(S) then no else yes(S) ).
:- pred null(string).
:- mode null(in) is semidet.
:- pragma foreign_proc("C",
null(S::in),
[will_not_call_mercury, thread_safe, promise_pure],
"
SUCCESS_INDICATOR = (S == NULL);
").
:- pragma foreign_proc("MC++",
null(S::in),
[will_not_call_mercury, thread_safe, promise_pure],
"
SUCCESS_INDICATOR = (S == NULL);
").
:- pred get_functor_2(type_desc__type_desc::in, int::in, string::out, int::out,
list(type_desc__type_desc)::out, list(string)::out) is semidet.
:- pragma foreign_proc("C",
get_functor_2(TypeDesc::in, FunctorNumber::in, FunctorName::out,
Arity::out, TypeInfoList::out, ArgNameList::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
MR_TypeInfo type_info;
MR_Construct_Info construct_info;
int arity;
bool success;
type_info = (MR_TypeInfo) TypeDesc;
/*
** Get information for this functor number and
** store in construct_info. If this is a discriminated union
** type and if the functor number is in range, we
** succeed.
*/
MR_save_transient_registers();
success = MR_get_functors_check_range(FunctorNumber,
type_info, &construct_info);
MR_restore_transient_registers();
/*
** Get the functor name and arity, construct the list
** of type_infos for arguments.
*/
if (success) {
MR_make_aligned_string(FunctorName, (MR_String) (MR_Word)
construct_info.functor_name);
arity = construct_info.arity;
Arity = arity;
if (MR_TYPE_CTOR_INFO_IS_TUPLE(
MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info)))
{
MR_save_transient_registers();
TypeInfoList = MR_type_params_vector_to_list(Arity,
MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info));
ArgNameList = MR_list_empty();
MR_restore_transient_registers();
} else {
MR_save_transient_registers();
TypeInfoList = MR_pseudo_type_info_vector_to_type_info_list(
arity, MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
construct_info.arg_pseudo_type_infos);
ArgNameList = MR_arg_name_vector_to_list(
arity, construct_info.arg_names);
MR_restore_transient_registers();
}
}
SUCCESS_INDICATOR = success;
}").
:- pragma foreign_proc("MC++",
get_functor_2(_TypeDesc::in, _FunctorNumber::in, _FunctorName::out,
_Arity::out, _TypeInfoList::out, _ArgNameList::out),
[will_not_call_mercury, thread_safe, promise_pure],
"
mercury::runtime::Errors::SORRY(""foreign code for get_functor_2"");
SUCCESS_INDICATOR = FALSE;
").
:- pragma foreign_proc("C",
get_functor_ordinal(TypeDesc::in, FunctorNumber::in, Ordinal::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
MR_TypeInfo type_info;
MR_Construct_Info construct_info;
bool success;
type_info = (MR_TypeInfo) TypeDesc;
/*
** Get information for this functor number and
** store in construct_info. If this is a discriminated union
** type and if the functor number is in range, we
** succeed.
*/
MR_save_transient_registers();
success = MR_get_functors_check_range(FunctorNumber, type_info,
&construct_info);
MR_restore_transient_registers();
if (success) {
switch (construct_info.type_ctor_rep) {
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_ENUM_USEREQ:
Ordinal = construct_info.functor_info.
enum_functor_desc->MR_enum_functor_ordinal;
break;
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
case MR_TYPECTOR_REP_TUPLE:
Ordinal = 0;
break;
case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
case MR_TYPECTOR_REP_RESERVED_ADDR:
case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
Ordinal = construct_info.functor_info.
du_functor_desc->MR_du_functor_ordinal;
break;
default:
success = FALSE;
}
}
SUCCESS_INDICATOR = success;
}").
:- pragma foreign_proc("C",
construct(TypeDesc::in, FunctorNumber::in, ArgList::in) = (Term::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
MR_TypeInfo type_info;
MR_TypeCtorInfo type_ctor_info;
MR_Word new_data;
MR_Construct_Info construct_info;
bool success;
type_info = (MR_TypeInfo) TypeDesc;
/*
** Check range of FunctorNum, get info for this
** functor.
*/
MR_save_transient_registers();
success =
MR_get_functors_check_range(FunctorNumber, type_info, &construct_info)
&& MR_typecheck_arguments(type_info, construct_info.arity, ArgList,
construct_info.arg_pseudo_type_infos);
MR_restore_transient_registers();
/*
** Build the new term in `new_data'.
*/
if (success) {
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
if (MR_type_ctor_rep(type_ctor_info) != construct_info.type_ctor_rep) {
MR_fatal_error(""construct:construct: type_ctor_rep mismatch"");
}
switch (MR_type_ctor_rep(type_ctor_info)) {
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_ENUM_USEREQ:
new_data = construct_info.functor_info.enum_functor_desc->
MR_enum_functor_ordinal;
break;
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
if (MR_list_is_empty(ArgList)) {
MR_fatal_error(""notag arg list is empty"");
}
if (! MR_list_is_empty(MR_list_tail(ArgList))) {
MR_fatal_error(""notag arg list is too long"");
}
new_data = MR_field(MR_UNIV_TAG, MR_list_head(ArgList),
MR_UNIV_OFFSET_FOR_DATA);
break;
case MR_TYPECTOR_REP_RESERVED_ADDR:
case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
/*
** First check whether the functor we want is one of the
** reserved addresses.
*/
{
int i;
MR_ReservedAddrTypeLayout ra_layout;
int total_reserved_addrs;
const MR_ReservedAddrFunctorDesc *functor_desc;
ra_layout = MR_type_ctor_layout(type_ctor_info).layout_reserved_addr;
total_reserved_addrs = ra_layout->MR_ra_num_res_numeric_addrs
+ ra_layout->MR_ra_num_res_symbolic_addrs;
for (i = 0; i < total_reserved_addrs; i++) {
functor_desc = ra_layout->MR_ra_constants[i];
if (functor_desc->MR_ra_functor_ordinal == FunctorNumber)
{
new_data = (MR_Word)
functor_desc->MR_ra_functor_reserved_addr;
/* `break' here would just exit the `for' loop */
goto end_of_main_switch;
}
}
}
/*
** Otherwise, it is not one of the reserved addresses,
** so handle it like a normal DU type.
*/
/* fall through */
case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
{
const MR_DuFunctorDesc *functor_desc;
MR_Word arg_list;
MR_Word ptag;
MR_Word arity;
int i;
functor_desc = construct_info.functor_info.du_functor_desc;
if (functor_desc->MR_du_functor_exist_info != NULL) {
MR_fatal_error(""not yet implemented: construction ""
""of terms containing existentially types"");
}
arg_list = ArgList;
ptag = functor_desc->MR_du_functor_primary;
switch (functor_desc->MR_du_functor_sectag_locn) {
case MR_SECTAG_LOCAL:
new_data = (MR_Word) MR_mkword(ptag,
MR_mkbody((MR_Word)
functor_desc->MR_du_functor_secondary));
break;
case MR_SECTAG_REMOTE:
arity = functor_desc->MR_du_functor_orig_arity;
MR_tag_incr_hp_msg(new_data, ptag, arity + 1,
MR_PROC_LABEL, ""<created by construct:construct/3>"");
MR_field(ptag, new_data, 0) =
functor_desc->MR_du_functor_secondary;
for (i = 0; i < arity; i++) {
MR_field(ptag, new_data, i + 1) =
MR_field(MR_UNIV_TAG,
MR_list_head(arg_list),
MR_UNIV_OFFSET_FOR_DATA);
arg_list = MR_list_tail(arg_list);
}
break;
case MR_SECTAG_NONE:
arity = functor_desc->MR_du_functor_orig_arity;
MR_tag_incr_hp_msg(new_data, ptag, arity,
MR_PROC_LABEL, ""<created by construct:construct/3>"");
for (i = 0; i < arity; i++) {
MR_field(ptag, new_data, i) =
MR_field(MR_UNIV_TAG,
MR_list_head(arg_list),
MR_UNIV_OFFSET_FOR_DATA);
arg_list = MR_list_tail(arg_list);
}
break;
case MR_SECTAG_VARIABLE:
MR_fatal_error(""construct(): cannot construct variable"");
}
if (! MR_list_is_empty(arg_list)) {
MR_fatal_error(""excess arguments in construct:construct"");
}
}
break;
case MR_TYPECTOR_REP_TUPLE:
{
int arity, i;
MR_Word arg_list;
arity = MR_TYPEINFO_GET_TUPLE_ARITY(type_info);
if (arity == 0) {
new_data = (MR_Word) NULL;
} else {
MR_incr_hp_msg(new_data, arity, MR_PROC_LABEL,
""<created by construct:construct/3>"");
arg_list = ArgList;
for (i = 0; i < arity; i++) {
MR_field(MR_mktag(0), new_data, i) =
MR_field(MR_UNIV_TAG, MR_list_head(arg_list),
MR_UNIV_OFFSET_FOR_DATA);
arg_list = MR_list_tail(arg_list);
}
if (! MR_list_is_empty(arg_list)) {
MR_fatal_error(
""excess arguments in construct:construct"");
}
}
}
break;
default:
MR_fatal_error(""bad type_ctor_rep in construct:construct"");
}
end_of_main_switch:
/*
** Create a univ.
*/
MR_new_univ_on_hp(Term, type_info, new_data);
}
SUCCESS_INDICATOR = success;
}").
:- pragma foreign_proc("C#",
num_functors(_TypeInfo::in) = (Functors::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
mercury.runtime.Errors.SORRY(""foreign code for num_functors"");
// XXX keep the C# compiler quiet
Functors = 0;
}").
:- pragma foreign_proc("MC++",
get_functor(_TypeDesc::in, _FunctorNumber::in, _FunctorName::out,
_Arity::out, _TypeInfoList::out),
[will_not_call_mercury, thread_safe, promise_pure],
"
mercury::runtime::Errors::SORRY(""foreign code for get_functor"");
").
:- pragma foreign_proc("MC++",
get_functor_ordinal(_TypeDesc::in, _FunctorNumber::in, _Ordinal::out),
[will_not_call_mercury, thread_safe, promise_pure],
"
mercury::runtime::Errors::SORRY(""foreign code for get_functor_ordinal"");
").
:- pragma foreign_proc("C#",
construct(_TypeDesc::in, _FunctorNumber::in, _ArgList::in)
= (_Term::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
mercury.runtime.Errors.SORRY(""foreign code for construct"");
_Term = null;
// XXX this is required to keep the C# compiler quiet
SUCCESS_INDICATOR = false;
}").
construct_tuple(Args) =
construct_tuple_2(Args,
list__map(univ_type, Args),
list__length(Args)).
:- func construct_tuple_2(list(univ), list(type_desc__type_desc), int) = univ.
:- pragma foreign_proc("C",
construct_tuple_2(Args::in, ArgTypes::in, Arity::in) = (Term::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
MR_TypeInfo type_info;
MR_Word new_data;
MR_Word arg_value;
int i;
/*
** Construct a type_info for the tuple.
*/
MR_save_transient_registers();
type_info = MR_make_type(Arity, MR_TYPECTOR_DESC_MAKE_TUPLE(Arity),
ArgTypes);
MR_restore_transient_registers();
/*
** Create the tuple.
*/
if (Arity == 0) {
new_data = (MR_Word) NULL;
} else {
MR_incr_hp_msg(new_data, Arity, MR_PROC_LABEL,
""<created by construct:construct_tuple/1>"");
for (i = 0; i < Arity; i++) {
arg_value = MR_field(MR_UNIV_TAG,
MR_list_head(Args),
MR_UNIV_OFFSET_FOR_DATA);
MR_field(MR_mktag(0), new_data, i) = arg_value;
Args = MR_list_tail(Args);
}
}
/*
** Create a univ.
*/
MR_new_univ_on_hp(Term, type_info, new_data);
}").
:- pragma foreign_proc("C#",
construct_tuple_2(_Args::in, _ArgTypes::in, _Arity::in) = (_Term::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
mercury.runtime.Errors.SORRY(""construct_tuple_2"");
_Term = null;
}").