mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-15 22:03:26 +00:00
a8ffd3680c
Estimated hours taken: 14 Branches: main Change the compiler and tools so that `.' and not `:' is now used as the module separator in all output. Infix `.' now has associativity yfx and priority 10. NEWS: Report the change. configure.in: Amend the test for an up-to-date Mercury compiler to check whether it recognises `.' as a module qualifier. compiler/code_gen.m: compiler/error_util.m: compiler/hlds_out.m: compiler/prog_out.m: compiler/prog_util.m: compiler/rl_exprn.m: compiler/rl_gen.m: compiler/source_file_map.m: compiler/unused_args.m: library/io.m: library/rtti_implementation.m: library/type_desc.m: runtime/mercury_debug.c: runtime/mercury_deconstruct.c: runtime/mercury_stack_trace.c: Change `:' to `.' as module separator for output. compiler/mercury_to_mercury.m: compiler/prog_io_typeclass.m: As above. Fixed a bug where `.' was not being recognised as a module separator. doc/reference_manual.texi: Report the change. library/term_io.m: Ensure that infix `.' is written without surrounding spaces. tests/hard_coded/dot_separator.m: tests/hard_coded/dot_separator.exp: tests/hard_coded/Mmakefile: Test case added.
300 lines
9.5 KiB
C
300 lines
9.5 KiB
C
/*
|
|
** vim:ts=4 sw=4 expandtab
|
|
*/
|
|
/*
|
|
** Copyright (C) 2002-2003 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.
|
|
*/
|
|
|
|
/*
|
|
** mercury_deconstruct.c
|
|
**
|
|
** This file provides utility functions for deconstructing terms, for use by
|
|
** the standard library.
|
|
*/
|
|
|
|
#include "mercury_imp.h"
|
|
#include "mercury_deconstruct.h"
|
|
#include "mercury_deconstruct_macros.h"
|
|
#include "mercury_type_desc.h"
|
|
|
|
static MR_ConstString MR_expand_type_name(MR_TypeCtorInfo tci, MR_bool);
|
|
|
|
#define EXPAND_FUNCTION_NAME MR_expand_functor_args
|
|
#define EXPAND_TYPE_NAME MR_Expand_Functor_Args_Info
|
|
#define EXPAND_FUNCTOR_FIELD functor
|
|
#define EXPAND_ARGS_FIELD args
|
|
#include "mercury_ml_expand_body.h"
|
|
#undef EXPAND_FUNCTION_NAME
|
|
#undef EXPAND_TYPE_NAME
|
|
#undef EXPAND_FUNCTOR_FIELD
|
|
#undef EXPAND_ARGS_FIELD
|
|
|
|
#define EXPAND_FUNCTION_NAME MR_expand_functor_args_limit
|
|
#define EXPAND_TYPE_NAME MR_Expand_Functor_Args_Limit_Info
|
|
#define EXPAND_FUNCTOR_FIELD functor
|
|
#define EXPAND_ARGS_FIELD args
|
|
#define EXPAND_APPLY_LIMIT
|
|
#include "mercury_ml_expand_body.h"
|
|
#undef EXPAND_FUNCTION_NAME
|
|
#undef EXPAND_TYPE_NAME
|
|
#undef EXPAND_FUNCTOR_FIELD
|
|
#undef EXPAND_ARGS_FIELD
|
|
#undef EXPAND_APPLY_LIMIT
|
|
|
|
#define EXPAND_FUNCTION_NAME MR_expand_functor_only
|
|
#define EXPAND_TYPE_NAME MR_Expand_Functor_Only_Info
|
|
#define EXPAND_FUNCTOR_FIELD functor_only
|
|
#include "mercury_ml_expand_body.h"
|
|
#undef EXPAND_FUNCTION_NAME
|
|
#undef EXPAND_TYPE_NAME
|
|
#undef EXPAND_FUNCTOR_FIELD
|
|
|
|
#define EXPAND_FUNCTION_NAME MR_expand_args_only
|
|
#define EXPAND_TYPE_NAME MR_Expand_Args_Only_Info
|
|
#define EXPAND_ARGS_FIELD args_only
|
|
#include "mercury_ml_expand_body.h"
|
|
#undef EXPAND_FUNCTION_NAME
|
|
#undef EXPAND_TYPE_NAME
|
|
#undef EXPAND_ARGS_FIELD
|
|
|
|
#define EXPAND_FUNCTION_NAME MR_expand_chosen_arg_only
|
|
#define EXPAND_TYPE_NAME MR_Expand_Chosen_Arg_Only_Info
|
|
#define EXPAND_CHOSEN_ARG
|
|
#include "mercury_ml_expand_body.h"
|
|
#undef EXPAND_FUNCTION_NAME
|
|
#undef EXPAND_TYPE_NAME
|
|
#undef EXPAND_CHOSEN_ARG
|
|
|
|
#define EXPAND_FUNCTION_NAME MR_expand_named_arg_only
|
|
#define EXPAND_TYPE_NAME MR_Expand_Chosen_Arg_Only_Info
|
|
#define EXPAND_NAMED_ARG
|
|
#include "mercury_ml_expand_body.h"
|
|
#undef EXPAND_FUNCTION_NAME
|
|
#undef EXPAND_TYPE_NAME
|
|
#undef EXPAND_NAMED_ARG
|
|
|
|
/*
|
|
** N.B. any modifications to the signature of this function will require
|
|
** changes not only to library/deconstruct.m, but also to library/store.m
|
|
** and extras/trailed_update/tr_store.m.
|
|
*/
|
|
|
|
MR_bool
|
|
MR_arg(MR_TypeInfo type_info, MR_Word *term_ptr, int arg_index,
|
|
MR_TypeInfo *arg_type_info_ptr, MR_Word **arg_ptr,
|
|
MR_noncanon_handling noncanon)
|
|
{
|
|
MR_Expand_Chosen_Arg_Only_Info expand_info;
|
|
|
|
MR_expand_chosen_arg_only(type_info, term_ptr, noncanon, arg_index,
|
|
&expand_info);
|
|
|
|
/* Check range */
|
|
if (expand_info.chosen_index_exists) {
|
|
*arg_type_info_ptr = expand_info.chosen_type_info;
|
|
*arg_ptr = expand_info.chosen_value_ptr;
|
|
return MR_TRUE;
|
|
}
|
|
|
|
return MR_FALSE;
|
|
}
|
|
|
|
MR_bool
|
|
MR_named_arg(MR_TypeInfo type_info, MR_Word *term_ptr, MR_ConstString arg_name,
|
|
MR_TypeInfo *arg_type_info_ptr, MR_Word **arg_ptr,
|
|
MR_noncanon_handling noncanon)
|
|
{
|
|
MR_Expand_Chosen_Arg_Only_Info expand_info;
|
|
|
|
MR_expand_named_arg_only(type_info, term_ptr, noncanon, arg_name,
|
|
&expand_info);
|
|
|
|
/* Check range */
|
|
if (expand_info.chosen_index_exists) {
|
|
*arg_type_info_ptr = expand_info.chosen_type_info;
|
|
*arg_ptr = expand_info.chosen_value_ptr;
|
|
return MR_TRUE;
|
|
}
|
|
|
|
return MR_FALSE;
|
|
}
|
|
|
|
MR_bool
|
|
MR_named_arg_num(MR_TypeInfo type_info, MR_Word *term_ptr,
|
|
const char *arg_name, int *arg_num_ptr)
|
|
{
|
|
MR_TypeCtorInfo type_ctor_info;
|
|
MR_DuTypeLayout du_type_layout;
|
|
const MR_DuPtagLayout *ptag_layout;
|
|
const MR_DuFunctorDesc *functor_desc;
|
|
const MR_NotagFunctorDesc *notag_functor_desc;
|
|
MR_Word data;
|
|
int ptag;
|
|
MR_Word sectag;
|
|
MR_TypeInfo eqv_type_info;
|
|
int i;
|
|
|
|
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
|
|
|
|
switch (MR_type_ctor_rep(type_ctor_info)) {
|
|
case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
|
|
case MR_TYPECTOR_REP_RESERVED_ADDR:
|
|
{
|
|
MR_ReservedAddrTypeLayout ra_layout;
|
|
|
|
ra_layout = MR_type_ctor_layout(type_ctor_info).
|
|
MR_layout_reserved_addr;
|
|
data = *term_ptr;
|
|
|
|
/*
|
|
** First check if this value is one of
|
|
** the numeric reserved addresses.
|
|
*/
|
|
if ((MR_Unsigned) data <
|
|
(MR_Unsigned) ra_layout->MR_ra_num_res_numeric_addrs)
|
|
{
|
|
/*
|
|
** If so, it must be a constant, and constants never have
|
|
** any arguments.
|
|
*/
|
|
return MR_FALSE;
|
|
}
|
|
|
|
/*
|
|
** Next check if this value is one of the
|
|
** the symbolic reserved addresses.
|
|
*/
|
|
for (i = 0; i < ra_layout->MR_ra_num_res_symbolic_addrs; i++) {
|
|
if (data == (MR_Word) ra_layout->MR_ra_res_symbolic_addrs[i]) {
|
|
return MR_FALSE;
|
|
}
|
|
}
|
|
|
|
/*
|
|
** Otherwise, it is not one of the reserved addresses,
|
|
** so handle it like a normal DU type.
|
|
*/
|
|
du_type_layout = ra_layout->MR_ra_other_functors;
|
|
goto du_type;
|
|
}
|
|
|
|
|
|
case MR_TYPECTOR_REP_DU_USEREQ:
|
|
case MR_TYPECTOR_REP_DU:
|
|
data = *term_ptr;
|
|
du_type_layout = MR_type_ctor_layout(type_ctor_info).MR_layout_du;
|
|
/* fall through */
|
|
|
|
/*
|
|
** This label handles both the DU case and the second half of the
|
|
** RESERVED_ADDR case. `du_type_layout' and `data' must both be
|
|
** set before this code is entered.
|
|
*/
|
|
du_type:
|
|
ptag = MR_tag(data);
|
|
ptag_layout = &du_type_layout[ptag];
|
|
|
|
switch (ptag_layout->MR_sectag_locn) {
|
|
case MR_SECTAG_NONE:
|
|
functor_desc = ptag_layout->MR_sectag_alternatives[0];
|
|
break;
|
|
case MR_SECTAG_LOCAL:
|
|
sectag = MR_unmkbody(data);
|
|
functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
|
|
break;
|
|
case MR_SECTAG_REMOTE:
|
|
sectag = MR_field(ptag, data, 0);
|
|
functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
|
|
break;
|
|
case MR_SECTAG_VARIABLE:
|
|
MR_fatal_error("MR_named_arg_num(): unexpected variable");
|
|
default:
|
|
MR_fatal_error("MR_named_arg_num(): invalid sectag_locn");
|
|
}
|
|
|
|
if (functor_desc->MR_du_functor_arg_names == NULL) {
|
|
return MR_FALSE;
|
|
}
|
|
|
|
for (i = 0; i < functor_desc->MR_du_functor_orig_arity; i++) {
|
|
if (functor_desc->MR_du_functor_arg_names[i] != NULL
|
|
&& MR_streq(arg_name,
|
|
functor_desc->MR_du_functor_arg_names[i]))
|
|
{
|
|
*arg_num_ptr = i;
|
|
return MR_TRUE;
|
|
}
|
|
}
|
|
|
|
return MR_FALSE;
|
|
|
|
case MR_TYPECTOR_REP_EQUIV:
|
|
eqv_type_info = MR_create_type_info(
|
|
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
|
|
MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
|
|
return MR_named_arg_num(eqv_type_info, term_ptr, arg_name,
|
|
arg_num_ptr);
|
|
|
|
case MR_TYPECTOR_REP_EQUIV_GROUND:
|
|
eqv_type_info = MR_pseudo_type_info_is_ground(
|
|
MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
|
|
return MR_named_arg_num(eqv_type_info, term_ptr, arg_name,
|
|
arg_num_ptr);
|
|
|
|
case MR_TYPECTOR_REP_NOTAG:
|
|
case MR_TYPECTOR_REP_NOTAG_USEREQ:
|
|
case MR_TYPECTOR_REP_NOTAG_GROUND:
|
|
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
|
|
notag_functor_desc = MR_type_ctor_functors(type_ctor_info).
|
|
MR_functors_notag;
|
|
|
|
if (notag_functor_desc->MR_notag_functor_arg_name != NULL
|
|
&& MR_streq(arg_name,
|
|
notag_functor_desc->MR_notag_functor_arg_name))
|
|
{
|
|
*arg_num_ptr = 0;
|
|
return MR_TRUE;
|
|
}
|
|
|
|
return MR_FALSE;
|
|
|
|
default:
|
|
return MR_FALSE;
|
|
}
|
|
}
|
|
|
|
static MR_ConstString
|
|
MR_expand_type_name(MR_TypeCtorInfo tci, MR_bool wrap)
|
|
{
|
|
MR_String str;
|
|
int len;
|
|
|
|
len = 0;
|
|
len += strlen(tci->MR_type_ctor_module_name);
|
|
len += 1; /* '.' */
|
|
len += strlen(tci->MR_type_ctor_name);
|
|
len += 1; /* '/' */
|
|
len += 4; /* arity; we do not support arities above 1024 */
|
|
if (wrap) {
|
|
len += 4; /* <<>> */
|
|
}
|
|
len += 1; /* NULL */
|
|
|
|
if (tci->MR_type_ctor_arity > 9999) {
|
|
MR_fatal_error("MR_expand_type_name: arity > 9999");
|
|
}
|
|
|
|
MR_restore_transient_hp();
|
|
MR_allocate_aligned_string_msg(str, len, "MR_expand_type_name");
|
|
MR_save_transient_hp();
|
|
|
|
sprintf(str, wrap? "<<%s.%s/%d>>" : "%s.%s/%d",
|
|
tci->MR_type_ctor_module_name,
|
|
tci->MR_type_ctor_name,
|
|
tci->MR_type_ctor_arity);
|
|
|
|
return (MR_ConstString) str;
|
|
}
|