[m-rev.] global store implemented using typeclass

Holger Krug hkrug at rationalizer.com
Mon Jul 23 18:17:04 AEST 2001


Appended you can find a `diff -c' to file
mercury-compiler-rotd-2001-06-26/library/store.m adding global storage
functionality. This is done by replacing type `store(S)' by typeclass
`store' and declaring `io__state' as instance of typeclass `store'.

WARNING ! THE ONLY TEST DONE IS TO COMPILE THE CODE !

If the code seems to be appropriate please tell me, what changes
should be done to assure backwards compatibility. (E.g. renaming the
changed module to something like `cstore' [c = class] to allow the
simultaneous use of the old and new versions.)

-- 
Holger Krug
hkrug at rationalizer.com
-------------- next part --------------
*** mercury-compiler-rotd-2001-06-26/library/store.m	Mon Jun 25 17:52:04 2001
--- store.m	Mon Jul 23 10:06:22 2001
***************
*** 1,5 ****
--- 1,6 ----
  %-----------------------------------------------------------------------------%
  % Copyright (C) 1994-1997, 2000-2001 The University of Melbourne.
+ % Copyright (C) 2001 The Rationalizer Intelligent Software AG
  % This file may only be copied under the terms of the GNU Library General
  % Public License - see the file COPYING.LIB in the Mercury distribution.
  %-----------------------------------------------------------------------------%
***************
*** 23,44 ****
  % whereas it is possible to update individual fields of a reference
  % one at a time (presuming the reference refers to a structured term).
  %
  %-----------------------------------------------------------------------------%
  %-----------------------------------------------------------------------------%
  
  :- module store.
  :- interface.
  
! % Stores and keys are indexed by a type S that is used to distinguish
! % 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).
  
  	% initialize a new store
! :- some [S] pred store__new(store(S)).
  :- mode          store__new(uo) is det.
  
  %-----------------------------------------------------------------------------%
--- 24,74 ----
  % whereas it is possible to update individual fields of a reference
  % one at a time (presuming the reference refers to a structured term).
  %
+ % 07/17/01 hkrug at rationalizer.com:
+ %
+ %   `store' now works as well for declarative storage as also for
+ %   storage using the io__state
+ %   * `type store(S)' replaced by `typeclass store(S)'
+ %   * type `store(S)' in predicates replaced by typeclass constraint
+ %     `store(S)'
+ %   * instance declaration `instance store(io__state)' added
+ %   * public type `some_store_type' and unsafe obsolete predicate
+ %     `store__init/1' removed
+ %   
+ %   Changes are not backwards compatible:
+ %   * removed obsolete predicate `store__init/1' and type `some_store_type'
+ %   * type `store(S)' in predicate signatures have to be replaced by
+ %     typeclass constraint `<= store(S)'.
+ %
+ %   WARNING ! CHANGES 100% UNTESTED ! WARNING !
+ %
  %-----------------------------------------------------------------------------%
  %-----------------------------------------------------------------------------%
  
  :- module store.
  :- interface.
  
! % Stores and keys are indexed by a type S of typeclass store(S) that
! % is used to distinguish 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.
! 
! % Proposal for a language extension: If we could define an abstract
! % typeclass `store' in the following way:
! % :- interface.
! % :- typeclass store(S).
! % :- implementation.
! % :- typeclass store(S) where [].
! % we could assure that it would be impossible to declare/define instances
! % of class `store' outside the current module.
! :- typeclass store(S) where [].
  
! :- import_module io.
! :- instance store(io__state).
  
  	% initialize a new store
! :- some [S] pred store__new(S) => store(S).
  :- mode          store__new(uo) is det.
  
  %-----------------------------------------------------------------------------%
***************
*** 52,66 ****
  
  	% create a new mutable variable,
  	% initialized with the specified value
! :- pred store__new_mutvar(T, mutvar(T, S), store(S), store(S)).
  :- mode store__new_mutvar(in, out, di, uo) is det.
  
  	% lookup the value stored in a given mutable variable
! :- pred store__get_mutvar(mutvar(T, S), T, store(S), store(S)).
  :- mode store__get_mutvar(in, out, di, uo) is det.
  
  	% replace the value stored in a given mutable variable
! :- pred store__set_mutvar(mutvar(T, S), T, store(S), store(S)).
  :- mode store__set_mutvar(in, in, di, uo) is det.
  
  	% new_cyclic_mutvar(Func, Mutvar):
--- 82,96 ----
  
  	% create a new mutable variable,
  	% initialized with the specified value
! :- pred store__new_mutvar(T, mutvar(T, S), S, S) <= store(S).
  :- mode store__new_mutvar(in, out, di, uo) is det.
  
  	% lookup the value stored in a given mutable variable
! :- pred store__get_mutvar(mutvar(T, S), T, S, S) <= store(S).
  :- mode store__get_mutvar(in, out, di, uo) is det.
  
  	% replace the value stored in a given mutable variable
! :- pred store__set_mutvar(mutvar(T, S), T, S, S) <= store(S) .
  :- mode store__set_mutvar(in, in, di, uo) is det.
  
  	% new_cyclic_mutvar(Func, Mutvar):
***************
*** 81,87 ****
  	%	    store__new_cyclic_mutvar(func(CL) = node(X, CL), CList).
  	%
  :- pred store__new_cyclic_mutvar(func(mutvar(T, S)) = T, mutvar(T, S),
! 		store(S), store(S)).
  :- mode store__new_cyclic_mutvar(in, out, di, uo) is det.
  
  %-----------------------------------------------------------------------------%
--- 111,117 ----
  	%	    store__new_cyclic_mutvar(func(CL) = node(X, CL), CList).
  	%
  :- pred store__new_cyclic_mutvar(func(mutvar(T, S)) = T, mutvar(T, S),
! 		S, S) <= store(S).
  :- mode store__new_cyclic_mutvar(in, out, di, uo) is det.
  
  %-----------------------------------------------------------------------------%
***************
*** 101,113 ****
  	% of the representation of that value.
  	% It does however allocate one cell to hold the reference;
  	% you can use new_arg_ref to avoid that.)
! :- pred store__new_ref(T, ref(T, S), store(S), store(S)).
  :- mode store__new_ref(di, out, di, uo) is det.
  
  	% ref_functor(Ref, Functor, Arity):
  	% Given a reference to a term, return the functor and arity
  	% of that term.
! :- pred store__ref_functor(ref(T, S), string, int, store(S), store(S)).
  :- mode store__ref_functor(in, out, out, di, uo) is det.
  
  	% arg_ref(Ref, ArgNum, ArgRef):	     
--- 131,143 ----
  	% of the representation of that value.
  	% It does however allocate one cell to hold the reference;
  	% you can use new_arg_ref to avoid that.)
! :- pred store__new_ref(T, ref(T, S), S, S) <= store(S).
  :- mode store__new_ref(di, out, di, uo) is det.
  
  	% ref_functor(Ref, Functor, Arity):
  	% Given a reference to a term, return the functor and arity
  	% of that term.
! :- pred store__ref_functor(ref(T, S), string, int, S, S) <= store(S).
  :- mode store__ref_functor(in, out, out, di, uo) is det.
  
  	% arg_ref(Ref, ArgNum, ArgRef):	     
***************
*** 117,123 ****
  	% (argument numbers start from zero).
  	% It is an error if the argument number is out of range,
  	% or if the argument reference has the wrong type.
! :- pred store__arg_ref(ref(T, S), int, ref(ArgT, S), store(S), store(S)).
  :- mode store__arg_ref(in, in, out, di, uo) is det.
  
  	% new_arg_ref(Val, ArgNum, ArgRef):
--- 147,153 ----
  	% (argument numbers start from zero).
  	% It is an error if the argument number is out of range,
  	% or if the argument reference has the wrong type.
! :- pred store__arg_ref(ref(T, S), int, ref(ArgT, S), S, S) <= store(S).
  :- mode store__arg_ref(in, in, out, di, uo) is det.
  
  	% new_arg_ref(Val, ArgNum, ArgRef):
***************
*** 126,132 ****
  	% except that it is more efficient.
  	% It is an error if the argument number is out of range,
  	% or if the argument reference has the wrong type.
! :- pred store__new_arg_ref(T, int, ref(ArgT, S), store(S), store(S)).
  :- mode store__new_arg_ref(di, in, out, di, uo) is det.
  
  	% set_ref(Ref, ValueRef):
--- 156,162 ----
  	% except that it is more efficient.
  	% It is an error if the argument number is out of range,
  	% or if the argument reference has the wrong type.
! :- pred store__new_arg_ref(T, int, ref(ArgT, S), S, S) <= store(S).
  :- mode store__new_arg_ref(di, in, out, di, uo) is det.
  
  	% set_ref(Ref, ValueRef):
***************
*** 135,141 ****
  	% a reference to another term (ValueRef),
  	% update the store so that the term referred to by Ref
  	% is replaced with the term referenced by ValueRef.
! :- pred store__set_ref(ref(T, S), ref(T, S), store(S), store(S)).
  :- mode store__set_ref(in, in, di, uo) is det.
  
  	% set_ref_value(Ref, Value):
--- 165,171 ----
  	% a reference to another term (ValueRef),
  	% update the store so that the term referred to by Ref
  	% is replaced with the term referenced by ValueRef.
! :- pred store__set_ref(ref(T, S), ref(T, S), S, S) <= store(S).
  :- mode store__set_ref(in, in, di, uo) is det.
  
  	% set_ref_value(Ref, Value):
***************
*** 143,149 ****
  	% Given a reference to a term (Ref), and a value (Value),
  	% update the store so that the term referred to by Ref
  	% is replaced with Value.
! :- pred store__set_ref_value(ref(T, S), T, store(S), store(S)).
  :- mode store__set_ref_value(in, di, di, uo) is det.
  
  	% Given a reference to a term, return that term.
--- 173,179 ----
  	% Given a reference to a term (Ref), and a value (Value),
  	% update the store so that the term referred to by Ref
  	% is replaced with Value.
! :- pred store__set_ref_value(ref(T, S), T, S, S) <= store(S).
  :- mode store__set_ref_value(in, di, di, uo) is det.
  
  	% Given a reference to a term, return that term.
***************
*** 151,162 ****
  	% be inefficient if used to return large terms; it
  	% is most efficient with atomic terms.
  	% XXX current implementation buggy (does shallow copy)
! :- pred store__copy_ref_value(ref(T, S), T, store(S), store(S)).
  :- mode store__copy_ref_value(in, uo, di, uo) is det.
  
  	% Same as above, but without making a copy.
  	% Destroys the store.
! :- pred store__extract_ref_value(store(S), ref(T, S), T).
  :- mode store__extract_ref_value(di, in, out) is det.
  
  %-----------------------------------------------------------------------------%
--- 181,192 ----
  	% be inefficient if used to return large terms; it
  	% is most efficient with atomic terms.
  	% XXX current implementation buggy (does shallow copy)
! :- pred store__copy_ref_value(ref(T, S), T, S, S) <= store(S).
  :- mode store__copy_ref_value(in, uo, di, uo) is det.
  
  	% Same as above, but without making a copy.
  	% Destroys the store.
! :- pred store__extract_ref_value(S, ref(T, S), T) <= store(S).
  :- mode store__extract_ref_value(di, in, out) is det.
  
  %-----------------------------------------------------------------------------%
***************
*** 182,208 ****
  	% then the behaviour is undefined, and probably harmful.
  
  :- pred store__unsafe_arg_ref(ref(T, S), int, ref(ArgT, S),
! 				store(S), store(S)).
  :- mode store__unsafe_arg_ref(in, in, out, di, uo) is det.
  
! :- 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).
- 
- %-----------------------------------------------------------------------------%
  %-----------------------------------------------------------------------------%
  
  :- implementation.
--- 212,224 ----
  	% then the behaviour is undefined, and probably harmful.
  
  :- pred store__unsafe_arg_ref(ref(T, S), int, ref(ArgT, S),
! 				S, S) <= store(S).
  :- mode store__unsafe_arg_ref(in, in, out, di, uo) is det.
  
! :- pred store__unsafe_new_arg_ref(T, int, ref(ArgT, S), S, S) <= store(S).
  :- mode store__unsafe_new_arg_ref(di, in, out, di, uo) is det.
  
  %-----------------------------------------------------------------------------%
  %-----------------------------------------------------------------------------%
  
  :- implementation.
***************
*** 210,216 ****
  
  :- type some_store_type ---> some_store_type. 
  
! :- type store(S) ---> store(c_pointer).
  
  :- type mutvar(T, S) ---> mutvar(c_pointer).
  
--- 226,233 ----
  
  :- type some_store_type ---> some_store_type. 
  
! :- instance store(some_store_type) where []. 
! :- instance store(io__state) where [].
  
  :- type mutvar(T, S) ---> mutvar(c_pointer).
  
***************
*** 219,228 ****
  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 foreign_proc("C", store__do_init(_S0::uo), will_not_call_mercury, "").
--- 236,242 ----
  store__new(S) :-
  	store__do_init(S).
  
! :- pred store__do_init(some_store_type).
  :- mode store__do_init(uo) is det.
  
  :- pragma foreign_proc("C", store__do_init(_S0::uo), will_not_call_mercury, "").
***************
*** 267,273 ****
  ").
  
  :- pred store__unsafe_new_uninitialized_mutvar(mutvar(T, S),
! 						store(S), store(S)).
  :- mode store__unsafe_new_uninitialized_mutvar(out, di, uo) is det.
  
  :- pragma foreign_proc("C", unsafe_new_uninitialized_mutvar(Mutvar::out, S0::di, S::uo),
--- 281,287 ----
  ").
  
  :- pred store__unsafe_new_uninitialized_mutvar(mutvar(T, S),
! 						S, S) <= store(S).
  :- mode store__unsafe_new_uninitialized_mutvar(out, di, uo) is det.
  
  :- pragma foreign_proc("C", unsafe_new_uninitialized_mutvar(Mutvar::out, S0::di, S::uo),
***************
*** 300,306 ****
  	% refers to, without making a copy; it is unsafe because
  	% the store could later be modified, changing the returned
  	% value.
! :- pred store__unsafe_ref_value(ref(T, S), T, store(S), store(S)).
  :- mode store__unsafe_ref_value(in, uo, di, uo) is det.
  :- pragma foreign_proc("C", unsafe_ref_value(Ref::in, Val::uo, S0::di, S::uo),
  		will_not_call_mercury,
--- 314,320 ----
  	% refers to, without making a copy; it is unsafe because
  	% the store could later be modified, changing the returned
  	% value.
! :- pred store__unsafe_ref_value(ref(T, S), T, S, S) <= store(S).
  :- mode store__unsafe_ref_value(in, uo, di, uo) is det.
  :- pragma foreign_proc("C", unsafe_ref_value(Ref::in, Val::uo, S0::di, S::uo),
  		will_not_call_mercury,


More information about the reviews mailing list