mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-14 13:23:53 +00:00
Code Issues Projects Releases Wiki Activity
Files
2b559ad054cb33ef9d19b10fcfee3412e0780192
mercury/library/deconstruct.m
Zoltan Somogyi 2b559ad054 Move the RTTI-related parts of std_util.m to three new modules in the standard 
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.
2002-01-30 05:09:13 +00:00

871 lines
29 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% 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: deconstruct.m.
% Main author: zs.
% Stability: low.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- module deconstruct.
:- interface.
:- import_module std_util, list.
% functor, argument and deconstruct and their variants take any type
% (including univ), and return representation information for that type.
%
% The string representation of the functor that these predicates
% return is:
%
% - for user defined types, the functor that is given
% in the type definition. For lists, this
% means the functors [|]/2 and []/0 are used, even if
% the list uses the [....] shorthand.
% - for integers, the string is a base 10 number,
% positive integers have no sign.
% - for floats, the string is a floating point,
% base 10 number, positive floating point numbers have
% no sign.
% - for strings, the string, inside double quotation marks
% - for characters, the character inside single quotation marks
% - for predicates, the string <<predicate>>
% - for functions, the string <<function>>
% - for tuples, the string {}
% - for arrays, the string <<array>>
%
% The arity that these predicates return is:
%
% - for user defined types, the arity of the functor.
% - for integers, zero.
% - for floats, zero.
% - for strings, zero.
% - for characters, zero.
% - for predicates and functions, zero; we do not return the
% number of arguments expected by the predicate or function.
% - for tuples, the number of elements in the tuple.
% - for arrays, the number of elements in the array.
% functor(Data, Functor, Arity)
%
% Given a data item (Data), binds Functor to a string
% representation of the functor and Arity to the arity of this
% data item. (Aborts if the type of Data is a type with a
% non-canonical representation, i.e. one for which there is a
% user-defined equality predicate.)
%
% Functor_cc succeeds even if the first argument is of a
% non-canonical type.
%
:- pred functor(T::in, string::out, int::out) is det.
:- pred functor_cc(T::in, string::out, int::out) is cc_multi.
% arg(Data, ArgumentIndex) = Argument
% argument(Data, ArgumentIndex) = ArgumentUniv
%
% Given a data item (Data) and an argument index
% (ArgumentIndex), starting at 0 for the first argument, binds
% Argument to that argument of the functor of the data item. If
% the argument index is out of range -- that is, greater than or
% equal to the arity of the functor or lower than 0 -- then
% the call fails. For argument/2 the argument returned has the
% type univ, which can store any type. For arg/2, if the
% argument has the wrong type, then the call fails.
% (Both abort if the type of Data is a type with a non-canonical
% representation, i.e. one for which there is a user-defined
% equality predicate.)
%
% arg_cc and argument_cc succeed even if the first argument is
% of a non-canonical type.
%
:- func arg(T::in, int::in) = (ArgT::out) is semidet.
:- pred arg_cc(T::in, int::in, ArgT::out) is cc_nondet.
:- func argument(T::in, int::in) = (univ::out) is semidet.
:- pred argument_cc(T::in, int::in, univ::out) is cc_nondet.
% named_argument(Data, ArgumentName) = ArgumentUniv
%
% Same as argument/2, except the chosen argument is specified by giving
% its name rather than its position. If Data has no argument with that
% name, named_argument fails.
%
% named_argument_cc succeeds even if the first argument is
% of a non-canonical type.
%
:- func named_argument(T::in, string::in) = (univ::out) is semidet.
:- pred named_argument_cc(T::in, string::in, univ::out) is cc_nondet.
% det_arg(Data, ArgumentIndex) = Argument
% det_argument(Data, ArgumentIndex) = ArgumentUniv
%
% Same as arg/2 and argument/2 respectively, except that
% for cases where arg/2 or argument/2 would fail,
% det_arg/2 or det_argument/2 will abort.
%
% det_arg_cc and det_argument_cc succeed even if the first argument is
% of a non-canonical type.
%
:- func det_arg(T::in, int::in) = (ArgT::out) is det.
:- pred det_arg_cc(T::in, int::in, ArgT::out) is cc_multi.
:- func det_argument(T::in, int::in) = (univ::out) is det.
:- pred det_argument_cc(T::in, int::in, univ::out) is cc_multi.
% det_named_argument(Data, ArgumentName) = ArgumentUniv
%
% Same as named_argument/2, except that for cases where
% named_argument/2 would fail, det_named_argument/2 will abort.
%
:- func det_named_argument(T::in, string::in) = (univ::out) is det.
:- pred det_named_argument_cc(T::in, string::in, univ::out) is cc_multi.
% deconstruct(Data, Functor, Arity, Arguments)
%
% Given a data item (Data), binds Functor to a string
% representation of the functor, Arity to the arity of this data
% item, and Arguments to a list of arguments of the functor.
% The arguments in the list are each of type univ.
% (Aborts if the type of Data is a type with a non-canonical
% representation, i.e. one for which there is a user-defined
% equality predicate.)
%
% The cost of calling deconstruct depends greatly on how many arguments
% Data has. If Data is an array, then each element of the array is
% considered one of its arguments. Therefore calling deconstruct
% on large arrays can take a very large amount of memory and a very
% long time. If you call deconstruct in a situation in which you may
% pass it a large array, you should probably use limited_deconstruct
% instead.
%
% deconstruct_cc succeeds even if the first argument is
% of a non-canonical type.
%
:- pred deconstruct(T::in, string::out, int::out, list(univ)::out) is det.
:- pred deconstruct_cc(T::in, string::out, int::out, list(univ)::out)
is cc_multi.
% limited_deconstruct(Data, MaxArity, Functor, Arity, Arguments)
%
% limited_deconstruct works like deconstruct, but if the arity of T is
% greater than MaxArity, limited_deconstruct fails. This is useful in
% avoiding bad performance in cases where Data may be a large array.
%
% limited_deconstruct_cc succeeds even if the first argument is
% of a non-canonical type.
%
:- pred limited_deconstruct(T::in, int::in, string::out,
int::out, list(univ)::out) is semidet.
:- pred limited_deconstruct_cc(T::in, int::in, string::out,
int::out, list(univ)::out) is cc_nondet.
:- implementation.
:- interface.
% The rest of the interface is for use by implementors only.
:- type functor_tag_info
---> functor_integer(int)
; functor_float(float)
; functor_string(string)
; functor_enum(int)
; functor_local(int, int)
; functor_remote(int, int, list(univ))
; functor_unshared(int, list(univ))
; functor_notag(univ)
; functor_equiv(univ).
% get_functor_info is a variant of deconstruct for use by the compiler,
% specifically prog_rep.m and static_term.m. It differs from
% deconstruct in two main ways. First, instead of returning the
% function symbol, it returns implementation information about
% its tag. Second, it succeeds for just the kinds of terms needed
% to represent procedure bodies for ordinary procedures. For the time
% being, these are procedures that do not involve higher order code
% or tabling.
:- pred get_functor_info(univ::in, functor_tag_info::out) is semidet.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module int, require.
%-----------------------------------------------------------------------------%
:- pragma foreign_decl("C", "
#include ""mercury_deconstruct.h""
#include ""mercury_deconstruct_macros.h""
").
%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C",
functor(Term::in, Functor::out, Arity::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
#define PREDNAME ""functor/3""
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define FUNCTOR_ARG Functor
#define ARITY_ARG Arity
#include ""mercury_ml_functor_body.h""
#undef PREDNAME
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef FUNCTOR_ARG
#undef ARITY_ARG
}").
:- pragma foreign_proc("C",
functor_cc(Term::in, Functor::out, Arity::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
#define PREDNAME ""functor_cc/3""
#define ALLOW_NONCANONICAL
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define FUNCTOR_ARG Functor
#define ARITY_ARG Arity
#include ""mercury_ml_functor_body.h""
#undef PREDNAME
#undef ALLOW_NONCANONICAL
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef FUNCTOR_ARG
#undef ARITY_ARG
}").
functor_cc(_Term::in, _Functor::out, _Arity::out) :-
error("NYI: std_util__functor_cc/3").
/*
** N.B. any modifications to arg/2 might also require similar
** changes to store__arg_ref in store.m.
*/
:- pragma foreign_proc("C",
arg(Term::in, ArgumentIndex::in) = (Argument::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
#define PREDNAME ""arg/2""
#define NONCANON_HANDLING MR_ABORT_ON_NONCANONICAL
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define SELECTOR_ARG ArgumentIndex
#define SELECTED_ARG Argument
#define EXPECTED_TYPE_INFO TypeInfo_for_ArgT
#include ""mercury_ml_arg_body.h""
#undef PREDNAME
#undef NONCANON_HANDLING
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef SELECTOR_ARG
#undef SELECTED_ARG
#undef EXPECTED_TYPE_INFO
}").
:- pragma foreign_proc("C",
arg_cc(Term::in, ArgumentIndex::in, Argument::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
#define PREDNAME ""arg/2""
#define NONCANON_HANDLING MR_ALLOW_NONCANONICAL
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define SELECTOR_ARG ArgumentIndex
#define SELECTED_ARG Argument
#define EXPECTED_TYPE_INFO TypeInfo_for_ArgT
#include ""mercury_ml_arg_body.h""
#undef PREDNAME
#undef NONCANON_HANDLING
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef SELECTOR_ARG
#undef SELECTED_ARG
#undef EXPECTED_TYPE_INFO
}").
:- pragma foreign_proc("C",
argument(Term::in, ArgumentIndex::in) = (ArgumentUniv::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
#define PREDNAME ""argument/2""
#define NONCANON_HANDLING MR_FAIL_ON_NONCANONICAL
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define SELECTOR_ARG ArgumentIndex
#define SELECTED_ARG ArgumentUniv
#include ""mercury_ml_arg_body.h""
#undef PREDNAME
#undef NONCANON_HANDLING
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef SELECTOR_ARG
#undef SELECTED_ARG
}").
:- pragma foreign_proc("C",
argument_cc(Term::in, ArgumentIndex::in, ArgumentUniv::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
#define PREDNAME ""argument_cc/3""
#define NONCANON_HANDLING MR_ALLOW_NONCANONICAL
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define SELECTOR_ARG ArgumentIndex
#define SELECTED_ARG ArgumentUniv
#include ""mercury_ml_arg_body.h""
#undef PREDNAME
#undef NONCANON_HANDLING
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef SELECTOR_ARG
#undef SELECTED_ARG
}").
:- pragma foreign_proc("C",
named_argument(Term::in, ArgumentName::in) = (ArgumentUniv::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
#define PREDNAME ""named_argument/2""
#define NONCANON_HANDLING MR_FAIL_ON_NONCANONICAL
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define SELECTOR_ARG (MR_ConstString) ArgumentName
#define SELECTED_ARG ArgumentUniv
#define SELECT_BY_NAME
#include ""mercury_ml_arg_body.h""
#undef PREDNAME
#undef NONCANON_HANDLING
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef SELECTOR_ARG
#undef SELECTED_ARG
#undef SELECT_BY_NAME
}").
:- pragma foreign_proc("C",
named_argument_cc(Term::in, ArgumentName::in, ArgumentUniv::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
#define PREDNAME ""named_argument_cc/3""
#define NONCANON_HANDLING MR_ALLOW_NONCANONICAL
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define SELECTOR_ARG (MR_ConstString) ArgumentName
#define SELECTED_ARG ArgumentUniv
#define SELECT_BY_NAME
#include ""mercury_ml_arg_body.h""
#undef PREDNAME
#undef NONCANON_HANDLING
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef SELECTOR_ARG
#undef SELECTED_ARG
#undef SELECT_BY_NAME
}").
:- pragma foreign_proc("C",
deconstruct(Term::in, Functor::out, Arity::out, Arguments::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
#define PREDNAME ""deconstruct/4""
#define EXPAND_INFO_TYPE MR_Expand_Functor_Args_Info
#define EXPAND_INFO_CALL MR_expand_functor_args
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define FUNCTOR_ARG Functor
#define ARITY_ARG Arity
#define ARGUMENTS_ARG Arguments
#include ""mercury_ml_deconstruct_body.h""
#undef PREDNAME
#undef EXPAND_INFO_TYPE
#undef EXPAND_INFO_CALL
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef FUNCTOR_ARG
#undef ARITY_ARG
#undef ARGUMENTS_ARG
}").
:- pragma foreign_proc("C",
deconstruct_cc(Term::in, Functor::out, Arity::out, Arguments::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
#define PREDNAME ""deconstruct_cc/4""
#define EXPAND_INFO_TYPE MR_Expand_Functor_Args_Info
#define EXPAND_INFO_CALL MR_expand_functor_args
#define ALLOW_NONCANONICAL
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define FUNCTOR_ARG Functor
#define ARITY_ARG Arity
#define ARGUMENTS_ARG Arguments
#include ""mercury_ml_deconstruct_body.h""
#undef PREDNAME
#undef NONCANON_HANDLING
#undef EXPAND_INFO_TYPE
#undef EXPAND_INFO_CALL
#undef ALLOW_NONCANONICAL
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef FUNCTOR_ARG
#undef ARITY_ARG
#undef ARGUMENTS_ARG
}").
deconstruct_cc(_Term::in, _Functor::out, _Arity::out, _Arguments::out) :-
error("NYI: std_util__deconstruct_cc/3").
:- pragma foreign_proc("C",
limited_deconstruct(Term::in, MaxArity::in, Functor::out,
Arity::out, Arguments::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
#define PREDNAME ""limited_deconstruct/5""
#define EXPAND_INFO_TYPE MR_Expand_Functor_Args_Limit_Info
#define EXPAND_INFO_CALL MR_expand_functor_args_limit
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define MAX_ARITY_ARG MaxArity
#define FUNCTOR_ARG Functor
#define ARITY_ARG Arity
#define ARGUMENTS_ARG Arguments
#include ""mercury_ml_deconstruct_body.h""
#undef PREDNAME
#undef EXPAND_INFO_TYPE
#undef EXPAND_INFO_CALL
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef MAX_ARITY_ARG
#undef FUNCTOR_ARG
#undef ARITY_ARG
#undef ARGUMENTS_ARG
}").
:- pragma foreign_proc("C",
limited_deconstruct_cc(Term::in, MaxArity::in, Functor::out,
Arity::out, Arguments::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
#define PREDNAME ""limited_deconstruct_cc/5""
#define EXPAND_INFO_TYPE MR_Expand_Functor_Args_Limit_Info
#define EXPAND_INFO_CALL MR_expand_functor_args_limit
#define ALLOW_NONCANONICAL
#define TYPEINFO_ARG TypeInfo_for_T
#define TERM_ARG Term
#define MAX_ARITY_ARG MaxArity
#define FUNCTOR_ARG Functor
#define ARITY_ARG Arity
#define ARGUMENTS_ARG Arguments
#include ""mercury_ml_deconstruct_body.h""
#undef PREDNAME
#undef EXPAND_INFO_TYPE
#undef EXPAND_INFO_CALL
#undef ALLOW_NONCANONICAL
#undef TYPEINFO_ARG
#undef TERM_ARG
#undef MAX_ARITY_ARG
#undef FUNCTOR_ARG
#undef ARITY_ARG
#undef ARGUMENTS_ARG
}").
limited_deconstruct_cc(_Term::in, _MaxArity::in, _Functor::out, _Arity::out,
_Arguments::out) :-
error("NYI: std_util__limited_deconstruct_cc/3").
:- pragma foreign_proc("MC++",
functor(_Term::in, _Functor::out, _Arity::out),
[will_not_call_mercury, thread_safe, promise_pure],
"
mercury::runtime::Errors::SORRY(""foreign code for functor"");
").
:- pragma foreign_proc("C#",
arg(_Term::in, _ArgumentIndex::in) = (_Argument::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
mercury.runtime.Errors.SORRY(""foreign code for arg"");
// XXX this is required to keep the C# compiler quiet
SUCCESS_INDICATOR = false;
}").
:- pragma foreign_proc("C#",
arg_cc(_Term::in, _ArgumentIndex::in, _Argument::out),
[will_not_call_mercury, thread_safe],
"{
mercury.runtime.Errors.SORRY(""foreign code for arg_cc"");
// XXX this is required to keep the C# compiler quiet
SUCCESS_INDICATOR = false;
}").
:- pragma foreign_proc("C#",
argument(_Term::in, _ArgumentIndex::in) = (_ArgumentUniv::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
mercury.runtime.Errors.SORRY(""foreign code for argument"");
// XXX this is required to keep the C# compiler quiet
SUCCESS_INDICATOR = false;
}").
:- pragma foreign_proc("C#",
argument_cc(_Term::in, _ArgumentIndex::in, _ArgumentUniv::out),
[will_not_call_mercury, thread_safe],
"{
mercury.runtime.Errors.SORRY(""foreign code for argument_cc"");
// XXX this is required to keep the C# compiler quiet
SUCCESS_INDICATOR = false;
}").
:- pragma foreign_proc("C#",
named_argument(_Term::in, _ArgumentName::in) = (_ArgumentUniv::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
mercury.runtime.Errors.SORRY(""foreign code for named_argument"");
// XXX this is required to keep the C# compiler quiet
SUCCESS_INDICATOR = false;
}").
:- pragma foreign_proc("C#",
named_argument_cc(_Term::in, _ArgumentName::in, _ArgumentUniv::out),
[will_not_call_mercury, thread_safe],
"{
mercury.runtime.Errors.SORRY(""foreign code for named_argument_cc"");
// XXX this is required to keep the C# compiler quiet
SUCCESS_INDICATOR = false;
}").
det_arg(Type, ArgumentIndex) = Argument :-
( deconstruct__arg(Type, ArgumentIndex) = Argument0 ->
Argument = Argument0
;
( deconstruct__argument(Type, ArgumentIndex) = _ArgumentUniv ->
error("det_arg: argument had wrong type")
;
error("det_arg: argument number out of range")
)
).
det_arg_cc(Type, ArgumentIndex, Argument) :-
( deconstruct__arg_cc(Type, ArgumentIndex, Argument0) ->
Argument = Argument0
;
( deconstruct__argument_cc(Type, ArgumentIndex, _ArgumentUniv) ->
error("det_arg_cc: argument had wrong type")
;
error("det_arg_cc: argument number out of range")
)
).
det_argument(Type, ArgumentIndex) = Argument :-
( deconstruct__argument(Type, ArgumentIndex) = Argument0 ->
Argument = Argument0
;
error("det_argument: argument out of range")
).
det_argument_cc(Type, ArgumentIndex, Argument) :-
( deconstruct__argument_cc(Type, ArgumentIndex, Argument0) ->
Argument = Argument0
;
error("det_argument_cc: argument out of range")
).
det_named_argument(Type, ArgumentName) = Argument :-
( deconstruct__named_argument(Type, ArgumentName) = Argument0 ->
Argument = Argument0
;
error("det_named_argument: no argument with that name")
).
det_named_argument_cc(Type, ArgumentName, Argument) :-
( deconstruct__named_argument_cc(Type, ArgumentName, Argument0) ->
Argument = Argument0
;
error("det_named_argument_cc: no argument with that name")
).
deconstruct(Term::in, Functor::out, Arity::out, Arguments::out) :-
rtti_implementation__deconstruct(Term, Functor, Arity, Arguments).
:- pragma foreign_proc("MC++",
limited_deconstruct(_Term::in, _MaxArity::in, _Functor::out,
_Arity::out, _Arguments::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
mercury::runtime::Errors::SORRY(""foreign code for limited_deconstruct"");
SUCCESS_INDICATOR = FALSE;
}").
get_functor_info(Univ, FunctorInfo) :-
( univ_to_type(Univ, Int) ->
FunctorInfo = functor_integer(Int)
; univ_to_type(Univ, Float) ->
FunctorInfo = functor_float(Float)
; univ_to_type(Univ, String) ->
FunctorInfo = functor_string(String)
; get_enum_functor_info(Univ, Enum) ->
FunctorInfo = functor_enum(Enum)
%
% XXX we should handle reserved_addr types here
%
; get_du_functor_info(Univ, Where, Ptag, Sectag, Args) ->
( Where = 0 ->
FunctorInfo = functor_unshared(Ptag, Args)
; Where > 0 ->
FunctorInfo = functor_remote(Ptag, Sectag, Args)
;
FunctorInfo = functor_local(Ptag, Sectag)
)
; get_notag_functor_info(Univ, ExpUniv) ->
FunctorInfo = functor_notag(ExpUniv)
; get_equiv_functor_info(Univ, ExpUniv) ->
FunctorInfo = functor_equiv(ExpUniv)
;
fail
).
% Given a value of an arbitrary type, succeed if its type is defined
% as a notag type, and return a univ which bundles up the value
% with the type of the single function symbol of the notag type.
:- pred get_notag_functor_info(univ::in, univ::out) is semidet.
:- pragma foreign_proc("C",
get_notag_functor_info(Univ::in, ExpUniv::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
MR_TypeInfo type_info;
MR_TypeInfo exp_type_info;
MR_TypeCtorInfo type_ctor_info;
MR_NotagFunctorDesc *functor_desc;
MR_Word value;
MR_unravel_univ(Univ, type_info, value);
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
switch (MR_type_ctor_rep(type_ctor_info)) {
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
functor_desc = MR_type_ctor_functors(type_ctor_info).functors_notag;
exp_type_info = MR_pseudo_type_info_is_ground(
functor_desc->MR_notag_functor_arg_type);
MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = TRUE;
break;
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
functor_desc = MR_type_ctor_functors(type_ctor_info).functors_notag;
exp_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
functor_desc->MR_notag_functor_arg_type);
MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = TRUE;
break;
default:
SUCCESS_INDICATOR = FALSE;
break;
}
}").
:- pragma foreign_proc("MC++",
get_notag_functor_info(_Univ::in, _ExpUniv::out),
[will_not_call_mercury, thread_safe, promise_pure],
"
mercury::runtime::Errors::SORRY(""foreign code for get_notag_functor_info"");
").
% Given a value of an arbitrary type, succeed if its type is defined
% as an equivalence type, and return a univ which bundles up the value
% with the equivalent type. (I.e. this removes one layer of equivalence
% from the type stored in the univ.)
:- pred get_equiv_functor_info(univ::in, univ::out) is semidet.
:- pragma foreign_proc("C",
get_equiv_functor_info(Univ::in, ExpUniv::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
MR_TypeInfo type_info;
MR_TypeInfo exp_type_info;
MR_TypeCtorInfo type_ctor_info;
MR_Word value;
MR_unravel_univ(Univ, type_info, value);
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
switch (MR_type_ctor_rep(type_ctor_info)) {
case MR_TYPECTOR_REP_EQUIV:
exp_type_info = MR_pseudo_type_info_is_ground(
MR_type_ctor_layout(type_ctor_info).layout_equiv);
MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = TRUE;
break;
case MR_TYPECTOR_REP_EQUIV_GROUND:
exp_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_equiv);
MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = TRUE;
break;
default:
SUCCESS_INDICATOR = FALSE;
break;
}
}").
:- pragma foreign_proc("MC++",
get_equiv_functor_info(_Univ::in, _ExpUniv::out),
[will_not_call_mercury, thread_safe, promise_pure],
"
mercury::runtime::Errors::SORRY(""foreign code for get_equiv_functor_info"");
").
% Given a value of an arbitrary type, succeed if it is an enum type,
% and return the integer value corresponding to the value.
:- pred get_enum_functor_info(univ::in, int::out) is semidet.
:- pragma foreign_proc("C",
get_enum_functor_info(Univ::in, Enum::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
MR_TypeInfo type_info;
MR_TypeCtorInfo type_ctor_info;
MR_Word value;
MR_unravel_univ(Univ, type_info, value);
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
switch (MR_type_ctor_rep(type_ctor_info)) {
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_ENUM_USEREQ:
Enum = (MR_Integer) value;
SUCCESS_INDICATOR = TRUE;
break;
default:
SUCCESS_INDICATOR = FALSE;
break;
}
}").
:- pragma foreign_proc("MC++",
get_enum_functor_info(_Univ::in, _Enum::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
mercury::runtime::Errors::SORRY(""foreign code for get_enum_functor_info"");
}").
% Given a value of an arbitrary type, succeed if it is a general du type
% (i.e. non-enum, non-notag du type), and return the top function symbol's
% arguments as well as its tag information: an indication of where the
% secondary tag is (-1 for local secondary tag, 0 for nonexistent secondary
% tag, and 1 for remote secondary tag), as well as the primary and
% secondary tags themselves (the secondary tag argument will be meaningful
% only if the secondary tag exists, of course).
:- pred get_du_functor_info(univ::in, int::out, int::out, int::out,
list(univ)::out) is semidet.
:- pragma foreign_proc("C",
get_du_functor_info(Univ::in, Where::out, Ptag::out, Sectag::out,
Args::out),
[will_not_call_mercury, thread_safe, promise_pure],
"{
MR_TypeInfo type_info;
MR_TypeCtorInfo type_ctor_info;
const MR_DuPtagLayout *ptag_layout;
const MR_DuFunctorDesc *functor_desc;
MR_Word value;
MR_Word *arg_vector;
int i;
MR_unravel_univ(Univ, type_info, value);
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
switch (MR_type_ctor_rep(type_ctor_info)) {
case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
SUCCESS_INDICATOR = TRUE;
Ptag = MR_tag(value);
ptag_layout = &MR_type_ctor_layout(type_ctor_info).layout_du[Ptag];
switch(ptag_layout->MR_sectag_locn) {
case MR_SECTAG_LOCAL:
Where = -1;
Sectag = MR_unmkbody(value);
Args = MR_list_empty();
break;
case MR_SECTAG_REMOTE:
case MR_SECTAG_NONE:
if (ptag_layout->MR_sectag_locn == MR_SECTAG_NONE) {
Where = 0;
arg_vector = (MR_Word *) MR_body(value, Ptag);
Sectag = 0;
} else {
Where = 1;
arg_vector = (MR_Word *) MR_body(value, Ptag);
Sectag = arg_vector[0];
arg_vector++;
}
functor_desc = ptag_layout->MR_sectag_alternatives[Sectag];
if (functor_desc->MR_du_functor_exist_info != NULL) {
SUCCESS_INDICATOR = FALSE;
break;
}
Args = MR_list_empty_msg(MR_PROC_LABEL);
for (i = functor_desc->MR_du_functor_orig_arity - 1;
i >= 0; i--)
{
MR_Word arg;
MR_TypeInfo arg_type_info;
if (MR_arg_type_may_contain_var(functor_desc, i)) {
arg_type_info = MR_create_type_info_maybe_existq(
MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
type_info),
functor_desc->MR_du_functor_arg_types[i],
arg_vector, functor_desc);
} else {
arg_type_info = MR_pseudo_type_info_is_ground(
functor_desc->MR_du_functor_arg_types[i]);
}
MR_new_univ_on_hp(arg,
arg_type_info, arg_vector[i]);
Args = MR_list_cons_msg(arg, Args, MR_PROC_LABEL);
}
break;
case MR_SECTAG_VARIABLE:
MR_fatal_error(
""get_du_functor_info: unexpected variable"");
default:
MR_fatal_error(
""get_du_functor_info: unknown sectag locn"");
}
break;
default:
SUCCESS_INDICATOR = FALSE;
break;
}
}").
:- pragma foreign_proc("MC++",
get_du_functor_info(_Univ::in, _Where::out, _Ptag::out, _Sectag::out,
_Args::out),
[will_not_call_mercury, thread_safe, promise_pure],
"
mercury::runtime::Errors::SORRY(""foreign code for get_du_functor_info"");
").
Reference in New Issue View Git Blame Copy Permalink