diff: Array reorganisation
Andrew Bromage
bromage at cs.mu.oz.au
Thu Jul 24 14:46:47 AEST 1997
G'day.
Everyone who has an interest, speak up.
samples/diff/*.m (which heavily relies on arrays) will be fixed up as
soon as this passes review.
Cheers,
Andrew Bromage
Estimated hours taken: 6
The main purpose of this change is to rename array.m as bt_array.m, and
uniq_array.m as array.m. The interfaces of those two modules have grown
slightly so that they match a little more closely. Details are in the
file NEWS.
The implementation of bt_array (formerly array) has been changed to use
a slightly more efficient implementation.
NEWS:
Interface changes documented.
library/array.m:
library/bt_array.m:
Changes mentioned above and detailed in the NEWS file.
library/uniq_array.m:
Bereft of life and resting in peace.
library/io.m:
library/library.m:
library/std_util.m:
library/term.m:
compiler/base_type_layout.m:
runtime/deep_copy.c:
runtime/type_info.h:
Minor changes to fix the special case of base_type_layout
operations for arrays rather than uniq_arrays.
tests/hard_coded/write.exp:
tests/hard_coded/write.m:
Test writing of arrays.
Index: NEWS
===================================================================
RCS file: /home/staff/zs/imp/mercury/NEWS,v
retrieving revision 1.61
diff -u -r1.61 NEWS
--- NEWS 1997/07/16 17:23:34 1.61
+++ NEWS 1997/07/24 03:10:28
@@ -213,8 +213,48 @@
- XXX cleanup of integer division, mod & rem
- - uniq_array__shrink/3 has been added to the library. This is similar
- to uniq_array__resize/4 except that it's designed for cases when you
- only want to make an array smaller, so you don't have to supply a
- filler element.
+ - The interface to arrays has changed significantly. array.m has been
+ renamed bt_array.m (short for `backtrackable array') and uniq_array.m
+ has been renamed array.m.
+
+ The interfaces of both modules have been extended to make them closer
+ to each other.
+
+ The following predicates have been added to array.m (formerly
+ uniq_array.m):
+
+ + array__shrink/3 This is similar to array__resize/4 except
+ that it's designed for cases when you only want to make an
+ array smaller, so you don't have to supply a filler element.
+
+ + array__min/2, array__max/2, array__bounds/3 Finds the lower
+ (in this implementation, always 0), upper and both bounds of
+ a array respectively.
+
+ The following predicated have been added to bt_array.m (formerly
+ array.m):
+
+ + bt_array__min/2, bt_array__max/2, bt_array__size/2 Finds
+ the lower bound, upper bound and size of a bt_array
+ respectively.
+
+ + bt_array__in_bounds/2 Checks if an index is within the
+ bounds of a bt_array.
+
+ + bt_array__semidet_set/4 The semidet version of bt_array__set/4.
+
+ + bt_array__from_list/3 A replacement for bt_array__from_list/2,
+ which has been removed. The extra argument is the lower bound
+ for the new bt_array.
+
+ + bt_array__shrink/4 Analogous to array__shrink/3.
+
+ + bt_array__resize/5 A replacement for bt_array__resize/4. There
+ was a design flaw in the previous interface, in that if the
+ array increased in bounds, the extra slots were filled with one
+ particular element from the old bt_array. The extra argument is
+ the element to use to fill these slots instead.
+
+ See the modules array.m and bt_array.m or consult the library
+ reference for further details.
Index: compiler/base_type_layout.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/base_type_layout.m,v
retrieving revision 1.19
diff -u -r1.19 base_type_layout.m
--- base_type_layout.m 1997/05/23 06:16:15 1.19
+++ base_type_layout.m 1997/07/24 01:42:05
@@ -30,7 +30,7 @@
%
% library: std_util.m - functor, arg, expand,
% solutions
-% uniq_array.m - uniq_array type
+% array.m - array type
% io.m - io__stream type
% mercury_builtin.m - builtin types
%
@@ -62,7 +62,7 @@
% Tag 0 - CONST Word = 6 - univ
% Tag 0 - CONST Word = 7 - pred
% Tag 0 - CONST Word = 8 - void
-% Tag 0 - CONST Word = 9 - uniq_array
+% Tag 0 - CONST Word = 9 - array
% Tag 0 - CONST Word = 10 - type_info
% Tag 0 - CONST Word = 11 - c_pointer
% Words 12 - 1024 reserved for future use
Index: library/io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/io.m,v
retrieving revision 1.129
diff -u -r1.129 io.m
--- io.m 1997/07/23 07:34:16 1.129
+++ io.m 1997/07/24 01:38:46
@@ -928,7 +928,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module map, dir, term, term_io, varset, require, time, uniq_array.
+:- import_module map, dir, term, term_io, varset, require, time, array.
:- import_module int, std_util.
:- type io__state
@@ -1349,7 +1349,7 @@
%
% we need to special-case the builtin types:
% int, char, float, string
- % type_info, univ, c_pointer, uniq_array
+ % type_info, univ, c_pointer, array
%
( { univ_to_type(Univ, String) } ->
term_io__quote_string(String)
@@ -1365,17 +1365,17 @@
io__write_univ_as_univ(OrigUniv)
; { univ_to_type(Univ, C_Pointer) } ->
io__write_c_pointer(C_Pointer)
- ; { type_ctor_name(type_ctor(univ_type(Univ))) = "uniq_array" } ->
+ ; { type_ctor_name(type_ctor(univ_type(Univ))) = "array" } ->
%
% XXX shouldn't type names be module-qualified?
- % shouldn't that be "uniq_array:uniq_array"?
+ % shouldn't that be "array:array"?
%
% Note that we can't use univ_to_type above, because we
- % want to match on a non-ground type `uniq_array(T)'
- % (matching against `uniq_array(void)' isn't much use).
+ % want to match on a non-ground type `array(T)'
+ % (matching against `array(void)' isn't much use).
% Instead, we explicitly check the type name.
% That makes it tricky to get the value, so
- % we can't use io__write_uniq_array below... instead we
+ % we can't use io__write_array below... instead we
% use the following, which is a bit of a hack.
%
{ term__univ_to_term(Univ, Term) },
@@ -1547,12 +1547,12 @@
io__write_univ(X),
io__write_term_args(Xs).
-:- pred io__write_uniq_array(uniq_array(T), io__state, io__state).
-:- mode io__write_uniq_array(in, di, uo) is det.
+:- pred io__write_array(array(T), io__state, io__state).
+:- mode io__write_array(in, di, uo) is det.
-io__write_uniq_array(UniqArray) -->
- io__write_string("uniq_array("),
- { uniq_array__to_list(UniqArray, List) },
+io__write_array(Array) -->
+ io__write_string("array("),
+ { array__to_list(Array, List) },
io__write(List),
io__write_string(")").
Index: library/library.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/library.m,v
retrieving revision 1.33
diff -u -r1.33 library.m
--- library.m 1997/06/13 08:45:52 1.33
+++ library.m 1997/07/15 06:23:55
@@ -24,10 +24,11 @@
:- implementation.
:- import_module array, assoc_list, bag, bimap, bintree, bintree_set, bool.
-:- import_module char, dir, eqvclass, float, math, getopt, graph, group, int.
+:- import_module bt_array, char, dir, eqvclass, float.
+:- import_module math, getopt, graph, group, int.
:- import_module io, list, map, multi_map, pqueue, queue, random, relation.
:- import_module require, set, set_bbbtree, set_ordlist, set_unordlist, stack.
-:- import_module std_util, string, term, term_io, tree234, uniq_array, varset.
+:- import_module std_util, string, term, term_io, tree234, varset.
:- import_module store, rbtree, parser, lexer, ops, time.
:- import_module prolog.
Index: library/std_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/std_util.m,v
retrieving revision 1.95
diff -u -r1.95 std_util.m
--- std_util.m 1997/07/18 04:42:00 1.95
+++ std_util.m 1997/07/23 05:25:24
@@ -2349,8 +2349,8 @@
fatal_error(""ML_expand: found void"");
break;
- case TYPELAYOUT_UNIQ_ARRAY_VALUE:
- fatal_error(""ML_expand: found uniq_array"");
+ case TYPELAYOUT_ARRAY_VALUE:
+ fatal_error(""ML_expand: found array"");
break;
case TYPELAYOUT_TYPEINFO_VALUE:
Index: library/term.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/term.m,v
retrieving revision 1.73
diff -u -r1.73 term.m
--- term.m 1997/06/30 06:35:40 1.73
+++ term.m 1997/07/15 06:26:31
@@ -290,7 +290,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module std_util, require, uniq_array, int, string.
+:- import_module std_util, require, array, int, string.
%-----------------------------------------------------------------------------%
@@ -377,21 +377,21 @@
term__term_to_univ_special_case("float", [], Term, _, _, ok(Univ)) :-
Term = term__functor(term__float(Float), [], _),
type_to_univ(Float, Univ).
-term__term_to_univ_special_case("uniq_array", [ElemType], Term, _Type,
+term__term_to_univ_special_case("array", [ElemType], Term, _Type,
PrevContext, Result) :-
%
- % uniq_arrays are represented as terms of the form
- % uniq_array([elem1, elem2, ...])
+ % arrays are represented as terms of the form
+ % array([elem1, elem2, ...])
%
- Term = term__functor(term__atom("uniq_array"), [ArgList], TermContext),
+ Term = term__functor(term__atom("array"), [ArgList], TermContext),
- % To convert such terms back to uniq_arrays, we first
+ % To convert such terms back to arrays, we first
% convert the term representing the list of elements back to a list,
- % and then (if successful) we just call the uniq_array/1 function.
+ % and then (if successful) we just call the array/1 function.
%
ListTypeCtor = type_ctor(type_of([0])),
ListType = det_make_type(ListTypeCtor, [ElemType]),
- ArgContext = arg_context(term__atom("uniq_array"), 1, TermContext),
+ ArgContext = arg_context(term__atom("array"), 1, TermContext),
NewContext = [ArgContext | PrevContext],
term__try_term_to_univ_2(ArgList, ListType, NewContext, ArgResult),
(
@@ -401,7 +401,7 @@
% :- some [T] pred has_type(T::unused, type_info::in) is det.
has_type(List, ListType),
det_univ_to_type(ListUniv, List),
- Array = uniq_array(List),
+ Array = array(List),
Result = ok(univ(Array))
****************/
% since we don't have existential types, we have to use
@@ -410,7 +410,7 @@
list_of_any(List), % explicit type qualification
% to avoid unbound type variables
List = unsafe_cast(univ_value_as_type_any(ListUniv)),
- Array = uniq_array(List),
+ Array = array(List),
ArrayTypeCtor = type_ctor(type_of(Array)),
ArrayType = det_make_type(ArrayTypeCtor, [ElemType]),
Result = ok(unsafe_any_to_univ(ArrayType, unsafe_cast(Array)))
@@ -520,7 +520,7 @@
:- type any == c_pointer.
-:- pred array_of_any(uniq_array(any)::unused) is det.
+:- pred array_of_any(array(any)::unused) is det.
array_of_any(_).
:- pred list_of_any(list(any)::unused) is det.
@@ -617,23 +617,22 @@
type_info_to_term(Context, univ_type(UnivValue), TypeTerm),
term__univ_to_term(UnivValue, ValueTerm).
-term__univ_to_term_special_case("uniq_array", [ElemType], Univ, Context,
- Term) :-
- Term = term__functor(term__atom("uniq_array"), [ArgsTerm], Context),
+term__univ_to_term_special_case("array", [ElemType], Univ, Context, Term) :-
+ Term = term__functor(term__atom("array"), [ArgsTerm], Context),
ListTypeCtor = type_ctor(type_of([0])),
ListType = det_make_type(ListTypeCtor, [ElemType]),
/***
XXX existential types not yet implemented
has_type(List, ListType),
det__univ_to_type(Univ, Array),
- uniq_array__to_list(Array, List),
+ array__to_list(Array, List),
term__type_to_term(List, ArgsTerm).
***/
% instead, we need to use some unsafe casts...
array_of_any(Array), % explicit type qualification
% to avoid unbound type variables
Array = unsafe_cast(univ_value_as_type_any(Univ)),
- uniq_array__to_list(Array, List),
+ array__to_list(Array, List),
ListUniv = unsafe_any_to_univ(ListType, unsafe_cast(List)),
term__univ_to_term(ListUniv, ArgsTerm).
Index: runtime/deep_copy.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/deep_copy.c,v
retrieving revision 1.12
diff -u -r1.12 deep_copy.c
--- deep_copy.c 1997/07/16 15:56:46 1.12
+++ deep_copy.c 1997/07/23 05:25:37
@@ -173,15 +173,15 @@
fatal_error("Attempt to use a VOID tag in deep_copy");
break;
- case TYPELAYOUT_UNIQ_ARRAY_VALUE:
+ case TYPELAYOUT_ARRAY_VALUE:
if (in_range(data_value)) {
- MR_UniqArrayType *new_array;
- MR_UniqArrayType *old_array;
+ MR_ArrayType *new_array;
+ MR_ArrayType *old_array;
Integer array_size;
- old_array = (MR_UniqArrayType *) data_value;
+ old_array = (MR_ArrayType *) data_value;
array_size = old_array->size;
- new_array = MR_make_uniq_array(array_size);
+ new_array = MR_make_array(array_size);
new_array->size = array_size;
for (i = 0; i < array_size; i++) {
new_array->elements[i] = old_array->elements[i];
Index: runtime/type_info.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/type_info.h,v
retrieving revision 1.27
diff -u -r1.27 type_info.h
--- type_info.h 1997/07/16 15:56:51 1.27
+++ type_info.h 1997/07/23 05:25:41
@@ -9,7 +9,7 @@
** Definitions for accessing the type_infos, type_layouts, and
** type_functors tables generated by the Mercury compiler.
** Also contains definitions for accessing the Mercury `univ' type
-** and the Mercury `uniq_array' type.
+** and the Mercury `array' type.
*/
#ifndef TYPE_INFO_H
@@ -254,7 +254,7 @@
#define TYPELAYOUT_UNIV_VALUE ((Integer) 6)
#define TYPELAYOUT_PREDICATE_VALUE ((Integer) 7)
#define TYPELAYOUT_VOID_VALUE ((Integer) 8)
-#define TYPELAYOUT_UNIQ_ARRAY_VALUE ((Integer) 9)
+#define TYPELAYOUT_ARRAY_VALUE ((Integer) 9)
#define TYPELAYOUT_TYPEINFO_VALUE ((Integer) 10)
#define TYPELAYOUT_C_POINTER_VALUE ((Integer) 11)
@@ -373,7 +373,7 @@
/*
** Macros are provided here to initialize base_type_infos, both for
** builtin types (such as in library/mercury_builtin.m) and user
-** defined C types (like library/uniq_array.m). Also, the automatically
+** defined C types (like library/array.m). Also, the automatically
** generated code uses these initializers.
**
** Examples of use:
@@ -768,15 +768,15 @@
/*
** definitions for accessing the representation of the
-** Mercury `uniq_array' type
+** Mercury `array' type
*/
typedef struct {
Integer size;
Word elements[1]; /* really this is variable-length */
-} MR_UniqArrayType;
+} MR_ArrayType;
-#define MR_make_uniq_array(sz) ((MR_UniqArrayType *) make_many(Word, (sz) + 1))
+#define MR_make_array(sz) ((MR_ArrayType *) make_many(Word, (sz) + 1))
/*---------------------------------------------------------------------------*/
#endif /* not TYPEINFO_H */
Index: tests/hard_coded/write.exp
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/write.exp,v
retrieving revision 1.5
diff -u -r1.5 write.exp
--- write.exp 1997/07/18 06:05:48 1.5
+++ write.exp 1997/07/24 01:49:00
@@ -43,5 +43,5 @@
1
empty
qwerty(4)
-uniq_array([1, 2, 3, 4])
+array([1, 2, 3, 4])
Index: tests/hard_coded/write.m
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/write.m,v
retrieving revision 1.3
diff -u -r1.3 write.m
--- write.m 1997/07/18 06:05:43 1.3
+++ write.m 1997/07/24 01:48:44
@@ -10,7 +10,7 @@
:- implementation.
-:- import_module list, int, std_util, term, map, uniq_array.
+:- import_module list, int, std_util, term, map, array.
:- pred test_ops(io__state::di, io__state::uo) is det.
:- pred test_builtins(io__state::di, io__state::uo) is det.
@@ -150,8 +150,8 @@
% a no tag type
io__write(qwerty(4)), newline,
- { uniq_array__from_list([1,2,3,4], UniqArray) },
- io__write(UniqArray), newline,
+ { array__from_list([1,2,3,4], Array) },
+ io__write(Array), newline,
newline.
Replaced file: library/array.m
===================================================================
%-----------------------------------------------------------------------------%
% Copyright (C) 1997 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.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- module array.
:- interface.
:- import_module list, term.
:- type array(T).
% 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 array(I) = unique(array(I)).
:- inst array(I) = bound(array(I)).
:- inst array == array(ground).
:- inst array_skel == array(free).
:- mode array_di == di(array).
:- mode array_uo == out(array).
:- mode array_ui == in(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.
%-----------------------------------------------------------------------------%
:- 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.
% type_to_term/2 for arrays
:- pred array_to_term(array(T), term).
:- mode array_to_term(in, out) is det.
% term_to_type/2 for arrays
:- pred array_from_term(term, array(T)).
:- mode array_from_term(in, out) is semidet.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module std_util, 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/type_info.h.
%-----------------------------------------------------------------------------%
:- pragma(c_code, "
Define_extern_entry(mercury____Unify___array__array_1_0);
Define_extern_entry(mercury____Index___array__array_1_0);
Define_extern_entry(mercury____Compare___array__array_1_0);
Define_extern_entry(mercury____TermToType___array__array_1_0);
Define_extern_entry(mercury____TypeToTerm___array__array_1_0);
#ifdef USE_TYPE_LAYOUT
const struct mercury_data_array__base_type_layout_array_1_struct {
TYPE_LAYOUT_FIELDS
} mercury_data_array__base_type_layout_array_1 = {
make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG,
mkbody(TYPELAYOUT_ARRAY_VALUE))
};
const struct mercury_data_array__base_type_functors_array_1_struct {
Integer f1;
} mercury_data_array__base_type_functors_array_1 = {
MR_TYPEFUNCTORS_SPECIAL
};
#endif
Declare_entry(mercury__array__array_equal_2_0);
Declare_entry(mercury__array__array_compare_3_0);
Declare_entry(mercury__array__array_to_term_2_0);
Declare_entry(mercury__array__array_from_term_2_0);
BEGIN_MODULE(array_module)
init_entry(mercury____Unify___array__array_1_0);
init_entry(mercury____Index___array__array_1_0);
init_entry(mercury____Compare___array__array_1_0);
init_entry(mercury____TermToType___array__array_1_0);
init_entry(mercury____TypeToTerm___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);
index_output = -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));
Define_entry(mercury____TermToType___array__array_1_0);
/* this is implemented in Mercury, not hand-coded low-level C */
tailcall(ENTRY(mercury__array__array_from_term_2_0),
ENTRY(mercury____TermToType___array__array_1_0));
Define_entry(mercury____TypeToTerm___array__array_1_0);
/* this is implemented in Mercury, not hand-coded low-level C */
tailcall(ENTRY(mercury__array__array_to_term_2_0),
ENTRY(mercury____TypeToTerm___array__array_1_0));
END_MODULE
/* Ensure that the initialization code for the above module gets run. */
/*
INIT sys_init_array_module
*/
void sys_init_array_module(void); /* suppress gcc -Wmissing-decl warning */
void sys_init_array_module(void) {
extern ModuleFunc array_module;
array_module();
}
").
%-----------------------------------------------------------------------------%
% 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
)
).
% type_to_term for arrays
array_to_term(Array, Term) :-
array__to_list(Array, List),
type_to_term(List, ListTerm),
term__context_init(Context),
Term = term__functor(term__atom("array"), [ListTerm], Context).
% term_to_type for arrays
array_from_term(Term, Array) :-
Term = term__functor(term__atom("array"), [ListTerm], _),
term_to_type(ListTerm, List),
array__from_list(List, Array).
%-----------------------------------------------------------------------------%
:- 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),
"
Array = (Word) ML_make_array(Size, Item);
").
:- pragma(c_code,
array__make_empty_array(Array::array_uo),
"
Array = (Word) ML_make_array(0, 0);
").
%-----------------------------------------------------------------------------%
:- pragma(c_code, array__min(Array::array_ui, Min::out), "
/* Array not used */
Min = 0;
").
:- pragma(c_code, array__min(Array::in, Min::out), "
/* Array not used */
Min = 0;
").
:- pragma(c_code, array__max(Array::array_ui, Max::out), "
Max = ((MR_ArrayType *)Array)->size - 1;
").
:- pragma(c_code, array__max(Array::in, Max::out), "
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), "
Max = ((MR_ArrayType *)Array)->size;
").
:- pragma(c_code, array__size(Array::in, Max::out), "
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), "{
MR_ArrayType *array = (MR_ArrayType *)Array;
if ((Unsigned) Index >= (Unsigned) array->size) {
fatal_error(""array__lookup: array index out of bounds"");
}
Item = array->elements[Index];
}").
:- pragma(c_code, array__lookup(Array::in, Index::in, Item::out), "{
MR_ArrayType *array = (MR_ArrayType *)Array;
if ((Unsigned) Index >= (Unsigned) array->size) {
fatal_error(""array__lookup: array index out of bounds"");
}
Item = array->elements[Index];
}").
%-----------------------------------------------------------------------------%
:- pragma(c_code, array__set(Array0::array_di, Index::in,
Item::in, Array::array_uo), "{
MR_ArrayType *array = (MR_ArrayType *)Array0;
if ((Unsigned) Index >= (Unsigned) array->size) {
fatal_error(""array__set: array index out of bounds"");
}
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 *) make_many(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
*/
oldmem(old_array);
return array;
}
").
:- pragma(c_code,
array__resize(Array0::array_di, Size::in, Item::in,
Array::array_uo),
"
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 *) make_many(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
*/
oldmem(old_array);
return array;
}
").
:- pragma(c_code,
array__shrink(Array0::array_di, Size::in,
Array::array_uo),
"
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),
"
Array =
(Word) ML_copy_array((MR_ArrayType *) Array0);
").
:- pragma(c_code,
array__copy(Array0::in, Array::array_uo),
"
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)
)
)
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
New File: library/bt_array.m
===================================================================
%-----------------------------------------------------------------------------%
% Copyright (C) 1995 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: bt_array.m
% Main author: bromage.
% Stability: medium-low
% This file contains a set of predicates for generating an manipulating
% a bt_array data structure. This implementation allows O(log n) access
% and update time, and does not require the bt_array to be unique. If you
% need O(1) access/update time, use the uniq_bt_array datatype instead.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- module bt_array.
:- interface.
:- import_module int, list.
:- type bt_array(T).
%-----------------------------------------------------------------------------%
% bt_array__init(Low, Array) creates a bt_array of size zero
% starting at index Low.
:- pred bt_array__make_empty_array(int, bt_array(T)).
:- mode bt_array__make_empty_array(in, out) is det.
% bt_array__init creates a bt_array with bounds from Low to High,
% with each element initialized to Init.
:- pred bt_array__init(int, int, T, bt_array(T)).
:- mode bt_array__init(in, in, in, out) is det. % want a bt_array_skeleton?
%-----------------------------------------------------------------------------%
% array__min returns the lower bound of the array
:- pred bt_array__min(bt_array(_T), int).
:- mode bt_array__min(in, out) is det.
% array__max returns the upper bound of the array
:- pred bt_array__max(bt_array(_T), int).
:- mode bt_array__max(in, out) is det.
% array__size returns the length of the array,
% i.e. upper bound - lower bound + 1.
:- pred bt_array__size(bt_array(_T), int).
:- mode bt_array__size(in, out) is det.
% bt_array__bounds returns the upper and lower bounds of a bt_array.
:- pred bt_array__bounds(bt_array(_T), int, int).
:- mode bt_array__bounds(in, out, out) is det.
% bt_array__in_bounds checks whether an index is in the bounds
% of a bt_array
:- pred bt_array__in_bounds(bt_array(_T), int).
:- mode bt_array__in_bounds(in, in) is semidet.
%-----------------------------------------------------------------------------%
% bt_array__lookup returns the Nth element of a bt_array.
% It is an error if the index is out of bounds.
:- pred bt_array__lookup(bt_array(T), int, T).
:- mode bt_array__lookup(in, in, out) is det.
% bt_array__semidet_lookup is like bt_array__lookup except that
% it fails if the index is out of bounds.
:- pred bt_array__semidet_lookup(bt_array(T), int, T).
:- mode bt_array__semidet_lookup(in, in, out) is semidet.
% bt_array__set sets the nth element of a bt_array, and returns the
% resulting bt_array.
% It is an error if the index is out of bounds.
:- pred bt_array__set(bt_array(T), int, T, bt_array(T)).
:- mode bt_array__set(in, in, in, out) is det.
% bt_array__set sets the nth element of a bt_array, and returns the
% resulting bt_array (good opportunity for destructive update ;-).
% It fails if the index is out of bounds.
:- pred bt_array__semidet_set(bt_array(T), int, T, bt_array(T)).
:- mode bt_array__semidet_set(in, in, in, out) is semidet.
% `bt_array__resize(BtArray0, Lo, Hi, Item, BtArray)' is true
% if BtArray is a bt_array created by expanding or shrinking
% BtArray0 to fit the bounds (Lo,Hi). If the new bounds are
% not wholly contained within the bounds of BtArray0, Item is
% used to fill out the other places.
:- pred bt_array__resize(bt_array(T), int, int, T, bt_array(T)).
:- mode bt_array__resize(in, in, in, in, out) is det.
% `bt_array__shrink(BtArray0, Lo, Hi, Item, BtArray)' is true
% if BtArray is a bt_array created by shrinking BtArray0 to
% fit the bounds (Lo,Hi). It is an error if the new bounds
% are not wholly within the bounds of BtArray0.
:- pred bt_array__shrink(bt_array(T), int, int, bt_array(T)).
:- mode bt_array__shrink(in, in, in, out) is det.
% `bt_array__from_list(Low, List, BtArray)' takes a list (of
% possibly zero length), and returns a bt_array containing
% those elements in the same order that they occured in the
% list. The lower bound of the new array is `Low'.
:- pred bt_array__from_list(int, list(T), bt_array(T)).
:- mode bt_array__from_list(in, in, out) is det.
% bt_array__to_list takes a bt_array and returns a list containing
% the elements of the bt_array in the same order that they
% occurred in the bt_array.
:- pred bt_array__to_list(bt_array(T), list(T)).
:- mode bt_array__to_list(in, out) is det.
% bt_array__fetch_items takes a bt_array and a lower and upper
% index, and places those items in the bt_array between these
% indices into a list. It is an error if either index is
% out of bounds.
:- pred bt_array__fetch_items(bt_array(T), int, int, list(T)).
:- mode bt_array__fetch_items(in, in, in, out) is det.
% bt_array__bsearch takes a bt_array, an element to be found
% and a comparison predicate and returns the position of
% the element in the bt_array. Assumes the bt_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 bt_array__bsearch(bt_array(T), T, pred(T, T, comparison_result), int).
:- mode bt_array__bsearch(in, in, pred(in, in, out) is det, out) is semidet.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module require.
:- type bt_array(T) ---> bt_array(int, int, ra_list(T)).
%-----------------------------------------------------------------------------%
bt_array__make_empty_array(Low, bt_array(Low, Hi, ListOut)) :-
Hi is Low - 1,
ra_list_nil(ListOut).
bt_array__init(Low, High, Item, bt_array(Low, High, ListOut)) :-
ra_list_nil(ListIn),
ElemsToAdd is High - Low + 1,
bt_array__add_elements(ElemsToAdd, Item, ListIn, ListOut).
:- pred bt_array__add_elements(int, T, ra_list(T), ra_list(T)).
:- mode bt_array__add_elements(in, in, in, out) is det.
bt_array__add_elements(ElemsToAdd, Item, RaList0, RaList) :-
( ElemsToAdd =< 0 ->
RaList0 = RaList
;
ra_list_cons(Item, RaList0, RaList1),
ElemsToAdd1 is ElemsToAdd - 1,
bt_array__add_elements(ElemsToAdd1, Item, RaList1, RaList)
).
%-----------------------------------------------------------------------------%
bt_array__min(bt_array(Low, _, _), Low).
bt_array__max(bt_array(_, High, _), High).
bt_array__size(bt_array(Low, High, _), Size) :-
Size is High - Low + 1.
bt_array__bounds(bt_array(Low, High, _), Low, High).
bt_array__in_bounds(bt_array(Low, High, _), Index) :-
Low =< Index, Index =< High.
%-----------------------------------------------------------------------------%
:- pragma inline(actual_position/4).
:- pred actual_position(int, int, int, int).
:- mode actual_position(in, in, in, out) is det.
actual_position(Low, High, Index, Pos) :-
Pos is High - Low - Index + 1.
bt_array__lookup(bt_array(Low, High, RaList), Index, Item) :-
actual_position(Low, High, Index, Pos),
( ra_list_lookup(Pos, RaList, Item0) ->
Item = Item0
;
error("bt_array__lookup: Array subscript out of bounds")
).
bt_array__semidet_lookup(bt_array(Low, High, RaList), Index, Item) :-
actual_position(Low, High, Index, Pos),
ra_list_lookup(Pos, RaList, Item).
%-----------------------------------------------------------------------------%
bt_array__set(BtArray0, Index, Item, BtArray) :-
( bt_array__semidet_set(BtArray0, Index, Item, BtArray1) ->
BtArray = BtArray1
;
error("bt_array__set: index out of bounds")
).
bt_array__semidet_set(bt_array(Low, High, RaListIn), Index, Item,
bt_array(Low, High, RaListOut)) :-
actual_position(Low, High, Index, Pos),
ra_list_update(RaListIn, Pos, Item, RaListOut).
%-----------------------------------------------------------------------------%
bt_array__resize(Array0, L, H, Item, Array) :-
Array0 = bt_array(L0, H0, RaList0),
( L = L0 ->
% Optimise the common case where the lower bounds are
% the same.
( H < H0 ->
SizeDiff is H - H0,
( ra_list_drop(SizeDiff, RaList0, RaList1) ->
RaList = RaList1
;
error("bt_array__resize: Can't resize to a less-than-empty array")
),
Array = bt_array(L, H, RaList)
; H > H0 ->
SizeDiff is H0 - H,
bt_array__add_elements(SizeDiff, Item, RaList0, RaList),
Array = bt_array(L, H, RaList)
;
Array = Array0
)
;
int__max(L, L0, L1),
int__min(H, H0, H1),
bt_array__fetch_items(Array0, L1, H1, Items),
bt_array__init(L, H, Item, Array1),
bt_array__insert_items(Array1, L1, Items, Array)
).
bt_array__shrink(Array0, L, H, Array) :-
Array0 = bt_array(L0, H0, RaList0),
( ( L < L0 ; H > H0 ) ->
error("bt_array__shrink: New bounds are larger than old ones")
; L = L0 ->
% Optimise the common case where the lower bounds are
% the same.
SizeDiff is H - H0,
( ra_list_drop(SizeDiff, RaList0, RaList1) ->
RaList = RaList1
;
error("bt_array__shrink: Can't resize to a less-than-empty array")
),
Array = bt_array(L, H, RaList)
;
( ra_list_head(RaList0, Item0) ->
Item = Item0
;
error("bt_array__shrink: Can't shrink an empty array")
),
int__max(L, L0, L1),
int__min(H, H0, H1),
bt_array__fetch_items(Array0, L1, H1, Items),
bt_array__init(L, H, Item, Array1),
bt_array__insert_items(Array1, L1, Items, Array)
).
%-----------------------------------------------------------------------------%
bt_array__from_list(Low, List, bt_array(Low, High, RaList)) :-
list__length(List, Len),
High is Low + Len - 1,
ra_list_nil(RaList0),
bt_array__reverse_into_ra_list(List, RaList0, RaList).
:- pred bt_array__reverse_into_ra_list(list(T), ra_list(T), ra_list(T)).
:- mode bt_array__reverse_into_ra_list(in, in, out) is det.
bt_array__reverse_into_ra_list([], RaList, RaList).
bt_array__reverse_into_ra_list([X | Xs], RaList0, RaList) :-
ra_list_cons(X, RaList0, RaList1),
bt_array__reverse_into_ra_list(Xs, RaList1, RaList).
%-----------------------------------------------------------------------------%
:- pred bt_array__insert_items(bt_array(T), int, list(T), bt_array(T)).
:- mode bt_array__insert_items(in, in, in, out) is det.
bt_array__insert_items(Array, _N, [], Array).
bt_array__insert_items(Array0, N, [Head|Tail], Array) :-
bt_array__set(Array0, N, Head, Array1),
N1 is N + 1,
bt_array__insert_items(Array1, N1, Tail, Array).
%-----------------------------------------------------------------------------%
bt_array__to_list(bt_array(_, _, RaList), List) :-
bt_array__reverse_from_ra_list(RaList, [], List).
:- pred bt_array__reverse_from_ra_list(ra_list(T), list(T), list(T)).
:- mode bt_array__reverse_from_ra_list(in, in, out) is det.
bt_array__reverse_from_ra_list(RaList0, Xs0, Xs) :-
( ra_list_head_tail(RaList0, X, RaList1) ->
bt_array__reverse_from_ra_list(RaList1, [X | Xs0], Xs)
;
Xs0 = Xs
).
%-----------------------------------------------------------------------------%
bt_array__fetch_items(bt_array(ALow, AHigh, RaList0), Low, High, List) :-
(
Low > High
->
List = []
;
actual_position(ALow, AHigh, High, Drop),
ra_list_drop(Drop, RaList0, RaList),
Take is High - Low + 1,
bt_array__reverse_from_ra_list_count(Take, RaList, [], List0)
->
List = List0
;
List = []
).
:- pred bt_array__reverse_from_ra_list_count(int, ra_list(T), list(T), list(T)).
:- mode bt_array__reverse_from_ra_list_count(in, in, in, out) is det.
bt_array__reverse_from_ra_list_count(I, RaList0, Xs0, Xs) :-
(
ra_list_head_tail(RaList0, X, RaList1),
I >= 0
->
I1 is I - 1,
bt_array__reverse_from_ra_list_count(I1, RaList1, [X | Xs0], Xs)
;
Xs0 = Xs
).
%-----------------------------------------------------------------------------%
bt_array__bsearch(A, El, Compare, I) :-
bt_array__bounds(A, Lo, Hi),
Lo =< Hi,
bt_array__bsearch_2(A, Lo, Hi, El, Compare, I).
:- pred bt_array__bsearch_2(bt_array(T), int, int, T,
pred(T, T, comparison_result), int).
:- mode bt_array__bsearch_2(in, in, in, in, pred(in, in, out) is det,
out) is semidet.
bt_array__bsearch_2(A, Lo, Hi, El, Compare, I) :-
Width is Hi - Lo,
% If Width < 0, there is no range left.
Width >= 0,
% If Width == 0, we may just have found our element.
% Do a Compare to check.
( Width = 0 ->
bt_array__lookup(A, Lo, X),
call(Compare, El, X, (=)),
I = Lo
;
% Otherwise find the middle element of the range
% and check against that. NOTE: We can't use
% "// 2" because division always rounds towards
% zero whereas we want the result to be rounded
% down. (Indices can be negative.) We could use
% "div 2", but that's a little more expensive, and
% we know that we're always dividing by a power of
% 2. Until such time as we implement strength
% reduction, the >> 1 stays.
Mid is (Lo + Hi) >> 1,
bt_array__lookup(A, Mid, XMid),
call(Compare, XMid, El, Comp),
( Comp = (<),
Mid1 is Mid + 1,
bt_array__bsearch_2(A, Mid1, Hi, El, Compare, I)
; Comp = (=),
bt_array__bsearch_2(A, Lo, Mid, El, Compare, I)
; Comp = (>),
Mid1 is Mid - 1,
bt_array__bsearch_2(A, Lo, Mid1, El, Compare, I)
)
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% This is a perfect application for submodules, but Mercury doesn't have
% them. :-(
% :- module ra_list.
% :- interface.
% :- type ra_list(T).
:- pred ra_list_nil(ra_list(T)).
:- mode ra_list_nil(uo) is det.
:- pred ra_list_cons(T, ra_list(T), ra_list(T)).
:- mode ra_list_cons(in, in, out) is det.
:- pred ra_list_head(ra_list(T), T).
:- mode ra_list_head(in, out) is semidet.
:- pred ra_list_tail(ra_list(T), ra_list(T)).
:- mode ra_list_tail(in, out) is semidet.
:- pred ra_list_head_tail(ra_list(T), T, ra_list(T)).
:- mode ra_list_head_tail(in, out, out) is semidet.
%-----------------------------------------------------------------------------%
:- pred ra_list_lookup(int, ra_list(T), T).
:- mode ra_list_lookup(in, in, out) is semidet.
:- pred ra_list_update(ra_list(T), int, T, ra_list(T)).
:- mode ra_list_update(in, in, in, out) is semidet.
%-----------------------------------------------------------------------------%
:- pred ra_list_drop(int, ra_list(T), ra_list(T)).
:- mode ra_list_drop(in, in, out) is semidet.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% :- implementation.
:- type ra_list(T) --->
nil
; cons(int, ra_list_bintree(T), ra_list(T)).
:- type ra_list_bintree(T) --->
leaf(T)
; node(T, ra_list_bintree(T), ra_list_bintree(T)).
%-----------------------------------------------------------------------------%
:- pragma inline(ra_list_nil/1).
ra_list_nil(nil).
:- pragma inline(ra_list_cons/3).
ra_list_cons(X, List0, List) :-
(
List0 = cons(Size1, T1, cons(Size2, T2, Rest)),
Size1 = Size2
->
List = cons(1+Size1+Size2, node(X, T1, T2), Rest)
;
List = cons(1, leaf(X), List0)
).
:- pragma inline(ra_list_head/2).
ra_list_head(cons(_, leaf(X), _), X).
ra_list_head(cons(_, node(X, _, _), _), X).
:- pragma inline(ra_list_tail/2).
ra_list_tail(cons(_, leaf(_), Tail), Tail).
ra_list_tail(cons(Size, node(_, T1, T2), Rest), Tail) :-
Size2 = Size // 2,
Tail = cons(Size2, T1, cons(Size2, T2, Rest)).
:- pragma inline(ra_list_head_tail/3).
ra_list_head_tail(cons(_, leaf(X), Tail), X, Tail).
ra_list_head_tail(cons(Size, node(X, T1, T2), Rest), X, Tail) :-
Size2 = Size // 2,
Tail = cons(Size2, T1, cons(Size2, T2, Rest)).
%-----------------------------------------------------------------------------%
:- pragma inline(ra_list_update/4).
ra_list_lookup(I, List, X) :-
I >= 0,
ra_list_lookup_2(I, List, X).
:- pred ra_list_lookup_2(int, ra_list(T), T).
:- mode ra_list_lookup_2(in, in, out) is semidet.
ra_list_lookup_2(I, cons(Size, T, Rest), X) :-
( I < Size ->
ra_list_bintree_lookup(Size, T, I, X)
;
ra_list_lookup_2(I - Size, Rest, X)
).
:- pred ra_list_bintree_lookup(int, ra_list_bintree(T), int, T).
:- mode ra_list_bintree_lookup(in, in, in, out) is semidet.
ra_list_bintree_lookup(_, leaf(X), 0, X).
ra_list_bintree_lookup(Size, node(X0, T1, T2), I, X) :-
( I = 0 ->
X0 = X
;
Size2 = Size // 2,
( I =< Size2 ->
ra_list_bintree_lookup(Size2, T1, I-1, X)
;
ra_list_bintree_lookup(Size2, T2, I-1-Size2, X)
)
).
%-----------------------------------------------------------------------------%
:- pragma inline(ra_list_update/4).
ra_list_update(List0, I, X, List) :-
I >= 0,
ra_list_update_2(List0, I, X, List).
:- pred ra_list_update_2(ra_list(T), int, T, ra_list(T)).
:- mode ra_list_update_2(in, in, in, out) is semidet.
ra_list_update_2(cons(Size, T0, Rest), I, X, List) :-
( I < Size ->
ra_list_bintree_update(Size, T0, I, X, T),
List = cons(Size, T, Rest)
;
ra_list_update_2(Rest, I - Size, X, List0),
List = cons(Size, T0, List0)
).
:- pred ra_list_bintree_update(int, ra_list_bintree(T), int, T,
ra_list_bintree(T)).
:- mode ra_list_bintree_update(in, in, in, in, out) is semidet.
ra_list_bintree_update(_, leaf(_), 0, X, leaf(X)).
ra_list_bintree_update(Size, node(X0, T1, T2), I, X, T) :-
( I = 0 ->
T = node(X, T1, T2)
;
Size2 = Size // 2,
( I =< Size2 ->
ra_list_bintree_update(Size2, T1, I-1, X, T0),
T = node(X0, T0, T2)
;
ra_list_bintree_update(Size2, T2, I-1-Size2, X, T0),
T = node(X0, T1, T0)
)
).
%-----------------------------------------------------------------------------%
ra_list_drop(N, As, Bs) :-
(
N > 0
->
As = cons(Size, _, Cs),
( Size < N ->
N1 is N - Size,
ra_list_drop(N1, Cs, Bs)
;
ra_list_slow_drop(N, As, Bs)
)
;
As = Bs
).
:- pred ra_list_slow_drop(int, ra_list(T), ra_list(T)).
:- mode ra_list_slow_drop(in, in, out) is semidet.
ra_list_slow_drop(N, As, Bs) :-
(
N > 0
->
N1 is N - 1,
ra_list_tail(As, Cs),
ra_list_slow_drop(N1, Cs, Bs)
;
As = Bs
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
More information about the developers
mailing list