[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