[m-rev.] for review: store-based arrays
Mark Brown
mark at mercurylang.org
Mon Jun 27 10:32:18 AEST 2016
On Thu, Jun 9, 2016 at 2:19 AM, Mark Brown <mark at mercurylang.org> wrote:
> On Mon, Jun 6, 2016 at 11:02 AM, Julien Fischer <jfischer at opturion.com> wrote:
>> The rest looks fine, but I think you ought to provide more of the operations
>> from the array module, is_empty, min, max, various folds etc.
>
> Okay. I'll post that as a separate diff, as there will probably be
> some bikeshedding to do regarding what exactly to include (for
> example, I'm happier with {least,greatest}_index than with the
> synonyms {min,max}, since I always think that the latter mean
> least/greatest *element*, not index).
A diff for this is attached for review by anyone.
Mark
-------------- next part --------------
commit 7acd16c66b4f80a6c30aa036cc770158e959a910
Author: Mark Brown <mark at mercurylang.org>
Date: Mon Jun 27 09:25:23 2016 +1000
More array operations for the store module.
library/store.m:
Add various functions and predicates similar to those
found in array.m.
Accumulator predicates have modes with up to the last two
accumulator pairs being unique, instead of just the last pair
as in most other modules. The reason for this is so that
arrays that come from different stores can more readily be
used together.
library/array.m:
Export generate_foldl2.
tests/hard_coded/Mmakefile:
tests/hard_coded/io_array.{m,exp}:
tests/hard_coded/io_array_2.{m,exp}:
tests/hard_coded/io_array_3.{m,exp}:
Test cases for store-based arrays.
diff --git a/library/array.m b/library/array.m
index fd0da48..8399830 100644
--- a/library/array.m
+++ b/library/array.m
@@ -134,6 +134,24 @@
:- mode generate_foldl(in, in(pred(in, out, di, uo) is semidet),
array_uo, di, uo) is semidet.
+ % As above, but with two accumulators.
+ %
+:- pred generate_foldl2(int, pred(int, T, A, A, B, B), array(T), A, A, B, B).
+:- mode generate_foldl2(in, in(pred(in, out, in, out, in, out) is det),
+ array_uo, in, out, in, out) is det.
+:- mode generate_foldl2(in, in(pred(in, out, in, out, mdi, muo) is det),
+ array_uo, in, out, mdi, muo) is det.
+:- mode generate_foldl2(in, in(pred(in, out, in, out, di, uo) is det),
+ array_uo, in, out, di, uo) is det.
+:- mode generate_foldl2(in, in(pred(in, out, di, uo, di, uo) is det),
+ array_uo, di, uo, di, uo) is det.
+:- mode generate_foldl2(in, in(pred(in, out, in, out, in, out) is semidet),
+ array_uo, in, out, in, out) is semidet.
+:- mode generate_foldl2(in, in(pred(in, out, in, out, mdi, muo) is semidet),
+ array_uo, in, out, mdi, muo) is semidet.
+:- mode generate_foldl2(in, in(pred(in, out, in, out, di, uo) is semidet),
+ array_uo, in, out, di, uo) is semidet.
+
%---------------------------------------------------------------------------%
% min returns the lower bound of the array.
@@ -1501,6 +1519,49 @@ generate_foldl_2(Index, Size, GenPred, !Array, !Acc) :-
true
).
+generate_foldl2(Size, GenPred, Array, !A, !B) :-
+ compare(Result, Size, 0),
+ (
+ Result = (<),
+ error("array.generate_foldl2: negative size")
+ ;
+ Result = (=),
+ make_empty_array(Array)
+ ;
+ Result = (>),
+ GenPred(0, FirstElem, !A, !B),
+ Array0 = unsafe_init(Size, FirstElem, 0),
+ generate_foldl2_2(1, Size, GenPred, Array0, Array, !A, !B)
+ ).
+
+:- pred generate_foldl2_2(int, int, pred(int, T, A, A, B, B),
+ array(T), array(T), A, A, B, B).
+:- mode generate_foldl2_2(in, in, in(pred(in, out, in, out, in, out) is det),
+ array_di, array_uo, in, out, in, out) is det.
+:- mode generate_foldl2_2(in, in, in(pred(in, out, in, out, mdi, muo) is det),
+ array_di, array_uo, in, out, mdi, muo) is det.
+:- mode generate_foldl2_2(in, in, in(pred(in, out, in, out, di, uo) is det),
+ array_di, array_uo, in, out, di, uo) is det.
+:- mode generate_foldl2_2(in, in, in(pred(in, out, di, uo, di, uo) is det),
+ array_di, array_uo, di, uo, di, uo) is det.
+:- mode generate_foldl2_2(in, in,
+ in(pred(in, out, in, out, in, out) is semidet),
+ array_di, array_uo, in, out, in, out) is semidet.
+:- mode generate_foldl2_2(in, in,
+ in(pred(in, out, in, out, mdi, muo) is semidet),
+ array_di, array_uo, in, out, mdi, muo) is semidet.
+:- mode generate_foldl2_2(in, in, in(pred(in, out, in, out, di, uo) is semidet),
+ array_di, array_uo, in, out, di, uo) is semidet.
+
+generate_foldl2_2(Index, Size, GenPred, !Array, !A, !B) :-
+ ( if Index < Size then
+ GenPred(Index, Elem, !A, !B),
+ array.unsafe_set(Index, Elem, !Array),
+ generate_foldl2_2(Index + 1, Size, GenPred, !Array, !A, !B)
+ else
+ true
+ ).
+
%---------------------------------------------------------------------------%
min(A) = N :-
diff --git a/library/store.m b/library/store.m
index 019fab5..478733e 100644
--- a/library/store.m
+++ b/library/store.m
@@ -140,31 +140,81 @@
:- 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.
+ % Create a mutable array containing the elements in a list,
+ % in the same order.
%
:- pred new_array_from_list(list(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, in
+ % reverse order.
+ %
+:- pred new_array_from_reverse_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).
+ % generate_array(Size, Generate, Array, !Store):
+ % Create an array with indices 0..Size-1, with the initial value
+ % at index K equal to Generate(K).
+ %
+:- pred generate_array(int::in, (func(int) = T)::in, generic_array(T, S)::out,
+ S::di, S::uo) is det <= store(S).
+
+ % As above, but use a generator predicate and pass the store through it.
+ %
+:- pred generate_array_foldl(int::in,
+ pred(int, T, S, S)::in(pred(in, out, di, uo) is det),
+ generic_array(T, S)::out, S::di, S::uo) is det <= store(S).
+
+ % As above, but with a second accumulator.
+ %
+:- pred generate_array_foldl2(int, pred(int, T, A, A, S, S),
+ generic_array(T, S), A, A, S, S) <= store(S).
+:- mode generate_array_foldl2(in, in(pred(in, out, in, out, di, uo) is det),
+ out, in, out, di, uo) is det.
+:- mode generate_array_foldl2(in, in(pred(in, out, di, uo, di, uo) is det),
+ out, di, uo, di, uo) is det.
+
+%---------------------------------------------------------------------------%
+
% Return the size of an array.
%
:- func array_size(generic_array(T, S)) = int.
+ % Return the least index of an array.
+ % (In the current implementation this is always zero.)
+ %
+:- func array_least_index(generic_array(T, S)) = int.
+
+ % Return the greatest index of an array.
+ %
+:- func array_greatest_index(generic_array(T, S)) = int.
+
+ % True iff the index is valid for the array.
+ %
+:- pred array_in_bounds(generic_array(T, S)::in, int::in) is semidet.
+
+%---------------------------------------------------------------------------%
+
% 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).
+:- pred array_lookup(generic_array(T, S)::in, int::in, T::out, S::di, S::uo)
+ 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).
+:- pred unsafe_array_lookup(generic_array(T, S)::in, int::in, T::out,
+ S::di, S::uo) is det <= store(S).
% Sets the N'th element of an array.
% Throws an exception if the index is out of bounds.
@@ -179,6 +229,114 @@
is det <= store(S).
%---------------------------------------------------------------------------%
+
+ % Return a list containing the elements of the array, in the same order.
+ %
+:- func array_to_list(generic_array(T, S)::in, S::ui) = (list(T)::out) is det
+ <= store(S).
+:- pred array_to_list(generic_array(T, S)::in, list(T)::out, S::di, S::uo)
+ is det <= store(S).
+
+ % Return a list containing the elements of the array between the
+ % given lower and upper index (inclusive), in the same order.
+ % Throw an exception if either index is out of bounds.
+ %
+:- func array_fetch_items(generic_array(T, S)::in, int::in, int::in, S::ui)
+ = (list(T)::out) is det <= store(S).
+:- pred array_fetch_items(generic_array(T, S)::in, int::in, int::in,
+ list(T)::out, S::di, S::uo) is det <= store(S).
+
+ % Concatenate the elements of two arrays to form a new array.
+ %
+:- pred array_append(generic_array(T, S)::in, generic_array(T, S)::in,
+ generic_array(T, S)::out, S::di, S::uo) is det <= store(S).
+
+%---------------------------------------------------------------------------%
+
+ % Apply a predicate once for each index and corresponding element
+ % in the array, starting from the least index.
+ %
+:- pred array_foldl(pred(int, T, S, S), generic_array(T, S), S, S) <= store(S).
+:- mode array_foldl(in(pred(in, in, di, uo) is det), in, di, uo) is det.
+
+ % As above, but with a second accumulator.
+ %
+:- pred array_foldl2(pred(int, T, A, A, S, S),
+ generic_array(T, S), A, A, S, S) <= store(S).
+:- mode array_foldl2(in(pred(in, in, in, out, di, uo) is det),
+ in, in, out, di, uo) is det.
+:- mode array_foldl2(in(pred(in, in, di, uo, di, uo) is det),
+ in, di, uo, di, uo) is det.
+
+ % As above, but with a third accumulator.
+ %
+:- pred array_foldl3(pred(int, T, A, A, B, B, S, S),
+ generic_array(T, S), A, A, B, B, S, S) <= store(S).
+:- mode array_foldl3(in(pred(in, in, in, out, in, out, di, uo) is det),
+ in, in, out, in, out, di, uo) is det.
+:- mode array_foldl3(in(pred(in, in, in, out, di, uo, di, uo) is det),
+ in, in, out, di, uo, di, uo) is det.
+
+ % Apply a predicate once for each index and corresponding element
+ % in the array, starting from the greatest index.
+ %
+:- pred array_foldr(pred(int, T, S, S), generic_array(T, S), S, S) <= store(S).
+:- mode array_foldr(in(pred(in, in, di, uo) is det), in, di, uo) is det.
+
+ % As above, but with a second accumulator.
+ %
+:- pred array_foldr2(pred(int, T, A, A, S, S),
+ generic_array(T, S), A, A, S, S) <= store(S).
+:- mode array_foldr2(in(pred(in, in, in, out, di, uo) is det),
+ in, in, out, di, uo) is det.
+:- mode array_foldr2(in(pred(in, in, di, uo, di, uo) is det),
+ in, di, uo, di, uo) is det.
+
+ % As above, but with a third accumulator.
+ %
+:- pred array_foldr3(pred(int, T, A, A, B, B, S, S),
+ generic_array(T, S), A, A, B, B, S, S) <= store(S).
+:- mode array_foldr3(in(pred(in, in, in, out, in, out, di, uo) is det),
+ in, in, out, in, out, di, uo) is det.
+:- mode array_foldr3(in(pred(in, in, in, out, di, uo, di, uo) is det),
+ in, in, out, di, uo, di, uo) is det.
+
+ % Apply a predicate once for each index and corresponding elements
+ % in the arrays, starting from the least index.
+ % Throws an exception if the arrays are not the same size.
+ %
+:- pred array_foldl_corresponding(pred(int, T, U, S, S),
+ generic_array(T, S), generic_array(U, S), S, S) <= store(S).
+:- mode array_foldl_corresponding(in(pred(in, in, in, di, uo) is det),
+ in, in, di, uo) is det.
+
+ % As above, but with a second accumulator.
+ %
+:- pred array_foldl2_corresponding(pred(int, T, U, A, A, S, S),
+ generic_array(T, S), generic_array(U, S), A, A, S, S) <= store(S).
+:- mode array_foldl2_corresponding(in(pred(in, in, in, in, out, di, uo) is det),
+ in, in, in, out, di, uo) is det.
+:- mode array_foldl2_corresponding(in(pred(in, in, in, di, uo, di, uo) is det),
+ in, in, di, uo, di, uo) is det.
+
+ % Apply a function once for each element in an array, returning
+ % a new array containing the results.
+ %
+:- pred array_map(func(T) = U, generic_array(T, S), generic_array(U, S), S, S)
+ <= store(S).
+:- mode array_map(in, in, out, di, uo) is det.
+
+ % Apply a function once for each index and corresponding elements
+ % in the arrays, starting from the least index, and returning
+ % a new array containing the results.
+ % Throws an exception if the arrays are not the same size.
+ %
+:- pred array_map_corresponding(func(T, U) = V,
+ generic_array(T, S), generic_array(U, S), generic_array(V, S), S, S)
+ <= store(S).
+:- mode array_map_corresponding(in, in, in, out, di, uo) is det.
+
+%---------------------------------------------------------------------------%
%
% References
%
@@ -312,6 +470,7 @@
:- import_module array.
:- import_module deconstruct.
+:- import_module int.
:- import_module require.
:- instance store(store(S)) where [].
@@ -544,11 +703,30 @@ new_array(Size, Init, Array, !Store) :-
new_array_from_list(List, Array, !Store) :-
Array = generic_array(array.array(List)).
+new_array_from_reverse_list(RevList, Array, !Store) :-
+ Array = generic_array(array.from_reverse_list(RevList)).
+
copy_array(generic_array(A0), generic_array(A), !Store) :-
array.copy(A0, A).
+generate_array(Size, Func, generic_array(A), !Store) :-
+ A = array.generate(Size, Func).
+
+generate_array_foldl(Size, Pred, generic_array(A), !Store) :-
+ array.generate_foldl(Size, Pred, A, !Store).
+
+generate_array_foldl2(Size, Pred, generic_array(A), !Acc, !Store) :-
+ array.generate_foldl2(Size, Pred, A, !Acc, !Store).
+
array_size(generic_array(A)) = array.size(A).
+array_least_index(generic_array(A)) = array.least_index(A).
+
+array_greatest_index(generic_array(A)) = array.greatest_index(A).
+
+array_in_bounds(generic_array(A), I) :-
+ array.in_bounds(A, I).
+
array_lookup(generic_array(A), I, _Store) = Elem :-
( if
array.bounds_checks,
@@ -559,9 +737,15 @@ array_lookup(generic_array(A), I, _Store) = Elem :-
array.unsafe_lookup(A, I, Elem)
).
+array_lookup(Array, I, Elem, !Store) :-
+ Elem = array_lookup(Array, I, !.Store).
+
unsafe_array_lookup(generic_array(A), I, _Store) = Elem :-
array.unsafe_lookup(A, I, Elem).
+unsafe_array_lookup(Array, I, Elem, !Store) :-
+ Elem = unsafe_array_lookup(Array, I, !.Store).
+
array_set(generic_array(A), I, Elem, !Store) :-
( if
array.bounds_checks,
@@ -575,6 +759,205 @@ array_set(generic_array(A), I, Elem, !Store) :-
unsafe_array_set(generic_array(A), I, Elem, !Store) :-
array.very_unsafe_set(A, I, Elem, !Store).
+array_to_list(generic_array(A), _Store) = array.to_list(A).
+
+array_to_list(generic_array(A), List, !Store) :-
+ array.to_list(A, List).
+
+array_fetch_items(generic_array(A), Start, End, _Store) =
+ array.fetch_items(A, Start, End).
+
+array_fetch_items(generic_array(A), Start, End, List, !Store) :-
+ array.fetch_items(A, Start, End, List).
+
+array_append(generic_array(A), generic_array(B), generic_array(C), !S) :-
+ C = array.append(A, B).
+
+:- impure pred use_array_in_store(array(T)::array_di, S::di, S::uo)
+ is det.
+
+use_array_in_store(_, !Store) :-
+ impure private_builtin.imp.
+
+%---------------------------------------------------------------------------%
+
+array_foldl(Pred, Array, !Store) :-
+ do_array_foldl(Pred, Array, 0, array_size(Array), !Store).
+
+:- pred do_array_foldl(pred(int, T, S, S), generic_array(T, S), int, int, S, S)
+ <= store(S).
+:- mode do_array_foldl(in(pred(in, in, di, uo) is det), in, in, in, di, uo)
+ is det.
+
+do_array_foldl(Pred, Array, Index, Size, !Store) :-
+ ( if Index < Size then
+ Elem = unsafe_array_lookup(Array, Index, !.Store),
+ Pred(Index, Elem, !Store),
+ do_array_foldl(Pred, Array, Index + 1, Size, !Store)
+ else
+ true
+ ).
+
+array_foldl2(Pred, Array, !Acc, !Store) :-
+ do_array_foldl2(Pred, Array, 0, array_size(Array), !Acc, !Store).
+
+:- pred do_array_foldl2(pred(int, T, A, A, S, S),
+ generic_array(T, S), int, int, A, A, S, S) <= store(S).
+:- mode do_array_foldl2(in(pred(in, in, in, out, di, uo) is det),
+ in, in, in, in, out, di, uo) is det.
+:- mode do_array_foldl2(in(pred(in, in, di, uo, di, uo) is det),
+ in, in, in, di, uo, di, uo) is det.
+
+do_array_foldl2(Pred, Array, Index, Size, !Acc, !Store) :-
+ ( if Index < Size then
+ Elem = unsafe_array_lookup(Array, Index, !.Store),
+ Pred(Index, Elem, !Acc, !Store),
+ do_array_foldl2(Pred, Array, Index + 1, Size, !Acc, !Store)
+ else
+ true
+ ).
+
+array_foldl3(Pred, Array, !Acc1, !Acc2, !Store) :-
+ do_array_foldl3(Pred, Array, 0, array_size(Array), !Acc1, !Acc2, !Store).
+
+:- pred do_array_foldl3(pred(int, T, A, A, B, B, S, S),
+ generic_array(T, S), int, int, A, A, B, B, S, S) <= store(S).
+:- mode do_array_foldl3(in(pred(in, in, in, out, in, out, di, uo) is det),
+ in, in, in, in, out, in, out, di, uo) is det.
+:- mode do_array_foldl3(in(pred(in, in, in, out, di, uo, di, uo) is det),
+ in, in, in, in, out, di, uo, di, uo) is det.
+
+do_array_foldl3(Pred, Array, Index, Size, !Acc1, !Acc2, !Store) :-
+ ( if Index < Size then
+ Elem = unsafe_array_lookup(Array, Index, !.Store),
+ Pred(Index, Elem, !Acc1, !Acc2, !Store),
+ do_array_foldl3(Pred, Array, Index + 1, Size, !Acc1, !Acc2, !Store)
+ else
+ true
+ ).
+
+array_foldr(Pred, Array, !Store) :-
+ do_array_foldr(Pred, Array, array_greatest_index(Array), !Store).
+
+:- pred do_array_foldr(pred(int, T, S, S), generic_array(T, S), int, S, S)
+ <= store(S).
+:- mode do_array_foldr(in(pred(in, in, di, uo) is det), in, in, di, uo) is det.
+
+do_array_foldr(Pred, Array, Index, !Store) :-
+ ( if Index >= 0 then
+ Elem = unsafe_array_lookup(Array, Index, !.Store),
+ Pred(Index, Elem, !Store),
+ do_array_foldr(Pred, Array, Index - 1, !Store)
+ else
+ true
+ ).
+
+array_foldr2(Pred, Array, !Acc, !Store) :-
+ do_array_foldr2(Pred, Array, array_greatest_index(Array), !Acc, !Store).
+
+:- pred do_array_foldr2(pred(int, T, A, A, S, S), generic_array(T, S), int,
+ A, A, S, S) <= store(S).
+:- mode do_array_foldr2(in(pred(in, in, in, out, di, uo) is det), in, in,
+ in, out, di, uo) is det.
+:- mode do_array_foldr2(in(pred(in, in, di, uo, di, uo) is det), in, in,
+ di, uo, di, uo) is det.
+
+do_array_foldr2(Pred, Array, Index, !Acc, !Store) :-
+ ( if Index >= 0 then
+ Elem = unsafe_array_lookup(Array, Index, !.Store),
+ Pred(Index, Elem, !Acc, !Store),
+ do_array_foldr2(Pred, Array, Index - 1, !Acc, !Store)
+ else
+ true
+ ).
+
+array_foldr3(Pred, Array, !Acc1, !Acc2, !Store) :-
+ do_array_foldr3(Pred, Array, array_greatest_index(Array), !Acc1, !Acc2,
+ !Store).
+
+:- pred do_array_foldr3(pred(int, T, A, A, B, B, S, S), generic_array(T, S),
+ int, A, A, B, B, S, S) <= store(S).
+:- mode do_array_foldr3(in(pred(in, in, in, out, in, out, di, uo) is det), in,
+ in, in, out, in, out, di, uo) is det.
+:- mode do_array_foldr3(in(pred(in, in, in, out, di, uo, di, uo) is det), in,
+ in, in, out, di, uo, di, uo) is det.
+
+do_array_foldr3(Pred, Array, Index, !Acc1, !Acc2, !Store) :-
+ ( if Index >= 0 then
+ Elem = unsafe_array_lookup(Array, Index, !.Store),
+ Pred(Index, Elem, !Acc1, !Acc2, !Store),
+ do_array_foldr3(Pred, Array, Index - 1, !Acc1, !Acc2, !Store)
+ else
+ true
+ ).
+
+array_foldl_corresponding(Pred, Array1, Array2, !Store) :-
+ Size = array_size(Array1),
+ ( if Size = array_size(Array2) then
+ do_array_foldl_corresponding(Pred, Array1, Array2, 0, Size, !Store)
+ else
+ error("store.array_foldl_corresponding: size mismatch")
+ ).
+
+:- pred do_array_foldl_corresponding(pred(int, T, U, S, S),
+ generic_array(T, S), generic_array(U, S), int, int, S, S) <= store(S).
+:- mode do_array_foldl_corresponding(in(pred(in, in, in, di, uo) is det),
+ in, in, in, in, di, uo) is det.
+
+do_array_foldl_corresponding(Pred, Array1, Array2, Index, Size, !Store) :-
+ ( if Index < Size then
+ Elem1 = unsafe_array_lookup(Array1, Index, !.Store),
+ Elem2 = unsafe_array_lookup(Array2, Index, !.Store),
+ Pred(Index, Elem1, Elem2, !Store),
+ do_array_foldl_corresponding(Pred, Array1, Array2, Index + 1, Size,
+ !Store)
+ else
+ true
+ ).
+
+array_foldl2_corresponding(Pred, Array1, Array2, !Acc, !Store) :-
+ Size = array_size(Array1),
+ ( if Size = array_size(Array2) then
+ do_array_foldl2_corresponding(Pred, Array1, Array2, 0, Size,
+ !Acc, !Store)
+ else
+ error("store.array_foldl2_corresponding: size mismatch")
+ ).
+
+:- pred do_array_foldl2_corresponding(pred(int, T, U, A, A, S, S),
+ generic_array(T, S), generic_array(U, S), int, int, A, A, S, S)
+ <= store(S).
+:- mode do_array_foldl2_corresponding(
+ in(pred(in, in, in, in, out, di, uo) is det),
+ in, in, in, in, in, out, di, uo) is det.
+:- mode do_array_foldl2_corresponding(
+ in(pred(in, in, in, di, uo, di, uo) is det),
+ in, in, in, in, di, uo, di, uo) is det.
+
+do_array_foldl2_corresponding(Pred, Array1, Array2, Index, Size,
+ !Acc, !Store) :-
+ ( if Index < Size then
+ Elem1 = unsafe_array_lookup(Array1, Index, !.Store),
+ Elem2 = unsafe_array_lookup(Array2, Index, !.Store),
+ Pred(Index, Elem1, Elem2, !Acc, !Store),
+ do_array_foldl2_corresponding(Pred, Array1, Array2, Index + 1, Size,
+ !Acc, !Store)
+ else
+ true
+ ).
+
+array_map(Func, generic_array(A1), generic_array(A2), !Store) :-
+ A2 = array.map(Func, A1).
+
+array_map_corresponding(Func, Array1, Array2, Array3, !Store) :-
+ Array1 = generic_array(A1),
+ Array2 = generic_array(A2),
+ Pred = ( pred(Elem1::in, Elem2::in, Elem3::out, !.S::di, !:S::uo) is det :-
+ Elem3 = Func(Elem1, Elem2)
+ ),
+ array.map_corresponding_foldl(Pred, A1, A2, A3, !Store),
+ Array3 = generic_array(A3).
+
%---------------------------------------------------------------------------%
:- pragma foreign_type("C#", generic_ref(T, S), "store.Ref").
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index d2dc634..1fc286a 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -718,6 +718,16 @@ else
SETENV_PROGS =
endif
+# Store arrays are not supported in Erlang.
+ifeq "$(filter erlang%,$(GRADE))" ""
+ STORE_ARRAY_PROGS = \
+ io_array \
+ io_array_2 \
+ io_array_3
+else
+ STORE_ARRAY_PROGS =
+endif
+
PROGS = \
$(ORDINARY_PROGS) \
$(PROF_PROGS) \
@@ -738,7 +748,8 @@ PROGS = \
$(CTGC_PROGS) \
$(BIG_DATA_PROGS) \
$(CONC_PROGS) \
- $(SETENV_PROGS)
+ $(SETENV_PROGS) \
+ $(STORE_ARRAY_PROGS)
#-----------------------------------------------------------------------------#
diff --git a/tests/hard_coded/io_array.exp b/tests/hard_coded/io_array.exp
new file mode 100644
index 0000000..57478d2
--- /dev/null
+++ b/tests/hard_coded/io_array.exp
@@ -0,0 +1,27 @@
+["", "", "", "", ""]
+Size: 5
+
+[1, 2, 3]
+[3, 2, 1]
+
+[1, 2, 3]
+[1, 7, 3]
+
+Generating 0 -> 2
+Generating 1 -> 4
+Generating 2 -> 6
+[2, 4, 6]
+
+Generating 0 -> 1
+Generating 1 -> 3
+Generating 2 -> 5
+[1, 3, 5]
+
+[1, 2, 3, 4, 5]
+[3, 4]
+
+[1, 2, 3, 1, 2, 3]
+
+[1, 2, 3]
+[2, 3, 4]
+
diff --git a/tests/hard_coded/io_array.m b/tests/hard_coded/io_array.m
new file mode 100644
index 0000000..712f120
--- /dev/null
+++ b/tests/hard_coded/io_array.m
@@ -0,0 +1,140 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+%
+% Test I/O state arrays.
+%
+
+:- module io_array.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module store.
+:- import_module string.
+
+main(!IO) :-
+ test1(!IO),
+ test2(!IO),
+ test3(!IO),
+ test4(!IO),
+ test5(!IO),
+ test6(!IO),
+ test7(!IO),
+ test8(!IO).
+
+%---------------------------------------------------------------------------%
+
+:- pred test1(io::di, io::uo) is det.
+
+test1(!IO) :-
+ new_array(5, "", A, !IO),
+ write_io_array(A, !IO),
+ io.format("Size: %d\n", [i(array_size(A))], !IO),
+ io.nl(!IO).
+
+:- pred test2(io::di, io::uo) is det.
+
+test2(!IO) :-
+ List = [1, 2, 3],
+ new_array_from_list(List, A, !IO),
+ new_array_from_reverse_list(List, B, !IO),
+ write_io_array(A, !IO),
+ write_io_array(B, !IO),
+ io.nl(!IO).
+
+:- pred test3(io::di, io::uo) is det.
+
+test3(!IO) :-
+ new_array_from_list([1, 2, 3], A, !IO),
+ copy_array(A, B, !IO),
+ array_set(B, 1, 7, !IO),
+ write_io_array(A, !IO),
+ write_io_array(B, !IO),
+ io.nl(!IO).
+
+:- pred test4(io::di, io::uo) is det.
+
+test4(!IO) :-
+ F = (func(I) = (I + 1) * 2),
+ P = (pred(I::in, E::out, !.S::di, !:S::uo) is det :-
+ E = F(I),
+ io.format("Generating %d -> %d\n", [i(I), i(E)], !S)
+ ),
+ generate_array(3, F, A, !IO),
+ generate_array_foldl(3, P, B, !IO),
+ write_io_array(A, !IO),
+ io.nl(!IO).
+
+:- pred test5(io::di, io::uo) is det.
+
+test5(!IO) :-
+ P = (pred(I::in, E::out, A0::in, A::out, !.S::di, !:S::uo) is det :-
+ E = A0,
+ A = A0 + 2,
+ io.format("Generating %d -> %d\n", [i(I), i(E)], !S)
+ ),
+ generate_array_foldl2(3, P, A, 1, _, !IO),
+ write_io_array(A, !IO),
+ io.nl(!IO).
+
+:- pred test6(io::di, io::uo) is det.
+
+test6(!IO) :-
+ new_array_from_list([1, 2, 3, 4, 5], A, !IO),
+ array_to_list(A, L1, !IO),
+ array_fetch_items(A, 2, 3, L2, !IO),
+ io.write_line(L1, !IO),
+ io.write_line(L2, !IO),
+ io.nl(!IO).
+
+:- pred test7(io::di, io::uo) is det.
+
+test7(!IO) :-
+ new_array_from_list([1, 2, 3], A, !IO),
+ array_append(A, A, B, !IO),
+ write_io_array(B, !IO),
+ io.nl(!IO).
+
+:- pred test8(io::di, io::uo) is det.
+
+test8(!IO) :-
+ new_array_from_list([1, 2, 3], A, !IO),
+ F = (func(X) = X + 1),
+ array_map(F, A, B, !IO),
+ write_io_array(A, !IO),
+ write_io_array(B, !IO),
+ io.nl(!IO).
+
+%---------------------------------------------------------------------------%
+
+:- pred write_io_array(io_array(T)::in, io::di, io::uo) is det.
+
+write_io_array(A, !IO) :-
+ ( if array_size(A) = 0 then
+ io.write_string("[]\n", !IO)
+ else
+ io.write_string("[", !IO),
+ unsafe_array_lookup(A, 0, E, !IO),
+ io.write(E, !IO),
+ write_io_array_2(A, 1, !IO),
+ io.write_string("]\n", !IO)
+ ).
+
+:- pred write_io_array_2(io_array(T)::in, int::in, io::di, io::uo) is det.
+
+write_io_array_2(A, I, !IO) :-
+ ( if I < array_size(A) then
+ io.write_string(", ", !IO),
+ unsafe_array_lookup(A, I, E, !IO),
+ io.write(E, !IO),
+ write_io_array_2(A, I + 1, !IO)
+ else
+ true
+ ).
+
diff --git a/tests/hard_coded/io_array_2.exp b/tests/hard_coded/io_array_2.exp
new file mode 100644
index 0000000..612d1c4
--- /dev/null
+++ b/tests/hard_coded/io_array_2.exp
@@ -0,0 +1,24 @@
+0 -> 1;
+1 -> 2;
+2 -> 3;
+3 -> 4;
+
+Sum: 10
+
+[2, 3, 4, 5]
+
+[2, 3, 4, 5]
+Sum: 10
+
+3 -> 4;
+2 -> 3;
+1 -> 2;
+0 -> 1;
+
+Sum: 10
+
+[2, 3, 4, 5]
+
+[2, 3, 4, 5]
+Sum: 10
+
diff --git a/tests/hard_coded/io_array_2.m b/tests/hard_coded/io_array_2.m
new file mode 100644
index 0000000..0de6fa5
--- /dev/null
+++ b/tests/hard_coded/io_array_2.m
@@ -0,0 +1,137 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+%
+% Test folding over I/O state arrays.
+%
+
+:- module io_array_2.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module store.
+:- import_module string.
+
+main(!IO) :-
+ new_array_from_list([1, 2, 3, 4], A, !IO),
+ test1(A, !IO),
+ test2(A, !IO),
+ test3(A, !IO),
+ test4(A, !IO),
+ test5(A, !IO),
+ test6(A, !IO),
+ test7(A, !IO),
+ test8(A, !IO).
+
+%---------------------------------------------------------------------------%
+
+:- pred test1(io_array(int)::in, io::di, io::uo) is det.
+
+test1(A, !IO) :-
+ P = (pred(I::in, E::in, !.S::di, !:S::uo) is det :-
+ io.format("%d -> %d;\n", [i(I), i(E)], !S)
+ ),
+ array_foldl(P, A, !IO),
+ io.nl(!IO).
+
+:- pred test2(io_array(int)::in, io::di, io::uo) is det.
+
+test2(A, !IO) :-
+ P = (pred(_::in, E::in, A0::in, A::out, !.S::di, !:S::uo) is det :-
+ A = A0 + E
+ ),
+ array_foldl2(P, A, 0, Sum, !IO),
+ io.format("Sum: %d\n\n", [i(Sum)], !IO).
+
+:- pred test3(io_array(int)::in, io::di, io::uo) is det.
+
+test3(A, !IO) :-
+ some [!St] (
+ store.init(!:St),
+ new_array(array_size(A), 0, B, !St),
+ P = (pred(I::in, E::in, !.St::di, !:St::uo, !.S::di, !:S::uo) is det :-
+ unsafe_array_set(B, I, E + 1, !St)
+ ),
+ array_foldl2(P, A, !St, !IO),
+ array_to_list(B, List, !St),
+ !.St = _
+ ),
+ io.write_line(List, !IO),
+ io.nl(!IO).
+
+:- pred test4(io_array(int)::in, io::di, io::uo) is det.
+
+test4(A, !IO) :-
+ some [!St] (
+ store.init(!:St),
+ new_array(array_size(A), 0, B, !St),
+ P = (pred(I::in, E::in, X0::in, X::out, !.St::di, !:St::uo,
+ !.S::di, !:S::uo) is det :-
+ X = X0 + E,
+ unsafe_array_set(B, I, E + 1, !St)
+ ),
+ array_foldl3(P, A, 0, Sum, !St, !IO),
+ array_to_list(B, List, !St),
+ !.St = _
+ ),
+ io.write_line(List, !IO),
+ io.format("Sum: %d\n\n", [i(Sum)], !IO).
+
+:- pred test5(io_array(int)::in, io::di, io::uo) is det.
+
+test5(A, !IO) :-
+ P = (pred(I::in, E::in, !.S::di, !:S::uo) is det :-
+ io.format("%d -> %d;\n", [i(I), i(E)], !S)
+ ),
+ array_foldr(P, A, !IO),
+ io.nl(!IO).
+
+:- pred test6(io_array(int)::in, io::di, io::uo) is det.
+
+test6(A, !IO) :-
+ P = (pred(_::in, E::in, A0::in, A::out, !.S::di, !:S::uo) is det :-
+ A = A0 + E
+ ),
+ array_foldr2(P, A, 0, Sum, !IO),
+ io.format("Sum: %d\n\n", [i(Sum)], !IO).
+
+:- pred test7(io_array(int)::in, io::di, io::uo) is det.
+
+test7(A, !IO) :-
+ some [!St] (
+ store.init(!:St),
+ new_array(array_size(A), 0, B, !St),
+ P = (pred(I::in, E::in, !.St::di, !:St::uo, !.S::di, !:S::uo) is det :-
+ unsafe_array_set(B, I, E + 1, !St)
+ ),
+ array_foldr2(P, A, !St, !IO),
+ array_to_list(B, List, !St),
+ !.St = _
+ ),
+ io.write_line(List, !IO),
+ io.nl(!IO).
+
+:- pred test8(io_array(int)::in, io::di, io::uo) is det.
+
+test8(A, !IO) :-
+ some [!St] (
+ store.init(!:St),
+ new_array(array_size(A), 0, B, !St),
+ P = (pred(I::in, E::in, X0::in, X::out, !.St::di, !:St::uo,
+ !.S::di, !:S::uo) is det :-
+ X = X0 + E,
+ unsafe_array_set(B, I, E + 1, !St)
+ ),
+ array_foldr3(P, A, 0, Sum, !St, !IO),
+ array_to_list(B, List, !St),
+ !.St = _
+ ),
+ io.write_line(List, !IO),
+ io.format("Sum: %d\n\n", [i(Sum)], !IO).
+
diff --git a/tests/hard_coded/io_array_3.exp b/tests/hard_coded/io_array_3.exp
new file mode 100644
index 0000000..99e7bbc
--- /dev/null
+++ b/tests/hard_coded/io_array_3.exp
@@ -0,0 +1,13 @@
+0 -> 1, "one";
+1 -> 2, "two";
+2 -> 3, "three";
+3 -> 4, "four";
+
+0 -> 1, "one";
+1 -> 2, "two";
+2 -> 3, "three";
+3 -> 4, "four";
+Sum: 10
+
+[4, 5, 8, 8]
+
diff --git a/tests/hard_coded/io_array_3.m b/tests/hard_coded/io_array_3.m
new file mode 100644
index 0000000..b982f7e
--- /dev/null
+++ b/tests/hard_coded/io_array_3.m
@@ -0,0 +1,57 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+%
+% Test folding and mapping over corresponding I/O state arrays.
+%
+
+:- module io_array_3.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module store.
+:- import_module string.
+
+main(!IO) :-
+ new_array_from_list([1, 2, 3, 4], A, !IO),
+ new_array_from_list(["one", "two", "three", "four"], B, !IO),
+ test1(A, B, !IO),
+ test2(A, B, !IO),
+ test3(A, B, !IO).
+
+%---------------------------------------------------------------------------%
+
+:- pred test1(io_array(int)::in, io_array(string)::in, io::di, io::uo) is det.
+
+test1(A, B, !IO) :-
+ P = (pred(I::in, EA::in, EB::in, !.S::di, !:S::uo) is det :-
+ io.format("%d -> %d, ""%s"";\n", [i(I), i(EA), s(EB)], !S)
+ ),
+ array_foldl_corresponding(P, A, B, !IO),
+ io.nl(!IO).
+
+:- pred test2(io_array(int)::in, io_array(string)::in, io::di, io::uo) is det.
+
+test2(A, B, !IO) :-
+ P = (pred(I::in, EA::in, EB::in, X0::in, X::out, !.S::di, !:S::uo) is det :-
+ X = X0 + EA,
+ io.format("%d -> %d, ""%s"";\n", [i(I), i(EA), s(EB)], !S)
+ ),
+ array_foldl2_corresponding(P, A, B, 0, Sum, !IO),
+ io.format("Sum: %d\n\n", [i(Sum)], !IO).
+
+:- pred test3(io_array(int)::in, io_array(string)::in, io::di, io::uo) is det.
+
+test3(A, B, !IO) :-
+ F = (func(EA, EB) = EA + string.length(EB)),
+ array_map_corresponding(F, A, B, C, !IO),
+ array_to_list(C, List, !IO),
+ io.write_line(List, !IO),
+ io.nl(!IO).
+
More information about the reviews
mailing list