Change library/store.m to make use of existential types.

Estimated hours taken: 2

Change library/store.m to make use of existential types.

library/store.m:
	Add a new existentially predicate store__new/1, which is like the old
	store__init/1 but existentially typed.  This ensures safety,
	by preventing you from using a key from one store as an index
	into a different store.

	The unsafe store__init predicate is now declared `pragma obsolete'.
	The store__some_store_type type is now also documented as obsolete
	(unfortunately there is currently no equivalent to a `pragma obsolete'
	declaration for types).

browser/declarative_execution.m:
extras/trailed_update/samples/interpreter.m:
	Use store__new rather than the obsolete store__init.

tests/general/intermod_type2.m:
	Avoid using the obsolete type store__some_store_type.

extras/curses/user.m:
	Add a new predicate init_curse_store, and use that
	instead of the obsolete store__init.
	Also rename set_curse and get_curse as set_curse_store
	and get_curse_store respectively.

NEWS:
	Mention this change.

NEWS

@@ -43,6 +43,11 @@ Changes to the standard library:
   module.  These make it more convenient to work with non-ground
   terms of the corresponding type.
 
+* The `store' module now makes use of existential types.
+
+  The `store__init/1' predicate and the `store__some_store_type' type
+  are now deprecated; the new existentially typed predicate
+  `store__new/1' should be used instead.
 
 NEWS for Mercury release 0.9.1:
 -------------------------------

browser/declarative_execution.m

@@ -413,7 +413,7 @@ neg_node_set_status(Neg0, Status) = Neg :-
 :- mode set_trace_node_arg(di, in, di, out) is det.
 
 set_trace_node_arg(Node0, FieldNum, Val, Node) :-
-	store__init(S0),
+	store__new(S0),
 	store__new_ref(Node0, Ref, S0, S1),
 	store__arg_ref(Ref, FieldNum, ArgRef, S1, S2),
 	store__set_ref_value(ArgRef, Val, S2, S),

extras/curses/user.m

@@ -150,9 +150,9 @@
 :- import_module mcurses:misc, mcurses:basics.
 :- import_module array, char, int, list, require, std_util, store, string.
 
-:- type curse	== store(some_store_type).
+:- type curse_store_type ---> curse_store_type.
-
+:- type curse_store == store(curse_store_type).
-:- type win == mutvar(window, some_store_type).
+:- type win	== mutvar(window, curse_store).
 
 :- type window
 	--->	win(
@@ -179,13 +179,13 @@
 
 init(Win) -->
 	init,
-	{ store__init(Curse0) },
 	cols(Cols),
 	rows(Rows),
 	{ array__init(Cols*Rows, ' ' - [], Data) },
-	{ Func = (func(Self) = win(Self, Cols, Rows, [], Data, [], [])) },
+	{ MakeWin = (func(Self) = win(Self, Cols, Rows, [], Data, [], [])) },
-	{ store__new_cyclic_mutvar(Func, Win, Curse0, Curse) },
+	{ init_curse_store(Curse0) },
-	set_curse(Curse),
+	{ store__new_cyclic_mutvar(MakeWin, Win, Curse0, Curse) },
+	set_curse_store(Curse),
 	set_root(Win),
 	refresh.
 
@@ -574,23 +574,23 @@ update_data([C|Cs], Y, X, Xmax, Data0, Data) :-
 :- pred new_win(window::in, win::out, io__state::di, io__state::uo) is det.
 
 new_win(Window, Win) -->
-	get_curse(Curse0),
+	get_curse_store(Curse0),
 	{ store__new_mutvar(Window, Win, Curse0, Curse) },
-	set_curse(Curse).
+	set_curse_store(Curse).
 
 :- pred get_win(win::in, window::out, io__state::di, io__state::uo) is det.
 
 get_win(Win, Window) -->
-	get_curse(Curse0),
+	get_curse_store(Curse0),
 	{ store__get_mutvar(Win, Window, Curse0, Curse) },
-	set_curse(Curse).
+	set_curse_store(Curse).
 
 :- pred set_win(win::in, window::in, io__state::di, io__state::uo) is det.
 
 set_win(Win, Window) -->
-	get_curse(Curse0),
+	get_curse_store(Curse0),
 	{ store__set_mutvar(Win, Window, Curse0, Curse) },
-	set_curse(Curse).
+	set_curse_store(Curse).
 
 %----------------------------------------------------------------------------%
 
@@ -620,9 +620,15 @@ set_win(Win, Window) -->
 
 %----------------------------------------------------------------------------%
 
-:- pred get_curse(curse::uo, io__state::di, io__state::uo) is det.
+% XXX get_curse_store is not unique-mode-correct.
+% You need to be careful to ensure that get_curse_store
+% and set_curse_store are only ever used in pairs.
 
-:- pred set_curse(curse::di, io__state::di, io__state::uo) is det.
+:- pred init_curse_store(curse_store::uo) is det.
+
+:- pred get_curse_store(curse_store::uo, io__state::di, io__state::uo) is det.
+
+:- pred set_curse_store(curse_store::di, io__state::di, io__state::uo) is det.
 
 :- pragma c_header_code("
 	extern Word	curse_store;
@@ -632,13 +638,23 @@ set_win(Win, Window) -->
 	Word		curse_store;
 ").
 
-:- pragma c_code(get_curse(C::uo, I0::di, I::uo),
+:- pragma c_code(init_curse_store(C::uo),
+	[will_not_call_mercury], "
+	/*
+	** Here we rely on the fact that stores have no
+	** real representation, so we can fill in any
+	** dummy value for C.
+	*/
+	C = 0;
+").
+
+:- pragma c_code(get_curse_store(C::uo, I0::di, I::uo),
 	[will_not_call_mercury], "
 	C = curse_store;
 	I = I0;
 ").
 
-:- pragma c_code(set_curse(C::di, I0::di, I::uo),
+:- pragma c_code(set_curse_store(C::di, I0::di, I::uo),
 	[will_not_call_mercury], "
 	curse_store = C;
 	I = I0;

extras/trailed_update/samples/interpreter.m

@@ -66,7 +66,7 @@ main_loop_2(term(VarSet, Goal), Database) -->
 	%%% It would be a good idea to add some special commands
 	%%% with side-effects (such as `consult' and `listing');
 	%%% these could be identified and processed here.
-	{ store__init(Store0) },
+	{ store__new(Store0) },
 	{ map__init(VarMap0) },
 	{ term_to_my_term(Goal, MyGoal, VarMap0, VarMap, Store0, Store1) },
 	print_solutions(VarSet, VarMap, MyGoal, Store1, Database),

library/store.m

@@ -30,28 +30,16 @@
 :- interface.
 
 % Stores and keys are indexed by a type S that is used to distinguish
-% between different stores.  The idea is to use an existential type
+% between different stores.  By using an existential type declaration
-% declaration for store__init:
+% for store__new (see below), we use the type system to ensure at
-%	:- some [S] pred store__init(store(S)).
+% compile time that you never attempt to use a key from one store
-% That way, we could use the type system to ensure at compile time
+% to access a different store.
-% that you never attempt to use a key from one store to access a
-% different store.
-% However, Mercury doesn't yet support existential types :-(
-% For the moment we just use a type `some_store_type'
-% instead of `some [S] ... S'. 
-% So currently this check is not done --
-% if you attempt to use a key from one store to access a
-% different store, the behaviour is undefined.
-% This will hopefully be rectified in some future version when
-% Mercury does support existential types.
 
 :- type store(S).
 
-:- type some_store_type.
+	% initialize a new store
-
+:- some [S] pred store__new(store(S)).
-	% initialize a store
+:- mode          store__new(uo) is det.
-:- pred store__init(store(some_store_type)).
-:- mode store__init(uo) is det.
 
 %-----------------------------------------------------------------------------%
 %
@@ -200,6 +188,20 @@
 :- pred store__unsafe_new_arg_ref(T, int, ref(ArgT, S), store(S), store(S)).
 :- mode store__unsafe_new_arg_ref(di, in, out, di, uo) is det.
 
+%-----------------------------------------------------------------------------%
+%
+% Unsafe interfaces retained only for backwards compatibility
+%
+
+	% OBSOLETE: use `S' or `some [S] ... S' instead.
+:- type some_store_type.
+
+	% initialize a store
+	% OBSOLETE: use store__new/1 instead
+:- pred store__init(store(some_store_type)).
+:- mode store__init(uo) is det.
+:- pragma obsolete(store__init/1).
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -214,7 +216,16 @@
 
 :- type ref(T, S) ---> ref(c_pointer).
 
-:- pragma c_code(init(_S0::uo), will_not_call_mercury, "").
+store__new(S) :-
+	store__do_init(S).
+
+store__init(S) :-
+	store__do_init(S).
+
+:- pred store__do_init(store(some_store_type)).
+:- mode store__do_init(uo) is det.
+
+:- pragma c_code(store__do_init(_S0::uo), will_not_call_mercury, "").
 
 /* 
 Note -- the syntax for the operations on stores

tests/general/intermod_type2.m

@@ -15,9 +15,11 @@
 
 :- import_module array, char, int, list, require, std_util, store, string.
 
-:- type curse	== store(some_store_type).
+:- type my_store_type.
 
-:- type win == mutvar(window, some_store_type).
+:- type curse	== store(my_store_type).
+
+:- type win == mutvar(window, my_store_type).
 
 :- type window
 	--->	win(