mercury/library/rtti_implementation.m

%-----------------------------------------------------------------------------%
% Copyright (C) 2001-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.
%-----------------------------------------------------------------------------%

% File: rtti_implementation.m.
% Main author: trd, petdr.
% Stability: low.

% This file is intended to provide portable RTTI functionality by implementing
% most of Mercury's RTTI functionality in Mercury.
%
% This is simpler writing large amounts of low-level C code, and is much
% easier to maintain and port to new platforms.
%
% This module is not complete, the majority of the functionality is
% implemented, but the following still needs to be implemented
% 	* functionality required to support construct.construct
% 	* functionality required to support type_desc.type_ctor
% 	* currently we recognise RTTI for higher order types, however
% 	  we don't interpret that RTTI fully.
%
% The plan is to migrate most of the Mercury level data structures in
% compiler/rtti.m here, and to interpret them, instead of relying on access
% to C level data structures.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- module rtti_implementation.

:- interface.

:- import_module deconstruct, list.

:- use_module std_util.
:- use_module type_desc.

	% Our type_info and type_ctor_info implementations are both
	% abstract types.
:- type type_info.
:- type type_ctor_info.

:- func get_type_info(T::unused) = (type_info::out) is det.

:- pred generic_unify(T::in, T::in) is semidet.

:- pred generic_compare(comparison_result::out, T::in, T::in) is det.

:- pred compare_type_infos(comparison_result::out,
		type_info::in, type_info::in) is det.

:- pred type_ctor_and_args(type_info::in,
		type_ctor_info::out,
		list(type_info)::out) is det.

:- pred type_ctor_name_and_arity(type_ctor_info::in,
		string::out, string::out, int::out) is det.

:- pred deconstruct(T, noncanon_handling, string, int, list(std_util__univ)).
:- mode deconstruct(in, in(do_not_allow), out, out, out) is det.
:- mode deconstruct(in, in(canonicalize), out, out, out) is det.
:- mode deconstruct(in, in(include_details_cc), out, out, out) is cc_multi.
:- mode deconstruct(in, in, out, out, out) is cc_multi.

	% This is useful in a few places, so we'd like to share the code, but
	% it's better to put it into an implementation module such as this one.
:- func unsafe_cast(T1::in) = (T2::out) is det.

%-----------------------------------------------------------------------------%
%
% Implementations for use from construct.

:- func num_functors(type_desc__type_desc) = int.

:- pred get_functor(type_desc__type_desc::in, int::in, string::out, int::out,
		list(type_desc__type_desc)::out) is semidet.

:- 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.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module array, bool, int, require, string.

	% std_util has a lot of types and functions with the same names,
	% so we prefer to keep the namespace separate.
:- use_module std_util.

	% It is convenient to represent the type_ctor_rep as a Mercury 
	% enumeration, so 
	%
	% The type_ctor_rep needs to be kept up to date with the real
	% definition in runtime/mercury_type_info.h.
:- type type_ctor_rep 
	---> 	enum 
	; 	enum_usereq
	;	du
	;	du_usereq
	;	notag
	;	notag_usereq
	;	equiv
	;	(func)
	;	int
	;	char
	;	float
	;	string
	;	(pred)
	;	subgoal
	;	void
	;	c_pointer
	;	typeinfo
	;	typeclassinfo
	;	array
	;	succip
	;	hp
	;	curfr
	;	maxfr
	;	redofr
	;	redoip
	;	trail_ptr
	;	ticket
	;	notag_ground
	;	notag_ground_usereq
	;	equiv_ground
	;	tuple
	;	reserved_addr
	;	reserved_addr_usereq
	;	type_ctor_info
	;	base_typeclass_info
	;	type_desc
	;	type_ctor_desc
	;	foreign
	;	reference
	;	stable_c_pointer
	;	unknown.

	% We keep all the other types abstract.

:- type type_ctor_info ---> type_ctor_info(c_pointer).
:- type type_info ---> type_info(c_pointer).
:- type compare_pred ---> compare_pred(c_pointer).
:- type type_layout ---> type_layout(c_pointer).
:- type pred_type ---> pred_type(c_pointer).
:- type pseudo_type_info ---> pred_type(c_pointer).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Implementation of the interface to construct.
%

	% See MR_get_num_functors in runtime/mercury_construct.c
num_functors(TypeDesc) = NumFunctors :-
	TypeCtorInfo = get_type_ctor_info(unsafe_cast(TypeDesc)),
	TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
	( TypeCtorRep = du,
		NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
	; TypeCtorRep = du_usereq,
		NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
	; TypeCtorRep = reserved_addr,
		NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
	; TypeCtorRep = reserved_addr_usereq,
		NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
	; TypeCtorRep = enum,
		NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
	; TypeCtorRep = enum_usereq,
		NumFunctors = TypeCtorInfo ^ type_ctor_num_functors

	; TypeCtorRep = notag,
		NumFunctors = 1
	; TypeCtorRep = notag_usereq,
		NumFunctors = 1
	; TypeCtorRep = notag_ground,
		NumFunctors = 1
	; TypeCtorRep = notag_ground_usereq,
		NumFunctors = 1
	; TypeCtorRep = tuple,
		NumFunctors = 1
	; TypeCtorRep = subgoal,
		NumFunctors = -1

	; TypeCtorRep = equiv_ground,
		error("rtti_implementation num_functors for equiv types")
	; TypeCtorRep = equiv,
		error("rtti_implementation num_functors for equiv types")

	; TypeCtorRep = int,
		NumFunctors = -1
	; TypeCtorRep = char,
		NumFunctors = -1
	; TypeCtorRep = float,
		NumFunctors = -1
	; TypeCtorRep = string,
		NumFunctors = -1
	; TypeCtorRep = (func),
		NumFunctors = -1
	; TypeCtorRep = (pred),
		NumFunctors = -1
	; TypeCtorRep = void,
		NumFunctors = -1
	; TypeCtorRep = c_pointer,
		NumFunctors = -1
	; TypeCtorRep = stable_c_pointer,
		NumFunctors = -1
	; TypeCtorRep = typeinfo,
		NumFunctors = -1
	; TypeCtorRep = type_ctor_info,
		NumFunctors = -1
	; TypeCtorRep = type_desc,
		NumFunctors = -1
	; TypeCtorRep = type_ctor_desc,
		NumFunctors = -1
	; TypeCtorRep = typeclassinfo,
		NumFunctors = -1
	; TypeCtorRep = base_typeclass_info,
		NumFunctors = -1
	; TypeCtorRep = array,
		NumFunctors = -1
	; TypeCtorRep = succip,
		NumFunctors = -1
	; TypeCtorRep = hp,
		NumFunctors = -1
	; TypeCtorRep = curfr,
		NumFunctors = -1
	; TypeCtorRep = maxfr,
		NumFunctors = -1
	; TypeCtorRep = redofr,
		NumFunctors = -1
	; TypeCtorRep = redoip,
		NumFunctors = -1
	; TypeCtorRep = trail_ptr,
		NumFunctors = -1
	; TypeCtorRep = ticket,
		NumFunctors = -1
	; TypeCtorRep = foreign,
		NumFunctors = -1
	; TypeCtorRep = reference,
		NumFunctors = -1

	; TypeCtorRep = unknown,
		error("num_functors: unknown type_ctor_rep")
	).

get_functor(TypeDesc, FunctorNumber, FunctorName, Arity, TypeInfoList) :-
	get_functor_impl(TypeDesc, FunctorNumber,
			FunctorName, Arity, TypeInfoList, _Names).

get_functor_2(TypeDesc, FunctorNumber,
		FunctorName, Arity, TypeInfoList, Names) :-
	get_functor_impl(TypeDesc, FunctorNumber,
			FunctorName, Arity, TypeInfoList, Names).

:- pred get_functor_impl(type_desc__type_desc::in, int::in,
		string::out, int::out, list(type_desc__type_desc)::out,
		list(string)::out) is semidet.

get_functor_impl(TypeDesc, FunctorNumber,
		FunctorName, Arity, TypeInfoList, Names) :-
	FunctorNumber >= 0,
	FunctorNumber < TypeDesc ^ num_functors,
	TypeInfo = unsafe_cast(TypeDesc),
	TypeCtorInfo = get_type_ctor_info(TypeInfo),
	TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
	( TypeCtorRep = du,
		get_functor_du(TypeCtorRep, TypeInfo, TypeCtorInfo,
				FunctorNumber, FunctorName, Arity,
				TypeInfoList, Names)
	; TypeCtorRep = du_usereq,
		get_functor_du(TypeCtorRep, TypeInfo, TypeCtorInfo,
				FunctorNumber, FunctorName, Arity,
				TypeInfoList, Names)
	; TypeCtorRep = reserved_addr,
		get_functor_du(TypeCtorRep, TypeInfo, TypeCtorInfo,
				FunctorNumber, FunctorName, Arity,
				TypeInfoList, Names)
	; TypeCtorRep = reserved_addr_usereq,
		get_functor_du(TypeCtorRep, TypeInfo, TypeCtorInfo,
				FunctorNumber, FunctorName, Arity,
				TypeInfoList, Names)

	; TypeCtorRep = subgoal,
		fail

	; TypeCtorRep = enum,
		get_functor_enum(TypeCtorRep, TypeCtorInfo,
				FunctorNumber, FunctorName, Arity,
				TypeInfoList, Names)
	; TypeCtorRep = enum_usereq,
		get_functor_enum(TypeCtorRep, TypeCtorInfo,
				FunctorNumber, FunctorName, Arity,
				TypeInfoList, Names)

	; TypeCtorRep = notag,
		get_functor_notag(TypeCtorRep, TypeCtorInfo,
				FunctorNumber, FunctorName, Arity,
				TypeInfoList, Names)
	; TypeCtorRep = notag_usereq,
		get_functor_notag(TypeCtorRep, TypeCtorInfo,
				FunctorNumber, FunctorName, Arity,
				TypeInfoList, Names)
	; TypeCtorRep = notag_ground,
		get_functor_notag(TypeCtorRep, TypeCtorInfo,
				FunctorNumber, FunctorName, Arity,
				TypeInfoList, Names)
	; TypeCtorRep = notag_ground_usereq,
		get_functor_notag(TypeCtorRep, TypeCtorInfo,
				FunctorNumber, FunctorName, Arity,
				TypeInfoList, Names)

	; TypeCtorRep = equiv_ground,
		NewTypeInfo = collapse_equivalences(TypeInfo),
		get_functor_impl(unsafe_cast(NewTypeInfo), FunctorNumber,
				FunctorName, Arity, TypeInfoList, Names)
	; TypeCtorRep = equiv,
		NewTypeInfo = collapse_equivalences(TypeInfo),
		get_functor_impl(unsafe_cast(NewTypeInfo), FunctorNumber,
				FunctorName, Arity, TypeInfoList, Names)

	; TypeCtorRep = tuple,
		FunctorName = "{}",
		Arity = get_var_arity_typeinfo_arity(TypeInfo),
		TypeInfoList = iterate(1, Arity, (func(I) =
			unsafe_cast(TypeInfo ^ var_arity_type_info_index(I)))
		),
		Names = list__duplicate(Arity, null_string)

	; TypeCtorRep = int,
		fail
	; TypeCtorRep = char,
		fail
	; TypeCtorRep = float,
		fail
	; TypeCtorRep = string,
		fail
	; TypeCtorRep = (func),
		fail
	; TypeCtorRep = (pred),
		fail
	; TypeCtorRep = void,
		fail
	; TypeCtorRep = c_pointer,
		fail
	; TypeCtorRep = stable_c_pointer,
		fail
	; TypeCtorRep = typeinfo,
		fail
	; TypeCtorRep = type_ctor_info,
		fail
	; TypeCtorRep = type_desc,
		fail
	; TypeCtorRep = type_ctor_desc,
		fail
	; TypeCtorRep = typeclassinfo,
		fail
	; TypeCtorRep = base_typeclass_info,
		fail
	; TypeCtorRep = array,
		fail
	; TypeCtorRep = succip,
		fail
	; TypeCtorRep = hp,
		fail
	; TypeCtorRep = curfr,
		fail
	; TypeCtorRep = maxfr,
		fail
	; TypeCtorRep = redofr,
		fail
	; TypeCtorRep = redoip,
		fail
	; TypeCtorRep = trail_ptr,
		fail
	; TypeCtorRep = ticket,
		fail
	; TypeCtorRep = foreign,
		fail
	; TypeCtorRep = reference,
		fail

	; TypeCtorRep = unknown,
		error("get_functor: unknown type_ctor_rep")
	).

:- pred get_functor_du(type_ctor_rep::in(du), type_info::in, type_ctor_info::in,
		int::in, string::out, int::out,
		list(type_desc__type_desc)::out,
		list(string)::out) is semidet.

get_functor_du(TypeCtorRep, TypeInfo, TypeCtorInfo, FunctorNumber,
		FunctorName, Arity, TypeDescList, Names) :-
	TypeFunctors = TypeCtorInfo ^ type_ctor_functors,
	DuFunctorDesc = TypeFunctors ^
			    du_functor_desc(TypeCtorRep, FunctorNumber),

		% XXX We don't handle functors with existentially quantified
		% arguments.
	not (_ = DuFunctorDesc ^ du_functor_exist_info),

	FunctorName = DuFunctorDesc ^ du_functor_name,
	Arity = DuFunctorDesc ^ du_functor_arity,

	ArgTypes = DuFunctorDesc ^ du_functor_arg_types,
	F = (func(I) = ArgTypeDesc :-
		PseudoTypeInfo = get_pti_from_arg_types(ArgTypes, I),
			% XXX we can pass 0 instead of an instance of the
			% functor because that is only needed for functors
			% with existentially quantified arguments.
			% 
		get_arg_type_info(TypeInfo, PseudoTypeInfo, 0,
				DuFunctorDesc, ArgTypeInfo),
		ArgTypeDesc = unsafe_cast(ArgTypeInfo)
	),
	TypeDescList = iterate(0, Arity - 1, F),

	( ArgNames = DuFunctorDesc ^ du_functor_arg_names ->
		Names = iterate(0, Arity - 1,
				(func(I) = ArgNames ^ unsafe_index(I)))
	;
		Names = list__duplicate(Arity, null_string)
	).

:- pred get_functor_enum(type_ctor_rep::in(enum),
		type_ctor_info::in, int::in, string::out, int::out,
		list(type_desc__type_desc)::out,
		list(string)::out) is det.

get_functor_enum(TypeCtorRep, TypeCtorInfo, FunctorNumber,
		FunctorName, Arity, TypeDescList, Names) :-
	TypeFunctors = TypeCtorInfo ^ type_ctor_functors,
	EnumFunctorDesc = TypeFunctors ^
			    enum_functor_desc(TypeCtorRep, FunctorNumber),

	FunctorName = EnumFunctorDesc ^ enum_functor_name,
	Arity = 0,
	TypeDescList = [],
	Names = [].

:- pred get_functor_notag(type_ctor_rep::in(notag),
		type_ctor_info::in, int::in, string::out, int::out,
		list(type_desc__type_desc)::out,
		list(string)::out) is det.

get_functor_notag(TypeCtorRep, TypeCtorInfo, FunctorNumber,
		FunctorName, Arity, TypeDescList, Names) :-
	TypeFunctors = TypeCtorInfo ^ type_ctor_functors,
	NoTagFunctorDesc = TypeFunctors ^
			    notag_functor_desc(TypeCtorRep, FunctorNumber),

	FunctorName = NoTagFunctorDesc ^ notag_functor_name,
	Arity = 1,

	ArgType = NoTagFunctorDesc ^ notag_functor_arg_type,
	ArgName = NoTagFunctorDesc ^ notag_functor_arg_name,

	TypeDescList = [unsafe_cast(ArgType)],
	Names = [ArgName].

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- pragma foreign_proc("C#",
	get_type_info(_T::unused) = (TypeInfo::out),
	[will_not_call_mercury, promise_pure, thread_safe],
" 
	TypeInfo = TypeInfo_for_T;
").

:- pragma foreign_proc("C",
	get_type_info(_T::unused) = (TypeInfo::out), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	TypeInfo = TypeInfo_for_T;
").

get_type_info(_) = _ :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("get_type_info").

:- func get_var_arity_typeinfo_arity(type_info) = int.

:- pragma foreign_proc("C#",
	get_var_arity_typeinfo_arity(TypeInfo::in) = (Arity::out),
	[will_not_call_mercury, promise_pure, thread_safe],
" 
	Arity = (int) TypeInfo[(int) var_arity_ti.arity];
").

get_var_arity_typeinfo_arity(_) = _ :-
	private_builtin__sorry("get_var_arity_typeinfo_arity").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

generic_compare(Res, X, Y) :-
	TypeInfo = get_type_info(X),
	TypeCtorInfo = get_type_ctor_info(TypeInfo),
	TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
	( 
		TypeCtorRep = tuple 
	->
		compare_tuple(TypeInfo, Res, X, Y)
	; 	
		( TypeCtorRep = (pred) ; TypeCtorRep = (func) )
	->
		error("rtti_implementation.m: unimplemented: higher order comparisons")
	;	
		Arity = TypeCtorInfo ^ type_ctor_arity,
		ComparePred = TypeCtorInfo ^ type_ctor_compare_pred,
		( Arity = 0 ->
			result_call_4(ComparePred, Res, X, Y)
		; Arity = 1 ->
			result_call_5(ComparePred, Res,
				TypeInfo ^ type_info_index(1), X, Y)
		; Arity = 2 ->
			result_call_6(ComparePred, Res,  
				TypeInfo ^ type_info_index(1),
				TypeInfo ^ type_info_index(2), 
				X, Y)
		; Arity = 3 ->
			result_call_7(ComparePred, Res,
				TypeInfo ^ type_info_index(1),
				TypeInfo ^ type_info_index(2), 
				TypeInfo ^ type_info_index(3),
				X, Y)
		; Arity = 4 ->
			result_call_8(ComparePred, Res,
				TypeInfo ^ type_info_index(1),
				TypeInfo ^ type_info_index(2), 
				TypeInfo ^ type_info_index(3),
				TypeInfo ^ type_info_index(4),
				X, Y)
		; Arity = 5 ->
			result_call_9(ComparePred, Res,
				TypeInfo ^ type_info_index(1),
				TypeInfo ^ type_info_index(2), 
				TypeInfo ^ type_info_index(3),
				TypeInfo ^ type_info_index(4),
				TypeInfo ^ type_info_index(5),
				X, Y)
		;
			error("compare/3: type arity > 5 not supported")
		)
	).

generic_unify(X, Y) :-
	TypeInfo = get_type_info(X),
	TypeCtorInfo = get_type_ctor_info(TypeInfo),
	TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
	( 
		TypeCtorRep = tuple 
	->
		unify_tuple(TypeInfo, X, Y)
	; 	
		( TypeCtorRep = (pred) ; TypeCtorRep = (func) )
	->
		error("rtti_implementation.m: unimplemented: higher order unifications")
	;	
		Arity = TypeCtorInfo ^ type_ctor_arity,
		UnifyPred = TypeCtorInfo ^ type_ctor_unify_pred,
		( Arity = 0 ->
			semidet_call_3(UnifyPred, X, Y)
		; Arity = 1 ->
			semidet_call_4(UnifyPred,
				TypeInfo ^ type_info_index(1), X, Y)
		; Arity = 2 ->
			semidet_call_5(UnifyPred, 
				TypeInfo ^ type_info_index(1),
				TypeInfo ^ type_info_index(2), 
				X, Y)
		; Arity = 3 ->
			semidet_call_6(UnifyPred, 
				TypeInfo ^ type_info_index(1),
				TypeInfo ^ type_info_index(2), 
				TypeInfo ^ type_info_index(3),
				X, Y)
		; Arity = 4 ->
			semidet_call_7(UnifyPred, 
				TypeInfo ^ type_info_index(1),
				TypeInfo ^ type_info_index(2), 
				TypeInfo ^ type_info_index(3),
				TypeInfo ^ type_info_index(4),
				X, Y)
		; Arity = 5 ->
			semidet_call_8(UnifyPred, 
				TypeInfo ^ type_info_index(1),
				TypeInfo ^ type_info_index(2), 
				TypeInfo ^ type_info_index(3),
				TypeInfo ^ type_info_index(4),
				TypeInfo ^ type_info_index(5),
				X, Y)
		;
			error("unify/2: type arity > 5 not supported")
		)
	).

	% check for tuple and higher order cases

:- pred unify_tuple(type_info::in, T::in, T::in) is semidet.

unify_tuple(TypeInfo, TermA, TermB) :- 
	Arity = get_var_arity_typeinfo_arity(TypeInfo),
	unify_tuple_pos(1, Arity, TypeInfo, TermA, TermB).

:- pred unify_tuple_pos(int::in, int::in,
		type_info::in, T::in, T::in) is semidet.

unify_tuple_pos(Loc, TupleArity, TypeInfo, TermA, TermB) :-
	( Loc > TupleArity ->
		true
	;
		ArgTypeInfo = TypeInfo ^ var_arity_type_info_index(Loc),

		SubTermA = get_subterm(ArgTypeInfo, TermA, Loc - 1, 0),
		SubTermB = get_subterm(ArgTypeInfo, TermB, Loc - 1, 0),

		generic_unify(SubTermA, unsafe_cast(SubTermB)),

		unify_tuple_pos(Loc + 1, TupleArity, TypeInfo, TermA, TermB)
	).

:- pred compare_tuple(type_info::in, comparison_result::out, T::in, T::in)
	is det.

compare_tuple(TypeInfo, Result, TermA, TermB) :- 
	Arity = get_var_arity_typeinfo_arity(TypeInfo),
	compare_tuple_pos(1, Arity, TypeInfo, Result, TermA, TermB).

:- pred compare_tuple_pos(int::in, int::in, type_info::in,
		comparison_result::out, T::in, T::in) is det.

compare_tuple_pos(Loc, TupleArity, TypeInfo, Result, TermA, TermB) :-
	( Loc > TupleArity ->
		Result = (=)
	;
		ArgTypeInfo = TypeInfo ^ var_arity_type_info_index(Loc),

		SubTermA = get_subterm(ArgTypeInfo, TermA, Loc - 1, 0),
		SubTermB = get_subterm(ArgTypeInfo, TermB, Loc - 1, 0),

		generic_compare(SubResult, SubTermA, unsafe_cast(SubTermB)),
		( SubResult = (=) ->
			compare_tuple_pos(Loc + 1, TupleArity, TypeInfo,
					Result, TermA, TermB)
		;
			Result = SubResult
		)
	).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

	% Implement generic calls -- we could use call/N but then we would
	% have to create a real closure.
	%
	% We first give "unimplemented" definitions in Mercury, which will be
	% used by default.

:- pred semidet_call_3(P::in, T::in, U::in) is semidet.
semidet_call_3(_::in, _::in, _::in) :-
	semidet_unimplemented("semidet_call_3").

:- pred semidet_call_4(P::in, A::in, T::in, U::in) is semidet.
semidet_call_4(_::in, _::in, _::in, _::in) :-
	semidet_unimplemented("semidet_call_4").

:- pred semidet_call_5(P::in, A::in, B::in, T::in, U::in) is semidet.
semidet_call_5(_::in, _::in, _::in, _::in, _::in) :-
	semidet_unimplemented("semidet_call_5").

:- pred semidet_call_6(P::in, A::in, B::in, C::in, T::in, U::in) is semidet.
semidet_call_6(_::in, _::in, _::in, _::in, _::in, _::in) :-
	semidet_unimplemented("semidet_call_6").

:- pred semidet_call_7(P::in, A::in, B::in, C::in, D::in, T::in, U::in)
	is semidet.
semidet_call_7(_::in, _::in, _::in, _::in, _::in, _::in, _::in) :-
	semidet_unimplemented("semidet_call_7").

:- pred semidet_call_8(P::in, A::in, B::in, C::in, D::in, E::in, T::in, U::in)
	is semidet.
semidet_call_8(_::in, _::in, _::in, _::in, _::in, _::in, _::in, _::in) :-
	semidet_unimplemented("semidet_call_8").

:- pred result_call_4(P::in, comparison_result::out,
		T::in, U::in) is det.
result_call_4(_::in, (=)::out, _::in, _::in) :-
	det_unimplemented("result_call_4").

:- pred result_call_5(P::in, comparison_result::out,
		A::in, T::in, U::in) is det.
result_call_5(_::in, (=)::out, _::in, _::in, _::in) :-
	det_unimplemented("comparison_result").

:- pred result_call_6(P::in, comparison_result::out,
		A::in, B::in, T::in, U::in) is det.
result_call_6(_::in, (=)::out, _::in, _::in, _::in, _::in) :-
	det_unimplemented("comparison_result").

:- pred result_call_7(P::in, comparison_result::out,
		A::in, B::in, C::in, T::in, U::in) is det.
result_call_7(_::in, (=)::out, _::in, _::in, _::in, _::in, _::in) :-
	det_unimplemented("comparison_result").

:- pred result_call_8(P::in, comparison_result::out,
		A::in, B::in, C::in, D::in, T::in, U::in) is det.
result_call_8(_::in, (=)::out, _::in, _::in, _::in, _::in, _::in, _::in) :-
	det_unimplemented("comparison_result").

:- pred result_call_9(P::in, comparison_result::out,
		A::in, B::in, C::in, D::in, E::in, T::in, U::in) is det.
result_call_9(_::in, (=)::out, _::in, _::in, _::in, _::in, _::in,
		_::in, _::in) :-
	det_unimplemented("result_call_9").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

	% We override the above definitions in the .NET backend.

:- pragma foreign_proc("C#",
	semidet_call_3(Pred::in, X::in, Y::in), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	SUCCESS_INDICATOR =
		mercury.runtime.GenericCall.semidet_call_3(Pred, X, Y);
").
:- pragma foreign_proc("C#",
	semidet_call_4(Pred::in, A::in, X::in, Y::in), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	SUCCESS_INDICATOR =
		mercury.runtime.GenericCall.semidet_call_4(Pred, A, X, Y);
").
:- pragma foreign_proc("C#",
	semidet_call_5(Pred::in, A::in, B::in, X::in, Y::in), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	SUCCESS_INDICATOR =
		mercury.runtime.GenericCall.semidet_call_5(Pred, A, B, X, Y);
").
:- pragma foreign_proc("C#",
	semidet_call_6(Pred::in, A::in, B::in, C::in, X::in, Y::in), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	SUCCESS_INDICATOR =
		mercury.runtime.GenericCall.semidet_call_6(Pred, A, B, C,
			X, Y);
").
:- pragma foreign_proc("C#",
	semidet_call_7(Pred::in, A::in, B::in, C::in, D::in, X::in, Y::in), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	SUCCESS_INDICATOR =
		mercury.runtime.GenericCall.semidet_call_7(Pred, A, B, C, D,
			X, Y);
").
:- pragma foreign_proc("C#",
	semidet_call_8(Pred::in, A::in, B::in, C::in, D::in, E::in,
		X::in, Y::in), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	SUCCESS_INDICATOR =
		mercury.runtime.GenericCall.semidet_call_8(Pred, A, B, C, D,
			E, X, Y);
").

:- pragma foreign_proc("C#",
	result_call_4(Pred::in, Res::out, X::in, Y::in), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	mercury.runtime.GenericCall.result_call_4(Pred, ref Res, X, Y);
").

:- pragma foreign_proc("C#",
	result_call_5(Pred::in, Res::out, A::in, X::in, Y::in), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	mercury.runtime.GenericCall.result_call_5(Pred, A, ref Res, X, Y);
").
:- pragma foreign_proc("C#",
	result_call_6(Pred::in, Res::out, A::in, B::in, X::in, Y::in), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	mercury.runtime.GenericCall.result_call_6(Pred, A, B, ref Res, X, Y);
").
:- pragma foreign_proc("C#",
	result_call_7(Pred::in, Res::out, A::in, B::in, C::in, X::in, Y::in), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	mercury.runtime.GenericCall.result_call_7(Pred, A, B, C, ref Res, X, Y);
").
:- pragma foreign_proc("C#",
	result_call_8(Pred::in, Res::out, A::in, B::in, C::in, D::in, X::in, Y::in), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	mercury.runtime.GenericCall.result_call_8(Pred, A, B, C, D,
		ref Res, X, Y);
").
:- pragma foreign_proc("C#",
	result_call_9(Pred::in, Res::out, A::in, B::in, C::in, D::in, E::in,
		X::in, Y::in), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	mercury.runtime.GenericCall.result_call_9(Pred, 
		A, B, C, D, E, ref Res, X, Y);
").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

compare_type_infos(Res, TypeInfo1, TypeInfo2) :-
	( same_pointer_value(TypeInfo1, TypeInfo2) ->
		Res = (=)
	;
		NewTypeInfo1 = collapse_equivalences(TypeInfo1),
		NewTypeInfo2 = collapse_equivalences(TypeInfo2),
		( same_pointer_value(NewTypeInfo1, NewTypeInfo2) ->
			Res = (=)
		;
			compare_collapsed_type_infos(Res, TypeInfo1, TypeInfo2)
		)
	).

:- pred compare_collapsed_type_infos(comparison_result::out,
		type_info::in, type_info::in) is det.

compare_collapsed_type_infos(Res, TypeInfo1, TypeInfo2) :-
	TypeCtorInfo1 = get_type_ctor_info(TypeInfo1),
	TypeCtorInfo2 = get_type_ctor_info(TypeInfo2),

		% The comparison here is arbitrary.
		% In the past we just compared pointers of the type_c
	compare(NameRes, TypeCtorInfo1 ^ type_ctor_name,
		TypeCtorInfo2 ^ type_ctor_name),
	( NameRes = (=) ->
		compare(ModNameRes, 
			TypeCtorInfo1 ^ type_ctor_module_name,
			TypeCtorInfo2 ^ type_ctor_module_name),
		( 
			ModNameRes = (=),
			type_ctor_is_variable_arity(TypeCtorInfo1)
		->
			Arity1 = get_var_arity_typeinfo_arity(TypeInfo1),
			Arity2 = get_var_arity_typeinfo_arity(TypeInfo2),
			compare(ArityRes, Arity1, Arity2),
			( ArityRes = (=) ->
				compare_var_arity_typeinfos(1, Arity1,
						Res, TypeInfo1, TypeInfo2)
			;
				Res = ArityRes
			)
		;
			Res = ModNameRes
		)
	;
		Res = NameRes
	).

:- pred compare_var_arity_typeinfos(int::in, int::in,
		comparison_result::out, type_info::in, type_info::in) is det.

compare_var_arity_typeinfos(Loc, Arity, Result, TypeInfoA, TypeInfoB) :-
	( Loc > Arity ->
		Result = (=)
	;
		SubTypeInfoA = TypeInfoA ^ var_arity_type_info_index(Loc),
		SubTypeInfoB = TypeInfoB ^ var_arity_type_info_index(Loc),

		compare_collapsed_type_infos(SubResult,
				SubTypeInfoA, SubTypeInfoB),
		( SubResult = (=) ->
			compare_var_arity_typeinfos(Loc + 1, Arity, Result,
					TypeInfoA, TypeInfoB)
		;
			Result = SubResult
		)
	).

:- pred type_ctor_is_variable_arity(type_ctor_info::in) is semidet.
type_ctor_is_variable_arity(TypeCtorInfo) :-
	( TypeCtorInfo ^ type_ctor_rep = (pred)
	; TypeCtorInfo ^ type_ctor_rep = (func)
	; TypeCtorInfo ^ type_ctor_rep = tuple
	).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

	% In the .NET backend, we don't generally have to collapse equivalences
	% because they are already collapsed (il grades require
	% intermodule optimization, which will collapse them for us).
	% 
	% XXX For other backends this code may have to be completed.

:- func collapse_equivalences(type_info) = type_info.
collapse_equivalences(TypeInfo) = NewTypeInfo :-
	TypeCtorInfo = get_type_ctor_info(TypeInfo),
	( 
		( 
		  TypeCtorInfo ^ type_ctor_rep = equiv_ground 
		;
		  TypeCtorInfo ^ type_ctor_rep = equiv 
		)
	->
		error("rtti_implementation.m: unimplemented: collapsing equivalence types")
	;
		NewTypeInfo = TypeInfo
	).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

type_ctor_name_and_arity(TypeCtorInfo, ModuleName, Name, Arity) :-
	ModuleName = type_ctor_module_name(TypeCtorInfo),
	Name = type_ctor_name(TypeCtorInfo),
	Arity = type_ctor_arity(TypeCtorInfo).

type_ctor_and_args(TypeInfo0, TypeCtorInfo, TypeArgs) :-
	TypeInfo = collapse_equivalences(TypeInfo0),
	TypeCtorInfo = get_type_ctor_info(TypeInfo),
	( 
		type_ctor_is_variable_arity(TypeCtorInfo)
	->
		Arity = get_var_arity_typeinfo_arity(TypeInfo),
		TypeArgs = iterate(1, Arity,
			(func(X) = TypeInfo ^ var_arity_type_info_index(X))
		)
	;
		Arity = type_ctor_arity(TypeCtorInfo),
		TypeArgs = iterate(1, Arity,
			(func(X) = TypeInfo ^ type_info_index(X))
		)
	).

:- func iterate(int, int, func(int, T)) = list(T).
iterate(Start, Max, Func) = Results :-
	( Start =< Max ->
		Res = Func(Start),
		Results = [Res | iterate(Start + 1, Max, Func)]
	;
		Results = []
	).

:- pred iterate_foldl(int, int, pred(int, T, T), T, T).
:- mode iterate_foldl(in, in, pred(in, in, out) is det, in, out) is det.
iterate_foldl(Start, Max, Pred) -->
	( { Start =< Max } ->
		Pred(Start),
		iterate_foldl(Start + 1, Max, Pred)
	;
		[]
	).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

deconstruct(Term, NonCanon, Functor, Arity, Arguments) :-
	TypeInfo = get_type_info(Term),
	TypeCtorInfo = get_type_ctor_info(TypeInfo),
	TypeCtorRep = type_ctor_rep(TypeCtorInfo),
	deconstruct(Term, TypeInfo, TypeCtorInfo, TypeCtorRep,
			NonCanon, Functor, Arity, Arguments).

:- pred deconstruct(T, type_info, type_ctor_info, type_ctor_rep,
		noncanon_handling, string, int, list(std_util__univ)).
:- mode deconstruct(in, in, in, in, in(do_not_allow), out, out, out) is det.
:- mode deconstruct(in, in, in, in, in(canonicalize), out, out, out) is det.
:- mode deconstruct(in, in, in, in,
		in(include_details_cc), out, out, out) is cc_multi.
:- mode deconstruct(in, in, in, in, in, out, out, out) is cc_multi.

	% Code to perform deconstructions (XXX not yet complete).
	%
	% There are many cases to implement here, only the ones that were
	% immediately useful (e.g. called by io__write) have been implemented
	% so far.

deconstruct(Term, TypeInfo, TypeCtorInfo, TypeCtorRep,
		NonCanon, Functor, Arity, Arguments) :-
	( 
		TypeCtorRep = enum_usereq,
		handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep,
				NonCanon, Functor, Arity, Arguments)
	; 	
		TypeCtorRep = enum,
		Functor = "some_enum", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = du_usereq,
		handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep,
				NonCanon, Functor, Arity, Arguments)
	;
		TypeCtorRep = du,

		LayoutInfo = type_layout(TypeCtorInfo),
		PTag = get_primary_tag(Term),
		PTagEntry = LayoutInfo ^ ptag_index(PTag),
		SecTagLocn = PTagEntry ^ sectag_locn,
		(
			SecTagLocn = none,
			FunctorDesc = PTagEntry ^ du_sectag_alternatives(0),
			Functor = FunctorDesc ^ du_functor_name,
			Arity = FunctorDesc ^ du_functor_arity,
			Arguments = iterate(0, Arity - 1, 
				(func(X) = std_util__univ(
					get_arg(Term, X, SecTagLocn,
						FunctorDesc, TypeInfo))
				))
		;
			SecTagLocn = local,
			Functor = "some_du_local_sectag",
			Arity = 0,
			Arguments = []
		;
			SecTagLocn = remote,
			SecTag = get_remote_secondary_tag(Term),
			FunctorDesc = PTagEntry ^
				du_sectag_alternatives(SecTag),
			Functor = FunctorDesc ^ du_functor_name,
			Arity = FunctorDesc ^ du_functor_arity,
			Arguments = iterate(0, Arity - 1, 
				(func(X) = std_util__univ(
					get_arg(Term, X, SecTagLocn,
						FunctorDesc, TypeInfo))
				))
		;
			SecTagLocn = variable,
			Functor = "some_du_variable_sectag",
			Arity = 0,
			Arguments = []
		)
	;
		TypeCtorRep = notag_usereq,
		handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep,
				NonCanon, Functor, Arity, Arguments)
	;
		TypeCtorRep = notag,
		Functor = "some_notag", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = notag_ground_usereq,
		handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep,
				NonCanon, Functor, Arity, Arguments)
	;
		TypeCtorRep = notag_ground,
		Functor = "some_notag_ground", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = equiv_ground,
		Functor = "some_equiv_ground", 
		Arity = 0,
		Arguments = []
	;
		% XXX noncanonical term
		TypeCtorRep = (func),
		Functor = "<<function>>", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = equiv,
		Functor = "some_equiv", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = int,
		det_dynamic_cast(Term, Int),
		Functor = string__int_to_string(Int),
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = char,
		det_dynamic_cast(Term, Char),

		% XXX should escape characters correctly
		Functor = "'" ++ char_to_string(Char) ++ "'",
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = float,
		det_dynamic_cast(Term, Float),
		Functor = float_to_string(Float),
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = string,
		det_dynamic_cast(Term, String),

		% XXX should escape characters in the string correctly
		Functor = "\"" ++ String ++ "\"",
		Arity = 0,
		Arguments = []
	;
		% XXX noncanonical term
		TypeCtorRep = (pred),
		Functor = "<<predicate>>", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = tuple,
		type_ctor_and_args(TypeInfo, _TypeCtorInfo, TypeArgs),
		Functor = "{}", 
		Arity = get_var_arity_typeinfo_arity(TypeInfo),
		list__map_foldl(
			(pred(TI::in, U::out, Index::in, Next::out) is det :-
				SubTerm = get_subterm(TI, Term, Index, 0),
				U = std_util__univ(SubTerm),
				Next = Index + 1
			), TypeArgs, Arguments, 0, _)
	;
		% XXX noncanonical term
		TypeCtorRep = subgoal,
		Functor = "<<subgoal>>", 
		Arity = 0,
		Arguments = []
	;
		% There is no way to create values of type `void', so this
		% should never happen.
		TypeCtorRep = void,
		error("rtti_implementation.m: cannot deconstruct void types")
	;
		% XXX noncanonical term
		TypeCtorRep = c_pointer,
		Functor = "<<c_pointer>>", 
		Arity = 0,
		Arguments = []
	;
		% XXX noncanonical term
		TypeCtorRep = stable_c_pointer,
		Functor = "<<stable_c_pointer>>", 
		Arity = 0,
		Arguments = []
	;
		% XXX noncanonical term
		TypeCtorRep = typeinfo,
		Functor = "some_typeinfo", 
		Arity = 0,
		Arguments = []
	;
		% XXX noncanonical term
		TypeCtorRep = typeclassinfo,
		Functor = "<<typeclassinfo>>", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = array,

		% Constrain the T in array(T) to the correct element type.
		std_util__type_ctor_and_args(std_util__type_of(Term), _, Args),
		( Args = [ElemType] ->
			std_util__has_type(Elem, ElemType),
			same_array_elem_type(Array, Elem)
		;
			error("An array which doesn't have a type_ctor arg")
		),

		det_dynamic_cast(Term, Array),

		Functor = "<<array>>", 
		Arity = array__size(Array),
		Arguments = array__foldr(
				(func(Elem, List) =
					[std_util__univ(Elem) | List]),
				Array, [])
	;
		TypeCtorRep = succip,
		Functor = "<<succip>>", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = hp,
		Functor = "<<hp>>", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = curfr,
		Functor = "<<curfr>>", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = maxfr,
		Functor = "<<maxfr>>", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = redofr,
		Functor = "<<redofr>>", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = redoip,
		Functor = "<<redoip>>", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = trail_ptr,
		Functor = "<<trail_ptr>>", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = ticket,
		Functor = "<<ticket>>", 
		Arity = 0,
		Arguments = []
	;
		% XXX FIXME!!!
		TypeCtorRep = reserved_addr,
		Functor = "some_reserved_addr", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = reserved_addr_usereq,
		handle_usereq_type(Term, TypeInfo, TypeCtorInfo, TypeCtorRep,
				NonCanon, Functor, Arity, Arguments)
	;
		% XXX noncanonical term
		TypeCtorRep = type_ctor_info,
		Functor = "some_typectorinfo", 
		Arity = 0,
		Arguments = []
	;
		% XXX noncanonical term
		TypeCtorRep = base_typeclass_info,
		Functor = "<<basetypeclassinfo>>", 
		Arity = 0,
		Arguments = []
	;
		% XXX noncanonical term
		TypeCtorRep = type_desc,
		Functor = "some_type_desc", 
		Arity = 0,
		Arguments = []
	;
		% XXX noncanonical term
		TypeCtorRep = type_ctor_desc,
		Functor = "some_type_ctor_desc", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = foreign,
		Functor = "<<foreign>>", 
		Arity = 0,
		Arguments = []
	;
		% XXX noncanonical term
		TypeCtorRep = reference,
		Functor = "<<reference>>", 
		Arity = 0,
		Arguments = []
	;
		TypeCtorRep = unknown,
		error("rtti_implementation: unknown type_ctor rep in deconstruct")
	).

:- pred det_dynamic_cast(T::in, U::out) is det.

det_dynamic_cast(Term, Actual) :-
	std_util__type_to_univ(Term, Univ),
	std_util__det_univ_to_type(Univ, Actual).

:- pred same_array_elem_type(array(T)::unused, T::unused) is det.
same_array_elem_type(_, _).


:- inst usereq == bound(enum_usereq; du_usereq; notag_usereq;
				notag_ground_usereq; reserved_addr_usereq).

:- pred handle_usereq_type(T, type_info, type_ctor_info, type_ctor_rep,
		noncanon_handling, string, int, list(std_util__univ)).

:- mode handle_usereq_type(in, in, in, in(usereq),
		in(do_not_allow), out, out, out) is erroneous.
:- mode handle_usereq_type(in, in, in, in(usereq),
		in(canonicalize), out, out, out) is det.
:- mode handle_usereq_type(in, in, in, in(usereq),
		in(include_details_cc), out, out, out) is cc_multi.
:- mode handle_usereq_type(in, in, in, in(usereq),
		in, out, out, out) is cc_multi.


handle_usereq_type(Term, TypeInfo, TypeCtorInfo,
		TypeCtorRep, NonCanon, Functor, Arity, Arguments) :-
	( NonCanon = do_not_allow,
		error("attempt to deconstruct noncanonical term")
	; NonCanon = canonicalize,
		Functor = expand_type_name(TypeCtorInfo, yes),
		Arity = 0,
		Arguments = []
	; NonCanon = include_details_cc,
		( TypeCtorRep = enum_usereq,
			BaseTypeCtorRep = enum
		; TypeCtorRep = du_usereq,
			BaseTypeCtorRep = du
		; TypeCtorRep = notag_usereq,
			BaseTypeCtorRep = notag
		; TypeCtorRep = notag_ground_usereq,
			BaseTypeCtorRep = notag_ground
		; TypeCtorRep = reserved_addr_usereq,
			BaseTypeCtorRep = reserved_addr
		),
		deconstruct(Term, TypeInfo, TypeCtorInfo, BaseTypeCtorRep,
				NonCanon, Functor, Arity, Arguments)
	).


	% MR_expand_type_name from mercury_deconstruct.c
:- func expand_type_name(type_ctor_info, bool) = string.

expand_type_name(TypeCtorInfo, Wrap) = Name :-
	( Wrap = yes ->
		FmtStr = "<<%s.%s/%d>>"
	;
		FmtStr = "%s.%s/%d"
	),
	Name = string__format(FmtStr, [s(TypeCtorInfo ^ type_ctor_module_name),
			s(TypeCtorInfo ^ type_ctor_name),
			i(TypeCtorInfo ^ type_ctor_arity)]).

	% Retrieve an argument number from a term, given the functor
	% descriptor.

:- some [T] func get_arg(U, int, sectag_locn, du_functor_desc, type_info) = T.

get_arg(Term, Index, SecTagLocn, FunctorDesc, TypeInfo) = (Arg) :-
	( ExistInfo = FunctorDesc ^ du_functor_exist_info ->
		ExtraArgs = (ExistInfo ^ exist_info_typeinfos_plain) + 
				(ExistInfo ^ exist_info_tcis)
	;
		ExtraArgs = 0
	),

	ArgTypes = FunctorDesc ^ du_functor_arg_types,
	PseudoTypeInfo = get_pti_from_arg_types(ArgTypes, Index),
	get_arg_type_info(TypeInfo, PseudoTypeInfo, Term,
			FunctorDesc, ArgTypeInfo),
	( ( SecTagLocn = none ; high_level_data ) ->
		TagOffset = 0
	;
		TagOffset = 1
	),
	RealArgsOffset = TagOffset + ExtraArgs,
	Arg = get_subterm(ArgTypeInfo, Term, Index, RealArgsOffset).

:- pred high_level_data is semidet.
:- pragma promise_pure(high_level_data/0).
:- pragma foreign_proc("C#",
	high_level_data,
	[will_not_call_mercury, thread_safe],
"
#if MR_HIGHLEVEL_DATA
	SUCCESS_INDICATOR = true;
#else
	SUCCESS_INDICATOR = false;
#endif
").
high_level_data :-
	( std_util__semidet_succeed ->
		private_builtin__sorry("high_level_data")
	;
		std_util__semidet_succeed
	).

:- pred get_arg_type_info(type_info::in, P::in, T::in,
	du_functor_desc::in, type_info::out) is det.

get_arg_type_info(TypeInfoParams, PseudoTypeInfo, Term,
		FunctorDesc, ArgTypeInfo) :-
	( 
		typeinfo_is_variable(PseudoTypeInfo, VarNum)
	->
		get_type_info_for_var(TypeInfoParams,
			VarNum, Term, FunctorDesc, ExpandedTypeInfo),
		( typeinfo_is_variable(ExpandedTypeInfo, _) ->
			error("get_arg_type_info: unbound type variable")
		;
			ArgTypeInfo = ExpandedTypeInfo
		)
	;
		CastTypeInfo = type_info_cast(PseudoTypeInfo),
		TypeCtorInfo = get_type_ctor_info(CastTypeInfo),
		( 
			type_ctor_is_variable_arity(TypeCtorInfo)
		->
			Arity = pseudotypeinfo_get_higher_order_arity(
				CastTypeInfo),
			StartRegionSize = 2
		;
			Arity = TypeCtorInfo ^ type_ctor_arity,
			StartRegionSize = 1
		),
		ArgTypeInfo0 = std_util__no,
		UpperBound = Arity + StartRegionSize - 1,

		iterate_foldl(StartRegionSize, UpperBound,
			(pred(I::in, TI0::in, TI::out) is det :-

				PTI = get_pti_from_type_info(CastTypeInfo, I),
				get_arg_type_info(TypeInfoParams, PTI,
					Term, FunctorDesc, ETypeInfo),
				( 
					same_pointer_value_untyped(
						ETypeInfo, PTI)
				->
					TI = TI0
				;
					TI0 = std_util__yes(TypeInfo0)
				->
					unsafe_promise_unique(TypeInfo0,
						TypeInfo1),
					update_type_info_index(I, 
						ETypeInfo, TypeInfo1, TypeInfo),
					TI = std_util__yes(TypeInfo)
				;
					NewTypeInfo0 = new_type_info(
						CastTypeInfo, UpperBound),
					update_type_info_index(I, 
						ETypeInfo, NewTypeInfo0, 
						NewTypeInfo),
					TI = std_util__yes(NewTypeInfo)
				)
			), ArgTypeInfo0, MaybeArgTypeInfo),
		( MaybeArgTypeInfo = std_util__yes(ArgTypeInfo1) ->
			ArgTypeInfo = ArgTypeInfo1
		;
			ArgTypeInfo = CastTypeInfo
		)
	).

	% XXX this is completely unimplemented.
:- func pseudotypeinfo_get_higher_order_arity(type_info) = int.
pseudotypeinfo_get_higher_order_arity(_) = 1 :-
	det_unimplemented("pseudotypeinfo_get_higher_order_arity").

	% Make a new type-info with the given arity, using the given type_info
	% as the basis.

:- func new_type_info(type_info::in, int::in) = (type_info::uo) is det.
new_type_info(TypeInfo::in, _::in) = (NewTypeInfo::uo) :- 
	unsafe_promise_unique(TypeInfo, NewTypeInfo),
	det_unimplemented("new_type_info").

:- pragma foreign_proc("C#",
	new_type_info(OldTypeInfo::in, Arity::in) = (NewTypeInfo::uo),
	[promise_pure],
"
	NewTypeInfo = new object[Arity + 1];
	System.Array.Copy(OldTypeInfo, NewTypeInfo, OldTypeInfo.Length);
").

	% Get the pseudo-typeinfo at the given index from the argument types.
	
:- some [T] func get_pti_from_arg_types(arg_types, int) = T.

get_pti_from_arg_types(_::in, _::in) = (42::out) :-
	det_unimplemented("get_pti_from_arg_types").

:- pragma foreign_proc("C#",
	get_pti_from_arg_types(ArgTypes::in, Index::in) =
		(ArgTypeInfo::out), [promise_pure], "
	ArgTypeInfo = ArgTypes[Index];
").

	% Get the pseudo-typeinfo at the given index from a type-info.

:- some [T] func get_pti_from_type_info(type_info, int) = T.

get_pti_from_type_info(_::in, _::in) = (42::out) :-
	det_unimplemented("get_pti_from_type_info").

:- pragma foreign_proc("C#",
	get_pti_from_type_info(TypeInfo::in, Index::in) = (PTI::out),
	[promise_pure],
"
	PTI = TypeInfo[Index];
").

	% Get the type info for a particular type variable number
	% (it might be in the type_info or in the term itself).
	%
	% XXX existentially quantified vars are not yet handled.
	
:- pred get_type_info_for_var(
		type_info::in, int::in, T::in, du_functor_desc::in,
		type_info::out) is det.

get_type_info_for_var(TypeInfo, VarNum, Term, FunctorDesc, ArgTypeInfo) :-
	(
		type_variable_is_univ_quant(VarNum) 
	->
		ArgTypeInfo = TypeInfo ^ type_info_index(VarNum)
	;
		( ExistInfo0 = FunctorDesc ^ du_functor_exist_info ->
			ExistInfo = ExistInfo0
		;
			error("get_type_info_for_var no exist_info")
		),

		ExistVarNum = VarNum - pseudotypeinfo_exist_var_base - 1,
		ExistLocn = ExistInfo ^ typeinfo_locns_index(ExistVarNum),
		Slot = ExistLocn ^ exist_arg_num,
		Offset = ExistLocn ^ exist_offset_in_tci,
		
		SlotMaybeTypeInfo = get_typeinfo_from_term(Term, Slot),
		( Offset < 0 ->
			ArgTypeInfo = SlotMaybeTypeInfo
		;
			ArgTypeInfo = typeclass_info_type_info(
				SlotMaybeTypeInfo, Offset)
		)
	).

	% An unchecked cast to type_info (for pseudo-typeinfos).

:- func type_info_cast(T) = type_info.

type_info_cast(X) = unsafe_cast(X).

	% Get a subterm term, given its type_info, the original term, its
	% index and the start region size.

:- some [T] func get_subterm(type_info, U, int, int) = T.

get_subterm(_::in, _::in, _::in, _::in) = (42::out) :-
	det_unimplemented("get_subterm").

:- pragma foreign_proc("C#",
	get_subterm(TypeInfo::in, Term::in, Index::in,
		ExtraArgs::in) = (Arg::out), [promise_pure], "
	int i = Index + ExtraArgs;
	try {
		// try low level data
		Arg = ((object[]) Term)[i];
	} catch (System.InvalidCastException) {
		// try high level data
		Arg = Term.GetType().GetFields()[i].GetValue(Term);
	}
	TypeInfo_for_T = TypeInfo;
").

	% Test whether a type info is variable.

:- pred typeinfo_is_variable(T::in, int::out) is semidet.

typeinfo_is_variable(_::in, 42::out) :-
	semidet_unimplemented("typeinfo_is_variable").

:- pragma foreign_proc("C#",
	typeinfo_is_variable(TypeInfo::in, VarNum::out), [promise_pure], "
	try {
		VarNum = System.Convert.ToInt32(TypeInfo);
		SUCCESS_INDICATOR = true;
	}
	catch (System.Exception e) {
		SUCCESS_INDICATOR = false;
	}
").

	% Tests for universal and existentially quantified variables.

:- pred type_variable_is_univ_quant(int::in) is semidet.
:- pred type_variable_is_exist_quant(int::in) is semidet.

type_variable_is_exist_quant(X) :- X > pseudotypeinfo_exist_var_base.
type_variable_is_univ_quant(X) :- X =< pseudotypeinfo_exist_var_base.

:- func pseudotypeinfo_exist_var_base = int.
:- func pseudotypeinfo_max_var = int.

pseudotypeinfo_exist_var_base = 512.
pseudotypeinfo_max_var = 1024.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% XXX we have only implemented the .NET backend for the low-level data case.

:- func get_type_ctor_info(type_info) = type_ctor_info is det.

:- pragma foreign_code("C#", "

	// The field numbers of the contents of type_infos.
	enum fixed_arity_ti {
		type_ctor_info		= 0,
		arg_type_infos		= 1
	}

	enum var_arity_ti {
		type_ctor_info		= 0,
		arity			= 1,
		arg_type_infos		= 2
	}

	// The field numbers of the contents of type_ctor_infos.
	// Fill this in as you add new field accessors.

	enum type_ctor_info_field_nums {
		type_ctor_arity 	= 0,
		// type_ctor_version	= 1,
		type_ctor_num_ptags	= 2,
		type_ctor_rep		= 3,
		type_ctor_unify_pred 	= 4,
		type_ctor_compare_pred	= 5,
		type_ctor_module_name	= 6,
		type_ctor_name		= 7,
		type_functors		= 8,
		type_layout		= 9,
		type_ctor_num_functors	= 10,
		type_ctor_flags		= 11
	}

	enum ptag_layout_field_nums {
		sectag_sharers		= 0,
		sectag_locn		= 1,
		sectag_alternatives	= 2
	}

	enum du_functor_field_nums {
		du_functor_name		= 0,
		du_functor_orig_arity	= 1,
		du_functor_arg_type_contains_var = 2,
		du_functor_sectag_locn	= 3,
		du_functor_primary	= 4,
		du_functor_secondary	= 5,
		du_functor_ordinal	= 6,
		du_functor_arg_types	= 7,
		du_functor_arg_names	= 8,
		du_functor_exist_info	= 9
	}

	enum exist_info_field_nums {
		typeinfos_plain		= 0,
		typeinfos_in_tci	= 1,
		tcis			= 2,
		typeinfo_locns		= 3
	}

	enum exist_locn_field_nums {
		exist_arg_num			= 0,
		exist_offset_in_tci		= 1
	}

").

:- pragma foreign_proc("C#",
	get_type_ctor_info(TypeInfo::in) = (TypeCtorInfo::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	try {
		TypeCtorInfo = (object[]) TypeInfo[0];
	} catch (System.InvalidCastException) {
		TypeCtorInfo = TypeInfo;
	}
").

:- pragma foreign_proc("C",
	get_type_ctor_info(TypeInfo::in) = (TypeCtorInfo::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	TypeCtorInfo = (MR_Word) MR_TYPEINFO_GET_TYPE_CTOR_INFO(
		(MR_TypeInfo) TypeInfo);
").

get_type_ctor_info(_) = _ :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("get_type_ctor_info").

:- pred same_pointer_value(T::in, T::in) is semidet.
:- pred same_pointer_value_untyped(T::in, U::in) is semidet.

same_pointer_value(X, Y) :- same_pointer_value_untyped(X, Y).

:- pragma foreign_proc("C#",
	same_pointer_value_untyped(T1::in, T2::in),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	SUCCESS_INDICATOR = (T1 == T2);
").

:- pragma foreign_proc("C",
	same_pointer_value_untyped(T1::in, T2::in), 
	[will_not_call_mercury, promise_pure, thread_safe],
"
	SUCCESS_INDICATOR = (T1 == T2);
").

same_pointer_value_untyped(_, _) :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("same_pointer_value_untyped").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- func get_primary_tag(T) = int.
:- func get_remote_secondary_tag(T) = int.

get_primary_tag(_::in) = (0::out) :- 
	det_unimplemented("get_primary_tag").

get_remote_secondary_tag(_::in) = (0::out) :- 
	det_unimplemented("get_remote_secondary_tag").

:- pragma foreign_proc("C#",
	get_primary_tag(X::in) = (Tag::out), [promise_pure], "
	// We don't look at X to find the tag, for .NET low-level data
	// there is no primary tag, so we always return zero.
	Tag = 0;
").

:- pragma foreign_proc("C#",
	get_remote_secondary_tag(X::in) = (Tag::out), [promise_pure], "
	try {
		// try the low-level data representation
		object[] data = (object[]) X;
		Tag = (int) data[0];
	} catch (System.InvalidCastException) {
		// try the high-level data representation
		Tag = (int) X.GetType().GetField(""data_tag"").GetValue(X);
	}
").

:- type sectag_locn ---> none ; local ; remote ; variable.

:- type du_sectag_alternatives ---> du_sectag_alternatives(c_pointer).

:- type ptag_entry ---> ptag_entry(c_pointer).

:- type arg_types ---> arg_types(c_pointer).

:- type arg_names ---> arg_names(c_pointer).

:- type exist_info ---> exist_info(c_pointer).

:- type typeinfo_locn ---> typeinfo_locn(c_pointer).

:- func ptag_index(int, type_layout) = ptag_entry.

	% This is an "unimplemented" definition in Mercury, which will be
	% used by default.

ptag_index(_::in, TypeLayout::in) = (unsafe_cast(TypeLayout)::out) :- 
	det_unimplemented("ptag_index").

:- pragma foreign_proc("C#",
	ptag_index(X::in, TypeLayout::in) = (PtagEntry::out), [promise_pure], "
	PtagEntry = (object[]) TypeLayout[X];
").

:- func sectag_locn(ptag_entry) = sectag_locn.

sectag_locn(PTagEntry::in) = (unsafe_cast(PTagEntry)::out) :- 
	det_unimplemented("sectag_locn").

:- pragma foreign_proc("C#",
	sectag_locn(PTagEntry::in) = (SectagLocn::out), [promise_pure], "
	SectagLocn = mercury.runtime.LowLevelData.make_enum((int)
		PTagEntry[(int) ptag_layout_field_nums.sectag_locn]);
").

:- func du_sectag_alternatives(int, ptag_entry) = du_functor_desc.

du_sectag_alternatives(_::in, PTagEntry::in) = (unsafe_cast(PTagEntry)::out) :- 
	det_unimplemented("sectag_alternatives").

:- pragma foreign_proc("C#",
	du_sectag_alternatives(X::in, PTagEntry::in) =
		(FunctorDescriptor::out), [promise_pure], "
	object[] sectag_alternatives;
	sectag_alternatives = (object []) 
		PTagEntry[(int) ptag_layout_field_nums.sectag_alternatives];
	FunctorDescriptor = (object []) sectag_alternatives[X];
").

:- func typeinfo_locns_index(int, exist_info) = typeinfo_locn.

typeinfo_locns_index(X::in, _::in) = (unsafe_cast(X)::out) :- 
	det_unimplemented("typeinfo_locns_index").

:- pragma foreign_proc("C#",
	typeinfo_locns_index(X::in, ExistInfo::in) = (TypeInfoLocn::out),
	[promise_pure],
"
	TypeInfoLocn = (object[]) ((object[]) ExistInfo[(int)
			exist_info_field_nums.typeinfo_locns])[X];
").

:- func exist_info_typeinfos_plain(exist_info) = int.

exist_info_typeinfos_plain(X::in) = (unsafe_cast(X)::out) :- 
	det_unimplemented("exist_info_typeinfos_plain").

:- pragma foreign_proc("C#",
	exist_info_typeinfos_plain(ExistInfo::in) = (TypeInfosPlain::out),
	[promise_pure],
"
	TypeInfosPlain = (int)
		ExistInfo[(int)
			exist_info_field_nums.typeinfos_plain];
").

:- func exist_info_tcis(exist_info) = int.

exist_info_tcis(X::in) = (unsafe_cast(X)::out) :- 
	det_unimplemented("exist_info_tcis").

:- pragma foreign_proc("C#",
	exist_info_tcis(ExistInfo::in) = (TCIs::out), [promise_pure], "
	TCIs = (int) ExistInfo[(int)
			exist_info_field_nums.tcis];
").

:- func exist_arg_num(typeinfo_locn) = int.

exist_arg_num(X::in) = (unsafe_cast(X)::out) :- 
	det_unimplemented("exist_arg_num").

:- pragma foreign_proc("C#",
	exist_arg_num(TypeInfoLocn::in) = (ArgNum::out), [promise_pure], "
	ArgNum = (int) TypeInfoLocn[(int) exist_locn_field_nums.exist_arg_num];
		
").

:- func exist_offset_in_tci(typeinfo_locn) = int.

exist_offset_in_tci(X::in) = (unsafe_cast(X)::out) :- 
	det_unimplemented("exist_arg_num").

:- pragma foreign_proc("C#",
	exist_offset_in_tci(TypeInfoLocn::in) = (ArgNum::out), [promise_pure], "
	ArgNum = (int)
		TypeInfoLocn[(int) exist_locn_field_nums.exist_offset_in_tci];
		
").

:- func get_typeinfo_from_term(U, int) = type_info.

get_typeinfo_from_term(_::in, X::in) = (unsafe_cast(X)::out) :- 
	det_unimplemented("get_typeinfo_from_term").

:- pragma foreign_proc("C#",
	get_typeinfo_from_term(Term::in, Index::in) = (TypeInfo::out),
	[promise_pure],
"
	try {
		TypeInfo = (object[]) ((object[]) Term)[Index];
	} catch (System.InvalidCastException) {
		// try high level data
		TypeInfo = (object[])
			Term.GetType().GetFields()[Index].GetValue(Term);
	}
").

:- func typeclass_info_type_info(type_info, int) = type_info.

typeclass_info_type_info(TypeClassInfo, Index) = unsafe_cast(TypeInfo) :-
	private_builtin__type_info_from_typeclass_info(
		unsafe_cast(TypeClassInfo)
			`with_type` private_builtin__typeclass_info(int),
		Index, TypeInfo
			`with_type` private_builtin__type_info(int)).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- func var_arity_type_info_index(int, type_info) = type_info.

var_arity_type_info_index(Index, TypeInfo) =
	TypeInfo ^ type_info_index(Index + 1).

:- func type_info_index(int, type_info) = type_info.

	% This is an "unimplemented" definition in Mercury, which will be
	% used by default.

type_info_index(_::in, TypeInfo::in) = (TypeInfo::out) :- 
	det_unimplemented("type_info_index").

:- pragma foreign_proc("C#",
	type_info_index(X::in, TypeInfo::in) = (TypeInfoAtIndex::out),
	[will_not_call_mercury, promise_pure],
"
	TypeInfoAtIndex = (object[]) TypeInfo[X];
").

:- pred update_type_info_index(int::in, type_info::in, type_info::di,
		type_info::uo) is det.

update_type_info_index(_::in, _::in, X::di, X::uo) :- 
	det_unimplemented("type_info_index").

:- pragma foreign_proc("C#",
	update_type_info_index(X::in, NewValue::in, OldTypeInfo::di,
		NewTypeInfo::uo), [will_not_call_mercury, promise_pure], "
	OldTypeInfo[X] = NewValue;
	NewTypeInfo = OldTypeInfo;
").

:- pred semidet_unimplemented(string::in) is semidet.
semidet_unimplemented(S) :-
	( std_util__semidet_succeed ->
		error("rtti_implementation: unimplemented: " ++ S)
	;
		std_util__semidet_succeed
	).

:- pred det_unimplemented(string::in) is det.
det_unimplemented(S) :-
	( std_util__semidet_succeed ->
		error("rtti_implementation: unimplemented: " ++ S)
	;
		true
	).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- func type_ctor_arity(type_ctor_info) = int.
:- pragma foreign_proc("C#",
	type_ctor_arity(TypeCtorInfo::in) = (Arity::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	Arity = (int) TypeCtorInfo[
			(int) type_ctor_info_field_nums.type_ctor_arity];
").
:- pragma foreign_proc("C",
	type_ctor_arity(TypeCtorInfo::in) = (Arity::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
	Arity = tci->MR_type_ctor_arity;
").
type_ctor_arity(_) = _ :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("type_ctor_arity").

:- some [P] func type_ctor_unify_pred(type_ctor_info) = P.
:- pragma foreign_proc("C#",
	type_ctor_unify_pred(TypeCtorInfo::in) = (UnifyPred::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	UnifyPred = TypeCtorInfo[
			(int) type_ctor_info_field_nums.type_ctor_unify_pred];
").
:- pragma foreign_proc("C",
	type_ctor_unify_pred(TypeCtorInfo::in) = (UnifyPred::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
	UnifyPred = (MR_Integer) tci->MR_type_ctor_unify_pred;
").
type_ctor_unify_pred(_) = "dummy value" :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("type_ctor_unify_pred").

:- some [P] func type_ctor_compare_pred(type_ctor_info) = P.
:- pragma foreign_proc("C#",
	type_ctor_compare_pred(TypeCtorInfo::in) = (UnifyPred::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	UnifyPred = TypeCtorInfo[
			(int) type_ctor_info_field_nums.type_ctor_compare_pred];
").

:- pragma foreign_proc("C",
	type_ctor_compare_pred(TypeCtorInfo::in) = (UnifyPred::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
	UnifyPred = (MR_Integer) tci->MR_type_ctor_compare_pred;
").

type_ctor_compare_pred(_) = "dummy value" :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("type_ctor_compare_pred").

:- func type_ctor_rep(type_ctor_info) = type_ctor_rep.
:- pragma foreign_proc("C#",
	type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	int rep;
	rep = (int) TypeCtorInfo[
		(int) type_ctor_info_field_nums.type_ctor_rep];
	TypeCtorRep = mercury.runtime.LowLevelData.make_enum(rep);
").
:- pragma foreign_proc("C",
	type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
	TypeCtorRep = MR_type_ctor_rep(tci);
").
type_ctor_rep(_) = _ :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("type_ctor_rep").

:- func type_ctor_module_name(type_ctor_info) = string.

:- pragma foreign_proc("C#",
	type_ctor_module_name(TypeCtorInfo::in) = (Name::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	Name = (string)
		TypeCtorInfo[(int)
		type_ctor_info_field_nums.type_ctor_module_name];
").

:- pragma foreign_proc("C",
	type_ctor_module_name(TypeCtorInfo::in) = (Name::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
	Name = (MR_String) MR_type_ctor_module_name(tci);
").

type_ctor_module_name(_) = _ :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("type_ctor_module_name").

:- func type_ctor_name(type_ctor_info) = string.

:- pragma foreign_proc("C#",
	type_ctor_name(TypeCtorInfo::in) = (Name::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	Name = (string)
		TypeCtorInfo[(int) type_ctor_info_field_nums.type_ctor_name];
").
:- pragma foreign_proc("C",
	type_ctor_name(TypeCtorInfo::in) = (Name::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
	Name = (MR_String) MR_type_ctor_name(tci);
").

type_ctor_name(_) = _ :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("type_ctor_name").



:- func type_ctor_functors(type_ctor_info) = type_functors.

:- pragma foreign_proc("C#",
	type_ctor_functors(TypeCtorInfo::in) = (Functors::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	Functors = (object[])
		TypeCtorInfo[(int) type_ctor_info_field_nums.type_functors];
").

type_ctor_functors(_) = _ :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("type_ctor_functors").



:- func type_layout(type_ctor_info) = type_layout.

:- pragma foreign_proc("C#",
	type_layout(TypeCtorInfo::in) = (TypeLayout::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	TypeLayout = (object[])
		TypeCtorInfo[(int) type_ctor_info_field_nums.type_layout];
").
:- pragma foreign_proc("C",
	type_layout(TypeCtorInfo::in) = (TypeLayout::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
	TypeLayout = (MR_Word) &(MR_type_ctor_layout(tci));
").

type_layout(_) = _ :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("type_layout").

:- func type_ctor_num_functors(type_ctor_info) = int.

:- pragma foreign_proc("C#",
	type_ctor_num_functors(TypeCtorInfo::in) = (TypeLayout::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	TypeLayout = (int)
		TypeCtorInfo[(int)
			type_ctor_info_field_nums.type_ctor_num_functors];
").

type_ctor_num_functors(_) = _ :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("type_ctor_num_functors").

:- pragma foreign_proc("C",
	unsafe_cast(VarIn::in) = (VarOut::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	VarOut = VarIn;
").
:- pragma foreign_proc("C#",
	unsafe_cast(VarIn::in) = (VarOut::out),
	[will_not_call_mercury, promise_pure, thread_safe],
"
	VarOut = VarIn;
").

unsafe_cast(_) = _ :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("unsafe_cast").

%-----------------------------------------------------------------------------%
%
% TypeFunctors
%
:- type type_functors ---> type_functors(c_pointer).
:- type du_functor_desc ---> du_functor_desc(c_pointer).
:- type enum_functor_desc ---> enum_functor_desc(c_pointer).
:- type notag_functor_desc ---> notag_functor_desc(c_pointer).

:- inst du == bound(du; du_usereq; reserved_addr; reserved_addr_usereq).
:- inst enum == bound(enum ; enum_usereq).
:- inst notag == bound(notag ; notag_usereq ;
				notag_ground ; notag_ground_usereq).

:- func du_functor_desc(type_ctor_rep, int, type_functors) = du_functor_desc.
:- mode du_functor_desc(in(du), in, in) = out is det.

du_functor_desc(_, Num, TypeFunctors) = DuFunctorDesc :-
	DuFunctorDesc = TypeFunctors ^ unsafe_index(Num).

:- func du_functor_name(du_functor_desc) = string.
du_functor_name(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(0).

:- func du_functor_arity(du_functor_desc) = int.
du_functor_arity(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(1).

:- func du_functor_arg_type_contains_var(du_functor_desc) = int.
du_functor_arg_type_contains_var(DuFunctorDesc) =
		DuFunctorDesc ^ unsafe_index(2).

:- func du_functor_sectag_locn(du_functor_desc) = sectag_locn.
du_functor_sectag_locn(DuFunctorDesc) =
	unsafe_make_enum(DuFunctorDesc ^ unsafe_index(3)).

:- func du_functor_primary(du_functor_desc) = int.
du_functor_primary(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(4).

:- func du_functor_secondary(du_functor_desc) = int.
du_functor_secondary(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(5).

:- func du_functor_ordinal(du_functor_desc) = int.
du_functor_ordinal(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(6).

:- func du_functor_arg_types(du_functor_desc) = arg_types.
du_functor_arg_types(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(7).

:- func du_functor_arg_names(du_functor_desc::in) = (arg_names::out) is semidet.
du_functor_arg_names(DuFunctorDesc) = ArgNames :-
	ArgNames = DuFunctorDesc ^ unsafe_index(8),
	not null(ArgNames).

:- func du_functor_exist_info(du_functor_desc::in) =
		(exist_info::out) is semidet.
du_functor_exist_info(DuFunctorDesc) = ExistInfo :-
	ExistInfo = DuFunctorDesc ^ unsafe_index(9),
	not null(ExistInfo).

 %--------------------------%

:- func enum_functor_desc(type_ctor_rep, int, type_functors)
		= enum_functor_desc.
:- mode enum_functor_desc(in(enum), in, in) = out is det.

enum_functor_desc(_, Num, TypeFunctors) = EnumFunctorDesc :-
	EnumFunctorDesc = TypeFunctors ^ unsafe_index(Num).

:- func enum_functor_name(enum_functor_desc) = string.
enum_functor_name(EnumFunctorDesc) = EnumFunctorDesc ^ unsafe_index(0).

:- func enum_functor_ordinal(enum_functor_desc) = int.
enum_functor_ordinal(EnumFunctorDesc) = EnumFunctorDesc ^ unsafe_index(1).

 %--------------------------%

:- func notag_functor_desc(type_ctor_rep, int, type_functors)
		= notag_functor_desc.
:- mode notag_functor_desc(in(notag), in, in) = out is det.

notag_functor_desc(_, Num, TypeFunctors) = NoTagFunctorDesc :-
	NoTagFunctorDesc = TypeFunctors ^ unsafe_index(Num).

:- func notag_functor_name(notag_functor_desc) = string.
notag_functor_name(NoTagFunctorDesc) = NoTagFunctorDesc ^ unsafe_index(0).

:- func notag_functor_arg_type(notag_functor_desc) = type_info.
notag_functor_arg_type(NoTagFunctorDesc) = NoTagFunctorDesc ^ unsafe_index(1).

:- func notag_functor_arg_name(notag_functor_desc) = string.
notag_functor_arg_name(NoTagFunctorDesc) = NoTagFunctorDesc ^ unsafe_index(2).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- func unsafe_index(int, T) = U.
:- pragma foreign_proc("C#",
	unsafe_index(Num::in, Array::in) = (Item::out),
	[will_not_call_mercury, thread_safe, promise_pure],
"
	Item = ((object []) Array)[Num];
").
unsafe_index(_, _) = _ :-
	private_builtin__sorry("rtti_implementation__unsafe_index").

 %--------------------------%

:- func unsafe_make_enum(int) = T.
:- pragma foreign_proc("C#", unsafe_make_enum(Num::in) = (Enum::out),
	[will_not_call_mercury, thread_safe, promise_pure],
"
	Enum = mercury.runtime.LowLevelData.make_enum(Num);
").
unsafe_make_enum(_) = _ :-
	private_builtin__sorry("rtti_implementation__unsafe_make_enum").

 %--------------------------%

:- pred null(T::in) is semidet.
:- pragma foreign_proc("C",
	null(S::in),
	[will_not_call_mercury, thread_safe, promise_pure],
"
	SUCCESS_INDICATOR = ((void *)S == NULL);
").
:- pragma foreign_proc("C#",
	null(S::in),
	[will_not_call_mercury, thread_safe, promise_pure],
"
	SUCCESS_INDICATOR = (S == null);
").
null(_) :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("rtti_implementation__null/1").

 %--------------------------%

:- func null_string = string.
:- pragma foreign_proc("C",
	null_string = (Str::out),
	[will_not_call_mercury, thread_safe, promise_pure],
"
	Str = NULL;
").
:- pragma foreign_proc("C#",
	null_string = (Str::out),
	[will_not_call_mercury, thread_safe, promise_pure],
"
	Str = null;
").
null_string = _ :-
	% This version is only used for back-ends for which there is no
	% matching foreign_proc version.
	private_builtin__sorry("rtti_implementation__null_string/0").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%