mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-12 20:34:19 +00:00
e9d90b2891
runtime/mercury_stack_trace.c: In the function MR_dump_stack_from_layout_clique initialise the variable lines_dumped_so_far. (This appears to be an actual bug.) runtime/mercury_prof.c: Only define the static global in_profiling_code if either of call count profiling or time profiling is enabled. runtime/mercury_context.c: runtime/mercury_deconstruct.c: runtime/mercury_deep_profiling.c: Only define some local variables in grades that require them. runtime/mercury_float.c: runtime/mercury_deep_copy_body.h: runtime/mercury_construct.c: runtime/mercury_memory_zones.c: runtime/mercury_stm.c: runtime/mercury_trace_base.c: runtime/mercury_type_info.c: Delete unused local variables. util/mdemangle.c: Delete an unused static global variable. Use fputs in place of fprintf in a couple of places in order to avoid warnings about format strings that are not string literals. Delete an unused function. util/mkinit.c: util/mkinit_erl.c: Delete unused local variables.
371 lines
12 KiB
C
371 lines
12 KiB
C
/*
|
|
** vim:ts=4 sw=4 expandtab
|
|
*/
|
|
/*
|
|
** Copyright (C) 2002-2005, 2007 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_construct.c
|
|
**
|
|
** This file provides utility functions for constructing terms, for use by
|
|
** the standard library.
|
|
*/
|
|
|
|
#include "mercury_conf.h"
|
|
#ifndef MR_HIGHLEVEL_CODE
|
|
#include "mercury_imp.h"
|
|
#endif
|
|
#include "mercury_type_info.h"
|
|
#include "mercury_construct.h"
|
|
#include "mercury_univ.h"
|
|
#include "mercury_misc.h" /* for MR_fatal_error() */
|
|
|
|
static int MR_get_functor_info(MR_TypeInfo type_info, int functor_number,
|
|
MR_Construct_Info *construct_info);
|
|
|
|
/*
|
|
** MR_get_functor_info:
|
|
**
|
|
** Extract the information for functor number `functor_number',
|
|
** for the type represented by type_info.
|
|
** We succeed if the type is some sort of discriminated union.
|
|
**
|
|
** You need to save and restore transient registers around
|
|
** calls to this function.
|
|
*/
|
|
|
|
static int
|
|
MR_get_functor_info(MR_TypeInfo type_info, int functor_number,
|
|
MR_Construct_Info *construct_info)
|
|
{
|
|
MR_TypeCtorInfo type_ctor_info;
|
|
|
|
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
|
|
construct_info->type_ctor_rep = MR_type_ctor_rep(type_ctor_info);
|
|
|
|
if (! MR_type_ctor_has_valid_rep(type_ctor_info)) {
|
|
MR_fatal_error("MR_get_functor_info: term of unknown representation");
|
|
}
|
|
|
|
switch(MR_type_ctor_rep(type_ctor_info)) {
|
|
|
|
case MR_TYPECTOR_REP_RESERVED_ADDR:
|
|
case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
|
|
case MR_TYPECTOR_REP_DU:
|
|
case MR_TYPECTOR_REP_DU_USEREQ:
|
|
{
|
|
const MR_DuFunctorDesc *functor_desc;
|
|
|
|
if (functor_number < 0 ||
|
|
functor_number >= MR_type_ctor_num_functors(type_ctor_info))
|
|
{
|
|
MR_fatal_error("MR_get_functor_info: "
|
|
"du functor_number out of range");
|
|
}
|
|
|
|
functor_desc = MR_type_ctor_functors(type_ctor_info).
|
|
MR_functors_du[functor_number];
|
|
construct_info->functor_info.du_functor_desc = functor_desc;
|
|
construct_info->functor_name = functor_desc->MR_du_functor_name;
|
|
construct_info->arity = functor_desc->MR_du_functor_orig_arity;
|
|
construct_info->arg_pseudo_type_infos =
|
|
functor_desc->MR_du_functor_arg_types;
|
|
construct_info->arg_names =
|
|
functor_desc->MR_du_functor_arg_names;
|
|
}
|
|
return MR_TRUE;
|
|
|
|
case MR_TYPECTOR_REP_ENUM:
|
|
case MR_TYPECTOR_REP_ENUM_USEREQ:
|
|
case MR_TYPECTOR_REP_DUMMY:
|
|
{
|
|
const MR_EnumFunctorDesc *functor_desc;
|
|
|
|
if (functor_number < 0 ||
|
|
functor_number >= MR_type_ctor_num_functors(type_ctor_info))
|
|
{
|
|
MR_fatal_error("MR_get_functor_info: "
|
|
"enum functor_number out of range");
|
|
}
|
|
|
|
functor_desc = MR_type_ctor_functors(type_ctor_info).
|
|
MR_functors_enum[functor_number];
|
|
construct_info->functor_info.enum_functor_desc = functor_desc;
|
|
construct_info->functor_name = functor_desc->MR_enum_functor_name;
|
|
construct_info->arity = 0;
|
|
construct_info->arg_pseudo_type_infos = NULL;
|
|
construct_info->arg_names = NULL;
|
|
}
|
|
return MR_TRUE;
|
|
|
|
case MR_TYPECTOR_REP_FOREIGN_ENUM:
|
|
case MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ:
|
|
{
|
|
const MR_ForeignEnumFunctorDesc *functor_desc;
|
|
|
|
if (functor_number < 0 ||
|
|
functor_number >= MR_type_ctor_num_functors(type_ctor_info))
|
|
{
|
|
MR_fatal_error("MR_get_functor_info: "
|
|
"foreign enum functor_number out of range");
|
|
}
|
|
functor_desc = MR_type_ctor_functors(type_ctor_info).
|
|
MR_functors_foreign_enum[functor_number];
|
|
construct_info->functor_info.foreign_enum_functor_desc
|
|
= functor_desc;
|
|
construct_info->functor_name =
|
|
functor_desc->MR_foreign_enum_functor_name;
|
|
construct_info->arity = 0;
|
|
construct_info->arg_pseudo_type_infos = NULL;
|
|
construct_info->arg_names = NULL;
|
|
}
|
|
return MR_TRUE;
|
|
|
|
case MR_TYPECTOR_REP_NOTAG:
|
|
case MR_TYPECTOR_REP_NOTAG_USEREQ:
|
|
case MR_TYPECTOR_REP_NOTAG_GROUND:
|
|
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
|
|
{
|
|
const MR_NotagFunctorDesc *functor_desc;
|
|
|
|
if (functor_number != 0) {
|
|
MR_fatal_error("MR_get_functor_info: "
|
|
"notag functor_number out of range");
|
|
}
|
|
|
|
functor_desc = MR_type_ctor_functors(type_ctor_info).
|
|
MR_functors_notag;
|
|
construct_info->functor_info.notag_functor_desc = functor_desc;
|
|
construct_info->functor_name = functor_desc->MR_notag_functor_name;
|
|
construct_info->arity = 1;
|
|
construct_info->arg_pseudo_type_infos =
|
|
&functor_desc->MR_notag_functor_arg_type;
|
|
construct_info->arg_names =
|
|
&functor_desc->MR_notag_functor_arg_name;
|
|
}
|
|
return MR_TRUE;
|
|
|
|
case MR_TYPECTOR_REP_EQUIV_GROUND:
|
|
case MR_TYPECTOR_REP_EQUIV:
|
|
return MR_get_functor_info(
|
|
MR_create_type_info(
|
|
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
|
|
MR_type_ctor_layout(type_ctor_info).MR_layout_equiv),
|
|
functor_number, construct_info);
|
|
|
|
case MR_TYPECTOR_REP_TUPLE:
|
|
construct_info->functor_name = "{}";
|
|
construct_info->arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
|
|
|
|
/* Tuple types don't have pseudo-type_infos for the functors. */
|
|
construct_info->arg_pseudo_type_infos = NULL;
|
|
construct_info->arg_names = NULL;
|
|
return MR_TRUE;
|
|
|
|
case MR_TYPECTOR_REP_INT:
|
|
case MR_TYPECTOR_REP_CHAR:
|
|
case MR_TYPECTOR_REP_FLOAT:
|
|
case MR_TYPECTOR_REP_STRING:
|
|
case MR_TYPECTOR_REP_BITMAP:
|
|
case MR_TYPECTOR_REP_FUNC:
|
|
case MR_TYPECTOR_REP_PRED:
|
|
case MR_TYPECTOR_REP_SUBGOAL:
|
|
case MR_TYPECTOR_REP_VOID:
|
|
case MR_TYPECTOR_REP_C_POINTER:
|
|
case MR_TYPECTOR_REP_STABLE_C_POINTER:
|
|
case MR_TYPECTOR_REP_TYPEINFO:
|
|
case MR_TYPECTOR_REP_TYPECTORINFO:
|
|
case MR_TYPECTOR_REP_PSEUDOTYPEDESC:
|
|
case MR_TYPECTOR_REP_TYPEDESC:
|
|
case MR_TYPECTOR_REP_TYPECTORDESC:
|
|
case MR_TYPECTOR_REP_TYPECLASSINFO:
|
|
case MR_TYPECTOR_REP_BASETYPECLASSINFO:
|
|
case MR_TYPECTOR_REP_ARRAY:
|
|
case MR_TYPECTOR_REP_SUCCIP:
|
|
case MR_TYPECTOR_REP_HP:
|
|
case MR_TYPECTOR_REP_CURFR:
|
|
case MR_TYPECTOR_REP_MAXFR:
|
|
case MR_TYPECTOR_REP_REDOFR:
|
|
case MR_TYPECTOR_REP_REDOIP:
|
|
case MR_TYPECTOR_REP_TRAIL_PTR:
|
|
case MR_TYPECTOR_REP_TICKET:
|
|
case MR_TYPECTOR_REP_FOREIGN:
|
|
case MR_TYPECTOR_REP_STABLE_FOREIGN:
|
|
case MR_TYPECTOR_REP_REFERENCE:
|
|
return MR_FALSE;
|
|
|
|
case MR_TYPECTOR_REP_UNKNOWN:
|
|
MR_fatal_error("MR_get_functor_info: unknown type_ctor_rep");
|
|
}
|
|
|
|
MR_fatal_error("MR_get_functor_info: unexpected fallthrough");
|
|
}
|
|
|
|
/*
|
|
** MR_typecheck_arguments:
|
|
**
|
|
** Given a list of univs (`arg_list'), and a vector of
|
|
** type_infos (`arg_vector'), checks that they are all of the
|
|
** same type; if so, returns MR_TRUE, otherwise returns MR_FALSE;
|
|
** `arg_vector' may contain type variables, these
|
|
** will be filled in by the type arguments of `type_info'.
|
|
**
|
|
** Assumes the length of the list has already been checked.
|
|
**
|
|
** You need to save and restore transient registers around
|
|
** calls to this function.
|
|
*/
|
|
|
|
MR_bool
|
|
MR_typecheck_arguments(MR_TypeInfo type_info, int arity, MR_Word arg_list,
|
|
const MR_PseudoTypeInfo *arg_pseudo_type_infos)
|
|
{
|
|
MR_TypeInfo arg_type_info;
|
|
MR_TypeInfo list_arg_type_info;
|
|
int comp;
|
|
int i;
|
|
|
|
/* Type check the list of arguments */
|
|
|
|
for (i = 0; i < arity; i++) {
|
|
if (MR_list_is_empty(arg_list)) {
|
|
return MR_FALSE;
|
|
}
|
|
|
|
list_arg_type_info = (MR_TypeInfo) MR_field(MR_UNIV_TAG,
|
|
MR_list_head(arg_list), MR_UNIV_OFFSET_FOR_TYPEINFO);
|
|
|
|
if (MR_TYPE_CTOR_INFO_IS_TUPLE(
|
|
MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info)))
|
|
{
|
|
arg_type_info =
|
|
MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)[i + 1];
|
|
} else {
|
|
arg_type_info = MR_create_type_info(
|
|
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
|
|
arg_pseudo_type_infos[i]);
|
|
}
|
|
|
|
comp = MR_compare_type_info(list_arg_type_info, arg_type_info);
|
|
if (comp != MR_COMPARE_EQUAL) {
|
|
return MR_FALSE;
|
|
}
|
|
arg_list = MR_list_tail(arg_list);
|
|
}
|
|
|
|
/* List should now be empty */
|
|
return MR_list_is_empty(arg_list);
|
|
}
|
|
|
|
/*
|
|
** MR_get_functors_check_range:
|
|
**
|
|
** Check that functor_number is in range, and get the functor
|
|
** info if it is. Return MR_FALSE if it is out of range, or
|
|
** if MR_get_functor_info returns MR_FALSE, otherwise return MR_TRUE.
|
|
**
|
|
** You need to save and restore transient registers around
|
|
** calls to this function.
|
|
*/
|
|
|
|
MR_bool
|
|
MR_get_functors_check_range(int functor_number, MR_TypeInfo type_info,
|
|
MR_Construct_Info *construct_info)
|
|
{
|
|
/*
|
|
** Check range of functor_number, get functors
|
|
** vector
|
|
*/
|
|
return functor_number < MR_get_num_functors(type_info) &&
|
|
functor_number >= 0 &&
|
|
MR_get_functor_info(type_info, functor_number, construct_info);
|
|
}
|
|
|
|
/*
|
|
** MR_get_num_functors:
|
|
**
|
|
** Get the number of functors for a type. If it isn't a
|
|
** discriminated union, return -1.
|
|
**
|
|
** You need to save and restore transient registers around
|
|
** calls to this function.
|
|
*/
|
|
|
|
int
|
|
MR_get_num_functors(MR_TypeInfo type_info)
|
|
{
|
|
MR_TypeCtorInfo type_ctor_info;
|
|
|
|
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
|
|
|
|
if (! MR_type_ctor_has_valid_rep(type_ctor_info)) {
|
|
MR_fatal_error("MR_get_num_functors: term of unknown representation");
|
|
}
|
|
|
|
switch(MR_type_ctor_rep(type_ctor_info)) {
|
|
case MR_TYPECTOR_REP_DU:
|
|
case MR_TYPECTOR_REP_DU_USEREQ:
|
|
case MR_TYPECTOR_REP_RESERVED_ADDR:
|
|
case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
|
|
case MR_TYPECTOR_REP_ENUM:
|
|
case MR_TYPECTOR_REP_ENUM_USEREQ:
|
|
case MR_TYPECTOR_REP_DUMMY:
|
|
case MR_TYPECTOR_REP_FOREIGN_ENUM:
|
|
case MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ:
|
|
return MR_type_ctor_num_functors(type_ctor_info);
|
|
|
|
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:
|
|
return 1;
|
|
|
|
case MR_TYPECTOR_REP_EQUIV_GROUND:
|
|
case MR_TYPECTOR_REP_EQUIV:
|
|
return MR_get_num_functors(
|
|
MR_create_type_info((MR_TypeInfo *) type_info,
|
|
MR_type_ctor_layout(type_ctor_info).MR_layout_equiv));
|
|
|
|
case MR_TYPECTOR_REP_INT:
|
|
case MR_TYPECTOR_REP_CHAR:
|
|
case MR_TYPECTOR_REP_FLOAT:
|
|
case MR_TYPECTOR_REP_STRING:
|
|
case MR_TYPECTOR_REP_BITMAP:
|
|
case MR_TYPECTOR_REP_FUNC:
|
|
case MR_TYPECTOR_REP_PRED:
|
|
case MR_TYPECTOR_REP_SUBGOAL:
|
|
case MR_TYPECTOR_REP_VOID:
|
|
case MR_TYPECTOR_REP_C_POINTER:
|
|
case MR_TYPECTOR_REP_STABLE_C_POINTER:
|
|
case MR_TYPECTOR_REP_TYPEINFO:
|
|
case MR_TYPECTOR_REP_TYPECTORINFO:
|
|
case MR_TYPECTOR_REP_PSEUDOTYPEDESC:
|
|
case MR_TYPECTOR_REP_TYPEDESC:
|
|
case MR_TYPECTOR_REP_TYPECTORDESC:
|
|
case MR_TYPECTOR_REP_TYPECLASSINFO:
|
|
case MR_TYPECTOR_REP_BASETYPECLASSINFO:
|
|
case MR_TYPECTOR_REP_ARRAY:
|
|
case MR_TYPECTOR_REP_SUCCIP:
|
|
case MR_TYPECTOR_REP_HP:
|
|
case MR_TYPECTOR_REP_CURFR:
|
|
case MR_TYPECTOR_REP_MAXFR:
|
|
case MR_TYPECTOR_REP_REDOFR:
|
|
case MR_TYPECTOR_REP_REDOIP:
|
|
case MR_TYPECTOR_REP_TRAIL_PTR:
|
|
case MR_TYPECTOR_REP_TICKET:
|
|
case MR_TYPECTOR_REP_FOREIGN:
|
|
case MR_TYPECTOR_REP_STABLE_FOREIGN:
|
|
case MR_TYPECTOR_REP_REFERENCE:
|
|
return -1;
|
|
|
|
case MR_TYPECTOR_REP_UNKNOWN:
|
|
MR_fatal_error("MR_get_num_functors: unknown type_ctor_rep");
|
|
}
|
|
|
|
MR_fatal_error("MR_get_num_functors: unexpected fallthrough");
|
|
}
|