mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-16 09:53:36 +00:00
Code Issues Projects Releases Wiki Activity
Files
bb52ce080434e29675598653cc09e2a63db086f1
mercury/library/array.m
Julien Fischer 3a7254bca2 Improve the documentation for array.fetch_items. 
Change the behaviour of the above predicate in the following ways:
- throw an index_out_of_bounds/0 exception instead of a software_error/0
  exception if either index is out of bounds.
- perform the out of bounds check before checking if the third argument is
  less than the second.

Add an more comprehensive test of fetch_items/4.

library/array.m:
    Make it clear that the range of indexes passed to fetch_items is
    inclusive.

    Throw an index_out_of_bounds/0 exception instead of a software_error/1
    exception if either of the indexes is out of bounds.

    Perform the array bounds check first, before checking if the third
    argument is less than the second.

    Document what happens if the upper index is less than the lower one.

    Fix a typo in the documentation of fill_range/4.

    Update the definition of to_list/2 to conform with the above change
    to the array bounds checks.

NEWS:
    Announce the above change to the semantics of fetch_items/0.

tests/hard_coded/Mmakefile:
tests/hard_coded/array_fetch_items.{m,exp}:
    Add a more comprehensive
2018-12-24 06:15:23 +00:00

3514 lines
117 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1993-1995, 1997-2012 The University of Melbourne.
% Copyright (C) 2013-2018 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: array.m.
% Main authors: fjh, bromage.
% Stability: medium-low.
%
% This module provides dynamically-sized one-dimensional arrays.
% Array indices start at zero.
%
% WARNING!
%
% Arrays are currently not unique objects. until this situation is resolved,
% it is up to the programmer to ensure that arrays are used in ways that
% preserve correctness. In the absence of mode reordering, one should therefore
% assume that evaluation will take place in left-to-right order. For example,
% the following code will probably not work as expected (f is a function,
% A an array, I an index, and X an appropriate value):
%
% Y = f(A ^ elem(I) := X, A ^ elem(I))
%
% The compiler is likely to compile this as
%
% V0 = A ^ elem(I) := X,
% V1 = A ^ elem(I),
% Y = f(V0, V1)
%
% and will be unaware that the first line should be ordered *after* the second.
% The safest thing to do is write things out by hand in the form
%
% A0I = A0 ^ elem(I),
% A1 = A0 ^ elem(I) := X,
% Y = f(A1, A0I)
%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- module array.
:- interface.
:- import_module list.
:- import_module maybe.
:- import_module pretty_printer.
:- import_module random.
:- type array(T).
:- inst array(I) == ground.
:- inst array == array(ground).
% XXX the current Mercury compiler doesn't support `ui' modes,
% so to work-around that problem, we currently don't use
% unique modes in this module.
% :- inst uniq_array(I) == unique.
% :- inst uniq_array == uniq_array(unique).
:- inst uniq_array(I) == array(I). % XXX work-around
:- inst uniq_array == uniq_array(ground). % XXX work-around
:- mode array_di == di(uniq_array).
:- mode array_uo == out(uniq_array).
:- mode array_ui == in(uniq_array).
% :- inst mostly_uniq_array(I) == mostly_unique).
% :- inst mostly_uniq_array == mostly_uniq_array(mostly_unique).
:- inst mostly_uniq_array(I) == array(I). % XXX work-around
:- inst mostly_uniq_array == mostly_uniq_array(ground). % XXX work-around
:- mode array_mdi == mdi(mostly_uniq_array).
:- mode array_muo == out(mostly_uniq_array).
:- mode array_mui == in(mostly_uniq_array).
% An `index_out_of_bounds' is the exception thrown
% on out-of-bounds array accesses. The string describes
% the predicate or function reporting the error.
:- type index_out_of_bounds
---> index_out_of_bounds(string).
%---------------------------------------------------------------------------%
% make_empty_array(Array) creates an array of size zero
% starting at lower bound 0.
%
:- pred make_empty_array(array(T)::array_uo) is det.
:- func make_empty_array = (array(T)::array_uo) is det.
% init(Size, Init, Array) creates an array with bounds from 0
% to Size-1, with each element initialized to Init. Throws an
% exception if Size < 0.
%
:- pred init(int, T, array(T)).
:- mode init(in, in, array_uo) is det.
:- func init(int, T) = array(T).
:- mode init(in, in) = array_uo is det.
% array/1 is a function that constructs an array from a list.
% (It does the same thing as the predicate from_list/2.)
% The syntax `array([...])' is used to represent arrays
% for io.read, io.write, term_to_type, and type_to_term.
%
:- func array(list(T)) = array(T).
:- mode array(in) = array_uo is det.
% generate(Size, Generate) = Array:
% Create an array with bounds from 0 to Size - 1 using the function
% Generate to set the initial value of each element of the array.
% The initial value of the element at index K will be the result of
% calling the function Generate(K). Throws an exception if Size < 0.
%
:- func generate(int::in, (func(int) = T)::in) = (array(T)::array_uo)
is det.
% generate_foldl(Size, Generate, Array, !Acc):
% As above, but using a predicate with an accumulator threaded through it
% to generate the initial value of each element.
%
:- pred generate_foldl(int, pred(int, T, A, A), array(T), A, A).
:- mode generate_foldl(in, in(pred(in, out, in, out) is det),
array_uo, in, out) is det.
:- mode generate_foldl(in, in(pred(in, out, mdi, muo) is det),
array_uo, mdi, muo) is det.
:- mode generate_foldl(in, in(pred(in, out, di, uo) is det),
array_uo, di, uo) is det.
:- mode generate_foldl(in, in(pred(in, out, in, out) is semidet),
array_uo, in, out) is semidet.
:- mode generate_foldl(in, in(pred(in, out, mdi, muo) is semidet),
array_uo, mdi, muo) is semidet.
:- mode generate_foldl(in, in(pred(in, out, di, uo) is semidet),
array_uo, di, uo) is semidet.
%---------------------------------------------------------------------------%
% min returns the lower bound of the array.
% Note: in this implementation, the lower bound is always zero.
%
:- pred min(array(_T), int).
%:- mode min(array_ui, out) is det.
:- mode min(in, out) is det.
:- func min(array(_T)) = int.
%:- mode min(array_ui) = out is det.
:- mode min(in) = out is det.
% least_index returns the lower bound of the array.
% In future, it will be changed to behave like semidet_least_index,
% failing on an empty array instead of returning an out-of-bounds index.
%
:- pragma obsolete(least_index/1).
:- func least_index(array(T)) = int.
%:- mode least_index(array_ui) = out is det.
:- mode least_index(in) = out is det.
% det_least_index returns the lower bound of the array.
% Throws an exception if the array is empty.
%
:- func det_least_index(array(T)) = int.
%:- mode det_least_index(array_ui) = out is det.
:- mode det_least_index(in) = out is det.
% semidet_least_index returns the lower bound of the array,
% or fails if the array is empty.
%
:- func semidet_least_index(array(T)) = int.
%:- mode semidet_least_index(array_ui) = out is semidet.
:- mode semidet_least_index(in) = out is semidet.
% max returns the upper bound of the array.
% Returns lower bound - 1 for an empty array
% (always -1 in this implementation).
%
:- pred max(array(_T), int).
%:- mode max(array_ui, out) is det.
:- mode max(in, out) is det.
:- func max(array(_T)) = int.
%:- mode max(array_ui) = out is det.
:- mode max(in) = out is det.
% greatest_index returns the upper bound of the array.
% In future, it will be changed to behave like semidet_greatest_index,
% failing on an empty array instead of returning an out-of-bounds index.
%
:- pragma obsolete(greatest_index/1).
:- func greatest_index(array(T)) = int.
%:- mode greatest_index(array_ui) = out is det.
:- mode greatest_index(in) = out is det.
% det_greatest_index returns the upper bound of the array.
% Throws an exception if the array is empty.
%
:- func det_greatest_index(array(T)) = int.
%:- mode det_greatest_index(array_ui) = out is det.
:- mode det_greatest_index(in) = out is det.
% semidet_greatest_index returns the upper bound of the array,
% or fails if the array is empty.
%
:- func semidet_greatest_index(array(T)) = int.
%:- mode semidet_greatest_index(array_ui) = out is semidet.
:- mode semidet_greatest_index(in) = out is semidet.
% size returns the length of the array,
% i.e. upper bound - lower bound + 1.
%
:- pred size(array(_T), int).
%:- mode size(array_ui, out) is det.
:- mode size(in, out) is det.
:- func size(array(_T)) = int.
%:- mode size(array_ui) = out is det.
:- mode size(in) = out is det.
% bounds(Array, Min, Max) returns the lower and upper bounds of an array.
% The upper bound will be lower bound - 1 for an empty array.
% Note: in this implementation, the lower bound is always zero.
%
:- pred bounds(array(_T), int, int).
%:- mode bounds(array_ui, out, out) is det.
:- mode bounds(in, out, out) is det.
% in_bounds checks whether an index is in the bounds of an array.
%
:- pred in_bounds(array(_T), int).
%:- mode in_bounds(array_ui, in) is semidet.
:- mode in_bounds(in, in) is semidet.
% is_empty(Array):
% True iff Array is an array of size zero.
%
:- pred is_empty(array(_T)).
%:- mode is_empty(array_ui) is semidet.
:- mode is_empty(in) is semidet.
%---------------------------------------------------------------------------%
% lookup returns the N'th element of an array.
% Throws an exception if the index is out of bounds.
%
:- pred lookup(array(T), int, T).
%:- mode lookup(array_ui, in, out) is det.
:- mode lookup(in, in, out) is det.
:- func lookup(array(T), int) = T.
%:- mode lookup(array_ui, in) = out is det.
:- mode lookup(in, in) = out is det.
% semidet_lookup returns the N'th element of an array.
% It fails if the index is out of bounds.
%
:- pred semidet_lookup(array(T), int, T).
%:- mode semidet_lookup(array_ui, in, out) is semidet.
:- mode semidet_lookup(in, in, out) is semidet.
% unsafe_lookup returns the N'th element of an array.
% It is an error if the index is out of bounds.
%
:- pred unsafe_lookup(array(T), int, T).
%:- mode unsafe_lookup(array_ui, in, out) is det.
:- mode unsafe_lookup(in, in, out) is det.
% set sets the N'th element of an array, and returns the
% resulting array (good opportunity for destructive update ;-).
% Throws an exception if the index is out of bounds.
%
:- pred set(int, T, array(T), array(T)).
:- mode set(in, in, array_di, array_uo) is det.
:- func set(array(T), int, T) = array(T).
:- mode set(array_di, in, in) = array_uo is det.
% semidet_set sets the nth element of an array, and returns
% the resulting array. It fails if the index is out of bounds.
%
:- pred semidet_set(int, T, array(T), array(T)).
:- mode semidet_set(in, in, array_di, array_uo) is semidet.
% unsafe_set sets the nth element of an array, and returns the
% resulting array. It is an error if the index is out of bounds.
%
:- pred unsafe_set(int, T, array(T), array(T)).
:- mode unsafe_set(in, in, array_di, array_uo) is det.
% slow_set sets the nth element of an array, and returns the
% resulting array. The initial array is not required to be unique,
% so the implementation may not be able to use destructive update.
% It is an error if the index is out of bounds.
%
:- pred slow_set(int, T, array(T), array(T)).
%:- mode slow_set(in, in, array_ui, array_uo) is det.
:- mode slow_set(in, in, in, array_uo) is det.
:- func slow_set(array(T), int, T) = array(T).
%:- mode slow_set(array_ui, in, in) = array_uo is det.
:- mode slow_set(in, in, in) = array_uo is det.
% semidet_slow_set sets the nth element of an array, and returns
% the resulting array. The initial array is not required to be unique,
% so the implementation may not be able to use destructive update.
% It fails if the index is out of bounds.
%
:- pred semidet_slow_set(int, T, array(T), array(T)).
%:- mode semidet_slow_set(in, in, array_ui, array_uo) is semidet.
:- mode semidet_slow_set(in, in, in, array_uo) is semidet.
% Field selection for arrays.
% Array ^ elem(Index) = lookup(Array, Index).
%
:- func elem(int, array(T)) = T.
%:- mode elem(in, array_ui) = out is det.
:- mode elem(in, in) = out is det.
% As above, but omit the bounds check.
%
:- func unsafe_elem(int, array(T)) = T.
%:- mode unsafe_elem(in, array_ui) = out is det.
:- mode unsafe_elem(in, in) = out is det.
% Field update for arrays.
% (Array ^ elem(Index) := Value) = set(Array, Index, Value).
%
:- func 'elem :='(int, array(T), T) = array(T).
:- mode 'elem :='(in, array_di, in) = array_uo is det.
% As above, but omit the bounds check.
%
:- func 'unsafe_elem :='(int, array(T), T) = array(T).
:- mode 'unsafe_elem :='(in, array_di, in) = array_uo is det.
% swap(I, J, !Array):
% Swap the item in the I'th position with the item in the J'th position.
% Throws an exception if either of I or J is out-of-bounds.
%
:- pred swap(int, int, array(T), array(T)).
:- mode swap(in, in, array_di, array_uo) is det.
% As above, but omit the bounds checks.
%
:- pred unsafe_swap(int, int, array(T), array(T)).
:- mode unsafe_swap(in, in, array_di, array_uo) is det.
% Returns every element of the array, one by one.
%
:- pred member(array(T)::in, T::out) is nondet.
%---------------------------------------------------------------------------%
% copy(Array0, Array):
% Makes a new unique copy of an array.
%
:- pred copy(array(T), array(T)).
%:- mode copy(array_ui, array_uo) is det.
:- mode copy(in, array_uo) is det.
:- func copy(array(T)) = array(T).
%:- mode copy(array_ui) = array_uo is det.
:- mode copy(in) = array_uo is det.
% resize(Size, Init, Array0, Array):
% The array is expanded or shrunk to make it fit the new size `Size'.
% Any new entries are filled with `Init'. Throws an exception if
% `Size' < 0.
%
:- pred resize(int, T, array(T), array(T)).
:- mode resize(in, in, array_di, array_uo) is det.
% resize(Array0, Size, Init) = Array:
% The array is expanded or shrunk to make it fit the new size `Size'.
% Any new entries are filled with `Init'. Throws an exception if
% `Size' < 0.
%
:- func resize(array(T), int, T) = array(T).
:- mode resize(array_di, in, in) = array_uo is det.
% shrink(Size, Array0, Array):
% The array is shrunk to make it fit the new size `Size'.
% Throws an exception if `Size' is larger than the size of `Array0' or
% if `Size' < 0.
%
:- pred shrink(int, array(T), array(T)).
:- mode shrink(in, array_di, array_uo) is det.
% shrink(Array0, Size) = Array:
% The array is shrunk to make it fit the new size `Size'.
% Throws an exception if `Size' is larger than the size of `Array0' or
% if `Size' < 0.
%
:- func shrink(array(T), int) = array(T).
:- mode shrink(array_di, in) = array_uo is det.
% fill(Item, Array0, Array):
% Sets every element of the array to `Elem'.
%
:- pred fill(T::in, array(T)::array_di, array(T)::array_uo) is det.
% fill_range(Item, Lo, Hi, !Array):
% Sets every element of the array with index in the range Lo..Hi
% (inclusive) to Item. Throws a software_error/1 exception if Lo > Hi.
% Throws an index_out_of_bounds/0 exception if Lo or Hi is out of bounds.
%
:- pred fill_range(T::in, int::in, int::in,
array(T)::array_di, array(T)::array_uo) is det.
% from_list takes a list, and returns an array containing those
% elements in the same order that they occurred in the list.
%
:- func from_list(list(T)::in) = (array(T)::array_uo) is det.
:- pred from_list(list(T)::in, array(T)::array_uo) is det.
% from_reverse_list takes a list, and returns an array containing
% those elements in the reverse order that they occurred in the list.
%
:- func from_reverse_list(list(T)::in) = (array(T)::array_uo) is det.
% to_list takes an array and returns a list containing the elements
% of the array in the same order that they occurred in the array.
%
:- pred to_list(array(T), list(T)).
%:- mode to_list(array_ui, out) is det.
:- mode to_list(in, out) is det.
:- func to_list(array(T)) = list(T).
%:- mode to_list(array_ui) = out is det.
:- mode to_list(in) = out is det.
% fetch_items(Array, Lo, Hi, List):
% Returns a list containing the items in the array with index in the range
% Lo..Hi (both inclusive) in the same order that they occurred in the
% array. Returns an empty list if Hi < Lo. Throws an index_out_of_bounds/0
% exception if Lo or Hi is out of bounds.
%
:- pred fetch_items(array(T), int, int, list(T)).
:- mode fetch_items(in, in, in, out) is det.
:- func fetch_items(array(T), int, int) = list(T).
%:- mode fetch_items(array_ui, in, in) = out is det.
:- mode fetch_items(in, in, in) = out is det.
% XXX We prefer users to call the new binary_search predicate
% instead of bsearch, which is why bsearch is marked as obsolete.
%
% bsearch takes an array, an element to be matched and a comparison
% predicate and returns the position of the first occurrence in the array
% of an element which is equivalent to the given one in the ordering
% provided. Assumes the array is sorted according to this ordering.
%
:- pred bsearch(array(T), T, comparison_pred(T), maybe(int)).
%:- mode bsearch(array_ui, in, in(comparison_pred), out) is det.
:- mode bsearch(in, in, in(comparison_pred), out) is det.
:- pragma obsolete(bsearch/4).
:- func bsearch(array(T), T, comparison_func(T)) = maybe(int).
%:- mode bsearch(array_ui, in, in(comparison_func)) = out is det.
:- mode bsearch(in, in, in(comparison_func)) = out is det.
:- pragma obsolete(bsearch/3).
% binary_search(A, X, I) does a binary search for the element X
% in the array A. If there is an element with that value in the array,
% it returns its index I; otherwise, it fails.
%
% The array A must be sorted into ascending order with respect to the
% the builtin Mercury order on terms for binary_search/3, and with respect
% to supplied comparison predicate for binary_search/4.
%
% The array may contain duplicates. If it does, and a search looks for
% a duplicated value, the search will return the index of one of the
% copies, but it is not specified *which* copy's index it will return.
%
:- pred binary_search(array(T)::array_ui,
T::in, int::out) is semidet.
:- pred binary_search(comparison_func(T)::in, array(T)::array_ui,
T::in, int::out) is semidet.
% approx_binary_search(A, X, I) does a binary search for the element X
% in the array A. If there is an element with that value in the array,
% it returns its index I. If there is no element with that value in the
% array, it returns an index whose slot contains the highest value in the
% array that is less than X, as measured by the builtin Mercury order
% on terms for approx_binary_search/3, and as measured by the supplied
% ordering for approx_binary_search/4. It will fail only if there is
% no value smaller than X in the array.
%
% The array A must be sorted into ascending order with respect to the
% the builtin Mercury order on terms for approx_binary_search/3, and
% with respect to supplied comparison predicate for approx_binary_search/4.
%
% The array may contain duplicates. If it does, and if either the
% searched-for value or (if that does not exist) the highest value
% smaller than the searched-for value is duplicated, the search will return
% the index of one of the copies, but it is not specified *which* copy's
% index it will return.
%
:- pred approx_binary_search(array(T)::array_ui,
T::in, int::out) is semidet.
:- pred approx_binary_search(comparison_func(T)::in, array(T)::array_ui,
T::in, int::out) is semidet.
% map(Closure, OldArray, NewArray) applies `Closure' to
% each of the elements of `OldArray' to create `NewArray'.
%
:- pred map(pred(T1, T2), array(T1), array(T2)).
%:- mode map(pred(in, out) is det, array_ui, array_uo) is det.
:- mode map(pred(in, out) is det, in, array_uo) is det.
:- func map(func(T1) = T2, array(T1)) = array(T2).
%:- mode map(func(in) = out is det, array_ui) = array_uo is det.
:- mode map(func(in) = out is det, in) = array_uo is det.
:- func array_compare(array(T), array(T)) = comparison_result.
:- mode array_compare(in, in) = uo is det.
% sort(Array) returns a version of Array sorted into ascending
% order.
%
% This sort is not stable. That is, elements that compare/3 decides are
% equal will appear together in the sorted array, but not necessarily
% in the same order in which they occurred in the input array. This is
% primarily only an issue with types with user-defined equivalence for
% which `equivalent' objects are otherwise distinguishable.
%
:- func sort(array(T)) = array(T).
:- mode sort(array_di) = array_uo is det.
% array.sort was previously buggy. This symbol provides a way to ensure
% that you are using the fixed version.
%
:- pred array.sort_fix_2014 is det.
% foldl(Fn, Array, X) is equivalent to
% list.foldl(Fn, to_list(Array), X)
% but more efficient.
%
:- func foldl(func(T1, T2) = T2, array(T1), T2) = T2.
%:- mode foldl(func(in, in) = out is det, array_ui, in) = out is det.
:- mode foldl(func(in, in) = out is det, in, in) = out is det.
%:- mode foldl(func(in, di) = uo is det, array_ui, di) = uo is det.
:- mode foldl(func(in, di) = uo is det, in, di) = uo is det.
% foldl(Pr, Array, !X) is equivalent to
% list.foldl(Pr, to_list(Array), !X)
% but more efficient.
%
:- pred foldl(pred(T1, T2, T2), array(T1), T2, T2).
:- mode foldl(pred(in, in, out) is det, in, in, out) is det.
:- mode foldl(pred(in, mdi, muo) is det, in, mdi, muo) is det.
:- mode foldl(pred(in, di, uo) is det, in, di, uo) is det.
:- mode foldl(pred(in, in, out) is semidet, in, in, out) is semidet.
:- mode foldl(pred(in, mdi, muo) is semidet, in, mdi, muo) is semidet.
:- mode foldl(pred(in, di, uo) is semidet, in, di, uo) is semidet.
% foldl2(Pr, Array, !X, !Y) is equivalent to
% list.foldl2(Pr, to_list(Array), !X, !Y)
% but more efficient.
%
:- pred foldl2(pred(T1, T2, T2, T3, T3), array(T1), T2, T2, T3, T3).
:- mode foldl2(pred(in, in, out, in, out) is det, in, in, out, in, out)
is det.
:- mode foldl2(pred(in, in, out, mdi, muo) is det, in, in, out, mdi, muo)
is det.
:- mode foldl2(pred(in, in, out, di, uo) is det, in, in, out, di, uo)
is det.
:- mode foldl2(pred(in, in, out, in, out) is semidet, in,
in, out, in, out) is semidet.
:- mode foldl2(pred(in, in, out, mdi, muo) is semidet, in,
in, out, mdi, muo) is semidet.
:- mode foldl2(pred(in, in, out, di, uo) is semidet, in,
in, out, di, uo) is semidet.
% As above, but with three accumulators.
%
:- pred foldl3(pred(T1, T2, T2, T3, T3, T4, T4), array(T1),
T2, T2, T3, T3, T4, T4).
:- mode foldl3(pred(in, in, out, in, out, in, out) is det,
in, in, out, in, out, in, out) is det.
:- mode foldl3(pred(in, in, out, in, out, mdi, muo) is det,
in, in, out, in, out, mdi, muo) is det.
:- mode foldl3(pred(in, in, out, in, out, di, uo) is det,
in, in, out, in, out, di, uo) is det.
:- mode foldl3(pred(in, in, out, in, out, in, out) is semidet,
in, in, out, in, out, in, out) is semidet.
:- mode foldl3(pred(in, in, out, in, out, mdi, muo) is semidet,
in, in, out, in, out, mdi, muo) is semidet.
:- mode foldl3(pred(in, in, out, in, out, di, uo) is semidet,
in, in, out, in, out, di, uo) is semidet.
% As above, but with four accumulators.
%
:- pred foldl4(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5), array(T1),
T2, T2, T3, T3, T4, T4, T5, T5).
:- mode foldl4(pred(in, in, out, in, out, in, out, in, out) is det,
in, in, out, in, out, in, out, in, out) is det.
:- mode foldl4(pred(in, in, out, in, out, in, out, mdi, muo) is det,
in, in, out, in, out, in, out, mdi, muo) is det.
:- mode foldl4(pred(in, in, out, in, out, in, out, di, uo) is det,
in, in, out, in, out, in, out, di, uo) is det.
:- mode foldl4(pred(in, in, out, in, out, in, out, in, out) is semidet,
in, in, out, in, out, in, out, in, out) is semidet.
:- mode foldl4(pred(in, in, out, in, out, in, out, mdi, muo) is semidet,
in, in, out, in, out, in, out, mdi, muo) is semidet.
:- mode foldl4(pred(in, in, out, in, out, in, out, di, uo) is semidet,
in, in, out, in, out, in, out, di, uo) is semidet.
% As above, but with five accumulators.
%
:- pred foldl5(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5, T6, T6),
array(T1), T2, T2, T3, T3, T4, T4, T5, T5, T6, T6).
:- mode foldl5(
pred(in, in, out, in, out, in, out, in, out, in, out) is det,
in, in, out, in, out, in, out, in, out, in, out) is det.
:- mode foldl5(
pred(in, in, out, in, out, in, out, in, out, mdi, muo) is det,
in, in, out, in, out, in, out, in, out, mdi, muo) is det.
:- mode foldl5(
pred(in, in, out, in, out, in, out, in, out, di, uo) is det,
in, in, out, in, out, in, out, in, out, di, uo) is det.
:- mode foldl5(
pred(in, in, out, in, out, in, out, in, out, in, out) is semidet,
in, in, out, in, out, in, out, in, out, in, out) is semidet.
:- mode foldl5(
pred(in, in, out, in, out, in, out, in, out, mdi, muo) is semidet,
in, in, out, in, out, in, out, in, out, mdi, muo) is semidet.
:- mode foldl5(
pred(in, in, out, in, out, in, out, in, out, di, uo) is semidet,
in, in, out, in, out, in, out, in, out, di, uo) is semidet.
%---------------------%
% foldr(Fn, Array, X) is equivalent to
% list.foldr(Fn, to_list(Array), X)
% but more efficient.
%
:- func foldr(func(T1, T2) = T2, array(T1), T2) = T2.
%:- mode foldr(func(in, in) = out is det, array_ui, in) = out is det.
:- mode foldr(func(in, in) = out is det, in, in) = out is det.
%:- mode foldr(func(in, di) = uo is det, array_ui, di) = uo is det.
:- mode foldr(func(in, di) = uo is det, in, di) = uo is det.
% foldr(P, Array, !Acc) is equivalent to
% list.foldr(P, to_list(Array), !Acc)
% but more efficient.
%
:- pred foldr(pred(T1, T2, T2), array(T1), T2, T2).
:- mode foldr(pred(in, in, out) is det, in, in, out) is det.
:- mode foldr(pred(in, mdi, muo) is det, in, mdi, muo) is det.
:- mode foldr(pred(in, di, uo) is det, in, di, uo) is det.
:- mode foldr(pred(in, in, out) is semidet, in, in, out) is semidet.
:- mode foldr(pred(in, mdi, muo) is semidet, in, mdi, muo) is semidet.
:- mode foldr(pred(in, di, uo) is semidet, in, di, uo) is semidet.
% As above, but with two accumulators.
%
:- pred foldr2(pred(T1, T2, T2, T3, T3), array(T1), T2, T2, T3, T3).
:- mode foldr2(pred(in, in, out, in, out) is det, in, in, out, in, out)
is det.
:- mode foldr2(pred(in, in, out, mdi, muo) is det, in, in, out, mdi, muo)
is det.
:- mode foldr2(pred(in, in, out, di, uo) is det, in, in, out, di, uo)
is det.
:- mode foldr2(pred(in, in, out, in, out) is semidet, in,
in, out, in, out) is semidet.
:- mode foldr2(pred(in, in, out, mdi, muo) is semidet, in,
in, out, mdi, muo) is semidet.
:- mode foldr2(pred(in, in, out, di, uo) is semidet, in,
in, out, di, uo) is semidet.
% As above, but with three accumulators.
%
:- pred foldr3(pred(T1, T2, T2, T3, T3, T4, T4), array(T1),
T2, T2, T3, T3, T4, T4).
:- mode foldr3(pred(in, in, out, in, out, in, out) is det, in,
in, out, in, out, in, out) is det.
:- mode foldr3(pred(in, in, out, in, out, mdi, muo) is det, in,
in, out, in, out, mdi, muo) is det.
:- mode foldr3(pred(in, in, out, in, out, di, uo) is det, in,
in, out, in, out, di, uo) is det.
:- mode foldr3(pred(in, in, out, in, out, in, out) is semidet, in,
in, out, in, out, in, out) is semidet.
:- mode foldr3(pred(in, in, out, in, out, mdi, muo) is semidet, in,
in, out, in, out, mdi, muo) is semidet.
:- mode foldr3(pred(in, in, out, in, out, di, uo) is semidet, in,
in, out, in, out, di, uo) is semidet.
% As above, but with four accumulators.
%
:- pred foldr4(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5), array(T1),
T2, T2, T3, T3, T4, T4, T5, T5).
:- mode foldr4(pred(in, in, out, in, out, in, out, in, out) is det,
in, in, out, in, out, in, out, in, out) is det.
:- mode foldr4(pred(in, in, out, in, out, in, out, mdi, muo) is det,
in, in, out, in, out, in, out, mdi, muo) is det.
:- mode foldr4(pred(in, in, out, in, out, in, out, di, uo) is det,
in, in, out, in, out, in, out, di, uo) is det.
:- mode foldr4(pred(in, in, out, in, out, in, out, in, out) is semidet,
in, in, out, in, out, in, out, in, out) is semidet.
:- mode foldr4(pred(in, in, out, in, out, in, out, mdi, muo) is semidet,
in, in, out, in, out, in, out, mdi, muo) is semidet.
:- mode foldr4(pred(in, in, out, in, out, in, out, di, uo) is semidet,
in, in, out, in, out, in, out, di, uo) is semidet.
% As above, but with five accumulators.
%
:- pred foldr5(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5, T6, T6),
array(T1), T2, T2, T3, T3, T4, T4, T5, T5, T6, T6).
:- mode foldr5(
pred(in, in, out, in, out, in, out, in, out, in, out) is det,
in, in, out, in, out, in, out, in, out, in, out) is det.
:- mode foldr5(
pred(in, in, out, in, out, in, out, in, out, mdi, muo) is det,
in, in, out, in, out, in, out, in, out, mdi, muo) is det.
:- mode foldr5(
pred(in, in, out, in, out, in, out, in, out, di, uo) is det,
in, in, out, in, out, in, out, in, out, di, uo) is det.
:- mode foldr5(
pred(in, in, out, in, out, in, out, in, out, in, out) is semidet,
in, in, out, in, out, in, out, in, out, in, out) is semidet.
:- mode foldr5(
pred(in, in, out, in, out, in, out, in, out, mdi, muo) is semidet,
in, in, out, in, out, in, out, in, out, mdi, muo) is semidet.
:- mode foldr5(
pred(in, in, out, in, out, in, out, in, out, di, uo) is semidet,
in, in, out, in, out, in, out, in, out, di, uo) is semidet.
%---------------------%
% foldl_corresponding(P, A, B, !Acc):
%
% Does the same job as foldl, but works on two arrays in parallel.
% Throws an exception if the array arguments differ in size.
%
:- pred foldl_corresponding(pred(T1, T2, T3, T3), array(T1), array(T2),
T3, T3).
:- mode foldl_corresponding(in(pred(in, in, in, out) is det), in, in,
in, out) is det.
:- mode foldl_corresponding(in(pred(in, in, mdi, muo) is det), in, in,
mdi, muo) is det.
:- mode foldl_corresponding(in(pred(in, in, di, uo) is det), in, in,
di, uo) is det.
:- mode foldl_corresponding(in(pred(in, in, in, out) is semidet), in, in,
in, out) is semidet.
:- mode foldl_corresponding(in(pred(in, in, mdi, muo) is semidet), in, in,
mdi, muo) is semidet.
:- mode foldl_corresponding(in(pred(in, in, di, uo) is semidet), in, in,
di, uo) is semidet.
% As above, but with two accumulators.
%
:- pred foldl2_corresponding(pred(T1, T2, T3, T3, T4, T4),
array(T1), array(T2), T3, T3, T4, T4).
:- mode foldl2_corresponding(in(pred(in, in, in, out, in, out) is det),
in, in, in, out, in, out) is det.
:- mode foldl2_corresponding(in(pred(in, in, in, out, mdi, muo) is det),
in, in, in, out, mdi, muo) is det.
:- mode foldl2_corresponding(in(pred(in, in, in, out, di, uo) is det),
in, in, in, out, di, uo) is det.
:- mode foldl2_corresponding(in(pred(in, in, in, out, in, out) is semidet),
in, in, in, out, in, out) is semidet.
:- mode foldl2_corresponding(in(pred(in, in, in, out, mdi, muo) is semidet),
in, in, in, out, mdi, muo) is semidet.
:- mode foldl2_corresponding(in(pred(in, in,in, out, di, uo) is semidet),
in, in, in, out, di, uo) is semidet.
%---------------------%
% map_foldl(P, A, B, !Acc):
% Invoke P(Aelt, Belt, !Acc) on each element of the A array,
% and construct array B from the resulting values of Belt.
%
:- pred map_foldl(pred(T1, T2, T3, T3), array(T1), array(T2), T3, T3).
:- mode map_foldl(in(pred(in, out, in, out) is det),
in, array_uo, in, out) is det.
:- mode map_foldl(in(pred(in, out, mdi, muo) is det),
in, array_uo, mdi, muo) is det.
:- mode map_foldl(in(pred(in, out, di, uo) is det),
in, array_uo, di, uo) is det.
:- mode map_foldl(in(pred(in, out, in, out) is semidet),
in, array_uo, in, out) is semidet.
%---------------------%
% map_corresponding_foldl(P, A, B, C, !Acc):
%
% Given two arrays A and B, invoke P(Aelt, Belt, Celt, !Acc) on
% each corresponding pair of elements Aelt and Belt. Build up the array C
% from the result Celt values. Return C and the final value of the
% accumulator.
%
% Throws an exception if A and B differ in size.
%
:- pred map_corresponding_foldl(pred(T1, T2, T3, T4, T4),
array(T1), array(T2), array(T3), T4, T4).
:- mode map_corresponding_foldl(
in(pred(in, in, out, in, out) is det),
in, in, array_uo, in, out) is det.
:- mode map_corresponding_foldl(
in(pred(in, in, out, mdi, muo) is det),
in, in, array_uo, mdi, muo) is det.
:- mode map_corresponding_foldl(
in(pred(in, in, out, di, uo) is det),
in, in, array_uo, di, uo) is det.
:- mode map_corresponding_foldl(
in(pred(in, in, out, in, out) is semidet),
in, in, array_uo, in, out) is semidet.
:- mode map_corresponding_foldl(
in(pred(in, in, out, mdi, muo) is semidet),
in, in, array_uo, mdi, muo) is semidet.
:- mode map_corresponding_foldl(
in(pred(in, in, out, di, uo) is semidet),
in, in, array_uo, di, uo) is semidet.
%---------------------%
% all_true(Pred, Array):
% True iff Pred is true for every element of Array.
%
:- pred all_true(pred(T), array(T)).
%:- mode all_true(in(pred(in) is semidet), array_ui) is semidet.
:- mode all_true(in(pred(in) is semidet), in) is semidet.
% all_false(Pred, Array):
% True iff Pred is false for every element of Array.
%
:- pred all_false(pred(T), array(T)).
%:- mode all_false(in(pred(in) is semidet), array_ui) is semidet.
:- mode all_false(in(pred(in) is semidet), in) is semidet.
% append(A, B) = C:
%
% Make C a concatenation of the arrays A and B.
%
:- func append(array(T)::in, array(T)::in) = (array(T)::array_uo) is det.
% random_permutation(A0, A, RS0, RS) permutes the elements in
% A0 given random seed RS0 and returns the permuted array in A
% and the next random seed in RS.
%
:- pred random_permutation(array(T)::array_di, array(T)::array_uo,
random.supply::mdi, random.supply::muo) is det.
% Convert an array to a pretty_printer.doc for formatting.
%
:- func array_to_doc(array(T)) = pretty_printer.doc.
:- mode array_to_doc(array_ui) = out is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
% Everything beyond here is not intended as part of the public interface,
% and will not appear in the Mercury Library Reference Manual.
:- interface.
% 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)).
%
:- some [T2] pred dynamic_cast_to_array(T1::in, array(T2)::out) is semidet.
:- implementation.
:- import_module exception.
:- import_module int.
:- import_module require.
:- import_module string.
:- import_module type_desc.
%
% Define the array type appropriately for the different targets.
% Note that the definitions here should match what is output by
% mlds_to_c.m, mlds_to_csharp.m, or mlds_to_java.m for mlds.mercury_array_type.
%
% MR_ArrayPtr is defined in runtime/mercury_types.h.
:- pragma foreign_type("C", array(T), "MR_ArrayPtr")
where equality is array.array_equal,
comparison is array.array_compare.
:- pragma foreign_type("C#", array(T), "System.Array")
where equality is array.array_equal,
comparison is array.array_compare.
% We can't use `java.lang.Object []', since we want a generic type
% that is capable of holding any kind of array, including e.g. `int []'.
% Java doesn't have any equivalent of .NET's System.Array class,
% so we just use the universal base `java.lang.Object'.
:- pragma foreign_type("Java", array(T), "/* Array */ java.lang.Object")
where equality is array.array_equal,
comparison is array.array_compare.
:- pragma foreign_type("Erlang", array(T), "")
where equality is array.array_equal,
comparison is array.array_compare.
% unify/2 for arrays
%
:- pred array_equal(array(T)::in, array(T)::in) is semidet.
:- pragma terminates(array_equal/2).
array_equal(Array1, Array2) :-
( if
array.size(Array1, Size),
array.size(Array2, Size)
then
equal_elements(0, Size, Array1, Array2)
else
fail
).
:- pred equal_elements(int, int, array(T), array(T)).
:- mode equal_elements(in, in, in, in) is semidet.
equal_elements(N, Size, Array1, Array2) :-
( if N = Size then
true
else
array.unsafe_lookup(Array1, N, Elem),
array.unsafe_lookup(Array2, N, Elem),
N1 = N + 1,
equal_elements(N1, Size, Array1, Array2)
).
array_compare(A1, A2) = C :-
array_compare(C, A1, A2).
% compare/3 for arrays
%
:- pred array_compare(comparison_result::uo, array(T)::in, array(T)::in)
is det.
:- pragma terminates(array_compare/3).
array_compare(Result, Array1, Array2) :-
array.size(Array1, Size1),
array.size(Array2, Size2),
compare(SizeResult, Size1, Size2),
(
SizeResult = (=),
compare_elements(0, Size1, Array1, Array2, Result)
;
( SizeResult = (<)
; SizeResult = (>)
),
Result = SizeResult
).
:- pred compare_elements(int::in, int::in, array(T)::in, array(T)::in,
comparison_result::uo) is det.
compare_elements(N, Size, Array1, Array2, Result) :-
( if N = Size then
Result = (=)
else
array.unsafe_lookup(Array1, N, Elem1),
array.unsafe_lookup(Array2, N, Elem2),
compare(ElemResult, Elem1, Elem2),
(
ElemResult = (=),
N1 = N + 1,
compare_elements(N1, Size, Array1, Array2, Result)
;
( ElemResult = (<)
; ElemResult = (>)
),
Result = ElemResult
)
).
%---------------------------------------------------------------------------%
:- pred bounds_checks is semidet.
:- pragma inline(bounds_checks/0).
:- pragma foreign_proc("C",
bounds_checks,
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"
#ifdef ML_OMIT_ARRAY_BOUNDS_CHECKS
SUCCESS_INDICATOR = MR_FALSE;
#else
SUCCESS_INDICATOR = MR_TRUE;
#endif
").
:- pragma foreign_proc("C#",
bounds_checks,
[will_not_call_mercury, promise_pure, thread_safe],
"
#if ML_OMIT_ARRAY_BOUNDS_CHECKS
SUCCESS_INDICATOR = false;
#else
SUCCESS_INDICATOR = true;
#endif
").
:- pragma foreign_proc("Java",
bounds_checks,
[will_not_call_mercury, promise_pure, thread_safe],
"
// never do bounds checking for Java (throw exceptions instead)
SUCCESS_INDICATOR = false;
").
:- pragma foreign_proc("Erlang",
bounds_checks,
[will_not_call_mercury, promise_pure, thread_safe],
"
SUCCESS_INDICATOR = true
").
%---------------------------------------------------------------------------%
:- pragma foreign_decl("C", "
#include ""mercury_heap.h"" // for MR_maybe_record_allocation()
#include ""mercury_library_types.h"" // for MR_ArrayPtr
// We do not yet record term sizes for arrays in term size profiling
// grades. Doing so would require
//
// - modifying ML_alloc_array to allocate an extra word for the size;
// - modifying all the predicates that call ML_alloc_array to compute the
// size of the array (the sum of the sizes of the elements and the size of
// the array itself);
// - modifying all the predicates that update array elements to compute the
// difference between the sizes of the terms being added to and deleted from
// the array, and updating the array size accordingly.
#define ML_alloc_array(newarray, arraysize, alloc_id) \
do { \
MR_Word newarray_word; \
MR_offset_incr_hp_msg(newarray_word, 0, (arraysize), \
alloc_id, ""array.array/1""); \
(newarray) = (MR_ArrayPtr) newarray_word; \
} while (0)
").
:- pragma foreign_decl("C", "
void ML_init_array(MR_ArrayPtr, MR_Integer size, MR_Word item);
").
:- pragma foreign_code("C", "
// The caller is responsible for allocating the memory for the array.
// This routine does the job of initializing the already-allocated memory.
void
ML_init_array(MR_ArrayPtr array, MR_Integer size, MR_Word item)
{
MR_Integer i;
array->size = size;
for (i = 0; i < size; i++) {
array->elements[i] = item;
}
}
").
:- pragma foreign_code("C#", "
public static System.Array
ML_new_array(int Size, object Item)
{
System.Array arr;
if (Size == 0) {
return null;
}
if (Item is int || Item is double || Item is char || Item is bool) {
arr = System.Array.CreateInstance(Item.GetType(), Size);
} else {
arr = new object[Size];
}
for (int i = 0; i < Size; i++) {
arr.SetValue(Item, i);
}
return arr;
}
public static System.Array
ML_unsafe_new_array(int Size, object Item, int IndexToSet)
{
System.Array arr;
if (Item is int || Item is double || Item is char || Item is bool) {
arr = System.Array.CreateInstance(Item.GetType(), Size);
} else {
arr = new object[Size];
}
arr.SetValue(Item, IndexToSet);
return arr;
}
public static System.Array
ML_array_resize(System.Array arr0, int Size, object Item)
{
if (Size == 0) {
return null;
}
if (arr0 == null) {
return ML_new_array(Size, Item);
}
if (arr0.Length == Size) {
return arr0;
}
int OldSize = arr0.Length;
System.Array arr;
if (Item is int) {
int[] tmp = (int[]) arr0;
System.Array.Resize(ref tmp, Size);
arr = tmp;
} else if (Item is double) {
double[] tmp = (double[]) arr0;
System.Array.Resize(ref tmp, Size);
arr = tmp;
} else if (Item is char) {
char[] tmp = (char[]) arr0;
System.Array.Resize(ref tmp, Size);
arr = tmp;
} else if (Item is bool) {
bool[] tmp = (bool[]) arr0;
System.Array.Resize(ref tmp, Size);
arr = tmp;
} else {
object[] tmp = (object[]) arr0;
System.Array.Resize(ref tmp, Size);
arr = tmp;
}
for (int i = OldSize; i < Size; i++) {
arr.SetValue(Item, i);
}
return arr;
}
public static System.Array
ML_shrink_array(System.Array arr, int Size)
{
if (arr == null) {
return null;
} else if (arr is int[]) {
int[] tmp = (int[]) arr;
System.Array.Resize(ref tmp, Size);
return tmp;
} else if (arr is double[]) {
double[] tmp = (double[]) arr;
System.Array.Resize(ref tmp, Size);
return tmp;
} else if (arr is char[]) {
char[] tmp = (char[]) arr;
System.Array.Resize(ref tmp, Size);
return tmp;
} else if (arr is bool[]) {
bool[] tmp = (bool[]) arr;
System.Array.Resize(ref tmp, Size);
return tmp;
} else {
object[] tmp = (object[]) arr;
System.Array.Resize(ref tmp, Size);
return tmp;
}
}
").
:- pragma foreign_code("Java", "
public static Object
ML_new_array(int Size, Object Item, boolean fill)
{
if (Size == 0) {
return null;
}
if (Item instanceof Integer) {
int[] as = new int[Size];
if (fill) {
java.util.Arrays.fill(as, (Integer) Item);
}
return as;
}
if (Item instanceof Double) {
double[] as = new double[Size];
if (fill) {
java.util.Arrays.fill(as, (Double) Item);
}
return as;
}
if (Item instanceof Character) {
char[] as = new char[Size];
if (fill) {
java.util.Arrays.fill(as, (Character) Item);
}
return as;
}
if (Item instanceof Boolean) {
boolean[] as = new boolean[Size];
if (fill) {
java.util.Arrays.fill(as, (Boolean) Item);
}
return as;
}
if (Item instanceof Byte) {
byte[] as = new byte[Size];
if (fill) {
java.util.Arrays.fill(as, (Byte) Item);
}
return as;
}
if (Item instanceof Short) {
short[] as = new short[Size];
if (fill) {
java.util.Arrays.fill(as, (Short) Item);
}
return as;
}
if (Item instanceof Long) {
long[] as = new long[Size];
if (fill) {
java.util.Arrays.fill(as, (Long) Item);
}
return as;
}
if (Item instanceof Float) {
float[] as = new float[Size];
if (fill) {
java.util.Arrays.fill(as, (Float) Item);
}
return as;
}
Object[] as = new Object[Size];
if (fill) {
java.util.Arrays.fill(as, Item);
}
return as;
}
public static Object
ML_unsafe_new_array(int Size, Object Item, int IndexToSet)
{
if (Item instanceof Integer) {
int[] as = new int[Size];
as[IndexToSet] = (Integer) Item;
return as;
}
if (Item instanceof Double) {
double[] as = new double[Size];
as[IndexToSet] = (Double) Item;
return as;
}
if (Item instanceof Character) {
char[] as = new char[Size];
as[IndexToSet] = (Character) Item;
return as;
}
if (Item instanceof Boolean) {
boolean[] as = new boolean[Size];
as[IndexToSet] = (Boolean) Item;
return as;
}
if (Item instanceof Byte) {
byte[] as = new byte[Size];
as[IndexToSet] = (Byte) Item;
return as;
}
if (Item instanceof Short) {
short[] as = new short[Size];
as[IndexToSet] = (Short) Item;
return as;
}
if (Item instanceof Long) {
long[] as = new long[Size];
as[IndexToSet] = (Long) Item;
return as;
}
if (Item instanceof Float) {
float[] as = new float[Size];
as[IndexToSet] = (Float) Item;
return as;
}
Object[] as = new Object[Size];
as[IndexToSet] = Item;
return as;
}
public static int
ML_array_size(Object Array)
{
if (Array == null) {
return 0;
} else if (Array instanceof int[]) {
return ((int[]) Array).length;
} else if (Array instanceof double[]) {
return ((double[]) Array).length;
} else if (Array instanceof char[]) {
return ((char[]) Array).length;
} else if (Array instanceof boolean[]) {
return ((boolean[]) Array).length;
} else if (Array instanceof byte[]) {
return ((byte[]) Array).length;
} else if (Array instanceof short[]) {
return ((short[]) Array).length;
} else if (Array instanceof long[]) {
return ((long[]) Array).length;
} else if (Array instanceof float[]) {
return ((float[]) Array).length;
} else {
return ((Object[]) Array).length;
}
}
public static Object
ML_array_resize(Object Array0, int Size, Object Item)
{
if (Size == 0) {
return null;
}
if (Array0 == null) {
return ML_new_array(Size, Item, true);
}
if (ML_array_size(Array0) == Size) {
return Array0;
}
if (Array0 instanceof int[]) {
int[] arr0 = (int[]) Array0;
int[] Array = new int[Size];
System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
for (int i = arr0.length; i < Size; i++) {
Array[i] = (Integer) Item;
}
return Array;
}
if (Array0 instanceof double[]) {
double[] arr0 = (double[]) Array0;
double[] Array = new double[Size];
System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
for (int i = arr0.length; i < Size; i++) {
Array[i] = (Double) Item;
}
return Array;
}
if (Array0 instanceof char[]) {
char[] arr0 = (char[]) Array0;
char[] Array = new char[Size];
System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
for (int i = arr0.length; i < Size; i++) {
Array[i] = (Character) Item;
}
return Array;
}
if (Array0 instanceof boolean[]) {
boolean[] arr0 = (boolean[]) Array0;
boolean[] Array = new boolean[Size];
System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
for (int i = arr0.length; i < Size; i++) {
Array[i] = (Boolean) Item;
}
return Array;
}
if (Array0 instanceof byte[]) {
byte[] arr0 = (byte[]) Array0;
byte[] Array = new byte[Size];
System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
for (int i = arr0.length; i < Size; i++) {
Array[i] = (Byte) Item;
}
return Array;
}
if (Array0 instanceof short[]) {
short[] arr0 = (short[]) Array0;
short[] Array = new short[Size];
System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
for (int i = arr0.length; i < Size; i++) {
Array[i] = (Short) Item;
}
return Array;
}
if (Array0 instanceof long[]) {
long[] arr0 = (long[]) Array0;
long[] Array = new long[Size];
System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
for (int i = arr0.length; i < Size; i++) {
Array[i] = (Long) Item;
}
return Array;
}
if (Array0 instanceof float[]) {
float[] arr0 = (float[]) Array0;
float[] Array = new float[Size];
System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
for (int i = arr0.length; i < Size; i++) {
Array[i] = (Float) Item;
}
return Array;
} else {
Object[] arr0 = (Object[]) Array0;
Object[] Array = new Object[Size];
System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
for (int i = arr0.length; i < Size; i++) {
Array[i] = Item;
}
return Array;
}
}
public static Object
ML_array_fill(Object array, int fromIndex, int toIndex, Object Item)
{
if (array == null) {
return null;
}
if (array instanceof int[]) {
java.util.Arrays.fill(((int []) array), fromIndex, toIndex, (Integer) Item);
} else if (array instanceof double[]) {
java.util.Arrays.fill(((double []) array), fromIndex, toIndex, (Double) Item);
} else if (array instanceof byte[]) {
java.util.Arrays.fill(((byte []) array), fromIndex, toIndex, (Byte) Item);
} else if (array instanceof short[]) {
java.util.Arrays.fill(((short []) array), fromIndex, toIndex,(Short) Item);
} else if (array instanceof long[]) {
java.util.Arrays.fill(((long []) array), fromIndex, toIndex,(Long) Item);
} else if (array instanceof char[]) {
java.util.Arrays.fill(((char []) array), fromIndex, toIndex,(Character) Item);
} else if (array instanceof boolean[]) {
java.util.Arrays.fill(((boolean []) array), fromIndex, toIndex,(Boolean) Item);
} else if (array instanceof float[]) {
java.util.Arrays.fill(((float []) array), fromIndex, toIndex,(Float) Item);
} else {
java.util.Arrays.fill(((Object []) array), fromIndex, toIndex,Item);
}
return array;
}
").
init(N, X) = A :-
array.init(N, X, A).
init(Size, Item, Array) :-
( if Size < 0 then
unexpected($pred, "negative size")
else
array.init_2(Size, Item, Array)
).
:- pred init_2(int::in, T::in, array(T)::array_uo) is det.
:- pragma foreign_proc("C",
init_2(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness,
sharing(yes(int, T, array(T)), [
cel(Item, []) - cel(Array, [T])
])
],
"
ML_alloc_array(Array, Size + 1, MR_ALLOC_ID);
ML_init_array(Array, Size, Item);
").
:- pragma foreign_proc("C#",
init_2(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
Array = array.ML_new_array(Size, Item);
").
:- pragma foreign_proc("Java",
init_2(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
Array = array.ML_new_array(Size, Item, true);
").
:- pragma foreign_proc("Erlang",
init_2(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
Array = erlang:make_tuple(Size, Item)
").
make_empty_array = A :-
array.make_empty_array(A).
:- pragma foreign_proc("C",
make_empty_array(Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"
ML_alloc_array(Array, 1, MR_ALLOC_ID);
ML_init_array(Array, 0, 0);
").
:- pragma foreign_proc("C#",
make_empty_array(Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
// XXX A better solution than using the null pointer to represent
// the empty array would be to create an array of size 0. However,
// we need to determine the element type of the array before we can
// do that. This could be done by examining the RTTI of the array
// type and then using System.Type.GetType(""<mercury type>"") to
// determine it. However constructing the <mercury type> string is
// a non-trivial amount of work.
Array = null;
").
:- pragma foreign_proc("Java",
make_empty_array(Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
// XXX as per C#
Array = null;
").
:- pragma foreign_proc("Erlang",
make_empty_array(Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
Array = {}
").
%---------------------------------------------------------------------------%
generate(Size, GenFunc) = Array :-
compare(Result, Size, 0),
(
Result = (<),
unexpected($pred, "negative size")
;
Result = (=),
make_empty_array(Array)
;
Result = (>),
FirstElem = GenFunc(0),
Array0 = unsafe_init(Size, FirstElem, 0),
Array = generate_2(1, Size, GenFunc, Array0)
).
:- func unsafe_init(int::in, T::in, int::in) = (array(T)::array_uo) is det.
:- pragma foreign_proc("C",
unsafe_init(Size::in, FirstElem::in, IndexToSet::in) = (Array::array_uo),
[promise_pure, will_not_call_mercury, thread_safe, will_not_modify_trail,
does_not_affect_liveness],
"
ML_alloc_array(Array, Size + 1, MR_ALLOC_ID);
// In debugging grades, we fill the array with the first element,
// in case the return value of a call to this predicate is examined
// in the debugger.
#if defined(MR_EXEC_TRACE)
ML_init_array(Array, Size, FirstElem);
#else
Array->size = Size;
Array->elements[IndexToSet] = FirstElem;
#endif
").
:- pragma foreign_proc("C#",
unsafe_init(Size::in, FirstElem::in, IndexToSet::in) = (Array::array_uo),
[promise_pure, will_not_call_mercury, thread_safe],
"
Array = array.ML_unsafe_new_array(Size, FirstElem, IndexToSet);
").
:- pragma foreign_proc("Java",
unsafe_init(Size::in, FirstElem::in, IndexToSet::in) = (Array::array_uo),
[promise_pure, will_not_call_mercury, thread_safe],
"
Array = array.ML_unsafe_new_array(Size, FirstElem, IndexToSet);
").
:- pragma foreign_proc("Erlang",
unsafe_init(Size::in, FirstElem::in, _IndexToSet::in) = (Array::array_uo),
[promise_pure, will_not_call_mercury, thread_safe],
"
Array = erlang:make_tuple(Size, FirstElem)
").
:- func generate_2(int::in, int::in, (func(int) = T)::in, array(T)::array_di)
= (array(T)::array_uo) is det.
generate_2(Index, Size, GenFunc, !.Array) = !:Array :-
( if Index < Size then
Elem = GenFunc(Index),
array.unsafe_set(Index, Elem, !Array),
!:Array = generate_2(Index + 1, Size, GenFunc, !.Array)
else
true
).
generate_foldl(Size, GenPred, Array, !Acc) :-
compare(Result, Size, 0),
(
Result = (<),
unexpected($pred, "negative size")
;
Result = (=),
make_empty_array(Array)
;
Result = (>),
GenPred(0, FirstElem, !Acc),
Array0 = unsafe_init(Size, FirstElem, 0),
generate_foldl_2(1, Size, GenPred, Array0, Array, !Acc)
).
:- pred generate_foldl_2(int, int, pred(int, T, A, A),
array(T), array(T), A, A).
:- mode generate_foldl_2(in, in, in(pred(in, out, in, out) is det),
array_di, array_uo, in, out) is det.
:- mode generate_foldl_2(in, in, in(pred(in, out, mdi, muo) is det),
array_di, array_uo, mdi, muo) is det.
:- mode generate_foldl_2(in, in, in(pred(in, out, di, uo) is det),
array_di, array_uo, di, uo) is det.
:- mode generate_foldl_2(in, in, in(pred(in, out, in, out) is semidet),
array_di, array_uo, in, out) is semidet.
:- mode generate_foldl_2(in, in, in(pred(in, out, mdi, muo) is semidet),
array_di, array_uo, mdi, muo) is semidet.
:- mode generate_foldl_2(in, in, in(pred(in, out, di, uo) is semidet),
array_di, array_uo, di, uo) is semidet.
generate_foldl_2(Index, Size, GenPred, !Array, !Acc) :-
( if Index < Size then
GenPred(Index, Elem, !Acc),
array.unsafe_set(Index, Elem, !Array),
generate_foldl_2(Index + 1, Size, GenPred, !Array, !Acc)
else
true
).
%---------------------------------------------------------------------------%
min(A) = N :-
array.min(A, N).
:- pragma foreign_proc("C",
min(Array::in, Min::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"
// Array not used.
Min = 0;
").
:- pragma foreign_proc("C#",
min(_Array::in, Min::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
// Array not used.
Min = 0;
").
:- pragma foreign_proc("Erlang",
min(Array::in, Min::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
% Array not used
Min = 0
").
:- pragma foreign_proc("Java",
min(_Array::in, Min::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
// Array not used.
Min = 0;
").
max(A) = N :-
array.max(A, N).
:- pragma foreign_proc("C",
max(Array::in, Max::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"
Max = Array->size - 1;
").
:- pragma foreign_proc("C#",
max(Array::in, Max::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
if (Array != null) {
Max = Array.Length - 1;
} else {
Max = -1;
}
").
:- pragma foreign_proc("Erlang",
max(Array::in, Max::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Max = size(Array) - 1
").
:- pragma foreign_proc("Java",
max(Array::in, Max::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
if (Array != null) {
Max = array.ML_array_size(Array) - 1;
} else {
Max = -1;
}
").
bounds(Array, Min, Max) :-
array.min(Array, Min),
array.max(Array, Max).
%---------------------------------------------------------------------------%
size(A) = N :-
array.size(A, N).
:- pragma foreign_proc("C",
size(Array::in, Max::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
"
Max = Array->size;
").
:- pragma foreign_proc("C#",
size(Array::in, Max::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
if (Array != null) {
Max = Array.Length;
} else {
Max = 0;
}
").
:- pragma foreign_proc("Erlang",
size(Array::in, Max::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Max = size(Array)
").
:- pragma foreign_proc("Java",
size(Array::in, Max::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Max = jmercury.array.ML_array_size(Array);
").
%---------------------------------------------------------------------------%
in_bounds(Array, Index) :-
array.bounds(Array, Min, Max),
Min =< Index, Index =< Max.
is_empty(Array) :-
array.size(Array, 0).
semidet_set(Index, Item, !Array) :-
( if array.in_bounds(!.Array, Index) then
array.unsafe_set(Index, Item, !Array)
else
fail
).
semidet_slow_set(Index, Item, !Array) :-
( if array.in_bounds(!.Array, Index) then
array.slow_set(Index, Item, !Array)
else
fail
).
slow_set(!.Array, N, X) = !:Array :-
array.slow_set(N, X, !Array).
slow_set(Index, Item, !Array) :-
array.copy(!Array),
array.set(Index, Item, !Array).
%---------------------------------------------------------------------------%
elem(Index, Array) = array.lookup(Array, Index).
unsafe_elem(Index, Array) = Elem :-
array.unsafe_lookup(Array, Index, Elem).
lookup(Array, N) = X :-
array.lookup(Array, N, X).
lookup(Array, Index, Item) :-
( if
bounds_checks,
not array.in_bounds(Array, Index)
then
out_of_bounds_error(Array, Index, "array.lookup")
else
array.unsafe_lookup(Array, Index, Item)
).
semidet_lookup(Array, Index, Item) :-
( if array.in_bounds(Array, Index) then
array.unsafe_lookup(Array, Index, Item)
else
fail
).
:- pragma foreign_proc("C",
unsafe_lookup(Array::in, Index::in, Item::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness,
sharing(yes(array(T), int, T), [
cel(Array, [T]) - cel(Item, [])
])
],
"
Item = Array->elements[Index];
").
:- pragma foreign_proc("C#",
unsafe_lookup(Array::in, Index::in, Item::out),
[will_not_call_mercury, promise_pure, thread_safe],
"{
Item = Array.GetValue(Index);
}").
:- pragma foreign_proc("Erlang",
unsafe_lookup(Array::in, Index::in, Item::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Item = element(Index + 1, Array)
").
:- pragma foreign_proc("Java",
unsafe_lookup(Array::in, Index::in, Item::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
if (Array instanceof int[]) {
Item = ((int[]) Array)[Index];
} else if (Array instanceof double[]) {
Item = ((double[]) Array)[Index];
} else if (Array instanceof char[]) {
Item = ((char[]) Array)[Index];
} else if (Array instanceof boolean[]) {
Item = ((boolean[]) Array)[Index];
} else if (Array instanceof byte[]) {
Item = ((byte[]) Array)[Index];
} else if (Array instanceof short[]) {
Item = ((short[]) Array)[Index];
} else if (Array instanceof long[]) {
Item = ((long[]) Array)[Index];
} else if (Array instanceof float[]) {
Item = ((float[]) Array)[Index];
} else {
Item = ((Object[]) Array)[Index];
}
").
%---------------------------------------------------------------------------%
'elem :='(Index, Array, Value) = array.set(Array, Index, Value).
set(A1, N, X) = A2 :-
array.set(N, X, A1, A2).
set(Index, Item, !Array) :-
( if
bounds_checks,
not array.in_bounds(!.Array, Index)
then
out_of_bounds_error(!.Array, Index, "array.set")
else
array.unsafe_set(Index, Item, !Array)
).
'unsafe_elem :='(Index, !.Array, Value) = !:Array :-
array.unsafe_set(Index, Value, !Array).
:- pragma foreign_proc("C",
unsafe_set(Index::in, Item::in, Array0::array_di, Array::array_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, []),
cel(Item, []) - cel(Array, [T])
])
],
"
Array0->elements[Index] = Item; // destructive update!
Array = Array0;
").
:- pragma foreign_proc("C#",
unsafe_set(Index::in, Item::in, Array0::array_di, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"{
Array0.SetValue(Item, Index); // destructive update!
Array = Array0;
}").
:- 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],
"
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;
} else {
((Object[]) Array0)[Index] = Item;
}
Array = Array0; // destructive update!
").
%---------------------------------------------------------------------------%
% lower bounds other than zero are not supported
% % array.resize takes an array and new lower and upper bounds.
% % the array is expanded or shrunk at each end to make it fit
% % the new bounds.
% :- pred array.resize(array(T), int, int, array(T)).
% :- mode array.resize(in, in, in, out) is det.
:- pragma foreign_decl("C", "
extern void
ML_resize_array(MR_ArrayPtr new_array, MR_ArrayPtr old_array,
MR_Integer array_size, MR_Word item);
").
:- pragma foreign_code("C", "
// The caller is responsible for allocating the storage for the new array.
// This routine does the job of copying the old array elements to the
// new array, initializing any additional elements in the new array,
// and deallocating the old array.
void
ML_resize_array(MR_ArrayPtr array, MR_ArrayPtr old_array,
MR_Integer array_size, MR_Word item)
{
MR_Integer i;
MR_Integer elements_to_copy;
elements_to_copy = old_array->size;
if (elements_to_copy > array_size) {
elements_to_copy = array_size;
}
array->size = array_size;
for (i = 0; i < elements_to_copy; i++) {
array->elements[i] = old_array->elements[i];
}
for (; i < array_size; i++) {
array->elements[i] = item;
}
// Since the mode on the old array is `array_di', it is safe to
// deallocate the storage for it.
#ifdef MR_CONSERVATIVE_GC
MR_GC_free_attrib(old_array);
#endif
}
").
resize(!.Array, N, X) = !:Array :-
array.resize(N, X, !Array).
resize(N, X, !Array) :-
( if N < 0 then
unexpected($pred, "cannot resize to a negative size")
else
do_resize(N, X, !Array)
).
:- pred do_resize(int, T, array(T), array(T)).
:- mode do_resize(in, in, array_di, array_uo) is det.
:- pragma foreign_proc("C",
do_resize(Size::in, Item::in, Array0::array_di, Array::array_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, []),
cel(Item, []) - cel(Array, [T])
])
],
"
if ((Array0)->size == Size) {
Array = Array0;
} else {
ML_alloc_array(Array, Size + 1, MR_ALLOC_ID);
ML_resize_array(Array, Array0, Size, Item);
}
").
:- pragma foreign_proc("C#",
do_resize(Size::in, Item::in, Array0::array_di, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
Array = array.ML_array_resize(Array0, Size, Item);
").
:- pragma foreign_proc("Erlang",
do_resize(Size::in, Item::in, Array0::array_di, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
InitialSize = size(Array0),
List = tuple_to_list(Array0),
if
Size < InitialSize ->
Array = list_to_tuple(lists:sublist(List, Size));
Size > InitialSize ->
Array = list_to_tuple(lists:append(List,
lists:duplicate(Size - InitialSize, Item)));
true ->
Array = Array0
end
").
:- pragma foreign_proc("Java",
do_resize(Size::in, Item::in, Array0::array_di, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
Array = jmercury.array.ML_array_resize(Array0, Size, Item);
").
%---------------------------------------------------------------------------%
:- pragma foreign_decl("C", "
extern void
ML_shrink_array(MR_ArrayPtr array, MR_ArrayPtr old_array,
MR_Integer array_size);
").
:- pragma foreign_code("C", "
// The caller is responsible for allocating the storage for the new array.
// This routine does the job of copying the old array elements to the
// new array and deallocating the old array.
void
ML_shrink_array(MR_ArrayPtr array, MR_ArrayPtr old_array,
MR_Integer array_size)
{
MR_Integer i;
array->size = array_size;
for (i = 0; i < array_size; i++) {
array->elements[i] = old_array->elements[i];
}
// Since the mode on the old array is `array_di', it is safe to
// deallocate the storage for it.
#ifdef MR_CONSERVATIVE_GC
MR_GC_free_attrib(old_array);
#endif
}
").
shrink(!.Array, N) = !:Array :-
array.shrink(N, !Array).
shrink(Size, !Array) :-
OldSize = array.size(!.Array),
( if Size < 0 then
unexpected($pred, "cannot shrink to a negative size")
else if Size > OldSize then
unexpected($pred, "cannot shrink to a larger size")
else if Size = OldSize then
true
else
array.shrink_2(Size, !Array)
).
:- pred shrink_2(int::in, array(T)::array_di, array(T)::array_uo) is det.
:- pragma foreign_proc("C",
shrink_2(Size::in, Array0::array_di, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness,
sharing(yes(int, array(T), array(T)), [
cel(Array0, []) - cel(Array, [])
])
],
"
ML_alloc_array(Array, Size + 1, MR_ALLOC_ID);
ML_shrink_array(Array, Array0, Size);
").
:- pragma foreign_proc("C#",
shrink_2(Size::in, Array0::array_di, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
Array = array.ML_shrink_array(Array0, Size);
").
:- pragma foreign_proc("Erlang",
shrink_2(Size::in, Array0::array_di, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
Array = list_to_tuple(lists:sublist(tuple_to_list(Array0), Size))
").
:- pragma foreign_proc("Java",
shrink_2(Size::in, Array0::array_di, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
if (Array0 == null) {
Array = null;
} else if (Array0 instanceof int[]) {
Array = new int[Size];
} else if (Array0 instanceof double[]) {
Array = new double[Size];
} else if (Array0 instanceof byte[]) {
Array = new byte[Size];
} else if (Array0 instanceof short[]) {
Array = new short[Size];
} else if (Array0 instanceof long[]) {
Array = new long[Size];
} else if (Array0 instanceof char[]) {
Array = new char[Size];
} else if (Array0 instanceof float[]) {
Array = new float[Size];
} else if (Array0 instanceof boolean[]) {
Array = new boolean[Size];
} else {
Array = new Object[Size];
}
if (Array != null) {
System.arraycopy(Array0, 0, Array, 0, Size);
}
").
%---------------------------------------------------------------------------%
fill(Item, !Array) :-
array.bounds(!.Array, Min, Max),
do_fill_range(Item, Min, Max, !Array).
fill_range(Item, Lo, Hi, !Array) :-
( if Lo > Hi then
unexpected($pred, "empty range")
else if not in_bounds(!.Array, Lo) then
arg_out_of_bounds_error(!.Array, "second", "fill_range", Lo)
else if not in_bounds(!.Array, Hi) then
arg_out_of_bounds_error(!.Array, "third", "fill_range", Hi)
else
do_fill_range(Item, Lo, Hi, !Array)
).
%---------------------------------------------------------------------------%
:- pred do_fill_range(T::in, int::in, int::in,
array(T)::array_di, array(T)::array_uo) is det.
:- pragma foreign_proc("Java",
do_fill_range(Item::in, Lo::in, Hi::in,
Array0::array_di, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
Array = jmercury.array.ML_array_fill(Array0, Lo, Hi + 1, Item);
").
do_fill_range(Item, Lo, Hi, !Array) :-
( if Lo =< Hi then
array.unsafe_set(Lo, Item, !Array),
do_fill_range(Item, Lo + 1, Hi, !Array)
else
true
).
%---------------------------------------------------------------------------%
:- pragma foreign_decl("C", "
extern void
ML_copy_array(MR_ArrayPtr array, MR_ConstArrayPtr old_array);
").
:- pragma foreign_code("C", "
// The caller is responsible for allocating the storage for the new array.
// This routine does the job of copying the array elements.
void
ML_copy_array(MR_ArrayPtr array, MR_ConstArrayPtr old_array)
{
// Any changes to this function will probably also require changes to
// - array.append below, and
// - MR_deep_copy() in runtime/mercury_deep_copy.[ch].
MR_Integer i;
MR_Integer array_size;
array_size = old_array->size;
array->size = array_size;
for (i = 0; i < array_size; i++) {
array->elements[i] = old_array->elements[i];
}
}
").
copy(A1) = A2 :-
array.copy(A1, A2).
:- pragma foreign_proc("C",
copy(Array0::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness,
sharing(yes(array(T), array(T)), [
cel(Array0, [T]) - cel(Array, [T])
])
],
"
ML_alloc_array(Array, Array0->size + 1, MR_ALLOC_ID);
ML_copy_array(Array, (MR_ConstArrayPtr) Array0);
").
:- pragma foreign_proc("C#",
copy(Array0::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
Array = (System.Array) Array0.Clone();
").
:- pragma foreign_proc("Erlang",
copy(Array0::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
Array = Array0
").
:- pragma foreign_proc("Java",
copy(Array0::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
int Size;
if (Array0 == null) {
Array = null;
Size = 0;
} else if (Array0 instanceof int[]) {
Size = ((int[]) Array0).length;
Array = new int[Size];
} else if (Array0 instanceof double[]) {
Size = ((double[]) Array0).length;
Array = new double[Size];
} else if (Array0 instanceof byte[]) {
Size = ((byte[]) Array0).length;
Array = new byte[Size];
} else if (Array0 instanceof short[]) {
Size = ((short[]) Array0).length;
Array = new short[Size];
} else if (Array0 instanceof long[]) {
Size = ((long[]) Array0).length;
Array = new long[Size];
} else if (Array0 instanceof char[]) {
Size = ((char[]) Array0).length;
Array = new char[Size];
} else if (Array0 instanceof float[]) {
Size = ((float[]) Array0).length;
Array = new float[Size];
} else if (Array0 instanceof boolean[]) {
Size = ((boolean[]) Array0).length;
Array = new boolean[Size];
} else {
Size = ((Object[]) Array0).length;
Array = new Object[Size];
}
if (Array != null) {
System.arraycopy(Array0, 0, Array, 0, Size);
}
").
%---------------------------------------------------------------------------%
array(List) = Array :-
array.from_list(List, Array).
from_list(List) = Array :-
array.from_list(List, Array).
from_list([], Array) :-
array.make_empty_array(Array).
from_list(List, Array) :-
List = [Head | Tail],
list.length(List, Len),
Array0 = array.unsafe_init(Len, Head, 0),
array.unsafe_insert_items(Tail, 1, Array0, Array).
%---------------------------------------------------------------------------%
:- pred unsafe_insert_items(list(T)::in, int::in,
array(T)::array_di, array(T)::array_uo) is det.
unsafe_insert_items([], _N, !Array).
unsafe_insert_items([Head | Tail], N, !Array) :-
unsafe_set(N, Head, !Array),
unsafe_insert_items(Tail, N + 1, !Array).
%---------------------------------------------------------------------------%
from_reverse_list([]) = Array :-
array.make_empty_array(Array).
from_reverse_list(RevList) = Array :-
RevList = [Head | Tail],
list.length(RevList, Len),
Array0 = array.unsafe_init(Len, Head, Len - 1),
unsafe_insert_items_reverse(Tail, Len - 2, Array0, Array).
:- pred unsafe_insert_items_reverse(list(T)::in, int::in,
array(T)::array_di, array(T)::array_uo) is det.
unsafe_insert_items_reverse([], _, !Array).
unsafe_insert_items_reverse([Head | Tail], N, !Array) :-
unsafe_set(N, Head, !Array),
unsafe_insert_items_reverse(Tail, N - 1, !Array).
%---------------------------------------------------------------------------%
to_list(Array) = List :-
to_list(Array, List).
to_list(Array, List) :-
( if is_empty(Array) then
List = []
else
bounds(Array, Low, High),
fetch_items(Array, Low, High, List)
).
%---------------------------------------------------------------------------%
fetch_items(Array, Low, High) = List :-
fetch_items(Array, Low, High, List).
fetch_items(Array, Low, High, List) :-
( if not in_bounds(Array, Low) then
arg_out_of_bounds_error(Array, "second", "fetch_items", Low)
else if not in_bounds(Array, High) then
arg_out_of_bounds_error(Array, "third", "fetch_items", High)
else if High < Low then
% If High is less than Low, then there cannot be any array indexes
% within the range Low -> High (inclusive). This can happen when
% calling to_list/2 on the empty array. Testing for this condition
% here rather than in to_list/2 is more general.
List = []
else
List = do_foldr_func(func(X, Xs) = [X | Xs], Array, [], Low, High)
).
%---------------------------------------------------------------------------%
bsearch(A, X, F) = MN :-
P = (pred(X1::in, X2::in, C::out) is det :- C = F(X1, X2)),
array.bsearch(A, X, P, MN).
bsearch(A, SearchX, Compare, Result) :-
array.bounds(A, Lo, Hi),
array.bsearch_2(A, Lo, Hi, SearchX, Compare, Result).
:- pred bsearch_2(array(T)::in, int::in, int::in, T::in,
pred(T, T, comparison_result)::in(pred(in, in, out) is det),
maybe(int)::out) is det.
bsearch_2(Array, Lo, Hi, SearchX, Compare, Result) :-
Width = Hi - Lo,
% If Width < 0, there is no range left.
( if Width < 0 then
Result = no
else
% If Width == 0, we may just have found our element.
% Do a Compare to check.
( if Width = 0 then
array.lookup(Array, Lo, LoX),
( if Compare(SearchX, LoX, (=)) then
Result = yes(Lo)
else
Result = no
)
else
% Otherwise find the middle element of the range
% and check against that.
% We calculate Mid this way to avoid overflow.
% The right shift by one bit is a fast implementation
% of division by 2.
Mid = Lo + ((Hi - Lo) `unchecked_right_shift` 1),
array.lookup(Array, Mid, MidX),
Compare(MidX, SearchX, Comp),
(
Comp = (<),
array.bsearch_2(Array, Mid + 1, Hi, SearchX, Compare, Result)
;
Comp = (=),
array.bsearch_2(Array, Lo, Mid, SearchX, Compare, Result)
;
Comp = (>),
array.bsearch_2(Array, Lo, Mid - 1, SearchX, Compare, Result)
)
)
).
%---------------------------------------------------------------------------%
map(F, A1) = A2 :-
P = (pred(X::in, Y::out) is det :- Y = F(X)),
array.map(P, A1, A2).
map(Closure, OldArray, NewArray) :-
( if array.semidet_lookup(OldArray, 0, Elem0) then
array.size(OldArray, Size),
Closure(Elem0, Elem),
NewArray0 = unsafe_init(Size, Elem, 0),
array.map_2(1, Size, Closure, OldArray, NewArray0, NewArray)
else
array.make_empty_array(NewArray)
).
:- pred map_2(int::in, int::in, pred(T1, T2)::in(pred(in, out) is det),
array(T1)::in, array(T2)::array_di, array(T2)::array_uo) is det.
map_2(N, Size, Closure, OldArray, !NewArray) :-
( if N >= Size then
true
else
array.unsafe_lookup(OldArray, N, OldElem),
Closure(OldElem, NewElem),
array.unsafe_set(N, NewElem, !NewArray),
map_2(N + 1, Size, Closure, OldArray, !NewArray)
).
%---------------------------------------------------------------------------%
swap(I, J, !Array) :-
( if not in_bounds(!.Array, I) then
arg_out_of_bounds_error(!.Array, "first", "array.swap", I)
else if not in_bounds(!.Array, J) then
arg_out_of_bounds_error(!.Array, "second", "array.swap", J)
else
unsafe_swap(I, J, !Array)
).
unsafe_swap(I, J, !Array) :-
array.unsafe_lookup(!.Array, I, IVal),
array.unsafe_lookup(!.Array, J, JVal),
array.unsafe_set(I, JVal, !Array),
array.unsafe_set(J, IVal, !Array).
%---------------------------------------------------------------------------%
member(A, X) :-
nondet_int_in_range(array.min(A), array.max(A), N),
array.unsafe_lookup(A, N, X).
%---------------------------------------------------------------------------%
% array.sort/1 has type specialised versions for arrays of ints and strings
% on the expectation that these constitute the common case and are hence
% worth providing a fast-path.
%
% Experiments indicate that type specialisation improves the speed of
% array.sort/1 by about 30-40%.
%
:- pragma type_spec(array.sort/1, T = int).
:- pragma type_spec(array.sort/1, T = string).
sort(A) = samsort_subarray(A, array.min(A), array.max(A)).
:- pragma no_inline(array.sort_fix_2014/0).
sort_fix_2014.
%---------------------------------------------------------------------------%
binary_search(A, SearchX, I) :-
array.binary_search(ordering, A, SearchX, I).
binary_search(Cmp, A, SearchX, I) :-
Lo = 0,
Hi = array.size(A) - 1,
binary_search_loop(Cmp, A, SearchX, Lo, Hi, I).
:- pred binary_search_loop(comparison_func(T)::in, array(T)::array_ui,
T::in, int::in, int::in, int::out) is semidet.
binary_search_loop(Cmp, A, SearchX, Lo, Hi, I) :-
% loop invariant: if SearchX is anywhere in A[0] .. A[array.size(A)-1],
% then it is in A[Lo] .. A[Hi].
Lo =< Hi,
% We calculate Mid this way to avoid overflow.
% The right shift by one bit is a fast implementation of division by 2.
Mid = Lo + ((Hi - Lo) `unchecked_right_shift` 1),
array.unsafe_lookup(A, Mid, MidX),
O = Cmp(MidX, SearchX),
(
O = (>),
binary_search_loop(Cmp, A, SearchX, Lo, Mid - 1, I)
;
O = (=),
I = Mid
;
O = (<),
binary_search_loop(Cmp, A, SearchX, Mid + 1, Hi, I)
).
%---------------------------------------------------------------------------%
approx_binary_search(A, SearchX, I) :-
approx_binary_search(ordering, A, SearchX, I).
approx_binary_search(Cmp, A, SearchX, I) :-
Lo = 0,
Hi = array.size(A) - 1,
approx_binary_search_loop(Cmp, A, SearchX, Lo, Hi, I).
:- pred approx_binary_search_loop(comparison_func(T)::in, array(T)::array_ui,
T::in, int::in, int::in, int::out) is semidet.
approx_binary_search_loop(Cmp, A, SearchX, Lo, Hi, I) :-
% loop invariant: if SearchX is anywhere in A[0] .. A[array.size(A)-1],
% then it is in A[Lo] .. A[Hi].
Lo =< Hi,
% We calculate Mid this way to avoid overflow.
% The right shift by one bit is a fast implementation of division by 2.
Mid = Lo + ((Hi - Lo) `unchecked_right_shift` 1),
array.unsafe_lookup(A, Mid, MidX),
O = Cmp(MidX, SearchX),
(
O = (>),
approx_binary_search_loop(Cmp, A, SearchX, Lo, Mid - 1, I)
;
O = (=),
I = Mid
;
O = (<),
( if
( if Mid < Hi then
% We get here only if Mid + 1 cannot exceed Hi,
% so the array access is safe.
array.unsafe_lookup(A, Mid + 1, MidP1X),
(<) = Cmp(SearchX, MidP1X)
else
Mid = Hi
)
then
I = Mid
else
approx_binary_search_loop(Cmp, A, SearchX, Mid + 1, Hi, I)
)
).
%---------------------------------------------------------------------------%
append(A, B) = C :-
SizeA = array.size(A),
SizeB = array.size(B),
SizeC = SizeA + SizeB,
( if
( if SizeA > 0 then
array.lookup(A, 0, InitElem)
else if SizeB > 0 then
array.lookup(B, 0, InitElem)
else
fail
)
then
C0 = array.init(SizeC, InitElem),
copy_subarray(A, 0, SizeA - 1, 0, C0, C1),
copy_subarray(B, 0, SizeB - 1, SizeA, C1, C)
else
C = array.make_empty_array
).
:- pragma foreign_proc("C",
append(ArrayA::in, ArrayB::in) = (ArrayC::array_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness,
sharing(yes(array(T), array(T), array(T)), [
cel(ArrayA, [T]) - cel(ArrayC, [T]),
cel(ArrayB, [T]) - cel(ArrayC, [T])
])
],
"
MR_Integer sizeC;
MR_Integer i;
MR_Integer offset;
sizeC = ArrayA->size + ArrayB->size;
ML_alloc_array(ArrayC, sizeC + 1, MR_ALLOC_ID);
ArrayC->size = sizeC;
for (i = 0; i < ArrayA->size; i++) {
ArrayC->elements[i] = ArrayA->elements[i];
}
offset = ArrayA->size;
for (i = 0; i < ArrayB->size; i++) {
ArrayC->elements[offset + i] = ArrayB->elements[i];
}
").
%---------------------------------------------------------------------------%
random_permutation(A0, A, RS0, RS) :-
Lo = array.min(A0),
Hi = array.max(A0),
Sz = array.size(A0),
permutation_2(Lo, Lo, Hi, Sz, A0, A, RS0, RS).
:- pred permutation_2(int::in, int::in, int::in, int::in,
array(T)::array_di, array(T)::array_uo,
random.supply::mdi, random.supply::muo) is det.
permutation_2(I, Lo, Hi, Sz, !A, !RS) :-
( if I > Hi then
true
else
random.random(R, !RS),
J = Lo + (R `rem` Sz),
swap_elems(I, J, !A),
permutation_2(I + 1, Lo, Hi, Sz, !A, !RS)
).
:- pred swap_elems(int::in, int::in, array(T)::array_di, array(T)::array_uo)
is det.
swap_elems(I, J, !A) :-
array.lookup(!.A, I, XI),
array.lookup(!.A, J, XJ),
array.unsafe_set(I, XJ, !A),
array.unsafe_set(J, XI, !A).
%---------------------------------------------------------------------------%
foldl(Fn, A, X) =
do_foldl_func(Fn, A, X, array.min(A), array.max(A)).
:- func do_foldl_func(func(T1, T2) = T2, array(T1), T2, int, int) = T2.
%:- mode do_foldl_func(func(in, in) = out is det, array_ui, in, in, in)
% = out is det.
:- mode do_foldl_func(func(in, in) = out is det, in, in, in, in) = out is det.
%:- mode do_foldl_func(func(in, di) = uo is det, array_ui, di, in, in)
% = uo is det.
:- mode do_foldl_func(func(in, di) = uo is det, in, di, in, in) = uo is det.
do_foldl_func(Fn, A, X, I, Max) =
( if Max < I then
X
else
do_foldl_func(Fn, A, Fn(A ^ unsafe_elem(I), X), I + 1, Max)
).
%---------------------------------------------------------------------------%
foldl(P, A, !Acc) :-
do_foldl_pred(P, A, array.min(A), array.max(A), !Acc).
:- pred do_foldl_pred(pred(T1, T2, T2), array(T1), int, int, T2, T2).
:- mode do_foldl_pred(pred(in, in, out) is det, in, in, in, in, out) is det.
:- mode do_foldl_pred(pred(in, mdi, muo) is det, in, in, in, mdi, muo) is det.
:- mode do_foldl_pred(pred(in, di, uo) is det, in, in, in, di, uo) is det.
:- mode do_foldl_pred(pred(in, in, out) is semidet, in, in, in, in, out)
is semidet.
:- mode do_foldl_pred(pred(in, mdi, muo) is semidet, in, in, in, mdi, muo)
is semidet.
:- mode do_foldl_pred(pred(in, di, uo) is semidet, in, in, in, di, uo)
is semidet.
do_foldl_pred(P, A, I, Max, !Acc) :-
( if Max < I then
true
else
P(A ^ unsafe_elem(I), !Acc),
do_foldl_pred(P, A, I + 1, Max, !Acc)
).
%---------------------------------------------------------------------------%
foldl2(P, A, !Acc1, !Acc2) :-
do_foldl2(P, array.min(A), array.max(A), A, !Acc1, !Acc2).
:- pred do_foldl2(pred(T1, T2, T2, T3, T3), int, int, array(T1), T2, T2,
T3, T3).
:- mode do_foldl2(pred(in, in, out, in, out) is det, in, in, in, in, out,
in, out) is det.
:- mode do_foldl2(pred(in, in, out, mdi, muo) is det, in, in, in, in, out,
mdi, muo) is det.
:- mode do_foldl2(pred(in, in, out, di, uo) is det, in, in, in, in, out,
di, uo) is det.
:- mode do_foldl2(pred(in, in, out, in, out) is semidet, in, in, in, in, out,
in, out) is semidet.
:- mode do_foldl2(pred(in, in, out, mdi, muo) is semidet, in, in, in, in, out,
mdi, muo) is semidet.
:- mode do_foldl2(pred(in, in, out, di, uo) is semidet, in, in, in, in, out,
di, uo) is semidet.
do_foldl2(P, I, Max, A, !Acc1, !Acc2) :-
( if Max < I then
true
else
P(A ^ unsafe_elem(I), !Acc1, !Acc2),
do_foldl2(P, I + 1, Max, A, !Acc1, !Acc2)
).
%---------------------------------------------------------------------------%
foldl3(P, A, !Acc1, !Acc2, !Acc3) :-
do_foldl3(P, array.min(A), array.max(A), A, !Acc1, !Acc2, !Acc3).
:- pred do_foldl3(pred(T1, T2, T2, T3, T3, T4, T4), int, int, array(T1),
T2, T2, T3, T3, T4, T4).
:- mode do_foldl3(pred(in, in, out, in, out, in, out) is det, in, in, in,
in, out, in, out, in, out) is det.
:- mode do_foldl3(pred(in, in, out, in, out, mdi, muo) is det, in, in, in,
in, out, in, out, mdi, muo) is det.
:- mode do_foldl3(pred(in, in, out, in, out, di, uo) is det, in, in, in,
in, out, in, out, di, uo) is det.
:- mode do_foldl3(pred(in, in, out, in, out, in, out) is semidet, in, in, in,
in, out, in, out, in, out) is semidet.
:- mode do_foldl3(pred(in, in, out, in, out, mdi, muo) is semidet, in, in, in,
in, out, in, out, mdi, muo) is semidet.
:- mode do_foldl3(pred(in, in, out, in, out, di, uo) is semidet, in, in, in,
in, out, in, out, di, uo) is semidet.
do_foldl3(P, I, Max, A, !Acc1, !Acc2, !Acc3) :-
( if Max < I then
true
else
P(A ^ unsafe_elem(I), !Acc1, !Acc2, !Acc3),
do_foldl3(P, I + 1, Max, A, !Acc1, !Acc2, !Acc3)
).
%---------------------------------------------------------------------------%
foldl4(P, A, !Acc1, !Acc2, !Acc3, !Acc4) :-
do_foldl4(P, array.min(A), array.max(A), A, !Acc1, !Acc2, !Acc3, !Acc4).
:- pred do_foldl4(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5), int, int,
array(T1), T2, T2, T3, T3, T4, T4, T5, T5).
:- mode do_foldl4(pred(in, in, out, in, out, in, out, in, out) is det, in, in,
in, in, out, in, out, in, out, in, out) is det.
:- mode do_foldl4(pred(in, in, out, in, out, in, out, mdi, muo) is det, in, in,
in, in, out, in, out, in, out, mdi, muo) is det.
:- mode do_foldl4(pred(in, in, out, in, out, in, out, di, uo) is det, in, in,
in, in, out, in, out, in, out, di, uo) is det.
:- mode do_foldl4(pred(in, in, out, in, out, in, out, in, out) is semidet,
in, in, in, in, out, in, out, in, out, in, out) is semidet.
:- mode do_foldl4(pred(in, in, out, in, out, in, out, mdi, muo) is semidet,
in, in, in, in, out, in, out, in, out, mdi, muo) is semidet.
:- mode do_foldl4(pred(in, in, out, in, out, in, out, di, uo) is semidet,
in, in, in, in, out, in, out, in, out, di, uo) is semidet.
do_foldl4(P, I, Max, A, !Acc1, !Acc2, !Acc3, !Acc4) :-
( if Max < I then
true
else
P(A ^ unsafe_elem(I), !Acc1, !Acc2, !Acc3, !Acc4),
do_foldl4(P, I + 1, Max, A, !Acc1, !Acc2, !Acc3, !Acc4)
).
%---------------------------------------------------------------------------%
foldl5(P, A, !Acc1, !Acc2, !Acc3, !Acc4, !Acc5) :-
do_foldl5(P, array.min(A), array.max(A), A, !Acc1, !Acc2, !Acc3, !Acc4,
!Acc5).
:- pred do_foldl5(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5, T6, T6),
int, int, array(T1), T2, T2, T3, T3, T4, T4, T5, T5, T6, T6).
:- mode do_foldl5(
pred(in, in, out, in, out, in, out, in, out, in, out) is det,
in, in, in, in, out, in, out, in, out, in, out, in, out) is det.
:- mode do_foldl5(
pred(in, in, out, in, out, in, out, in, out, mdi, muo) is det,
in, in, in, in, out, in, out, in, out, in, out, mdi, muo) is det.
:- mode do_foldl5(
pred(in, in, out, in, out, in, out, in, out, di, uo) is det,
in, in, in, in, out, in, out, in, out, in, out, di, uo) is det.
:- mode do_foldl5(
pred(in, in, out, in, out, in, out, in, out, in, out) is semidet,
in, in, in, in, out, in, out, in, out, in, out, in, out) is semidet.
:- mode do_foldl5(
pred(in, in, out, in, out, in, out, in, out, mdi, muo) is semidet,
in, in, in, in, out, in, out, in, out, in, out, mdi, muo) is semidet.
:- mode do_foldl5(
pred(in, in, out, in, out, in, out, in, out, di, uo) is semidet,
in, in, in, in, out, in, out, in, out, in, out, di, uo) is semidet.
do_foldl5(P, I, Max, A, !Acc1, !Acc2, !Acc3, !Acc4, !Acc5) :-
( if Max < I then
true
else
P(A ^ unsafe_elem(I), !Acc1, !Acc2, !Acc3, !Acc4, !Acc5),
do_foldl5(P, I + 1, Max, A, !Acc1, !Acc2, !Acc3, !Acc4, !Acc5)
).
%---------------------------------------------------------------------------%
foldr(Fn, A, X) =
do_foldr_func(Fn, A, X, array.min(A), array.max(A)).
:- func do_foldr_func(func(T1, T2) = T2, array(T1), T2, int, int) = T2.
%:- mode do_foldr_func(func(in, in) = out is det, array_ui, in, in, in)
% = out is det.
:- mode do_foldr_func(func(in, in) = out is det, in, in, in, in) = out is det.
%:- mode do_foldr_func(func(in, di) = uo is det, array_ui, di, in, in)
% = uo is det.
:- mode do_foldr_func(func(in, di) = uo is det, in, di, in, in) = uo is det.
do_foldr_func(Fn, A, X, Min, I) =
( if I < Min then
X
else
do_foldr_func(Fn, A, Fn(A ^ unsafe_elem(I), X), Min, I - 1)
).
%---------------------------------------------------------------------------%
foldr(P, A, !Acc) :-
do_foldr_pred(P, array.min(A), array.max(A), A, !Acc).
:- pred do_foldr_pred(pred(T1, T2, T2), int, int, array(T1), T2, T2).
:- mode do_foldr_pred(pred(in, in, out) is det, in, in, in, in, out) is det.
:- mode do_foldr_pred(pred(in, mdi, muo) is det, in, in, in, mdi, muo) is det.
:- mode do_foldr_pred(pred(in, di, uo) is det, in, in, in, di, uo) is det.
:- mode do_foldr_pred(pred(in, in, out) is semidet, in, in, in, in, out)
is semidet.
:- mode do_foldr_pred(pred(in, mdi, muo) is semidet, in, in, in, mdi, muo)
is semidet.
:- mode do_foldr_pred(pred(in, di, uo) is semidet, in, in, in, di, uo)
is semidet.
do_foldr_pred(P, Min, I, A, !Acc) :-
( if I < Min then
true
else
P(A ^ unsafe_elem(I), !Acc),
do_foldr_pred(P, Min, I - 1, A, !Acc)
).
%---------------------------------------------------------------------------%
foldr2(P, A, !Acc1, !Acc2) :-
do_foldr2(P, array.min(A), array.max(A), A, !Acc1, !Acc2).
:- pred do_foldr2(pred(T1, T2, T2, T3, T3), int, int, array(T1), T2, T2,
T3, T3).
:- mode do_foldr2(pred(in, in, out, in, out) is det, in, in, in, in, out,
in, out) is det.
:- mode do_foldr2(pred(in, in, out, mdi, muo) is det, in, in, in, in, out,
mdi, muo) is det.
:- mode do_foldr2(pred(in, in, out, di, uo) is det, in, in, in, in, out,
di, uo) is det.
:- mode do_foldr2(pred(in, in, out, in, out) is semidet, in, in, in, in, out,
in, out) is semidet.
:- mode do_foldr2(pred(in, in, out, mdi, muo) is semidet, in, in, in, in, out,
mdi, muo) is semidet.
:- mode do_foldr2(pred(in, in, out, di, uo) is semidet, in, in, in, in, out,
di, uo) is semidet.
do_foldr2(P, Min, I, A, !Acc1, !Acc2) :-
( if I < Min then
true
else
P(A ^ unsafe_elem(I), !Acc1, !Acc2),
do_foldr2(P, Min, I - 1, A, !Acc1, !Acc2)
).
%---------------------------------------------------------------------------%
foldr3(P, A, !Acc1, !Acc2, !Acc3) :-
do_foldr3(P, array.min(A), array.max(A), A, !Acc1, !Acc2, !Acc3).
:- pred do_foldr3(pred(T1, T2, T2, T3, T3, T4, T4), int, int, array(T1),
T2, T2, T3, T3, T4, T4).
:- mode do_foldr3(pred(in, in, out, in, out, in, out) is det, in, in, in,
in, out, in, out, in, out) is det.
:- mode do_foldr3(pred(in, in, out, in, out, mdi, muo) is det, in, in, in,
in, out, in, out, mdi, muo) is det.
:- mode do_foldr3(pred(in, in, out, in, out, di, uo) is det, in, in, in,
in, out, in, out, di, uo) is det.
:- mode do_foldr3(pred(in, in, out, in, out, in, out) is semidet, in, in, in,
in, out, in, out, in, out) is semidet.
:- mode do_foldr3(pred(in, in, out, in, out, mdi, muo) is semidet, in, in, in,
in, out, in, out, mdi, muo) is semidet.
:- mode do_foldr3(pred(in, in, out, in, out, di, uo) is semidet, in, in, in,
in, out, in, out, di, uo) is semidet.
do_foldr3(P, Min, I, A, !Acc1, !Acc2, !Acc3) :-
( if I < Min then
true
else
P(A ^ unsafe_elem(I), !Acc1, !Acc2, !Acc3),
do_foldr3(P, Min, I - 1, A, !Acc1, !Acc2, !Acc3)
).
%---------------------------------------------------------------------------%
foldr4(P, A, !Acc1, !Acc2, !Acc3, !Acc4) :-
do_foldr4(P, array.min(A), array.max(A), A, !Acc1, !Acc2, !Acc3, !Acc4).
:- pred do_foldr4(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5), int, int,
array(T1), T2, T2, T3, T3, T4, T4, T5, T5).
:- mode do_foldr4(pred(in, in, out, in, out, in, out, in, out) is det, in, in,
in, in, out, in, out, in, out, in, out) is det.
:- mode do_foldr4(pred(in, in, out, in, out, in, out, mdi, muo) is det, in, in,
in, in, out, in, out, in, out, mdi, muo) is det.
:- mode do_foldr4(pred(in, in, out, in, out, in, out, di, uo) is det, in, in,
in, in, out, in, out, in, out, di, uo) is det.
:- mode do_foldr4(pred(in, in, out, in, out, in, out, in, out) is semidet,
in, in, in, in, out, in, out, in, out, in, out) is semidet.
:- mode do_foldr4(pred(in, in, out, in, out, in, out, mdi, muo) is semidet,
in, in, in, in, out, in, out, in, out, mdi, muo) is semidet.
:- mode do_foldr4(pred(in, in, out, in, out, in, out, di, uo) is semidet,
in, in, in, in, out, in, out, in, out, di, uo) is semidet.
do_foldr4(P, Min, I, A, !Acc1, !Acc2, !Acc3, !Acc4) :-
( if I < Min then
true
else
P(A ^ unsafe_elem(I), !Acc1, !Acc2, !Acc3, !Acc4),
do_foldr4(P, Min, I - 1, A, !Acc1, !Acc2, !Acc3, !Acc4)
).
%---------------------------------------------------------------------------%
foldr5(P, A, !Acc1, !Acc2, !Acc3, !Acc4, !Acc5) :-
do_foldr5(P, array.min(A), array.max(A), A, !Acc1, !Acc2, !Acc3, !Acc4,
!Acc5).
:- pred do_foldr5(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5, T6, T6),
int, int, array(T1), T2, T2, T3, T3, T4, T4, T5, T5, T6, T6).
:- mode do_foldr5(
pred(in, in, out, in, out, in, out, in, out, in, out) is det,
in, in, in, in, out, in, out, in, out, in, out, in, out) is det.
:- mode do_foldr5(
pred(in, in, out, in, out, in, out, in, out, mdi, muo) is det,
in, in, in, in, out, in, out, in, out, in, out, mdi, muo) is det.
:- mode do_foldr5(
pred(in, in, out, in, out, in, out, in, out, di, uo) is det,
in, in, in, in, out, in, out, in, out, in, out, di, uo) is det.
:- mode do_foldr5(
pred(in, in, out, in, out, in, out, in, out, in, out) is semidet,
in, in, in, in, out, in, out, in, out, in, out, in, out) is semidet.
:- mode do_foldr5(
pred(in, in, out, in, out, in, out, in, out, mdi, muo) is semidet,
in, in, in, in, out, in, out, in, out, in, out, mdi, muo) is semidet.
:- mode do_foldr5(
pred(in, in, out, in, out, in, out, in, out, di, uo) is semidet,
in, in, in, in, out, in, out, in, out, in, out, di, uo) is semidet.
do_foldr5(P, Min, I, A, !Acc1, !Acc2, !Acc3, !Acc4, !Acc5) :-
( if I < Min then
true
else
P(A ^ unsafe_elem(I), !Acc1, !Acc2, !Acc3, !Acc4, !Acc5),
do_foldr5(P, Min, I - 1, A, !Acc1, !Acc2, !Acc3, !Acc4, !Acc5)
).
%---------------------------------------------------------------------------%
foldl_corresponding(P, A, B, !Acc) :-
MaxA = array.max(A),
MaxB = array.max(B),
( if MaxA = MaxB then
do_foldl_corresponding(P, 0, MaxA, A, B, !Acc)
else
unexpected($pred, "mismatched array sizes")
).
:- pred do_foldl_corresponding(pred(T1, T2, T3, T3), int, int,
array(T1), array(T2), T3, T3).
:- mode do_foldl_corresponding(in(pred(in, in, in, out) is det), in, in,
in, in, in, out) is det.
:- mode do_foldl_corresponding(in(pred(in, in, mdi, muo) is det), in, in,
in, in, mdi, muo) is det.
:- mode do_foldl_corresponding(in(pred(in, in, di, uo) is det), in, in,
in, in, di, uo) is det.
:- mode do_foldl_corresponding(in(pred(in, in, in, out) is semidet), in, in,
in, in, in, out) is semidet.
:- mode do_foldl_corresponding(in(pred(in, in, mdi, muo) is semidet), in, in,
in, in, mdi, muo) is semidet.
:- mode do_foldl_corresponding(in(pred(in, in, di, uo) is semidet), in, in,
in, in, di, uo) is semidet.
do_foldl_corresponding(P, I, Max, A, B, !Acc) :-
( if Max < I then
true
else
P(A ^ unsafe_elem(I), B ^ unsafe_elem(I), !Acc),
do_foldl_corresponding(P, I + 1, Max, A, B, !Acc)
).
foldl2_corresponding(P, A, B, !Acc1, !Acc2) :-
MaxA = array.max(A),
MaxB = array.max(B),
( if MaxA = MaxB then
do_foldl2_corresponding(P, 0, MaxA, A, B, !Acc1, !Acc2)
else
unexpected($pred, "mismatched array sizes")
).
:- pred do_foldl2_corresponding(pred(T1, T2, T3, T3, T4, T4), int, int,
array(T1), array(T2), T3, T3, T4, T4).
:- mode do_foldl2_corresponding(in(pred(in, in, in, out, in, out) is det),
in, in, in, in, in, out, in, out) is det.
:- mode do_foldl2_corresponding(in(pred(in, in, in, out, mdi, muo) is det),
in, in, in, in, in, out, mdi, muo) is det.
:- mode do_foldl2_corresponding(in(pred(in, in, in, out, di, uo) is det),
in, in, in, in, in, out, di, uo) is det.
:- mode do_foldl2_corresponding(in(pred(in, in, in, out, in, out) is semidet),
in, in, in, in, in, out, in, out) is semidet.
:- mode do_foldl2_corresponding(in(pred(in, in, in, out, mdi, muo) is semidet),
in, in, in, in, in, out, mdi, muo) is semidet.
:- mode do_foldl2_corresponding(in(pred(in, in, in, out, di, uo) is semidet),
in, in, in, in, in, out, di, uo) is semidet.
do_foldl2_corresponding(P, I, Max, A, B, !Acc1, !Acc2) :-
( if Max < I then
true
else
P(A ^ unsafe_elem(I), B ^ unsafe_elem(I), !Acc1, !Acc2),
do_foldl2_corresponding(P, I + 1, Max, A, B, !Acc1, !Acc2)
).
%---------------------------------------------------------------------------%
map_foldl(P, A, B, !Acc) :-
N = array.size(A),
( if N =< 0 then
B = array.make_empty_array
else
array.unsafe_lookup(A, 0, X),
P(X, Y, !Acc),
B1 = unsafe_init(N, Y, 0),
map_foldl_2(P, 1, A, B1, B, !Acc)
).
:- pred map_foldl_2(pred(T1, T2, T3, T3),
int, array(T1), array(T2), array(T2), T3, T3).
:- mode map_foldl_2(in(pred(in, out, in, out) is det),
in, in, array_di, array_uo, in, out) is det.
:- mode map_foldl_2(in(pred(in, out, mdi, muo) is det),
in, in, array_di, array_uo, mdi, muo) is det.
:- mode map_foldl_2(in(pred(in, out, di, uo) is det),
in, in, array_di, array_uo, di, uo) is det.
:- mode map_foldl_2(in(pred(in, out, in, out) is semidet),
in, in, array_di, array_uo, in, out) is semidet.
map_foldl_2(P, I, A, !B, !Acc) :-
( if I < array.size(A) then
array.unsafe_lookup(A, I, X),
P(X, Y, !Acc),
array.unsafe_set(I, Y, !B),
map_foldl_2(P, I + 1, A, !B, !Acc)
else
true
).
%---------------------------------------------------------------------------%
map_corresponding_foldl(P, A, B, C, !Acc) :-
SizeA = array.size(A),
SizeB = array.size(B),
( if SizeA \= SizeB then
unexpected($pred, "mismatched array sizes")
else if SizeA =< 0 then
C = array.make_empty_array
else
array.unsafe_lookup(A, 0, X),
array.unsafe_lookup(B, 0, Y),
P(X, Y, Z, !Acc),
C1 = unsafe_init(SizeA, Z, 0),
map_corresponding_foldl_2(P, 1, SizeA, A, B, C1, C, !Acc)
).
:- pred map_corresponding_foldl_2(pred(T1, T2, T3, T4, T4),
int, int, array(T1), array(T2), array(T3), array(T3), T4, T4).
:- mode map_corresponding_foldl_2(
in(pred(in, in, out, in, out) is det),
in, in, in, in, array_di, array_uo, in, out) is det.
:- mode map_corresponding_foldl_2(
in(pred(in, in, out, mdi, muo) is det),
in, in, in, in, array_di, array_uo, mdi, muo) is det.
:- mode map_corresponding_foldl_2(
in(pred(in, in, out, di, uo) is det),
in, in, in, in, array_di, array_uo, di, uo) is det.
:- mode map_corresponding_foldl_2(
in(pred(in, in, out, in, out) is semidet),
in, in, in, in, array_di, array_uo, in, out) is semidet.
:- mode map_corresponding_foldl_2(
in(pred(in, in, out, mdi, muo) is semidet),
in, in, in, in, array_di, array_uo, mdi, muo) is semidet.
:- mode map_corresponding_foldl_2(
in(pred(in, in, out, di, uo) is semidet),
in, in, in, in, array_di, array_uo, di, uo) is semidet.
map_corresponding_foldl_2(P, I, N, A, B, !C, !Acc) :-
( if I < N then
array.unsafe_lookup(A, I, X),
array.unsafe_lookup(B, I, Y),
P(X, Y, Z, !Acc),
array.unsafe_set(I, Z, !C),
map_corresponding_foldl_2(P, I + 1, N, A, B, !C, !Acc)
else
true
).
%---------------------------------------------------------------------------%
all_true(Pred, Array) :-
do_all_true(Pred, array.min(Array), array.max(Array), Array).
:- pred do_all_true(pred(T), int, int, array(T)).
%:- mode do_all_true(in(pred(in) is semidet), in, in, array_ui) is semidet.
:- mode do_all_true(in(pred(in) is semidet), in, in, in) is semidet.
do_all_true(Pred, I, UB, Array) :-
( if I =< UB then
array.unsafe_lookup(Array, I, Elem),
Pred(Elem),
do_all_true(Pred, I + 1, UB, Array)
else
true
).
all_false(Pred, Array) :-
do_all_false(Pred, array.min(Array), array.max(Array), Array).
:- pred do_all_false(pred(T), int, int, array(T)).
%:- mode do_all_false(in(pred(in) is semidet), in, in, array_ui) is semidet.
:- mode do_all_false(in(pred(in) is semidet), in, in, in) is semidet.
do_all_false(Pred, I, UB, Array) :-
( if I =< UB then
array.unsafe_lookup(Array, I, Elem),
not Pred(Elem),
do_all_false(Pred, I + 1, UB, Array)
else
true
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% SAMsort (smooth applicative merge) invented by R.A. O'Keefe.
%
% SAMsort is a mergesort variant that works by identifying contiguous
% monotonic sequences and merging them, thereby taking advantage of
% any existing order in the input sequence.
%
:- func samsort_subarray(array(T)::array_di, int::in, int::in) =
(array(T)::array_uo) is det.
:- pragma type_spec(samsort_subarray/3, T = int).
:- pragma type_spec(samsort_subarray/3, T = string).
samsort_subarray(A0, Lo, Hi) = A :-
samsort_up(0, array.copy(A0), A, A0, _, Lo, Hi, Lo).
% samsort_up(N, A0, A, B0, B, Lo, Hi, I):
%
% Precondition:
% We are N levels from the bottom (leaf nodes) of the tree.
% A0 is sorted from Lo .. I - 1.
% A0 and B0 are identical from I .. Hi.
% Postcondition:
% A is sorted from Lo .. Hi.
%
:- pred samsort_up(int::in, array(T)::array_di, array(T)::array_uo,
array(T)::array_di, array(T)::array_uo, int::in, int::in, int::in) is det.
:- pragma type_spec(samsort_up/8, T = int).
:- pragma type_spec(samsort_up/8, T = string).
samsort_up(N, A0, A, B0, B, Lo, Hi, I) :-
trace [compile_time(flag("array_sort"))] (
verify_sorted(A0, Lo, I - 1),
verify_identical(A0, B0, I, Hi)
),
( if I > Hi then
A = A0,
B = B0
% A is sorted from Lo .. Hi.
else if N > 0 then
% B0 and A0 are identical from I .. Hi.
samsort_down(N - 1, B0, B1, A0, A1, I, Hi, J),
% A1 is sorted from I .. J - 1.
% B1 and A1 are identical from J .. Hi.
merge_subarrays(A1, Lo, I - 1, I, J - 1, Lo, B1, B2),
A2 = A1,
% B2 is sorted from Lo .. J - 1.
% B2 and A2 are identical from J .. Hi.
samsort_up(N + 1, B2, B3, A2, A3, Lo, Hi, J),
% B3 is sorted from Lo .. Hi.
A = B3,
B = A3
% A is sorted from Lo .. Hi.
else
% N = 0, I = Lo
copy_run_ascending(A0, B0, B1, Lo, Hi, J),
% B1 is sorted from Lo .. J - 1.
% B1 and A0 are identical from J .. Hi.
samsort_up(N + 1, B1, B2, A0, A2, Lo, Hi, J),
% B2 is sorted from Lo .. Hi.
A = B2,
B = A2
% A is sorted from Lo .. Hi.
),
trace [compile_time(flag("array_sort"))] (
verify_sorted(A, Lo, Hi)
).
% samsort_down(N, A0, A, B0, B, Lo, Hi, I):
%
% Precondition:
% We are N levels from the bottom (leaf nodes) of the tree.
% A0 and B0 are identical from Lo .. Hi.
% Postcondition:
% B is sorted from Lo .. I - 1.
% A and B are identical from I .. Hi.
%
:- pred samsort_down(int::in, array(T)::array_di, array(T)::array_uo,
array(T)::array_di, array(T)::array_uo, int::in, int::in, int::out) is det.
:- pragma type_spec(samsort_down/8, T = int).
:- pragma type_spec(samsort_down/8, T = string).
samsort_down(N, A0, A, B0, B, Lo, Hi, I) :-
trace [compile_time(flag("array_sort"))] (
verify_identical(A0, B0, Lo, Hi)
),
( if Lo > Hi then
A = A0,
B = B0,
I = Lo
% B is sorted from Lo .. I - 1.
else if N > 0 then
samsort_down(N - 1, B0, B1, A0, A1, Lo, Hi, J),
samsort_down(N - 1, B1, B2, A1, A2, J, Hi, I),
% A2 is sorted from Lo .. J - 1.
% A2 is sorted from J .. I - 1.
A = A2,
merge_subarrays(A2, Lo, J - 1, J, I - 1, Lo, B2, B)
% B is sorted from Lo .. I - 1.
else
A = A0,
copy_run_ascending(A0, B0, B, Lo, Hi, I)
% B is sorted from Lo .. I - 1.
),
trace [compile_time(flag("array_sort"))] (
verify_sorted(B, Lo, I - 1),
verify_identical(A, B, I, Hi)
).
:- pred verify_sorted(array(T)::array_ui, int::in, int::in) is det.
verify_sorted(A, Lo, Hi) :-
( if Lo >= Hi then
true
else if compare((<), A ^ elem(Lo + 1), A ^ elem(Lo)) then
unexpected($module, $pred, "array range not sorted")
else
verify_sorted(A, Lo + 1, Hi)
).
:- pred verify_identical(array(T)::array_ui, array(T)::array_ui,
int::in, int::in) is det.
verify_identical(A, B, Lo, Hi) :-
( if Lo > Hi then
true
else if A ^ elem(Lo) = B ^ elem(Lo) then
verify_identical(A, B, Lo + 1, Hi)
else
unexpected($module, $pred, "array ranges not identical")
).
%---------------------------------------------------------------------------%
:- pred copy_run_ascending(array(T)::array_ui,
array(T)::array_di, array(T)::array_uo, int::in, int::in, int::out) is det.
:- pragma type_spec(copy_run_ascending/6, T = int).
:- pragma type_spec(copy_run_ascending/6, T = string).
copy_run_ascending(A, !B, Lo, Hi, I) :-
( if
Lo < Hi,
compare((>), A ^ elem(Lo), A ^ elem(Lo + 1))
then
I = search_until((<), A, Lo, Hi),
copy_subarray_reverse(A, Lo, I - 1, I - 1, !B)
else
I = search_until((>), A, Lo, Hi),
copy_subarray(A, Lo, I - 1, Lo, !B)
).
%---------------------------------------------------------------------------%
:- func search_until(comparison_result::in, array(T)::array_ui,
int::in, int::in) = (int::out) is det.
:- pragma type_spec(search_until/4, T = int).
:- pragma type_spec(search_until/4, T = string).
search_until(R, A, Lo, Hi) =
( if
Lo < Hi,
not compare(R, A ^ elem(Lo), A ^ elem(Lo + 1))
then
search_until(R, A, Lo + 1, Hi)
else
Lo + 1
).
%---------------------------------------------------------------------------%
% Assigns the subarray A[Lo..Hi] to B[InitI..Final], where InitI
% is the initial value of I, and FinalI = InitI + (Ho - Lo + 1).
% In this version, I is ascending, so B[InitI] gets A[Lo]
%
:- pred copy_subarray(array(T)::array_ui, int::in, int::in, int::in,
array(T)::array_di, array(T)::array_uo) is det.
:- pragma type_spec(copy_subarray/6, T = int).
:- pragma type_spec(copy_subarray/6, T = string).
copy_subarray(A, Lo, Hi, I, !B) :-
( if Lo =< Hi then
array.lookup(A, Lo, X),
% XXX Would it be safe to replace this with array.unsafe_set?
array.set(I, X, !B),
copy_subarray(A, Lo + 1, Hi, I + 1, !B)
else
true
).
% Assigns the subarray A[Lo..Hi] to B[InitI..Final], where InitI
% is the initial value of I, and FinalI = InitI - (Ho - Lo + 1).
% In this version, I is descending, so B[InitI] gets A[Hi].
%
:- pred copy_subarray_reverse(array(T)::array_ui, int::in, int::in, int::in,
array(T)::array_di, array(T)::array_uo) is det.
:- pragma type_spec(copy_subarray_reverse/6, T = int).
:- pragma type_spec(copy_subarray_reverse/6, T = string).
copy_subarray_reverse(A, Lo, Hi, I, !B) :-
( if Lo =< Hi then
array.lookup(A, Lo, X),
% XXX Would it be safe to replace this with array.unsafe_set?
array.set(I, X, !B),
copy_subarray_reverse(A, Lo + 1, Hi, I - 1, !B)
else
true
).
%---------------------------------------------------------------------------%
% merges the two sorted consecutive subarrays Lo1 .. Hi1 and Lo2 .. Hi2
% from A into the subarray starting at I in B.
%
:- pred merge_subarrays(array(T)::array_ui,
int::in, int::in, int::in, int::in, int::in,
array(T)::array_di, array(T)::array_uo) is det.
:- pragma type_spec(merge_subarrays/8, T = int).
:- pragma type_spec(merge_subarrays/8, T = string).
merge_subarrays(A, Lo1, Hi1, Lo2, Hi2, I, !B) :-
( if Lo1 > Hi1 then
copy_subarray(A, Lo2, Hi2, I, !B)
else if Lo2 > Hi2 then
copy_subarray(A, Lo1, Hi1, I, !B)
else
array.lookup(A, Lo1, X1),
array.lookup(A, Lo2, X2),
compare(R, X1, X2),
(
R = (<),
array.set(I, X1, !B),
merge_subarrays(A, Lo1 + 1, Hi1, Lo2, Hi2, I + 1, !B)
;
R = (=),
array.set(I, X1, !B),
merge_subarrays(A, Lo1 + 1, Hi1, Lo2, Hi2, I + 1, !B)
;
R = (>),
array.set(I, X2, !B),
merge_subarrays(A, Lo1, Hi1, Lo2 + 1, Hi2, I + 1, !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
% prevent the compiler from optimizing away the construction of the
% type_info in the caller, because it would prevent unused argument
% elimination. Performance is important here, because array.set and
% array.lookup are likely to be used in the inner loops of
% performance-critical applications.
array.bounds(Array, Min, Max),
string.format("%s: index %d not in range [%d, %d]",
[s(PredName), i(Index), i(Min), i(Max)], Msg),
throw(array.index_out_of_bounds(Msg)).
% Like the above, but for use in cases where the are multiple arguments
% that correspond to array indices.
%
:- pred arg_out_of_bounds_error(array(T), string, string, int).
:- mode arg_out_of_bounds_error(in, in, in, in) is erroneous.
arg_out_of_bounds_error(Array, ArgPosn, PredName, Index) :-
array.bounds(Array, Min, Max),
string.format("%s argument of %s: index %d not in range [%d, %d]",
[s(ArgPosn), s(PredName), i(Index), i(Min), i(Max)], Msg),
throw(array.index_out_of_bounds(Msg)).
%---------------------------------------------------------------------------%
least_index(A) = array.min(A).
det_least_index(A) = Index :-
( if array.is_empty(A) then
unexpected($pred, "empty array")
else
Index = array.min(A)
).
semidet_least_index(A) = Index :-
( if array.is_empty(A) then
fail
else
Index = array.min(A)
).
%---------------------------------------------------------------------------%
greatest_index(A) = array.max(A).
det_greatest_index(A) = Index :-
( if array.is_empty(A) then
unexpected($pred, "empty array")
else
Index = array.max(A)
).
semidet_greatest_index(A) = Index :-
( if array.is_empty(A) then
fail
else
Index = array.max(A)
).
%---------------------------------------------------------------------------%
array_to_doc(A) =
indent([str("array(["), array_to_doc_2(0, A), str("])")]).
:- func array_to_doc_2(int, array(T)) = doc.
array_to_doc_2(I, A) =
( if I > array.max(A) then
str("")
else
docs([
format_arg(format(A ^ elem(I))),
( if I = array.max(A) then str("") else group([str(", "), nl]) ),
format_susp((func) = array_to_doc_2(I + 1, A))
])
).
%---------------------------------------------------------------------------%
dynamic_cast_to_array(X, A) :-
% If X is an array then it has a type with one type argument.
[ArgTypeDesc] = type_args(type_of(X)),
% Convert ArgTypeDesc to a type variable ArgType.
(_ `with_type` ArgType) `has_type` ArgTypeDesc,
% Constrain the type of A to be array(ArgType) and do the cast.
dynamic_cast(X, A `with_type` array(ArgType)).
%---------------------------------------------------------------------------%
:- end_module array.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink