[m-rev.] for review: store-based arrays

Mark Brown mark at mercurylang.org
Fri Jun 3 23:15:25 AEST 2016


Hi all,

On Fri, Jun 3, 2016 at 3:28 AM, Mark Brown <mark at mercurylang.org> wrote:
> On Fri, Jun 3, 2016 at 1:12 AM, Mark Brown <mark at mercurylang.org> wrote:
>> This is for review by anyone.

Take two. I'd like to request a review, but general comments are also welcome.

Mark
-------------- next part --------------
commit 5ccf4a9bfb1ff89ec5af4efeb30d243a190f9d41
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 a new form of
    	array.unsafe_set to be (privately) exported from the array module.
    
    library/array.m:
    	Define array updates in terms of very_unsafe_set, which takes
    	a single array argument and a pair of store arguments, and
    	updates the array in situ. In the case of unique arrays we use
    	the array itself as the "store". This prevents the calls from
    	being optimized away while still allowing inlining.
    
    	Back-ends that do not use destructive update to implement arrays
    	(namely, Erlang) must implement unsafe_set rather than
    	very_unsafe_set; in this case the latter calls sorry/1, so
    	attempts to use the new interface on these back-ends will
    	currently abort.
    
    	Export predicates for use by the new code in store.m.
    
    NEWS:
    	Announce the addition to the standard library.

diff --git a/NEWS b/NEWS
index 5628bb5..dbb6262 100644
--- a/NEWS
+++ b/NEWS
@@ -130,6 +130,9 @@ Changes to the Mercury language:
 
 Changes to the Mercury standard library:
 
+* We have added a new array type to the store module, in which arrays are
+  ground values that are accessed via a unique store type such as io.
+
 * We have added variants of the process_options predicates to the getopt
   and getopt_io modules that represent errors using a type instead of strings.
   A new function, option_error_to_string/1, can be used to convert values
diff --git a/library/array.m b/library/array.m
index fd604f5..fd0da48 100644
--- a/library/array.m
+++ b/library/array.m
@@ -730,6 +730,24 @@
 
 :- 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.
+
+    % very_unsafe_set(array(T), Index, Item, !Store):
+    % Sets the N'th element. The array is destructively updated, and it is
+    % assumed that !Store is a store type that hosts the array.
+    % It is an error if the index is out of bounds or if !Store is not
+    % really the array's store.
+    %
+:- pred very_unsafe_set(array(T)::in, int::in, T::in, S::di, S::uo) 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 +866,6 @@ compare_elements(N, Size, Array1, Array2, Result) :-
 
 %---------------------------------------------------------------------------%
 
-:- pred bounds_checks is semidet.
 :- pragma inline(bounds_checks/0).
 
 :- pragma foreign_proc("C",
@@ -1730,59 +1747,67 @@ set(Index, Item, !Array) :-
 'unsafe_elem :='(Index, !.Array, Value) = !:Array :-
     array.unsafe_set(Index, Value, !Array).
 
-:- pragma foreign_proc("C",
+unsafe_set(Index, Item, !Array) :-
+    Array0 = !.Array,
+    unsafe_promise_unique(!Array),
+    array.very_unsafe_set(Array0, Index, Item, !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],
+"
+    Array = setelement(Index + 1, Array0, Item)
+").
+
+very_unsafe_set(_Array, _Index, _Item, !Store) :-
+    private_builtin.sorry("array.very_unsafe_set").
+
+:- pragma foreign_proc("C",
+    very_unsafe_set(Array::in, Index::in, Item::in, Store0::di, Store::uo),
     [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
         does_not_affect_liveness,
-        sharing(yes(int, T, array(T), array(T)), [
-            cel(Array0, []) - cel(Array, []),
+        sharing(yes(array(T), int, T, S, S), [
+            cel(Store0, []) - cel(Store, []),
             cel(Item, [])   - cel(Array, [T])
         ])
     ],
 "
-    Array0->elements[Index] = Item; /* destructive update! */
-    Array = Array0;
+    Array->elements[Index] = Item; /* destructive update! */
+    Store = Store0;
 ").
 
 :- pragma foreign_proc("C#",
-    unsafe_set(Index::in, Item::in, Array0::array_di, Array::array_uo),
+    very_unsafe_set(Array::in, Index::in, Item::in, Store0::di, Store::uo),
     [will_not_call_mercury, promise_pure, thread_safe],
 "{
-    Array0.SetValue(Item, Index);   /* destructive update! */
-    Array = Array0;
+    Array.SetValue(Item, Index);   /* destructive update! */
+    Store = Store0;
 }").
 
-:- 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),
+    very_unsafe_set(Array::in, Index::in, Item::in, Store0::di, Store::uo),
     [will_not_call_mercury, promise_pure, 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! */
+    Store = Store0;
 ").
 
 %---------------------------------------------------------------------------%
@@ -3114,12 +3139,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..019fab5 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,51 @@ 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).
+
+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
+        array.very_unsafe_set(A, I, Elem, !Store)
+    ).
+
+unsafe_array_set(generic_array(A), I, Elem, !Store) :-
+    array.very_unsafe_set(A, I, Elem, !Store).
+
+%---------------------------------------------------------------------------%
+
 :- pragma foreign_type("C#", generic_ref(T, S), "store.Ref").
 :- pragma foreign_code("C#",
 "


More information about the reviews mailing list