[m-rev.] for review: store-based arrays
Mark Brown
mark at mercurylang.org
Fri Jun 3 01:12:33 AEST 2016
Hi,
This is for review by anyone.
Mark.
-------------- next part --------------
commit 7f6c9bde6dc1683bd613566d702f786dab0ffb1d
Author: Mark Brown <mark at mercurylang.org>
Date: Fri Jun 3 00:04:19 2016 +1000
Add mutable arrays to the store module.
library/store.m:
Implement mutable arrays. These are essentially arrays from the
array module with a store-based interface around them.
Performing updates with this interface requires an impure form
of array.set which takes a single array argument and updates it
in situ.
library/array.m:
Define array updates in terms of impure_set, which takes a single
array argument and updates it in situ. Back-ends that do not use
destructive update to implement arrays (namely, Erlang) must
implement unsafe_set rather than impure_set; in this case the
latter calls sorry/1, so attempts to use the new interface on
these back-ends will abort.
Export predicates for use by the new code in store.m.
diff --git a/library/array.m b/library/array.m
index fd604f5..b9dc298 100644
--- a/library/array.m
+++ b/library/array.m
@@ -730,6 +730,22 @@
:- interface.
+ % Do we have bounds checks?
+ %
+:- pred bounds_checks is semidet.
+
+ % Throw an exception indicating an array bounds error.
+ %
+:- pred out_of_bounds_error(array(T), int, string).
+%:- mode out_of_bounds_error(array_ui, in, in) is erroneous.
+:- mode out_of_bounds_error(in, in, in) is erroneous.
+
+ % Update an array element in-place. Does not perform bounds checks.
+ %
+:- impure pred impure_set(array(T), int, T).
+% :- mode impure_set(array_ui, in, in) is det.
+:- mode impure_set(in, in, in) is det.
+
% dynamic_cast/2 won't work for arbitrary arrays since array/1 is
% not a ground type (that is, dynamic_cast/2 will work when the
% target type is e.g. array(int), but not when it is array(T)).
@@ -848,7 +864,6 @@ compare_elements(N, Size, Array1, Array2, Result) :-
%---------------------------------------------------------------------------%
-:- pred bounds_checks is semidet.
:- pragma inline(bounds_checks/0).
:- pragma foreign_proc("C",
@@ -1730,9 +1745,25 @@ set(Index, Item, !Array) :-
'unsafe_elem :='(Index, !.Array, Value) = !:Array :-
array.unsafe_set(Index, Value, !Array).
-:- pragma foreign_proc("C",
+:- pragma promise_pure(unsafe_set/4).
+
+unsafe_set(Index, Item, !Array) :-
+ impure array.impure_set(!.Array, Index, Item).
+ % unsafe_promise_unique(!Array).
+
+:- pragma foreign_proc("Erlang",
unsafe_set(Index::in, Item::in, Array0::array_di, Array::array_uo),
- [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Array = setelement(Index + 1, Array0, Item)
+").
+
+impure_set(_Array, _Index, _Item) :-
+ private_builtin.sorry("array.set").
+
+:- pragma foreign_proc("C",
+ impure_set(Array::in, Index::in, Item::in),
+ [will_not_call_mercury, thread_safe, will_not_modify_trail,
does_not_affect_liveness,
sharing(yes(int, T, array(T), array(T)), [
cel(Array0, []) - cel(Array, []),
@@ -1740,49 +1771,39 @@ set(Index, Item, !Array) :-
])
],
"
- Array0->elements[Index] = Item; /* destructive update! */
- Array = Array0;
+ Array->elements[Index] = Item; /* destructive update! */
").
:- pragma foreign_proc("C#",
- unsafe_set(Index::in, Item::in, Array0::array_di, Array::array_uo),
- [will_not_call_mercury, promise_pure, thread_safe],
+ impure_set(Array::in, Index::in, Item::in),
+ [will_not_call_mercury, thread_safe],
"{
- Array0.SetValue(Item, Index); /* destructive update! */
- Array = Array0;
+ Array.SetValue(Item, Index); /* destructive update! */
}").
-:- pragma foreign_proc("Erlang",
- unsafe_set(Index::in, Item::in, Array0::array_di, Array::array_uo),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Array = setelement(Index + 1, Array0, Item)
-").
-
:- pragma foreign_proc("Java",
- unsafe_set(Index::in, Item::in, Array0::array_di, Array::array_uo),
- [will_not_call_mercury, promise_pure, thread_safe],
+ impure_set(Array::in, Index::in, Item::in),
+ [will_not_call_mercury, thread_safe],
"
- if (Array0 instanceof int[]) {
- ((int[]) Array0)[Index] = (Integer) Item;
- } else if (Array0 instanceof double[]) {
- ((double[]) Array0)[Index] = (Double) Item;
- } else if (Array0 instanceof char[]) {
- ((char[]) Array0)[Index] = (Character) Item;
- } else if (Array0 instanceof boolean[]) {
- ((boolean[]) Array0)[Index] = (Boolean) Item;
- } else if (Array0 instanceof byte[]) {
- ((byte[]) Array0)[Index] = (Byte) Item;
- } else if (Array0 instanceof short[]) {
- ((short[]) Array0)[Index] = (Short) Item;
- } else if (Array0 instanceof long[]) {
- ((long[]) Array0)[Index] = (Long) Item;
- } else if (Array0 instanceof float[]) {
- ((float[]) Array0)[Index] = (Float) Item;
+ if (Array instanceof int[]) {
+ ((int[]) Array)[Index] = (Integer) Item;
+ } else if (Array instanceof double[]) {
+ ((double[]) Array)[Index] = (Double) Item;
+ } else if (Array instanceof char[]) {
+ ((char[]) Array)[Index] = (Character) Item;
+ } else if (Array instanceof boolean[]) {
+ ((boolean[]) Array)[Index] = (Boolean) Item;
+ } else if (Array instanceof byte[]) {
+ ((byte[]) Array)[Index] = (Byte) Item;
+ } else if (Array instanceof short[]) {
+ ((short[]) Array)[Index] = (Short) Item;
+ } else if (Array instanceof long[]) {
+ ((long[]) Array)[Index] = (Long) Item;
+ } else if (Array instanceof float[]) {
+ ((float[]) Array)[Index] = (Float) Item;
} else {
- ((Object[]) Array0)[Index] = Item;
+ ((Object[]) Array)[Index] = Item;
}
- Array = Array0; /* destructive update! */
").
%---------------------------------------------------------------------------%
@@ -3114,12 +3135,6 @@ merge_subarrays(A, Lo1, Hi1, Lo2, Hi2, I, !B) :-
%---------------------------------------------------------------------------%
- % Throw an exception indicating an array bounds error.
- %
-:- pred out_of_bounds_error(array(T), int, string).
-%:- mode out_of_bounds_error(array_ui, in, in) is erroneous.
-:- mode out_of_bounds_error(in, in, in) is erroneous.
-
out_of_bounds_error(Array, Index, PredName) :-
% Note: we deliberately do not include the array element type name in the
% error message here, for performance reasons: using the type name could
diff --git a/library/store.m b/library/store.m
index 758a745..25ac2cd 100644
--- a/library/store.m
+++ b/library/store.m
@@ -32,6 +32,7 @@
:- interface.
:- import_module io.
+:- import_module list.
%---------------------------------------------------------------------------%
@@ -117,6 +118,68 @@
%---------------------------------------------------------------------------%
%
+% Mutable arrays
+%
+
+ % generic_array(T, S):
+ %
+ % A mutable array of values of type T in store S.
+ %
+ % The mutable array interface is inherently not thread-safe.
+ % It is the programmer's responsibility to synchronise accesses to a
+ % mutable array from multiple threads where that is possible,
+ % namely references attached to the I/O state.
+ %
+:- type generic_array(T, S).
+:- type io_array(T) == generic_array(T, io).
+:- type store_array(T, S) == generic_array(T, store(S)).
+
+ % new_array(Size, Init, Array, !Store) creates a mutable array
+ % with indices 0..Size-1, and with each element initialized to Init.
+ %
+:- pred new_array(int::in, T::in, generic_array(T, S)::out, S::di, S::uo)
+ is det <= store(S).
+
+ % Create a mutable array containing the elements in a list.
+ %
+:- pred new_array_from_list(list(T)::in, generic_array(T, S)::out,
+ S::di, S::uo) is det <= store(S).
+
+ % Copy an existing array.
+ %
+:- pred copy_array(generic_array(T, S)::in, generic_array(T, S)::out,
+ S::di, S::uo) is det <= store(S).
+
+ % Return the size of an array.
+ %
+:- func array_size(generic_array(T, S)) = int.
+
+ % Return the N'th element of an array.
+ % Throws an exception if the index is out of bounds.
+ %
+:- func array_lookup(generic_array(T, S)::in, int::in, S::ui) = (T::out) is det
+ <= store(S).
+
+ % Return the N'th element of an array.
+ % It is an error if the index is out of bounds.
+ %
+:- func unsafe_array_lookup(generic_array(T, S)::in, int::in, S::ui) = (T::out)
+ is det <= store(S).
+
+ % Sets the N'th element of an array.
+ % Throws an exception if the index is out of bounds.
+ %
+:- pred array_set(generic_array(T, S)::in, int::in, T::in, S::di, S::uo) is det
+ <= store(S).
+
+ % Sets the N'th element of an array.
+ % It is an error if the index is out of bounds.
+ %
+:- pred unsafe_array_set(generic_array(T, S)::in, int::in, T::in, S::di, S::uo)
+ is det <= store(S).
+
+%---------------------------------------------------------------------------%
+%
% References
%
@@ -247,6 +310,7 @@
:- implementation.
+:- import_module array.
:- import_module deconstruct.
:- import_module require.
@@ -468,6 +532,55 @@ store.new_cyclic_mutvar(Func, MutVar, !Store) :-
%---------------------------------------------------------------------------%
+ % Mutable arrays are just arrays from the array module, with a
+ % store-based interface.
+ %
+:- type generic_array(T, S)
+ ---> generic_array(array(T)).
+
+new_array(Size, Init, Array, !Store) :-
+ Array = generic_array(array.init(Size, Init)).
+
+new_array_from_list(List, Array, !Store) :-
+ Array = generic_array(array.array(List)).
+
+copy_array(generic_array(A0), generic_array(A), !Store) :-
+ array.copy(A0, A).
+
+array_size(generic_array(A)) = array.size(A).
+
+array_lookup(generic_array(A), I, _Store) = Elem :-
+ ( if
+ array.bounds_checks,
+ not array.in_bounds(A, I)
+ then
+ array.out_of_bounds_error(A, I, "store.array_lookup")
+ else
+ array.unsafe_lookup(A, I, Elem)
+ ).
+
+unsafe_array_lookup(generic_array(A), I, _Store) = Elem :-
+ array.unsafe_lookup(A, I, Elem).
+
+:- pragma promise_pure(array_set/5).
+
+array_set(generic_array(A), I, Elem, !Store) :-
+ ( if
+ array.bounds_checks,
+ not array.in_bounds(A, I)
+ then
+ array.out_of_bounds_error(A, I, "store.array_set")
+ else
+ impure array.impure_set(A, I, Elem)
+ ).
+
+:- pragma promise_pure(unsafe_array_set/5).
+
+unsafe_array_set(generic_array(A), I, Elem, !Store) :-
+ impure array.impure_set(A, I, Elem).
+
+%---------------------------------------------------------------------------%
+
:- pragma foreign_type("C#", generic_ref(T, S), "store.Ref").
:- pragma foreign_code("C#",
"
More information about the reviews
mailing list