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.
This commit is contained in:
Fergus Henderson
2000-04-13 10:05:42 +00:00
parent 05042c60ca
commit 733f94a539
6 changed files with 75 additions and 41 deletions

5
NEWS
View File

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

View File

@@ -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),

View File

@@ -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 win == mutvar(window, some_store_type).
:- type curse_store_type ---> curse_store_type.
:- type curse_store == store(curse_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, [], [])) },
{ store__new_cyclic_mutvar(Func, Win, Curse0, Curse) },
set_curse(Curse),
{ MakeWin = (func(Self) = win(Self, Cols, Rows, [], Data, [], [])) },
{ init_curse_store(Curse0) },
{ 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;

View File

@@ -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),

View File

@@ -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
% declaration for store__init:
% :- some [S] pred store__init(store(S)).
% That way, we could use the type system to ensure at compile time
% 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.
% between different stores. By using an existential type declaration
% for store__new (see below), we use the type system to ensure at
% compile time that you never attempt to use a key from one store
% to access a different store.
:- type store(S).
:- type some_store_type.
% initialize a store
:- pred store__init(store(some_store_type)).
:- mode store__init(uo) is det.
% initialize a new store
:- some [S] pred store__new(store(S)).
:- mode store__new(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

View File

@@ -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(