chr_hashtable_store.pl

   1 /*  $Id$
   2
   3     Part of CHR (Constraint Handling Rules)
   4
   5     Author:        Tom Schrijvers
   6     E-mail:        Tom.Schrijvers@cs.kuleuven.be
   7     WWW:           http://www.swi-prolog.org
   8     Copyright (C): 2003-2004, K.U. Leuven
   9
  10     This program is free software; you can redistribute it and/or
  11     modify it under the terms of the GNU General Public License
  12     as published by the Free Software Foundation; either version 2
  13     of the License, or (at your option) any later version.
  14
  15     This program is distributed in the hope that it will be useful,
  16     but WITHOUT ANY WARRANTY; without even the implied warranty of
  17     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18     GNU General Public License for more details.
  19
  20     You should have received a copy of the GNU Lesser General Public
  21     License along with this library; if not, write to the Free Software
  22     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  23
  24     As a special exception, if you link this library with other files,
  25     compiled with a Free Software compiler, to produce an executable, this
  26     library does not by itself cause the resulting executable to be covered
  27     by the GNU General Public License. This exception does not however
  28     invalidate any other reasons why the executable file might be covered by
  29     the GNU General Public License.
  30 */
  31 % author: Tom Schrijvers
  32 % email:  Tom.Schrijvers@cs.kuleuven.be
  33 % copyright: K.U.Leuven, 2004
  34
  35 :- module(chr_hashtable_store,
  36         [ new_ht/1,
  37           lookup_ht/3,
  38           lookup_ht1/4,
  39           lookup_ht2/4,
  40           insert_ht/3,
  41           insert_ht/4,
  42           delete_ht/3,
  43           delete_ht1/4,
  44           delete_first_ht/3,
  45           value_ht/2,
  46           stats_ht/1,
  47           stats_ht/1
  48         ]).
  49
  50 :- use_module(pairlist).
  51 :- use_module(hprolog).
  52 :- use_module(library(lists)).
  53
  54 :- multifile user:goal_expansion/2.
  55 :- dynamic user:goal_expansion/2.
  56
  57 user:goal_expansion(term_hash(Term,Hash),hash_term(Term,Hash)).
  58
  59 % term_hash(Term,Hash) :-
  60 %       hash_term(Term,Hash).
  61 initial_capacity(89).
  62
  63 new_ht(HT) :-
  64         initial_capacity(Capacity),
  65         new_ht(Capacity,HT).
  66
  67 new_ht(Capacity,HT) :-
  68         functor(T1,t,Capacity),
  69         HT = ht(Capacity,0,Table),
  70         Table = T1.
  71
  72 lookup_ht(HT,Key,Values) :-
  73         term_hash(Key,Hash),
  74         lookup_ht1(HT,Hash,Key,Values).
  75 /*
  76         HT = ht(Capacity,_,Table),
  77         Index is (Hash mod Capacity) + 1,
  78         arg(Index,Table,Bucket),
  79         nonvar(Bucket),
  80         ( Bucket = K-Vs ->
  81             K == Key,
  82             Values = Vs
  83         ;
  84             lookup(Bucket,Key,Values)
  85         ).
  86 */
  87
  88 % :- load_foreign_library(chr_support).
  89
  90 /*
  91 lookup_ht1(HT,Hash,Key,Values) :-
  92         ( lookup_ht1_(HT,Hash,Key,Values) ->
  93                 true
  94         ;
  95                 ( lookup_ht1__(HT,Hash,Key,Values) ->
  96                         writeln(lookup_ht1(HT,Hash,Key,Values)),
  97                         throw(error)
  98                 ;
  99                         fail
 100                 )
 101         ).
 102 */
 103
 104 lookup_ht1(HT,Hash,Key,Values) :-
 105         HT = ht(Capacity,_,Table),
 106         Index is (Hash mod Capacity) + 1,
 107         arg(Index,Table,Bucket),
 108         nonvar(Bucket),
 109         ( Bucket = K-Vs ->
 110             K == Key,
 111             Values = Vs
 112         ;
 113             lookup(Bucket,Key,Values)
 114         ).
 115
 116 lookup_ht2(HT,Key,Values,Index) :-
 117         term_hash(Key,Hash),
 118         HT = ht(Capacity,_,Table),
 119         Index is (Hash mod Capacity) + 1,
 120         arg(Index,Table,Bucket),
 121         nonvar(Bucket),
 122         ( Bucket = K-Vs ->
 123             K == Key,
 124             Values = Vs
 125         ;
 126             lookup(Bucket,Key,Values)
 127         ).
 128
 129 lookup_pair_eq([P | KVs],Key,Pair) :-
 130         P = K-_,
 131         ( K == Key ->
 132                 P = Pair
 133         ;
 134                 lookup_pair_eq(KVs,Key,Pair)
 135         ).
 136
 137 insert_ht(HT,Key,Value) :-
 138         term_hash(Key,Hash),
 139         HT = ht(Capacity0,Load,Table0),
 140         LookupIndex is (Hash mod Capacity0) + 1,
 141         arg(LookupIndex,Table0,LookupBucket),
 142         ( var(LookupBucket) ->
 143                 LookupBucket = Key - [Value]
 144         ; LookupBucket = K-Values ->
 145                 ( K == Key ->
 146                         setarg(2,LookupBucket,[Value|Values])
 147                 ;
 148                         setarg(LookupIndex,Table0,[Key-[Value],LookupBucket])
 149                 )
 150         ;
 151                 ( lookup_pair_eq(LookupBucket,Key,Pair) ->
 152                         Pair = _-Values,
 153                         setarg(2,Pair,[Value|Values])
 154                 ;
 155                         setarg(LookupIndex,Table0,[Key-[Value]|LookupBucket])
 156                 )
 157         ),
 158         NLoad is Load + 1,
 159         setarg(2,HT,NLoad),
 160         ( Load == Capacity0 ->
 161                 expand_ht(HT,_Capacity)
 162         ;
 163                 true
 164         ).
 165
 166 insert_ht1(HT,Key,Hash,Value) :-
 167         HT = ht(Capacity0,Load,Table0),
 168         LookupIndex is (Hash mod Capacity0) + 1,
 169         arg(LookupIndex,Table0,LookupBucket),
 170         ( var(LookupBucket) ->
 171                 LookupBucket = Key - [Value]
 172         ; LookupBucket = K-Values ->
 173                 ( K == Key ->
 174                         setarg(2,LookupBucket,[Value|Values])
 175                 ;
 176                         setarg(LookupIndex,Table0,[Key-[Value],LookupBucket])
 177                 )
 178         ;
 179                 ( lookup_pair_eq(LookupBucket,Key,Pair) ->
 180                         Pair = _-Values,
 181                         setarg(2,Pair,[Value|Values])
 182                 ;
 183                         setarg(LookupIndex,Table0,[Key-[Value]|LookupBucket])
 184                 )
 185         ),
 186         NLoad is Load + 1,
 187         setarg(2,HT,NLoad),
 188         ( Load == Capacity0 ->
 189                 expand_ht(HT,_Capacity)
 190         ;
 191                 true
 192         ).
 193
 194 % LDK: insert version with extra argument denoting result
 195
 196 insert_ht(HT,Key,Value,Result) :-
 197         HT = ht(Capacity,Load,Table),
 198         term_hash(Key,Hash),
 199         LookupIndex is (Hash mod Capacity) + 1,
 200         arg(LookupIndex,Table,LookupBucket),
 201         (   var(LookupBucket)
 202         ->  Result = [Value],
 203             LookupBucket = Key - Result,
 204             NewLoad is Load + 1
 205         ;   LookupBucket = K - V
 206         ->  (   K = Key
 207             ->  Result = [Value|V],
 208                 setarg(2,LookupBucket,Result),
 209                 NewLoad = Load
 210             ;   Result = [Value],
 211                 setarg(LookupIndex,Table,[Key - Result,LookupBucket]),
 212                 NewLoad is Load + 1
 213             )
 214         ;   (   lookup_pair_eq(LookupBucket,Key,Pair)
 215             ->  Pair = _-Values,
 216                 Result = [Value|Values],
 217                 setarg(2,Pair,Result),
 218                 NewLoad = Load
 219             ;   Result = [Value],
 220                 setarg(LookupIndex,Table,[Key - Result|LookupBucket]),
 221                 NewLoad is Load + 1
 222             )
 223         ),
 224         setarg(2,HT,NewLoad),
 225         (   NewLoad > Capacity
 226         ->  expand_ht(HT,_)
 227         ;   true
 228         ).
 229
 230 % LDK: deletion of the first element of a bucket
 231 delete_first_ht(HT,Key,Values) :-
 232         HT = ht(Capacity,Load,Table),
 233         term_hash(Key,Hash),
 234         Index is (Hash mod Capacity) + 1,
 235         arg(Index,Table,Bucket),
 236         (   Bucket = _-[_|Values]
 237         ->  (   Values = []
 238             ->  setarg(Index,Table,_),
 239                 NewLoad is Load - 1
 240             ;   setarg(2,Bucket,Values),
 241                 NewLoad = Load
 242             )
 243         ;   lookup_pair_eq(Bucket,Key,Pair)
 244         ->  Pair = _-[_|Values],
 245             (   Values = []
 246             ->  pairlist_delete_eq(Bucket,Key,NewBucket),
 247                 (   NewBucket = []
 248                 ->  setarg(Index,Table,_)
 249                 ;   NewBucket = [OtherPair]
 250                 ->  setarg(Index,Table,OtherPair)
 251                 ;   setarg(Index,Table,NewBucket)
 252                 ),
 253                 NewLoad is Load - 1
 254             ;   setarg(2,Pair,Values),
 255                 NewLoad = Load
 256             )
 257         ).
 258
 259 delete_ht(HT,Key,Value) :-
 260         HT = ht(Capacity,Load,Table),
 261         NLoad is Load - 1,
 262         term_hash(Key,Hash),
 263         Index is (Hash mod Capacity) + 1,
 264         arg(Index,Table,Bucket),
 265         ( /* var(Bucket) ->
 266                 true
 267         ; */ Bucket = _K-Vs ->
 268                 ( /* _K == Key, */
 269                   delete_first_fail(Vs,Value,NVs) ->
 270                         setarg(2,HT,NLoad),
 271                         ( NVs == [] ->
 272                                 setarg(Index,Table,_)
 273                         ;
 274                                 setarg(2,Bucket,NVs)
 275                         )
 276                 ;
 277                         true
 278                 )
 279         ;
 280                 ( lookup_pair_eq(Bucket,Key,Pair),
 281                   Pair = _-Vs,
 282                   delete_first_fail(Vs,Value,NVs) ->
 283                         setarg(2,HT,NLoad),
 284                         ( NVs == [] ->
 285                                 pairlist_delete_eq(Bucket,Key,NBucket),
 286                                 ( NBucket = [Singleton] ->
 287                                         setarg(Index,Table,Singleton)
 288                                 ;
 289                                         setarg(Index,Table,NBucket)
 290                                 )
 291                         ;
 292                                 setarg(2,Pair,NVs)
 293                         )
 294                 ;
 295                         true
 296                 )
 297         ).
 298
 299 delete_first_fail([X | Xs], Y, Zs) :-
 300         ( X == Y ->
 301                 Zs = Xs
 302         ;
 303                 Zs = [X | Zs1],
 304                 delete_first_fail(Xs, Y, Zs1)
 305         ).
 306
 307 delete_ht1(HT,Key,Value,Index) :-
 308         HT = ht(_Capacity,Load,Table),
 309         NLoad is Load - 1,
 310         % term_hash(Key,Hash),
 311         % Index is (Hash mod _Capacity) + 1,
 312         arg(Index,Table,Bucket),
 313         ( /* var(Bucket) ->
 314                 true
 315         ; */ Bucket = _K-Vs ->
 316                 ( /* _K == Key, */
 317                   delete_first_fail(Vs,Value,NVs) ->
 318                         setarg(2,HT,NLoad),
 319                         ( NVs == [] ->
 320                                 setarg(Index,Table,_)
 321                         ;
 322                                 setarg(2,Bucket,NVs)
 323                         )
 324                 ;
 325                         true
 326                 )
 327         ;
 328                 ( lookup_pair_eq(Bucket,Key,Pair),
 329                   Pair = _-Vs,
 330                   delete_first_fail(Vs,Value,NVs) ->
 331                         setarg(2,HT,NLoad),
 332                         ( NVs == [] ->
 333                                 pairlist_delete_eq(Bucket,Key,NBucket),
 334                                 ( NBucket = [Singleton] ->
 335                                         setarg(Index,Table,Singleton)
 336                                 ;
 337                                         setarg(Index,Table,NBucket)
 338                                 )
 339                         ;
 340                                 setarg(2,Pair,NVs)
 341                         )
 342                 ;
 343                         true
 344                 )
 345         ).
 346 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 347 value_ht(HT,Value) :-
 348         HT = ht(Capacity,_,Table),
 349         value_ht(1,Capacity,Table,Value).
 350
 351 value_ht(I,N,Table,Value) :-
 352         I =< N,
 353         arg(I,Table,Bucket),
 354         (
 355                 nonvar(Bucket),
 356                 ( Bucket = _-Vs ->
 357                         true
 358                 ;
 359                         member(_-Vs,Bucket)
 360                 ),
 361                 member(Value,Vs)
 362         ;
 363                 J is I + 1,
 364                 value_ht(J,N,Table,Value)
 365         ).
 366
 367 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 368
 369 expand_ht(HT,NewCapacity) :-
 370         HT = ht(Capacity,_,Table),
 371         NewCapacity is Capacity * 2 + 1,
 372         functor(NewTable,t,NewCapacity),
 373         setarg(1,HT,NewCapacity),
 374         setarg(3,HT,NewTable),
 375         expand_copy(Table,1,Capacity,NewTable,NewCapacity).
 376
 377 expand_copy(Table,I,N,NewTable,NewCapacity) :-
 378         ( I > N ->
 379                 true
 380         ;
 381                 arg(I,Table,Bucket),
 382                 ( var(Bucket) ->
 383                         true
 384                 ; Bucket = Key - Value ->
 385                         expand_insert(NewTable,NewCapacity,Key,Value)
 386                 ;
 387                         expand_inserts(Bucket,NewTable,NewCapacity)
 388                 ),
 389                 J is I + 1,
 390                 expand_copy(Table,J,N,NewTable,NewCapacity)
 391         ).
 392
 393 expand_inserts([],_,_).
 394 expand_inserts([K-V|R],Table,Capacity) :-
 395         expand_insert(Table,Capacity,K,V),
 396         expand_inserts(R,Table,Capacity).
 397
 398 expand_insert(Table,Capacity,K,V) :-
 399         term_hash(K,Hash),
 400         Index is (Hash mod Capacity) + 1,
 401         arg(Index,Table,Bucket),
 402         ( var(Bucket) ->
 403                 Bucket = K - V
 404         ; Bucket = _-_ ->
 405                 setarg(Index,Table,[K-V,Bucket])
 406         ;
 407                 setarg(Index,Table,[K-V|Bucket])
 408         ).
 409 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 410 stats_ht(HT) :-
 411         HT = ht(Capacity,Load,Table),
 412         format('HT load = ~w / ~w\n',[Load,Capacity]),
 413         ( between(1,Capacity,Index),
 414                 arg(Index,Table,Entry),
 415                 ( var(Entry)  -> Size = 0
 416                 ; Entry = _-_ -> Size = 1
 417                 ; length(Entry,Size)
 418                 ),
 419                 format('~w : ~w\n',[Index,Size]),
 420                 fail
 421         ;
 422                 true
 423         ).