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