1/* 2 3This code implements hash-arrays. 4It requires the hash key to be a ground term. 5 6It relies on dynamic array code. 7 8*/ 9:- source. 10:- yap_flag(unknown,error). 11:- style_check(all). 12 13:- module(b_hash, [ b_hash_new/1, 14 b_hash_new/2, 15 b_hash_new/4, 16 b_hash_lookup/3, 17 b_hash_update/3, 18 b_hash_update/4, 19 b_hash_insert_new/4, 20 b_hash_insert/4 21 ]). 22 23:- use_module(library(terms), [ term_hash/4 ]). 24 25 26:- meta_predicate(b_hash_new(-,+,3,2)). 27 28array_default_size(2048). 29 30b_hash_new(hash(Keys, Vals, Size, N, _, _)) :- 31 array_default_size(Size), 32 array(Keys, Size), 33 array(Vals, Size), 34 create_mutable(0, N). 35 36b_hash_new(hash(Keys, Vals, Size, N, _, _), Size) :- 37 array(Keys, Size), 38 array(Vals, Size), 39 create_mutable(0, N). 40 41b_hash_new(hash(Keys,Vals, Size, N, HashF, CmpF), Size, HashF, CmpF) :- 42 array(Keys, Size), 43 array(Vals, Size), 44 create_mutable(0, N). 45 46b_hash_lookup(Key, Val, hash(Keys, Vals, Size, _, F, CmpF)):- 47 hash_f(Key, Size, Index, F), 48 fetch_key(Keys, Index, Size, Key, CmpF, ActualIndex), 49 array_element(Vals, ActualIndex, Mutable), 50 get_mutable(Val, Mutable). 51 52fetch_key(Keys, Index, Size, Key, CmpF, ActualIndex) :- 53 array_element(Keys, Index, El), 54 nonvar(El), 55 ( 56 cmp_f(CmpF, El, Key) 57 -> 58 Index = ActualIndex 59 ; 60 I1 is (Index+1) mod Size, 61 fetch_key(Keys, I1, Size, Key, CmpF, ActualIndex) 62 ). 63 64b_hash_update(Hash, Key, NewVal):- 65 Hash = hash(Keys, Vals, Size, _, F, CmpF), 66 hash_f(Key,Size,Index,F), 67 fetch_key(Keys, Index, Size, Key, CmpF, ActualIndex), 68 array_element(Vals, ActualIndex, Mutable), 69 update_mutable(NewVal, Mutable). 70 71b_hash_update(Hash, Key, OldVal, NewVal):- 72 Hash = hash(Keys, Vals, Size, _, F, CmpF), 73 hash_f(Key,Size,Index,F), 74 fetch_key(Keys, Index, Size, Key, CmpF, ActualIndex), 75 array_element(Vals, ActualIndex, Mutable), 76 get_mutable(OldVal, Mutable), 77 update_mutable(NewVal, Mutable). 78 79b_hash_insert(Hash, Key, NewVal, NewHash):- 80 Hash = hash(Keys, Vals, Size, N, F, CmpF), 81 hash_f(Key,Size,Index,F), 82 find_or_insert(Keys, Index, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash). 83 84find_or_insert(Keys, Index, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash) :- 85 array_element(Keys, Index, El), 86 ( 87 var(El) 88 -> 89 add_element(Keys, Index, Size, N, Vals, Key, NewVal, Hash, NewHash) 90 ; 91 cmp_f(CmpF, El, Key) 92 -> 93 % do rb_update 94 array_element(Vals, Index, Mutable), 95 update_mutable(NewVal, Mutable) 96 ; 97 I1 is (Index+1) mod Size, 98 find_or_insert(Keys, I1, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash) 99 ). 100 101b_hash_insert_new(Hash, Key, NewVal, NewHash):- 102 Hash = hash(Keys, Vals, Size, N, F, CmpF), 103 hash_f(Key,Size,Index,F), 104 find_or_insert_new(Keys, Index, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash). 105 106find_or_insert_new(Keys, Index, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash) :- 107 array_element(Keys, Index, El), 108 ( 109 var(El) 110 -> 111 add_element(Keys, Index, Size, N, Vals, Key, NewVal, Hash, NewHash) 112 ; 113 cmp_f(CmpF, El, Key) 114 -> 115 fail 116 ; 117 I1 is (Index+1) mod Size, 118 find_or_insert_new(Keys, I1, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash) 119 ). 120 121add_element(Keys, Index, Size, N, Vals, Key, NewVal, Hash, NewHash) :- 122 get_mutable(NEls, N), 123 NN is NEls+1, 124 update_mutable(NN, N), 125 ( 126 NN > Size/3 127 -> 128 expand_array(Hash, NewHash) 129 ; 130 Hash = NewHash 131 ), 132 array_element(Keys, Index, Key), 133 update_mutable(NN, N), 134 array_element(Vals, Index, Mutable), 135 create_mutable(NewVal, Mutable). 136 137expand_array(Hash, hash(NewKeys, NewVals, NewSize, X, F, CmpF)) :- 138 Hash = hash(Keys, Vals, Size, X, F, CmpF), 139 new_size(Size, NewSize), 140 array(NewKeys, NewSize), 141 array(NewVals, NewSize), 142 copy_hash_table(Size, Keys, Vals, F, NewSize, NewKeys, NewVals). 143 144new_size(Size, NewSize) :- 145 Size > 1048576, !, 146 NewSize is Size+1048576. 147new_size(Size, NewSize) :- 148 NewSize is Size*2. 149 150copy_hash_table(0, _, _, _, _, _, _) :- !. 151copy_hash_table(I1, Keys, Vals, F, Size, NewKeys, NewVals) :- 152 I is I1-1, 153 array_element(Keys, I, Key), 154 nonvar(Key), !, 155 array_element(Vals, I, Val), 156 insert_el(Key, Val, Size, F, NewKeys, NewVals), 157 copy_hash_table(I, Keys, Vals, F, Size, NewKeys, NewVals). 158copy_hash_table(I1, Keys, Vals, F, Size, NewKeys, NewVals) :- 159 I is I1-1, 160 copy_hash_table(I, Keys, Vals, F, Size, NewKeys, NewVals). 161 162insert_el(Key, Val, Size, F, NewKeys, NewVals) :- 163 hash_f(Key,Size,Index, F), 164 find_free(Index, Size, NewKeys, TrueIndex), 165 array_element(NewKeys, TrueIndex, Key), 166 array_element(NewVals, TrueIndex, Val). 167 168find_free(Index, Size, Keys, NewIndex) :- 169 array_element(Keys, Index, El), 170 ( 171 var(El) 172 -> 173 NewIndex = Index 174 ; 175 I1 is (Index+1) mod Size, 176 find_free(I1, Size, Keys, NewIndex) 177 ). 178 179hash_f(Key, Size, Index, F) :- 180 var(F), !, 181 term_hash(Key,-1,Size,Index). 182hash_f(Key, Size, Index, F) :- 183 call(F, Key, Size, Index). 184 185cmp_f(F, A, B) :- 186 var(F), !, 187 A == B. 188cmp_f(F, A, B) :- 189 call(F, A, B). 190 191