%-----------------------------------------------------------------------------%
% Copyright (C) 1998,2000, 2003, 2006 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
% 
% File      : ref_test.m
% Authors   : pets (Peter Schachte)
% Purpose   : test of reference types
%

:- module ref_test.
:- interface.
:- import_module io.

:- impure pred main(io::di, io::uo) is det.

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

:- implementation.

:- import_module int.

:- import_module nb_reference.
:- import_module reference.
:- import_module scoped_update.

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

main(IO, IO) :-
	impure new_reference(3, X),
	impure new_nb_reference(3, Y),
	(
		impure update(X, 42),
		impure update(Y, 42),
		semipure value(X, V1),
		semipure value(Y, W1),
		impure dump_integer(V1),
		impure dump_integer(W1),
		same(X, X1),
		same(Y, Y1),
		impure update(X1, 7),
		impure update(Y1, 7),
		semipure value(X, V2),
		semipure value(Y, W2),
		impure dump_integer(V2),
		impure dump_integer(W2),
		impure scope_test
	;
		impure scope_test2
	;
		semipure value(X, V3),
		impure dump_integer(V3),
		semipure value(Y, W3),
		impure dump_integer(W3)
	).


%  Here is an example of using references to implement non-backtrackable
%  global variables.  We implement global variables with a function that
%  returns a reference.

:- pragma foreign_decl("C", "
	extern MR_Integer globalvar;
").

:- pragma foreign_code("C", "
	MR_Integer globalvar = 0;
").

:- func globalvar = nb_reference(int).
:- pragma inline(globalvar/0).

globalvar = nb_reference__from_c_pointer(globalvar_2).

:- func globalvar_2 = c_pointer.
:- pragma inline(globalvar_2/0).

:- pragma foreign_proc("C",
	globalvar_2 = (Ref::out),
	[promise_pure, will_not_call_mercury],
"
	Ref = (MR_Word) &globalvar;
").


%  Here is an example of using the scoped_update module.  This effectively
%  creates two versions of globalvar:  one between the enter_scope/
%  exit_scope pair, and one outside it.

:- impure pred scope_test is failure.

scope_test :-
	small_int(I),
	semipure value(globalvar, V0),
	impure update(globalvar, V0 + I),
	impure scope_test_message("before", V0, V0 + I),
		% enter_scope needs to be passed the c_pointer since it is the
		% value this points to that needs to be saved.
	impure enter_scope(globalvar_2, Handle),
	small_int(J),
	semipure value(globalvar, V1),
	impure scope_test_message("inside", V1, V1 + (J * 10)),
	impure update(globalvar, V1 + (J * 10)),
	impure exit_scope(Handle),
	semipure value(globalvar, V2),
	impure update(globalvar, V2 + (I * 100)),
	impure scope_test_message("after", V2, V2 + (I * 100)),
	fail.

%  This predicate checks nested enter/exit scope calls.

:- impure pred scope_test2 is failure.

scope_test2 :-
	semipure value(globalvar, V0),
	impure update(globalvar, 0),
	impure scope_test_message("outside", V0, 0),
		% enter_scope needs to be passed the c_pointer since it is the
		% value this points to that needs to be saved.
	impure enter_scope(globalvar_2, Handle1),
	semipure value(globalvar, V1),
	impure update(globalvar, 1),
	impure scope_test_message("inside 1", V1, 1),
		% enter_scope needs to be passed the c_pointer since it is the
		% value this points to that needs to be saved.
	impure enter_scope(globalvar_2, Handle2),
	semipure value(globalvar, V2),
	impure update(globalvar, 2),
	impure scope_test_message("inside 2", V2, 2),
	impure exit_scope(Handle2),
	semipure value(globalvar, V3),
	impure update(globalvar, 3),
	impure scope_test_message("inside 1", V3, 3),
	impure exit_scope(Handle1),
	semipure value(globalvar, V4),
	impure update(globalvar, 4),
	impure scope_test_message("outside", V4, 4),
	fail.


:- pred same(T, T).
:- mode same(in, in) is semidet.
:- mode same(in, out) is det.
:- mode same(out, in) is det.

same(X,X).


:- pred small_int(int::out) is multi.

small_int(1).
small_int(2).
small_int(3).

:- pragma foreign_decl("C", "
	#include <stdio.h>
").

:- impure pred scope_test_message(string::in, int::in, int::in) is det.
:- pragma foreign_proc("C",
	scope_test_message(Prefix::in, Old::in, New::in),
	[will_not_call_mercury],
"
	printf(""%s scope ref = %d; reset to %d\\n"", (char *) Prefix,
			(int) Old, (int) New);
").

:- impure pred dump_integer(int::in) is det.
:- pragma foreign_proc("C",
	dump_integer(X::in),
	[will_not_call_mercury],
"
	printf(""%d\\n"", X);
").

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