/*             Copyright (C)1990-2002 UPM-CLIP                  	     */
/*                          1994-1995 Katholieke Universiteit Leuven.        */
/* Copyright(C) 1988, Swedish Institute of Computer Science                  */
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  Name: arrays.pl
%  Author: Lena Flood
%  Date: 8 November 1988
%  Purpose: Extendable arrays with logarithmic access time
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	
%  Adapted from shared code written by David Warren and Fernando Pereira.
 
%  Array extends from 0 to 2**Size - 1, where Size is a multiple of 2.
%  Note that 2**Size = 1<<Size.
 
:- module(arrays,
	[ new_array/1,
	  is_array/1,
	  aref/3,
	  arefa/3,
	  arefl/3,
	  aset/4,
	  array_to_list/2
	],
	[ assertions,
	  isomodes
	]).

/*
:- mode
	new_array(-),
	is_array(+),
	aref(+, +, ?),
	arefa(+, +, ?),
	arefl(+, +, ?),
	aset(+, +, +, -),
	array_to_list(+, -),
	subarray_to_list(+, +, +, +, ?, ?),
	check_int(+, +),
	enlarge_array(+, +, +, -, -),
	array_item(+, +, +, -),
	update_array_item(+, +, +, +, -),
	update_subarray(+, +, -, -, -).
*/

:- comment(title,"Extendable arrays with logarithmic access time").

:- comment(author,"Lena Flood").

:- comment(module,"This module implements extendable arrays with
   logarithmic access time. It has been adapted from shared code
   written by David Warren and Fernando Pereira.").

:- pred new_array(-Array) # "returns an empty new array @var{Array}.".
 
new_array(array($($,$,$,$),2)).

:- pred is_array(+Array) # "@var{Array} actually is an array.".
 
is_array(array(_,N)):- number(N).

:- pred aref(+Index, +Array, ?Element) 
	# "unifies @var{Element} to @var{Array}[@var{Index}], or fails if 
	  @var{Array}[@var{Index}] has not been set.".
	
aref(Index, array(Array,Size), Item) :-
	check_int(Index, aref(Index,array(Array,Size),Item)),
	Index < 1<<Size,
	array_item(Size, Index, Array, Item).

:- pred arefa(+Index, +Array, ?Element) 
	# "is as @tt{aref/3}, except that it unifies @var{Element} with
	  a new array if @var{Array}[@var{Index}] is undefined. This is 
	  useful for multidimensional arrays implemented as arrays of 
	  arrays.".
 
arefa(Index, array(Array,Size), Item) :-
	check_int(Index, arefa(Index,array(Array,Size),Item)),
	Index < 1<<Size,
	array_item(Size, Index, Array, Item), !.
arefa(_, _, Item) :- new_array(Item).

:- pred arefl(+Index, +Array, ?Element) 
	# "is as @tt{aref/3}, except that @var{Element} appears as
	  @tt{[]} for undefined cells. Thus, @tt{arefl(_,_,[])} always
	  succeeds no matter what you give in the first or second args.".
 
arefl(Index, array(Array,Size), Item) :-
	check_int(Index, arefl(Index,array(Array,Size),Item)),
	Index < 1<<Size,
	array_item(Size, Index, Array, Item), !.
arefl(_, _, []).

:- pred aset(+Index, +Array, Element, -NewArray) 
	# "unifies @var{NewArray} with the result of setting
	  @var{Array}[@var{Index}] to @var{Element}.".
 
aset(Index, array(Array0,Size0), Item, array(Array,Size)) :-
	check_int(Index, aset(Index,array(Array0,Size0),Item,array(Array,Size))),
	enlarge_array(Index, Size0, Array0, Size, Array1), 
	update_array_item(Size, Index, Array1, Item, Array).


:- pred array_to_list(+Array, -List) 
	# "returns a @var{List} of pairs Index-Element of all the elements
	  of @var{Array} that have been set.".
 
array_to_list(array($(A0,A1,A2,A3),Size), L0) :-
	N is Size-2,
	subarray_to_list(0, N, 0, A0, L0, L1), 
	subarray_to_list(1, N, 0, A1, L1, L2), 
	subarray_to_list(2, N, 0, A2, L2, L3), 
	subarray_to_list(3, N, 0, A3, L3, []).

subarray_to_list(K, 0, M, Item, [N-Item|L], L) :-
	Item \== $, !,
	N is K+M.
subarray_to_list(K, N, M, $(A0,A1,A2,A3), L0, L) :-
	N>0, !,
	N1 is N-2,
	M1 is (K+M)<<2,
	subarray_to_list(0, N1, M1, A0, L0, L1),
	subarray_to_list(1, N1, M1, A1, L1, L2),
	subarray_to_list(2, N1, M1, A2, L2, L3),
	subarray_to_list(3, N1, M1, A3, L3, L).
subarray_to_list(_, _, _, _, L, L).


%   check_int(+Number, +Goal)
%   checks that Number is a positive integer, if not an error is raised.
 
check_int(I, _) :- integer(I), I >= 0, !.
% SICStus
% check_int(I, Goal) :- prolog:illarg(domain(integer,>=(0)), Goal, 1, I).
check_int(I, Goal) :-
	goal2pred(Goal,Pred),
        ( integer(I) ->
            throw(error(domain_error(nonnegative_integer,I), Pred-1))
        ; throw(error(type_error(integer,I), Pred-1))
        ).

goal2pred(Goal,F/A):- functor(Goal,F,A).



enlarge_array(I, Size, Array, Size, Array) :-
	I < 1<<Size, !.
enlarge_array(I, Size0, Array0, Size, Array) :-
	Size1 is Size0 + 2,
	enlarge_array(I, Size1, $(Array0,$,$,$), Size, Array).


array_item(0, _, Item, Item) :- !,
        Item \== $ .
array_item(N, Index, Array, Item) :-
        N1 is N-2,
        Subindex is ((Index>>N1)/\3)+1,
        arg(Subindex, Array, Array1),
        array_item(N1, Index, Array1, Item).


update_array_item(0, _, _, NewItem, NewItem) :- !.
update_array_item(N, Index, Array, NewItem, NewArray) :-
	N1 is N-2,
	Subindex is Index >> N1 /\ 3,
	update_subarray(Subindex, Array, Array1, NewArray1, NewArray),
	update_array_item(N1, Index, Array1, NewItem, NewArray1).

update_subarray(I, $, X, X1, Array) :- !,
	update_subarray(I, $($,$,$,$), X, X1, Array).
update_subarray(0, $(W,X,Y,Z), W, W1, $(W1,X,Y,Z)).
update_subarray(1, $(W,X,Y,Z), X, X1, $(W,X1,Y,Z)).
update_subarray(2, $(W,X,Y,Z), Y, Y1, $(W,X,Y1,Z)).
update_subarray(3, $(W,X,Y,Z), Z, Z1, $(W,X,Y,Z1)).


%-------------------------------------------------------------------------
:- comment(version_maintenance,dir('../version')).

:- comment(version(1*9+236,2003/12/22,18:18*14+'CET'), "Added comment
   title.  (Edison Mera)").

:- comment(version(1*9+3,2002/05/23,21:32*30+'CEST'), "Turn comments
   into assertions for documentation.  (Francisco Bueno Carrillo)").

:- comment(version(1*3+62,1999/09/29,18:05*39+'MEST'), "Added
   libraries arrays and bitcodesets.  (Francisco Bueno Carrillo)").

%-------------------------------------------------------------------------
