1:- module(compiler_map).
2
3% This module is the old public-domain lib(logarr) with wrappers to
4% make it look like lib(m_map) from the Mercury library.
5
6:- export init/1.
7init(Map) :-
8	new_array(Map).
9
10:- export search/3.
11search(Map, Key, Value) :-
12	aref(Key, Map, Value).
13
14:- export lookup/3.
15lookup(Map, Key, Value) :-
16	( aref(Key, Map, Value) -> true ;
17	    printf(error, "No such key in %w%n", [lookup(Map, Key, Value)]),
18	    abort
19	).
20
21:- export delete/3.
22delete(Map0, Key, Map) :-
23	aset(Key, Map0, $, Map).
24
25:- export count/2.
26count(Map, N) :-
27	array_to_list(Map, List),
28	length(List, N).
29
30:- export to_sorted_assoc_list/2.
31to_sorted_assoc_list(Map, List) :-
32	array_to_list(Map, List).
33
34:- export to_assoc_list/2.
35to_assoc_list(Map, List) :-
36	array_to_list(Map, List).
37
38:- export keys/2.
39keys(Map, Keys) :-
40	array_to_list(Map, List),
41	( foreach(Key-_,List), foreach(Key,Keys) do true ).
42
43:- export from_sorted_assoc_list/2.
44from_sorted_assoc_list(List, Map) :-
45	new_array(Map0),
46	( foreach(Key-Value,List), fromto(Map0,Map1,Map2,Map) do
47	    aset(Key, Map1, Value, Map2)
48	).
49
50:- export det_insert/4.
51det_insert(Map0, Key, Value, Map) :-	% no checks
52	aset(Key, Map0, Value, Map).
53
54:- export det_update/4.
55det_update(Map0, Key, Value, Map) :-	% no checks
56	aset(Key, Map0, Value, Map).
57
58:- export portray(array/2, array_portray/2, []).
59array_portray(Array, array_portray(List)) :-
60        strict_is_array(Array),
61        array_to_list(Array, List).
62
63strict_is_array(array($(_,_,_,_),D)) ?-
64        integer(D).
65
66
67%   File   : LOGARR.PL
68%   Author : Mostly David H.D.Warren, some changes by Fernando Pereira
69%   Updated: 24 September 1984
70%   Purpose: Extendable arrays with logarithmic access time.
71
72/*  LOGARITHMIC ARRAYS.
73
74    An array extends from 0 to 2**Size - 1, where Size is a multiple of 2.
75    Note that 2**Size = 1<<Size.
76
77    External interface.
78
79    new_array(A) returns a new empty array A.
80
81    is_array(A) checks whether A is an array.
82
83    aref(Index,Array,Element) unifies Element with Array[Index],
84	or fails if Array[Index] has not been set.
85
86    arefa(Index,Array,Element) is as aref/3, except that it unifies
87	Element with a new array if Array[Index] is undefined.
88	This is useful for multidimensional arrays implemented
89	as arrays of arrays.
90
91    arefl(Index,Array,Element) is as aref/3, except that Element
92	appears as '[]' for undefined cells.
93
94    aset(Index,Array,Element,NewArray) unifies NewArray with the
95	result of setting Array[Index] to Element.
96
97    array_to_list(Array,List) returns a list of pairs Index-Element
98	of all the elements of Array that have been set.
99
100	In the interests of uniformity, R.A.O'K used the Prolog source
101	code tidier on this file; this is not its original layout.  He
102	made no algorithmic changes, however.
103*/
104
105/*
106:- export
107	new_array/1,
108	is_array/1,
109	aref/3,
110	arefa/3,
111	arefl/3,
112	aset/4,
113	array_to_list/2.
114
115:- mode
116	aref(+, +, ?),
117	arefa(+, +, ?),
118	arefl(+, +, ?),
119	array_to_list(+, -),
120	aset(+, +, +, -),
121	array_item(+, +, +, +, ?),
122	is_array(+),
123	new_array(-),
124	not_undef(+),
125	subarray(+, +, ?),
126	subarray_to_list(+, +, +, +, ?, ?),
127	update_subarray(+, +, ?, ?, -).
128*/
129
130new_array(array($($,$,$,$),2)).
131
132%is_array(array(_,_)).
133
134
135aref(Index, array(Array,Size), Item) :-
136	check_int(Index),
137	Index < 1<<Size,
138	N is Size-2,
139	Subindex is (Index>>N) /\ 3,
140	array_item(Subindex, N, Index, Array, Item).
141
142
143array_to_list(array($(A0,A1,A2,A3),Size), L0) :-
144	N is Size-2,
145	subarray_to_list(0, N, 0, A0, L0, L1),
146	subarray_to_list(1, N, 0, A1, L1, L2),
147	subarray_to_list(2, N, 0, A2, L2, L3),
148	subarray_to_list(3, N, 0, A3, L3, []).
149
150
151arefa(Index, array(Array,Size), Item) :-
152	check_int(Index),
153	Index < 1<<Size,
154	N is Size-2,
155	Subindex is (Index>>N) /\ 3,
156	array_item(Subindex, N, Index, Array, Item), !.
157arefa(_, _, Item) :-
158	new_array(Item).
159
160
161arefl(Index, array(Array,Size), Item) :-
162	check_int(Index),
163	Index < 1<<Size,
164	N is Size-2,
165	Subindex is (Index>>N) /\ 3,
166	array_item(Subindex, N, Index, Array, Item), !.
167arefl(_, _, []).
168
169
170aset(Index, array(Array0,Size0), Item, array(Array,Size)) :-
171	check_int(Index),
172	enlarge_array(Index, Size0, Array0, Size, Array1),
173	update_array_item(Size, Index, Array1, Item, Array).
174
175
176check_int(I) :-
177	integer(I), !.
178check_int(X) :-
179	write('Array index not integer: '), write(X), nl,
180%	trace,
181	fail.
182
183% Guts
184
185enlarge_array(I, Size, Array, Size, Array) :-
186	I < 1<<Size, !.
187enlarge_array(I, Size0, Array0, Size, Array) :-
188	Size1 is Size0 + 2,
189	Array1 = $(Array0,$,$,$),
190	enlarge_array(I, Size1, Array1, Size, Array).
191
192
193array_item(0, 0, _, $(Item,_,_,_), Item) :- !,
194	not_undef(Item).
195array_item(0, N, Index, $(Array,_,_,_), Item) :-
196	N1 is N-2,
197	Subindex is (Index >> N1) /\ 3,
198	array_item(Subindex, N1, Index, Array, Item).
199array_item(1, 0, _, $(_,Item,_,_), Item) :- !,
200	not_undef(Item).
201array_item(1, N, Index, $(_,Array,_,_), Item) :-
202	N1 is N-2,
203	Subindex is (Index >> N1) /\ 3,
204	array_item(Subindex, N1, Index, Array, Item).
205array_item(2, 0, _, $(_,_,Item,_), Item) :- !,
206	not_undef(Item).
207array_item(2, N, Index, $(_,_,Array,_), Item) :-
208	N1 is N-2,
209	Subindex is (Index >> N1) /\ 3,
210	array_item(Subindex, N1, Index, Array, Item).
211array_item(3, 0, _, $(_,_,_,Item), Item) :- !,
212	not_undef(Item).
213array_item(3, N, Index, $(_,_,_,Array), Item) :-
214	N1 is N-2,
215	Subindex is (Index >> N1) /\ 3,
216	array_item(Subindex, N1, Index, Array, Item).
217
218
219not_undef($) :- !,
220	fail.
221not_undef(_).
222
223
224%% [BEFORE OPEN-CODING 'subarray']
225%%
226%% array_item(0,Index,Item,Item) :- !,
227%%	not_undef(Item).
228%% array_item(N,Index,Array,Item) :-
229%%	N1 is N-2,
230%%	Subindex is (Index >> N1) /\ 3,
231%%	subarray(Subindex,Array,Array1),
232%%	array_item(N1,Index,Array1,Item).
233%%
234%% subarray(0,$(X,_,_,_),X).
235%% subarray(1,$(_,X,_,_),X).
236%% subarray(2,$(_,_,X,_),X).
237%% subarray(3,$(_,_,_,X),X).
238
239update_array_item(0, _, _, NewItem, NewItem) :- !.
240update_array_item(N, Index, Array, NewItem, NewArray) :-
241	N1 is N-2,
242	Subindex is (Index >> N1) /\ 3,
243	update_subarray(Subindex, Array, Array1, NewArray1, NewArray),
244	update_array_item(N1, Index, Array1, NewItem, NewArray1).
245
246
247update_subarray(I, $, X, X1, Array) :- !,
248	update_subarray1(I, $($,$,$,$), X, X1, Array).
249update_subarray(I, Array, X, X1, NewArray) :-
250	update_subarray1(I, Array, X, X1, NewArray).
251
252update_subarray1(0, $(W,X,Y,Z), W, W1, $(W1,X,Y,Z)).
253update_subarray1(1, $(W,X,Y,Z), X, X1, $(W,X1,Y,Z)).
254update_subarray1(2, $(W,X,Y,Z), Y, Y1, $(W,X,Y1,Z)).
255update_subarray1(3, $(W,X,Y,Z), Z, Z1, $(W,X,Y,Z1)).
256
257
258subarray_to_list(K, 0, M, Item, [N-Item|L], L) :-
259	not_undef(Item), !,
260	N is K+M.
261subarray_to_list(K, N, M, $(A0,A1,A2,A3), L0, L) :-
262	N > 0, !,
263	N1 is N-2,
264	M1 is (K+M) << 2,
265	subarray_to_list(0, N1, M1, A0, L0, L1),
266	subarray_to_list(1, N1, M1, A1, L1, L2),
267	subarray_to_list(2, N1, M1, A2, L2, L3),
268	subarray_to_list(3, N1, M1, A3, L3, L).
269subarray_to_list(_, _, _, _, L, L).
270