mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-14 05:12:33 +00:00
Estimated hours taken: 8, plus about 12 hours by Tyson.
Remove type_ctor_layouts and type_ctor_functors where not needed.
Simplify type_ctor_layouts by removing code that generates (and
documentations for) particularly representations that are no longer used
now that we use type_ctor_reps.
Several files also had miscellaneous cleanups and documentation fixes,
the most important being the move of the type_ctor_info structures
for preds/funcs from runtime/mercury_type_info.c to library/builtin.m.
compiler/base_type_layout.m:
Simplify documentation.
Remove references to representations in type_ctor_layouts that
are no longer used.compiler/base_type_layout.m:
compiler/base_type_info.m:
Keep base_type_info__type_ctor_rep_to_int in sync with
MR_TypeCtorRepresentation.
runtime/mercury_grade.h:
runtime/mercury_cpp.h:
Move the definitions of MR_STRINGIFY and MR_PASTEn to the new file
mercury_cpp.h. Add MR_PASTEn for several new values of n, for use by
mercury_type_info.h.
runtime/mercury_type_info.h:
Define macros for creating type_ctor_info structures for builtin types.
These have NULL layout and functor fields.
Remove several obsolete macros.
runtime/mercury_layout_util.c:
Use the new macros for defining a dummy type_ctor_info.
runtime/mercury_deep_copy_body.h:
runtime/mercury_tabling.c:
Modify the implementation of some RTTI functions to use the layout
and functors structures only if they are defined.
runtime/mercury_type_info.c:
Modify MR_collapse_equivalences to use the type_ctor_rep, not the
functors indicator, to check for equivalence, since the latter is
not guaranteed to be present.
Move the type_ctor_info structure for preds/funcs to builtin.m.
library/array.m:
Use these macros to define the type_ctor_info structure for array.
library/builtin.m:
Use these macros to define the type_ctor_info structure for int,
float, character, string, saved succip etc values, and for preds
and funcs.
library/private_builtin.m:
Use these macros to define the type_ctor_info structure for type_infos,
type_ctor_infos, typeclass_infos and base_typeclass_infos.
Move a c_header_code to the section that needs it.
library/std_util.m:
Use the new macros to define the type_ctor_info structure for univ
and for std_util's own type_info type.
Modify the implementations of some RTTI predicates to use the
layout and functors structures only if they are defined.
864 lines
27 KiB
Mathematica
864 lines
27 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1993-1995, 1997-2000 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU Library General
|
|
% Public License - see the file COPYING.LIB in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% File: array.m
|
|
% Main authors: fjh, bromage
|
|
% Stability: medium-low
|
|
|
|
% This module provides dynamically-sized one-dimensional arrays.
|
|
% Array indices start at zero.
|
|
|
|
% By default, the array__set and array__lookup procedures will check
|
|
% for bounds errors. But for better performance, it is possible to
|
|
% disable some of the checking by compiling with `--intermodule-optimization'
|
|
% and with the C macro symbol `ML_OMIT_ARRAY_BOUNDS_CHECKS'
|
|
% defined, e.g. by using `MCFLAGS=--intermodule-optimization' and
|
|
% `CFLAGS=-DML_OMIT_ARRAY_BOUNDS_CHECKS' in your Mmakefile,
|
|
% or by compiling with the command
|
|
% `mmc --intermodule-optimization --cflags -DML_OMIT_ARRAY_BOUNDS_CHECKS'.
|
|
%
|
|
% For maximum performance, all bounds checking can be disabled by
|
|
% recompiling this module using `CFLAGS=-DML_OMIT_ARRAY_BOUNDS_CHECKS'
|
|
% or `mmc --cflags -DML_OMIT_ARRAY_BOUNDS_CHECKS' as above. You can
|
|
% either recompile the entire library, or just copy `array.m' to your
|
|
% application's source directory and link with it directly instead of as
|
|
% part of the library.
|
|
%
|
|
|
|
% Ralph Becket <rwab1@cam.sri.com> 24/04/99
|
|
% Function forms added.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module array.
|
|
:- interface.
|
|
:- import_module list, std_util.
|
|
|
|
:- type array(T).
|
|
|
|
:- inst array(I) = bound(array(I)).
|
|
:- inst array == array(ground).
|
|
:- inst array_skel == array(free).
|
|
|
|
% 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(array(I)).
|
|
% :- inst uniq_array == uniq_array(unique).
|
|
:- inst uniq_array(I) = bound(array(I)). % XXX work-around
|
|
:- inst uniq_array == uniq_array(ground). % XXX work-around
|
|
:- inst uniq_array_skel == uniq_array(free).
|
|
|
|
:- 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(array(I)).
|
|
% :- inst mostly_uniq_array == mostly_uniq_array(mostly_unique).
|
|
:- inst mostly_uniq_array(I) = bound(array(I)). % XXX work-around
|
|
:- inst mostly_uniq_array == mostly_uniq_array(ground). % XXX work-around
|
|
:- inst mostly_uniq_array_skel == mostly_uniq_array(free).
|
|
|
|
:- mode array_mdi == mdi(mostly_uniq_array).
|
|
:- mode array_muo == out(mostly_uniq_array).
|
|
:- mode array_mui == in(mostly_uniq_array).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% array__make_empty_array(Array) creates an array of size zero
|
|
% starting at lower bound 0.
|
|
:- pred array__make_empty_array(array(T)).
|
|
:- mode array__make_empty_array(array_uo) is det.
|
|
|
|
% array__init(Size, Init, Array) creates an array
|
|
% with bounds from 0 to Size-1, with each element initialized to Init.
|
|
:- pred array__init(int, T, array(T)).
|
|
:- mode array__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 array__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.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% array__min returns the lower bound of the array.
|
|
% Note: in this implementation, the lower bound is always zero.
|
|
:- pred array__min(array(_T), int).
|
|
:- mode array__min(array_ui, out) is det.
|
|
:- mode array__min(in, out) is det.
|
|
|
|
% array__max returns the upper bound of the array.
|
|
:- pred array__max(array(_T), int).
|
|
:- mode array__max(array_ui, out) is det.
|
|
:- mode array__max(in, out) is det.
|
|
|
|
% array__size returns the length of the array,
|
|
% i.e. upper bound - lower bound + 1.
|
|
:- pred array__size(array(_T), int).
|
|
:- mode array__size(array_ui, out) is det.
|
|
:- mode array__size(in, out) is det.
|
|
|
|
% array__bounds returns the upper and lower bounds of an array.
|
|
% Note: in this implementation, the lower bound is always zero.
|
|
:- pred array__bounds(array(_T), int, int).
|
|
:- mode array__bounds(array_ui, out, out) is det.
|
|
:- mode array__bounds(in, out, out) is det.
|
|
|
|
% array__in_bounds checks whether an index is in the bounds
|
|
% of an array.
|
|
:- pred array__in_bounds(array(_T), int).
|
|
:- mode array__in_bounds(array_ui, in) is semidet.
|
|
:- mode array__in_bounds(in, in) is semidet.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% array__lookup returns the Nth element of an array.
|
|
% It is an error if the index is out of bounds.
|
|
:- pred array__lookup(array(T), int, T).
|
|
:- mode array__lookup(array_ui, in, out) is det.
|
|
:- mode array__lookup(in, in, out) is det.
|
|
|
|
% array__semidet_lookup returns the Nth element of an array.
|
|
% It fails if the index is out of bounds.
|
|
:- pred array__semidet_lookup(array(T), int, T).
|
|
:- mode array__semidet_lookup(array_ui, in, out) is semidet.
|
|
:- mode array__semidet_lookup(in, in, out) is semidet.
|
|
|
|
% array__set sets the nth element of an array, and returns the
|
|
% resulting array (good opportunity for destructive update ;-).
|
|
% It is an error if the index is out of bounds.
|
|
:- pred array__set(array(T), int, T, array(T)).
|
|
:- mode array__set(array_di, in, in, array_uo) is det.
|
|
|
|
|
|
% array__semidet_set sets the nth element of an array,
|
|
% and returns the resulting array.
|
|
% It fails if the index is out of bounds.
|
|
:- pred array__semidet_set(array(T), int, T, array(T)).
|
|
:- mode array__semidet_set(array_di, in, in, array_uo) is semidet.
|
|
|
|
% array__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 array__slow_set(array(T), int, T, array(T)).
|
|
:- mode array__slow_set(array_ui, in, in, array_uo) is det.
|
|
:- mode array__slow_set(in, in, in, array_uo) is det.
|
|
|
|
% array__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 array__semidet_slow_set(array(T), int, T, array(T)).
|
|
:- mode array__semidet_slow_set(array_ui, in, in, array_uo) is semidet.
|
|
:- mode array__semidet_slow_set(in, in, in, array_uo) is semidet.
|
|
|
|
% array__copy(Array0, Array):
|
|
% Makes a new unique copy of an array.
|
|
:- pred array__copy(array(T), array(T)).
|
|
:- mode array__copy(array_ui, array_uo) is det.
|
|
:- mode array__copy(in, array_uo) is det.
|
|
|
|
% array__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'.
|
|
:- pred array__resize(array(T), int, T, array(T)).
|
|
:- mode array__resize(array_di, in, in, array_uo) is det.
|
|
|
|
% array__shrink(Array0, Size, Array):
|
|
% The array is shrunk to make it fit the new size `Size'.
|
|
% It is an error if `Size' is larger than the size of `Array0'.
|
|
:- pred array__shrink(array(T), int, array(T)).
|
|
:- mode array__shrink(array_di, in, array_uo) is det.
|
|
|
|
|
|
% array__from_list takes a list,
|
|
% and returns an array containing those elements in
|
|
% the same order that they occured in the list.
|
|
:- pred array__from_list(list(T), array(T)).
|
|
:- mode array__from_list(in, array_uo) is det.
|
|
|
|
% array__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 array__to_list(array(T), list(T)).
|
|
:- mode array__to_list(array_ui, out) is det.
|
|
:- mode array__to_list(in, out) is det.
|
|
|
|
% array__fetch_items takes an array and a lower and upper
|
|
% index, and places those items in the array between these
|
|
% indices into a list. It is an error if either index is
|
|
% out of bounds.
|
|
:- pred array__fetch_items(array(T), int, int, list(T)).
|
|
:- mode array__fetch_items(in, in, in, out) is det.
|
|
|
|
|
|
% array__bsearch takes an array, an element to be found
|
|
% and a comparison predicate and returns the position of
|
|
% the element in the array. Assumes the array is in sorted
|
|
% order. Fails if the element is not present. If the
|
|
% element to be found appears multiple times, the index of
|
|
% the first occurrence is returned.
|
|
:- pred array__bsearch(array(T), T, pred(T, T, comparison_result),
|
|
maybe(int)).
|
|
:- mode array__bsearch(array_ui, in, pred(in, in, out) is det, out) is det.
|
|
:- mode array__bsearch(in, in, pred(in, in, out) is det, out) is det.
|
|
|
|
% array__map(Closure, OldArray, NewArray) applys `Closure' to
|
|
% each of the elements of `OldArray' to create `NewArray'.
|
|
:- pred array__map(pred(T1, T2), array(T1), array(T2)).
|
|
:- mode array__map(pred(in, out) is det, array_di, array_uo) 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.
|
|
|
|
% The following predicates have to be declared in the interface,
|
|
% otherwise dead code elimination will remove them.
|
|
% But they're an implementation detail; user code should just
|
|
% use the generic versions.
|
|
|
|
% unify/2 for arrays
|
|
|
|
:- pred array_equal(array(T), array(T)).
|
|
:- mode array_equal(in, in) is semidet.
|
|
|
|
% compare/3 for arrays
|
|
|
|
:- pred array_compare(comparison_result, array(T), array(T)).
|
|
:- mode array_compare(out, in, in) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
:- import_module int.
|
|
|
|
:- type array(T).
|
|
|
|
/****
|
|
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.
|
|
****/
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Arrays are implemented using the C interface.
|
|
|
|
% The C type which defines the representation of arrays is
|
|
% MR_ArrayType; it is defined in runtime/mercury_library_types.h.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pragma c_code("
|
|
|
|
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(array, array, 1, MR_TYPECTOR_REP_ARRAY);
|
|
|
|
Declare_entry(mercury__array__array_equal_2_0);
|
|
Declare_entry(mercury__array__array_compare_3_0);
|
|
|
|
BEGIN_MODULE(array_module_builtins)
|
|
init_entry(mercury____Unify___array__array_1_0);
|
|
init_entry(mercury____Index___array__array_1_0);
|
|
init_entry(mercury____Compare___array__array_1_0);
|
|
BEGIN_CODE
|
|
|
|
Define_entry(mercury____Unify___array__array_1_0);
|
|
/* this is implemented in Mercury, not hand-coded low-level C */
|
|
tailcall(ENTRY(mercury__array__array_equal_2_0),
|
|
ENTRY(mercury____Unify___array__array_1_0));
|
|
|
|
Define_entry(mercury____Index___array__array_1_0);
|
|
r1 = -1;
|
|
proceed();
|
|
|
|
Define_entry(mercury____Compare___array__array_1_0);
|
|
/* this is implemented in Mercury, not hand-coded low-level C */
|
|
tailcall(ENTRY(mercury__array__array_compare_3_0),
|
|
ENTRY(mercury____Compare___array__array_1_0));
|
|
|
|
END_MODULE
|
|
|
|
/* Ensure that the initialization code for the above module gets run. */
|
|
/*
|
|
INIT sys_init_array_module_builtins
|
|
*/
|
|
|
|
MR_MODULE_STATIC_OR_EXTERN ModuleFunc array_module_builtins;
|
|
|
|
void sys_init_array_module_builtins(void);
|
|
/* suppress gcc -Wmissing-decl warning */
|
|
void sys_init_array_module_builtins(void) {
|
|
array_module_builtins();
|
|
MR_INIT_TYPE_CTOR_INFO(
|
|
mercury_data_array__type_ctor_info_array_1,
|
|
array__array_1_0);
|
|
}
|
|
|
|
").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% unify/2 for arrays
|
|
|
|
array_equal(Array1, Array2) :-
|
|
array__size(Array1, Size),
|
|
array__size(Array2, Size),
|
|
array__equal_elements(0, Size, Array1, Array2).
|
|
|
|
:- pred array__equal_elements(int, int, array(T), array(T)).
|
|
:- mode array__equal_elements(in, in, in, in) is semidet.
|
|
|
|
array__equal_elements(N, Size, Array1, Array2) :-
|
|
( N = Size ->
|
|
true
|
|
;
|
|
array__lookup(Array1, N, Elem),
|
|
array__lookup(Array2, N, Elem),
|
|
N1 is N + 1,
|
|
array__equal_elements(N1, Size, Array1, Array2)
|
|
).
|
|
|
|
% compare/3 for arrays
|
|
|
|
array_compare(Result, Array1, Array2) :-
|
|
array__size(Array1, Size1),
|
|
array__size(Array2, Size2),
|
|
compare(SizeResult, Size1, Size2),
|
|
( SizeResult = (=) ->
|
|
array__compare_elements(0, Size1, Array1, Array2, Result)
|
|
;
|
|
Result = SizeResult
|
|
).
|
|
|
|
:- pred array__compare_elements(int, int, array(T), array(T),
|
|
comparison_result).
|
|
:- mode array__compare_elements(in, in, in, in, out) is det.
|
|
|
|
array__compare_elements(N, Size, Array1, Array2, Result) :-
|
|
( N = Size ->
|
|
Result = (=)
|
|
;
|
|
array__lookup(Array1, N, Elem1),
|
|
array__lookup(Array2, N, Elem2),
|
|
compare(ElemResult, Elem1, Elem2),
|
|
( ElemResult = (=) ->
|
|
N1 is N + 1,
|
|
array__compare_elements(N1, Size, Array1, Array2,
|
|
Result)
|
|
;
|
|
Result = ElemResult
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pragma c_header_code("
|
|
MR_ArrayType *ML_make_array(Integer size, Word item);
|
|
").
|
|
|
|
:- pragma c_code("
|
|
MR_ArrayType *
|
|
ML_make_array(Integer size, Word item)
|
|
{
|
|
Integer i;
|
|
MR_ArrayType *array;
|
|
|
|
array = MR_make_array(size);
|
|
array->size = size;
|
|
for (i = 0; i < size; i++) {
|
|
array->elements[i] = item;
|
|
}
|
|
return array;
|
|
}
|
|
").
|
|
|
|
:- pragma c_code(array__init(Size::in, Item::in, Array::array_uo),
|
|
[will_not_call_mercury, thread_safe], "
|
|
Array = (Word) ML_make_array(Size, Item);
|
|
").
|
|
|
|
:- pragma c_code(array__make_empty_array(Array::array_uo),
|
|
[will_not_call_mercury, thread_safe], "
|
|
Array = (Word) ML_make_array(0, 0);
|
|
").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pragma c_code(array__min(Array::array_ui, Min::out),
|
|
[will_not_call_mercury, thread_safe], "
|
|
/* Array not used */
|
|
Min = 0;
|
|
").
|
|
:- pragma c_code(array__min(Array::in, Min::out),
|
|
[will_not_call_mercury, thread_safe], "
|
|
/* Array not used */
|
|
Min = 0;
|
|
").
|
|
|
|
:- pragma c_code(array__max(Array::array_ui, Max::out),
|
|
[will_not_call_mercury, thread_safe], "
|
|
Max = ((MR_ArrayType *)Array)->size - 1;
|
|
").
|
|
:- pragma c_code(array__max(Array::in, Max::out),
|
|
[will_not_call_mercury, thread_safe], "
|
|
Max = ((MR_ArrayType *)Array)->size - 1;
|
|
").
|
|
|
|
array__bounds(Array, Min, Max) :-
|
|
array__min(Array, Min),
|
|
array__max(Array, Max).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pragma c_code(array__size(Array::array_ui, Max::out),
|
|
[will_not_call_mercury, thread_safe], "
|
|
Max = ((MR_ArrayType *)Array)->size;
|
|
").
|
|
:- pragma c_code(array__size(Array::in, Max::out),
|
|
[will_not_call_mercury, thread_safe], "
|
|
Max = ((MR_ArrayType *)Array)->size;
|
|
").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
array__in_bounds(Array, Index) :-
|
|
array__bounds(Array, Min, Max),
|
|
Min =< Index, Index =< Max.
|
|
|
|
array__semidet_lookup(Array, Index, Item) :-
|
|
array__in_bounds(Array, Index),
|
|
array__lookup(Array, Index, Item).
|
|
|
|
array__semidet_set(Array0, Index, Item, Array) :-
|
|
array__in_bounds(Array0, Index),
|
|
array__set(Array0, Index, Item, Array).
|
|
|
|
array__semidet_slow_set(Array0, Index, Item, Array) :-
|
|
array__in_bounds(Array0, Index),
|
|
array__slow_set(Array0, Index, Item, Array).
|
|
|
|
array__slow_set(Array0, Index, Item, Array) :-
|
|
array__copy(Array0, Array1),
|
|
array__set(Array1, Index, Item, Array).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pragma c_code(array__lookup(Array::array_ui, Index::in, Item::out),
|
|
[will_not_call_mercury, thread_safe], "{
|
|
MR_ArrayType *array = (MR_ArrayType *)Array;
|
|
#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
|
|
if ((Unsigned) Index >= (Unsigned) array->size) {
|
|
fatal_error(""array__lookup: array index out of bounds"");
|
|
}
|
|
#endif
|
|
Item = array->elements[Index];
|
|
}").
|
|
:- pragma c_code(array__lookup(Array::in, Index::in, Item::out),
|
|
[will_not_call_mercury, thread_safe], "{
|
|
MR_ArrayType *array = (MR_ArrayType *)Array;
|
|
#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
|
|
if ((Unsigned) Index >= (Unsigned) array->size) {
|
|
fatal_error(""array__lookup: array index out of bounds"");
|
|
}
|
|
#endif
|
|
Item = array->elements[Index];
|
|
}").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pragma c_code(array__set(Array0::array_di, Index::in,
|
|
Item::in, Array::array_uo),
|
|
[will_not_call_mercury, thread_safe], "{
|
|
MR_ArrayType *array = (MR_ArrayType *)Array0;
|
|
#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
|
|
if ((Unsigned) Index >= (Unsigned) array->size) {
|
|
fatal_error(""array__set: array index out of bounds"");
|
|
}
|
|
#endif
|
|
array->elements[Index] = Item; /* destructive update! */
|
|
Array = Array0;
|
|
}").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pragma c_header_code("
|
|
MR_ArrayType * ML_resize_array(MR_ArrayType *old_array,
|
|
Integer array_size, Word item);
|
|
").
|
|
|
|
:- pragma c_code("
|
|
MR_ArrayType *
|
|
ML_resize_array(MR_ArrayType *old_array, Integer array_size,
|
|
Word item)
|
|
{
|
|
Integer i;
|
|
MR_ArrayType* array;
|
|
Integer elements_to_copy;
|
|
|
|
elements_to_copy = old_array->size;
|
|
if (elements_to_copy == array_size) return old_array;
|
|
if (elements_to_copy > array_size) {
|
|
elements_to_copy = array_size;
|
|
}
|
|
|
|
array = (MR_ArrayType *) MR_GC_NEW_ARRAY(Word, array_size + 1);
|
|
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
|
|
*/
|
|
MR_GC_free(old_array);
|
|
|
|
return array;
|
|
}
|
|
").
|
|
|
|
:- pragma c_code(array__resize(Array0::array_di, Size::in, Item::in,
|
|
Array::array_uo), [will_not_call_mercury, thread_safe], "
|
|
Array = (Word) ML_resize_array(
|
|
(MR_ArrayType *) Array0, Size, Item);
|
|
").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pragma c_header_code("
|
|
MR_ArrayType * ML_shrink_array(MR_ArrayType *old_array,
|
|
Integer array_size);
|
|
").
|
|
|
|
:- pragma c_code("
|
|
MR_ArrayType *
|
|
ML_shrink_array(MR_ArrayType *old_array, Integer array_size)
|
|
{
|
|
Integer i;
|
|
MR_ArrayType* array;
|
|
Integer old_array_size;
|
|
|
|
old_array_size = old_array->size;
|
|
if (old_array_size == array_size) return old_array;
|
|
if (old_array_size < array_size) {
|
|
fatal_error(""array__shrink: can't shrink to a larger size"");
|
|
}
|
|
|
|
array = (MR_ArrayType *) MR_GC_NEW_ARRAY(Word, array_size + 1);
|
|
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
|
|
*/
|
|
MR_GC_free(old_array);
|
|
|
|
return array;
|
|
}
|
|
").
|
|
|
|
:- pragma c_code(array__shrink(Array0::array_di, Size::in, Array::array_uo),
|
|
[will_not_call_mercury, thread_safe], "
|
|
Array = (Word) ML_shrink_array(
|
|
(MR_ArrayType *) Array0, Size);
|
|
").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pragma c_header_code("
|
|
MR_ArrayType *ML_copy_array(MR_ArrayType *old_array);
|
|
").
|
|
|
|
:- pragma c_code("
|
|
MR_ArrayType *
|
|
ML_copy_array(MR_ArrayType *old_array)
|
|
{
|
|
/*
|
|
** Any changes to this function will probably also require
|
|
** changes to deepcopy() in runtime/deep_copy.c.
|
|
*/
|
|
|
|
Integer i;
|
|
MR_ArrayType* array;
|
|
Integer array_size;
|
|
|
|
array_size = old_array->size;
|
|
array = MR_make_array(array_size);
|
|
array->size = array_size;
|
|
for (i = 0; i < array_size; i++) {
|
|
array->elements[i] = old_array->elements[i];
|
|
}
|
|
return array;
|
|
}
|
|
").
|
|
|
|
:- pragma c_code(array__copy(Array0::array_ui, Array::array_uo),
|
|
[will_not_call_mercury, thread_safe], "
|
|
Array = (Word) ML_copy_array((MR_ArrayType *) Array0);
|
|
").
|
|
|
|
:- pragma c_code(array__copy(Array0::in, Array::array_uo),
|
|
[will_not_call_mercury, thread_safe], "
|
|
Array = (Word) ML_copy_array((MR_ArrayType *) Array0);
|
|
").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
array(List) = Array :-
|
|
array__from_list(List, Array).
|
|
|
|
array__from_list([], Array) :-
|
|
array__make_empty_array(Array).
|
|
array__from_list(List, Array) :-
|
|
List = [ Head | Tail ],
|
|
list__length(List, Len),
|
|
array__init(Len, Head, Array0),
|
|
array__insert_items(Tail, 1, Array0, Array).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred array__insert_items(list(T), int, array(T), array(T)).
|
|
:- mode array__insert_items(in, in, array_di, array_uo) is det.
|
|
|
|
array__insert_items([], _N, Array, Array).
|
|
array__insert_items([Head|Tail], N, Array0, Array) :-
|
|
array__set(Array0, N, Head, Array1),
|
|
N1 is N + 1,
|
|
array__insert_items(Tail, N1, Array1, Array).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
array__to_list(Array, List) :-
|
|
array__bounds(Array, Low, High),
|
|
array__fetch_items(Array, Low, High, List).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
array__fetch_items(Array, Low, High, List) :-
|
|
(
|
|
Low > High
|
|
->
|
|
List = []
|
|
;
|
|
Low1 is Low + 1,
|
|
array__fetch_items(Array, Low1, High, List0),
|
|
array__lookup(Array, Low, Item),
|
|
List = [Item|List0]
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
array__bsearch(A, El, Compare, Result) :-
|
|
array__bounds(A, Lo, Hi),
|
|
array__bsearch_2(A, Lo, Hi, El, Compare, Result).
|
|
|
|
:- pred array__bsearch_2(array(T), int, int, T,
|
|
pred(T, T, comparison_result), maybe(int)).
|
|
:- mode array__bsearch_2(in, in, in, in, pred(in, in, out) is det,
|
|
out) is det.
|
|
array__bsearch_2(Array, Lo, Hi, El, Compare, Result) :-
|
|
Width is Hi - Lo,
|
|
|
|
% If Width < 0, there is no range left.
|
|
( Width < 0 ->
|
|
Result = no
|
|
;
|
|
% If Width == 0, we may just have found our element.
|
|
% Do a Compare to check.
|
|
( Width = 0 ->
|
|
array__lookup(Array, Lo, X),
|
|
( call(Compare, El, X, (=)) ->
|
|
Result = yes(Lo)
|
|
;
|
|
Result = no
|
|
)
|
|
;
|
|
% Otherwise find the middle element of the range
|
|
% and check against that.
|
|
Mid is (Lo + Hi) >> 1, % `>> 1' is hand-optimized `div 2'.
|
|
array__lookup(Array, Mid, XMid),
|
|
call(Compare, XMid, El, Comp),
|
|
( Comp = (<),
|
|
Mid1 is Mid + 1,
|
|
array__bsearch_2(Array, Mid1, Hi, El, Compare, Result)
|
|
; Comp = (=),
|
|
array__bsearch_2(Array, Lo, Mid, El, Compare, Result)
|
|
; Comp = (>),
|
|
Mid1 is Mid - 1,
|
|
array__bsearch_2(Array, Lo, Mid1, El, Compare, Result)
|
|
)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
array__map(Closure, OldArray, NewArray) :-
|
|
( array__semidet_lookup(OldArray, 0, Elem0) ->
|
|
array__size(OldArray, Size),
|
|
call(Closure, Elem0, Elem),
|
|
array__init(Size, Elem, NewArray0),
|
|
array__map_2(1, Size, Closure, OldArray,
|
|
NewArray0, NewArray)
|
|
;
|
|
array__make_empty_array(NewArray)
|
|
).
|
|
|
|
:- pred array__map_2(int, int, pred(T1, T2), array(T1), array(T2), array(T2)).
|
|
:- mode array__map_2(in, in, pred(in, out) is det, in, array_di, array_uo)
|
|
is det.
|
|
|
|
array__map_2(N, Size, Closure, OldArray, NewArray0, NewArray) :-
|
|
( N >= Size ->
|
|
NewArray = NewArray0
|
|
;
|
|
array__lookup(OldArray, N, OldElem),
|
|
Closure(OldElem, NewElem),
|
|
array__set(NewArray0, N, NewElem, NewArray1),
|
|
array__map_2(N + 1, Size, Closure, OldArray,
|
|
NewArray1, NewArray)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
% Ralph Becket <rwab1@cam.sri.com> 24/04/99
|
|
% Function forms added.
|
|
|
|
:- interface.
|
|
|
|
:- func array__make_empty_array = array(T).
|
|
:- mode array__make_empty_array = array_uo is det.
|
|
|
|
:- func array__init(int, T) = array(T).
|
|
:- mode array__init(in, in) = array_uo is det.
|
|
|
|
:- func array__min(array(_T)) = int.
|
|
:- mode array__min(array_ui) = out is det.
|
|
|
|
:- func array__max(array(_T)) = int.
|
|
:- mode array__max(array_ui) = out is det.
|
|
|
|
:- func array__size(array(_T)) = int.
|
|
:- mode array__size(array_ui) = out is det.
|
|
|
|
:- func array__lookup(array(T), int) = T.
|
|
:- mode array__lookup(array_ui, in) = out is det.
|
|
|
|
:- func array__set(array(T), int, T) = array(T).
|
|
:- mode array__set(array_di, in, in) = array_uo is det.
|
|
|
|
:- func array__slow_set(array(T), int, T) = array(T).
|
|
:- mode array__slow_set(array_ui, in, in) = array_uo is det.
|
|
:- mode array__slow_set(in, in, in) = array_uo is det.
|
|
|
|
:- func array__copy(array(T)) = array(T).
|
|
:- mode array__copy(array_ui) = array_uo is det.
|
|
|
|
:- func array__resize(array(T), int, T) = array(T).
|
|
:- mode array__resize(array_di, in, in) = array_uo is det.
|
|
|
|
:- func array__shrink(array(T), int) = array(T).
|
|
:- mode array__shrink(array_di, in) = array_uo is det.
|
|
|
|
:- func array__from_list(list(T)) = array(T).
|
|
:- mode array__from_list(in) = array_uo is det.
|
|
|
|
:- func array__to_list(array(T)) = list(T).
|
|
:- mode array__to_list(array_ui) = out is det.
|
|
|
|
:- func array__fetch_items(array(T), int, int) = list(T).
|
|
:- mode array__fetch_items(array_ui, in, in) = out is det.
|
|
|
|
:- func array__bsearch(array(T), T, func(T,T) = comparison_result) = maybe(int).
|
|
:- mode array__bsearch(array_ui, in, func(in,in) = out is det) = out is det.
|
|
|
|
:- func array__map(func(T1) = T2, array(T1)) = array(T2).
|
|
:- mode array__map(func(in) = out is det, array_di) = array_uo is det.
|
|
|
|
:- func array_compare(array(T), array(T)) = comparison_result.
|
|
:- mode array_compare(in, in) = out is det.
|
|
|
|
% ---------------------------------------------------------------------------- %
|
|
% ---------------------------------------------------------------------------- %
|
|
|
|
:- implementation.
|
|
|
|
array__make_empty_array = A :-
|
|
array__make_empty_array(A).
|
|
|
|
array__init(N, X) = A :-
|
|
array__init(N, X, A).
|
|
|
|
array__min(A) = N :-
|
|
array__min(A, N).
|
|
|
|
array__max(A) = N :-
|
|
array__max(A, N).
|
|
|
|
array__size(A) = N :-
|
|
array__size(A, N).
|
|
|
|
array__lookup(A, N) = X :-
|
|
array__lookup(A, N, X).
|
|
|
|
array__set(A1, N, X) = A2 :-
|
|
array__set(A1, N, X, A2).
|
|
|
|
array__slow_set(A1, N, X) = A2 :-
|
|
array__slow_set(A1, N, X, A2).
|
|
|
|
array__copy(A1) = A2 :-
|
|
array__copy(A1, A2).
|
|
|
|
array__resize(A1, N, X) = A2 :-
|
|
array__resize(A1, N, X, A2).
|
|
|
|
array__shrink(A1, N) = A2 :-
|
|
array__shrink(A1, N, A2).
|
|
|
|
array__from_list(Xs) = A :-
|
|
array__from_list(Xs, A).
|
|
|
|
array__to_list(A) = Xs :-
|
|
array__to_list(A, Xs).
|
|
|
|
array__fetch_items(A, N1, N2) = Xs :-
|
|
array__fetch_items(A, N1, N2, Xs).
|
|
|
|
array__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).
|
|
|
|
array__map(F, A1) = A2 :-
|
|
P = ( pred(X::in, Y::out) is det :- Y = F(X) ),
|
|
array__map(P, A1, A2).
|
|
|
|
array_compare(A1, A2) = C :-
|
|
array_compare(C, A1, A2).
|
|
|