:- module type_desc.
:- use_module bool, builtin, list, private_builtin, require, rtti_implementation, string.
:- type (type_desc:type_desc).
:- type (type_desc:type_ctor_desc).
:- pragma foreign_import_module("C", type_desc).
:- pragma foreign_proc("C", type_desc:type_of(_Value :: (builtin:unused)) = (TypeInfo :: (builtin:out)), [will_not_call_mercury, thread_safe, not_tabled_for_io, promise_pure], "{
	TypeInfo = TypeInfo_for_T;

	/*
	** We used to collapse equivalences for efficiency here,
	** but that\'s not always desirable, due to the reverse
	** mode of make_type/2, and efficiency of type_infos
	** probably isn\'t very important anyway.
	*/
#if 0
	MR_save_transient_registers();
	TypeInfo = (MR_Word) MR_collapse_equivalences(
		(MR_TypeInfo) TypeInfo_for_T);
	MR_restore_transient_registers();
#endif

}").
:- pragma foreign_proc("C", type_desc:has_type(_Arg :: (builtin:unused), TypeInfo :: (builtin:in)), [will_not_call_mercury, thread_safe, not_tabled_for_io, promise_pure], "
	TypeInfo_for_T = TypeInfo;
").
:- pragma foreign_proc("C", type_desc:type_ctor_and_args(TypeDesc :: (builtin:in), TypeCtorDesc :: (builtin:out), ArgTypes :: (builtin:out)), [will_not_call_mercury, thread_safe, not_tabled_for_io, promise_pure], "{
	MR_TypeCtorDesc type_ctor_desc;
	MR_TypeInfo	type_info;

	MR_save_transient_registers();

	type_info = (MR_TypeInfo) TypeDesc;
	MR_type_ctor_and_args(type_info, MR_TRUE, &type_ctor_desc, &ArgTypes);
	TypeCtorDesc = (MR_Word) type_ctor_desc;

	MR_restore_transient_registers();
}").
:- pragma foreign_proc("C", type_desc:type_ctor(TypeInfo :: (builtin:in)) = (TypeCtor :: (builtin:out)), [will_not_call_mercury, thread_safe, not_tabled_for_io, promise_pure], "{
	MR_TypeCtorInfo type_ctor_info;
	MR_TypeInfo	type_info;

	MR_save_transient_registers();
	type_info = MR_collapse_equivalences((MR_TypeInfo) TypeInfo);
	MR_restore_transient_registers();

	type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);

	TypeCtor = (MR_Word) MR_make_type_ctor_desc(type_info, type_ctor_info);
}").
type_desc:type_args(Type_3) = ArgTypes_4 :-
		type_desc:type_ctor_and_args(Type_3, _TypeCtor_5, ArgTypes_4).
type_desc:type_ctor_name(TypeCtor_3) = Name_4 :-
		type_desc:type_ctor_name_and_arity(TypeCtor_3, _ModuleName_5, Name_4, _Arity_6).
type_desc:type_ctor_module_name(TypeCtor_3) = ModuleName_4 :-
		type_desc:type_ctor_name_and_arity(TypeCtor_3, ModuleName_4, _Name_5, _Arity_6).
type_desc:type_ctor_arity(TypeCtor_3) = Arity_4 :-
		type_desc:type_ctor_name_and_arity(TypeCtor_3, _ModuleName_5, _Name_6, Arity_4).
:- pragma foreign_proc("C", type_desc:type_ctor_name_and_arity(TypeCtorDesc :: (builtin:in), TypeCtorModuleName :: (builtin:out), TypeCtorName :: (builtin:out), TypeCtorArity :: (builtin:out)), [will_not_call_mercury, thread_safe, not_tabled_for_io, promise_pure], "{
	MR_TypeCtorDesc type_ctor_desc;

	type_ctor_desc = (MR_TypeCtorDesc) TypeCtorDesc;

	if (MR_TYPECTOR_DESC_IS_VARIABLE_ARITY(type_ctor_desc)) {
            TypeCtorModuleName = (MR_String) (MR_Word)
                MR_TYPECTOR_DESC_GET_VA_MODULE_NAME(type_ctor_desc);
            TypeCtorName = (MR_String) (MR_Word)
                MR_TYPECTOR_DESC_GET_VA_NAME(type_ctor_desc);
            TypeCtorArity = MR_TYPECTOR_DESC_GET_VA_ARITY(type_ctor_desc);
        } else {
            MR_TypeCtorInfo type_ctor_info;

            type_ctor_info = MR_TYPECTOR_DESC_GET_FIXED_ARITY_TYPE_CTOR_INFO(
                type_ctor_desc);

            /*
            ** We cast away the const-ness of the module and type names,
            ** because MR_String is defined as char *, not const char *.
            */

            TypeCtorModuleName = (MR_String) (MR_Integer)
                MR_type_ctor_module_name(type_ctor_info);
            TypeCtorName = (MR_String) (MR_Integer)
                MR_type_ctor_name(type_ctor_info);
            TypeCtorArity = type_ctor_info->MR_type_ctor_arity;
        }
}").
:- pragma promise_pure((type_desc:make_type)/2).
:- pragma foreign_proc("C", type_desc:make_type(TypeCtorDesc :: (builtin:out), ArgTypes :: (builtin:out)) = (TypeDesc :: (builtin:in)), [will_not_call_mercury, thread_safe, not_tabled_for_io], "{
	MR_TypeCtorDesc type_ctor_desc;
	MR_TypeInfo	type_info;

	MR_save_transient_registers();

	type_info = (MR_TypeInfo) TypeDesc;
	MR_type_ctor_and_args(type_info, MR_FALSE, &type_ctor_desc, &ArgTypes);
	TypeCtorDesc = (MR_Word) type_ctor_desc;

	MR_restore_transient_registers();
}").
:- pragma foreign_proc("C", type_desc:make_type(TypeCtorDesc :: (builtin:in), ArgTypes :: (builtin:in)) = (TypeDesc :: (builtin:out)), [will_not_call_mercury, thread_safe, not_tabled_for_io], "{
	MR_TypeCtorDesc	type_ctor_desc;
	MR_TypeCtorInfo	type_ctor_info;
	MR_Word		arg_type;
	int		list_length;
	int		arity;

	type_ctor_desc = (MR_TypeCtorDesc) TypeCtorDesc;

	if (MR_TYPECTOR_DESC_IS_VARIABLE_ARITY(type_ctor_desc)) {
		arity = MR_TYPECTOR_DESC_GET_VA_ARITY(type_ctor_desc);
	} else {
		type_ctor_info =
			MR_TYPECTOR_DESC_GET_FIXED_ARITY_TYPE_CTOR_INFO(
				type_ctor_desc);
		arity = type_ctor_info->MR_type_ctor_arity;
	}

	arg_type = ArgTypes;
	for (list_length = 0; ! MR_list_is_empty(arg_type); list_length++) {
		arg_type = MR_list_tail(arg_type);
	}

	if (list_length != arity) {
		SUCCESS_INDICATOR = MR_FALSE;
	} else {
		MR_save_transient_registers();
		TypeDesc = (MR_Word) MR_make_type(arity, type_ctor_desc,
			ArgTypes);
		MR_restore_transient_registers();
		SUCCESS_INDICATOR = MR_TRUE;
	}
}").
:- pragma termination_info(type_desc:type_of((builtin:unused)) = (builtin:out), infinite, cannot_loop).
:- pragma termination_info(type_desc:has_type((builtin:unused), (builtin:in)), infinite, cannot_loop).
:- pragma termination_info(type_desc:type_name((builtin:in)) = (builtin:out), infinite, can_loop).
:- pragma termination_info(type_desc:type_ctor_and_args((builtin:in), (builtin:out), (builtin:out)), infinite, cannot_loop).
:- pragma termination_info(type_desc:type_ctor((builtin:in)) = (builtin:out), infinite, cannot_loop).
:- pragma termination_info(type_desc:type_args((builtin:in)) = (builtin:out), infinite, cannot_loop).
:- pragma termination_info(type_desc:type_ctor_name((builtin:in)) = (builtin:out), infinite, cannot_loop).
:- pragma termination_info(type_desc:type_ctor_module_name((builtin:in)) = (builtin:out), infinite, cannot_loop).
:- pragma termination_info(type_desc:type_ctor_arity((builtin:in)) = (builtin:out), infinite, cannot_loop).
:- pragma termination_info(type_desc:type_ctor_name_and_arity((builtin:in), (builtin:out), (builtin:out), (builtin:out)), infinite, cannot_loop).
:- pragma termination_info(type_desc:make_type((builtin:in), (builtin:in)) = (builtin:out), infinite, cannot_loop).
:- pragma termination_info(type_desc:make_type((builtin:out), (builtin:out)) = (builtin:in), infinite, cannot_loop).
:- pragma termination_info(type_desc:det_make_type((builtin:in), (builtin:in)) = (builtin:out), infinite, can_loop).