[m-dev.] for review: make store.m use existential types
Fergus Henderson
fjh at cs.mu.OZ.AU
Mon Apr 10 18:18:09 AEST 2000
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.
Workspace: /home/pgrad/fjh/ws/hg
Index: library/store.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/store.m,v
retrieving revision 1.20
diff -u -d -r1.20 store.m
--- library/store.m 2000/03/24 10:27:42 1.20
+++ library/store.m 2000/04/09 10:56:40
@@ -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.
%-----------------------------------------------------------------------------%
%
@@ -201,7 +189,21 @@
:- 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).
+
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
:- implementation.
:- import_module std_util.
@@ -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
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.166
diff -u -d -r1.166 NEWS
--- NEWS 2000/03/13 03:59:51 1.166
+++ NEWS 2000/04/10 08:16:40
@@ -43,6 +43,11 @@
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:
-------------------------------
Index: browser/declarative_execution.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_execution.m,v
retrieving revision 1.7
diff -u -d -r1.7 declarative_execution.m
--- browser/declarative_execution.m 2000/03/01 04:17:23 1.7
+++ browser/declarative_execution.m 2000/04/09 08:13:26
@@ -413,7 +413,7 @@
:- 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),
Index: extras/curses/user.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/curses/user.m,v
retrieving revision 1.3
diff -u -d -r1.3 user.m
--- extras/curses/user.m 2000/04/10 08:11:02 1.3
+++ extras/curses/user.m 2000/04/10 08:05:22
@@ -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 @@
:- 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,10 +620,16 @@
%----------------------------------------------------------------------------%
-:- 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 @@
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;
Index: extras/trailed_update/samples/interpreter.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/trailed_update/samples/interpreter.m,v
retrieving revision 1.4
diff -u -d -r1.4 interpreter.m
--- extras/trailed_update/samples/interpreter.m 1998/02/15 06:23:46 1.4
+++ extras/trailed_update/samples/interpreter.m 2000/04/09 08:14:24
@@ -66,7 +66,7 @@
%%% 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),
Index: tests/general/intermod_type2.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/intermod_type2.m,v
retrieving revision 1.1
diff -u -d -r1.1 intermod_type2.m
--- tests/general/intermod_type2.m 1998/02/18 23:42:28 1.1
+++ tests/general/intermod_type2.m 2000/04/09 08:33:10
@@ -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(
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list