:- module store.
:- use_module builtin, io, private_builtin, std_util.
:- type (store:store(S))
	--->	store((builtin:c_pointer))
	.
:- type (store:some_store_type)
	--->	some_store_type
	.
:- type (store:generic_ref(T, S))
	--->	ref((builtin:c_pointer))
	.
:- type (store:generic_mutvar(T, S))
	--->	mutvar((builtin:c_pointer))
	.
:- typeclass store:store(T) where [

].
:- instance (store:store(store : store(S))) where [

].
:- instance (store:store(io : state)) where [

].
:- pragma foreign_import_module("C", store).
:- pred store:do_init((store:store((store:some_store_type)))).
:- mode store:do_init((builtin:uo)) is det.
:- pred store:unsafe_new_uninitialized_mutvar((store:generic_mutvar(T, S)), S, S) <= (store:store(S)).
:- mode store:unsafe_new_uninitialized_mutvar((builtin:out), (builtin:di), (builtin:uo)) is det.
:- pred store:unsafe_ref_value((store:generic_ref(T, S)), T, S, S) <= (store:store(S)).
:- mode store:unsafe_ref_value((builtin:in), (builtin:uo), (builtin:di), (builtin:uo)) is det.
store:new(S_2) :-
		store:do_init(S_2).
:- pragma foreign_proc("C", store:new_mutvar(Val :: (builtin:in), Mutvar :: (builtin:out), S0 :: (builtin:di), S :: (builtin:uo)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "
	MR_incr_hp_msg(Mutvar, 1, MR_PROC_LABEL, \"store:mutvar/2\");
	* (MR_Word *) Mutvar = Val;
	S = S0;
").
:- pragma foreign_proc("C", store:get_mutvar(Mutvar :: (builtin:in), Val :: (builtin:out), S0 :: (builtin:di), S :: (builtin:uo)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "
	Val = * (MR_Word *) Mutvar;
	S = S0;
").
:- pragma foreign_proc("C", store:set_mutvar(Mutvar :: (builtin:in), Val :: (builtin:in), S0 :: (builtin:di), S :: (builtin:uo)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "
	* (MR_Word *) Mutvar = Val;
	S = S0;
").
store:new_cyclic_mutvar(Func_5, MutVar_6, DCG_0_8, DCG_2_10) :-
		store:unsafe_new_uninitialized_mutvar(MutVar_6, DCG_0_8, DCG_1_9),
		Value_7 = apply(Func_5, MutVar_6),
		store:set_mutvar(MutVar_6, Value_7, DCG_1_9, DCG_2_10).
:- pragma foreign_proc("C", store:new_ref(Val :: (builtin:di), Ref :: (builtin:out), S0 :: (builtin:di), S :: (builtin:uo)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "
	MR_incr_hp_msg(Ref, 1, MR_PROC_LABEL, \"store:ref/2\");
	* (MR_Word *) Ref = Val;
	S = S0;
").
store:ref_functor(Ref_6, Functor_7, Arity_8, DCG_0_10, DCG_1_11) :-
		store:unsafe_ref_value(Ref_6, Val_9, DCG_0_10, DCG_1_11),
		std_util:functor(Val_9, Functor_7, Arity_8).
:- pragma foreign_proc("C", store:arg_ref(Ref :: (builtin:in), ArgNum :: (builtin:in), ArgRef :: (builtin:out), S0 :: (builtin:di), S :: (builtin:uo)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "{
	MR_TypeInfo	type_info;
	MR_TypeInfo	arg_type_info;
	MR_TypeInfo	exp_arg_type_info;
	MR_Word		*arg_ref;

	type_info = (MR_TypeInfo) TypeInfo_for_T;
	exp_arg_type_info = (MR_TypeInfo) TypeInfo_for_ArgT;

	MR_save_transient_registers();

	if (!MR_arg(type_info, (MR_Word *) Ref, ArgNum, &arg_type_info,
		&arg_ref, MR_NONCANON_ABORT))
	{
		MR_fatal_error(
			\"store__arg_ref: argument number out of range\");
	}

	if (MR_compare_type_info(arg_type_info, exp_arg_type_info) !=
		MR_COMPARE_EQUAL)
	{
		MR_fatal_error(\"store__arg_ref: argument has wrong type\");
	}

	MR_restore_transient_registers();

	ArgRef = (MR_Word) arg_ref;
	S = S0;
}").
:- pragma foreign_proc("C", store:new_arg_ref(Val :: (builtin:di), ArgNum :: (builtin:in), ArgRef :: (builtin:out), S0 :: (builtin:di), S :: (builtin:uo)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "{
	MR_TypeInfo	type_info;
	MR_TypeInfo	arg_type_info;
	MR_TypeInfo	exp_arg_type_info;
	MR_Word		*arg_ref;

	type_info = (MR_TypeInfo) TypeInfo_for_T;
	exp_arg_type_info = (MR_TypeInfo) TypeInfo_for_ArgT;

	MR_save_transient_registers();

	if (!MR_arg(type_info, (MR_Word *) &Val, ArgNum, &arg_type_info,
		&arg_ref, MR_NONCANON_ABORT))
	{
		MR_fatal_error(
			\"store__new_arg_ref: argument number out of range\");
	}

	if (MR_compare_type_info(arg_type_info, exp_arg_type_info) !=
		MR_COMPARE_EQUAL)
	{
		MR_fatal_error(
			\"store__new_arg_ref: argument has wrong type\");
	}

	MR_restore_transient_registers();

	/*
	** For no_tag types, the argument may have the same address as the
	** term.  Since the term (Val) is currently on the C stack, we can\'t
	** return a pointer to it; so if that is the case, then we need
	** to copy it to the heap before returning.
	*/

	if (arg_ref == &Val) {
		MR_incr_hp_msg(ArgRef, 1, MR_PROC_LABEL, \"store:ref/2\");
		* (MR_Word *) ArgRef = Val;
	} else {
		ArgRef = (MR_Word) arg_ref;
	}
	S = S0;
}").
:- pragma foreign_proc("C", store:set_ref(Ref :: (builtin:in), ValRef :: (builtin:in), S0 :: (builtin:di), S :: (builtin:uo)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "
	* (MR_Word *) Ref = * (MR_Word *) ValRef;
	S = S0;
").
:- pragma foreign_proc("C", store:set_ref_value(Ref :: (builtin:in), Val :: (builtin:di), S0 :: (builtin:di), S :: (builtin:uo)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "
	* (MR_Word *) Ref = Val;
	S = S0;
").
store:copy_ref_value(Ref_5, Val_6, DCG_0_7, DCG_1_8) :-
		store:unsafe_ref_value(Ref_5, Val_6, DCG_0_7, DCG_1_8).
:- pragma foreign_proc("C", store:extract_ref_value(_S :: (builtin:di), Ref :: (builtin:in), Val :: (builtin:out)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "
	Val = * (MR_Word *) Ref;
").
:- pragma foreign_proc("C", store:unsafe_arg_ref(Ref :: (builtin:in), Arg :: (builtin:in), ArgRef :: (builtin:out), S0 :: (builtin:di), S :: (builtin:uo)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "{
	/* unsafe - does not check type & arity, won\'t handle no_tag types */
	MR_Word *Ptr = (MR_Word *) MR_strip_tag((MR_Word) Ref);
	ArgRef = (MR_Word) &Ptr[Arg];
	S = S0;
}").
:- pragma foreign_proc("C", store:unsafe_new_arg_ref(Val :: (builtin:di), Arg :: (builtin:in), ArgRef :: (builtin:out), S0 :: (builtin:di), S :: (builtin:uo)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "{
	/* unsafe - does not check type & arity, won\'t handle no_tag types */
	MR_Word *Ptr = (MR_Word *) MR_strip_tag((MR_Word) Val);
	ArgRef = (MR_Word) &Ptr[Arg];
	S = S0;
}").
store:init(S_2) :-
		store:do_init(S_2).
:- pragma foreign_proc("C", store:do_init(_S0 :: (builtin:uo)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "").
:- pragma foreign_proc("C", store:unsafe_new_uninitialized_mutvar(Mutvar :: (builtin:out), S0 :: (builtin:di), S :: (builtin:uo)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "
	MR_incr_hp_msg(Mutvar, 1, MR_PROC_LABEL, \"store:mutvar/2\");
	S = S0;
").
:- pragma foreign_proc("C", store:unsafe_ref_value(Ref :: (builtin:in), Val :: (builtin:uo), S0 :: (builtin:di), S :: (builtin:uo)), [will_not_call_mercury, not_thread_safe, not_tabled_for_io, promise_pure], "
	Val = * (MR_Word *) Ref;
	S = S0;
").
:- pragma termination_info(store:new((builtin:uo)), infinite, cannot_loop).
:- pragma termination_info(store:new_mutvar((builtin:in), (builtin:out), (builtin:di), (builtin:uo)), infinite, cannot_loop).
:- pragma termination_info(store:get_mutvar((builtin:in), (builtin:out), (builtin:di), (builtin:uo)), infinite, cannot_loop).
:- pragma termination_info(store:set_mutvar((builtin:in), (builtin:in), (builtin:di), (builtin:uo)), infinite, cannot_loop).
:- pragma termination_info(store:new_cyclic_mutvar((builtin:in), (builtin:out), (builtin:di), (builtin:uo)), infinite, can_loop).
:- pragma termination_info(store:new_ref((builtin:di), (builtin:out), (builtin:di), (builtin:uo)), infinite, cannot_loop).
:- pragma termination_info(store:ref_functor((builtin:in), (builtin:out), (builtin:out), (builtin:di), (builtin:uo)), infinite, can_loop).
:- pragma termination_info(store:arg_ref((builtin:in), (builtin:in), (builtin:out), (builtin:di), (builtin:uo)), infinite, cannot_loop).
:- pragma termination_info(store:new_arg_ref((builtin:di), (builtin:in), (builtin:out), (builtin:di), (builtin:uo)), infinite, cannot_loop).
:- pragma termination_info(store:set_ref((builtin:in), (builtin:in), (builtin:di), (builtin:uo)), infinite, cannot_loop).
:- pragma termination_info(store:set_ref_value((builtin:in), (builtin:di), (builtin:di), (builtin:uo)), infinite, cannot_loop).
:- pragma termination_info(store:copy_ref_value((builtin:in), (builtin:uo), (builtin:di), (builtin:uo)), infinite, cannot_loop).
:- pragma termination_info(store:extract_ref_value((builtin:di), (builtin:in), (builtin:out)), infinite, cannot_loop).
:- pragma termination_info(store:unsafe_arg_ref((builtin:in), (builtin:in), (builtin:out), (builtin:di), (builtin:uo)), infinite, cannot_loop).
:- pragma termination_info(store:unsafe_new_arg_ref((builtin:di), (builtin:in), (builtin:out), (builtin:di), (builtin:uo)), infinite, cannot_loop).
:- pragma termination_info(store:init((builtin:uo)), infinite, cannot_loop).
