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(library(dialect/hprolog)).
  52 :- use_module(library(lists)).
  53
  54 :- multifile user:goal_expansion/2.
  55 :- dynamic user:goal_expansion/2.
  56
  57 initial_capacity(89).
  58
  59 new_ht(HT) :-
  60         initial_capacity(Capacity),
  61         new_ht(Capacity,HT).
  62
  63 new_ht(Capacity,HT) :-
  64         functor(T1,t,Capacity),
  65         HT = ht(Capacity,0,Table),
  66         Table = T1.
  67
  68 lookup_ht(HT,Key,Values) :-
  69         term_hash(Key,Hash),
  70         lookup_ht1(HT,Hash,Key,Values).
  71 /*
  72         HT = ht(Capacity,_,Table),
  73         Index is (Hash mod Capacity) + 1,
  74         arg(Index,Table,Bucket),
  75         nonvar(Bucket),
  76         ( Bucket = K-Vs ->
  77             K == Key,
  78             Values = Vs
  79         ;
  80             lookup(Bucket,Key,Values)
  81         ).
  82 */
  83
  84 % :- load_foreign_library(chr_support).
  85
  86 /*
  87 lookup_ht1(HT,Hash,Key,Values) :-
  88         ( lookup_ht1_(HT,Hash,Key,Values) ->
  89                 true
  90         ;
  91                 ( lookup_ht1__(HT,Hash,Key,Values) ->
  92                         writeln(lookup_ht1(HT,Hash,Key,Values)),
  93                         throw(error)
  94                 ;
  95                         fail
  96                 )
  97         ).
  98 */
  99
 100 lookup_ht1(HT,Hash,Key,Values) :-
 101         HT = ht(Capacity,_,Table),
 102         Index is (Hash mod Capacity) + 1,
 103         arg(Index,Table,Bucket),
 104         nonvar(Bucket),
 105         ( Bucket = K-Vs ->
 106             K == Key,
 107             Values = Vs
 108         ;
 109             lookup(Bucket,Key,Values)
 110         ).
 111
 112 lookup_ht2(HT,Key,Values,Index) :-
 113         term_hash(Key,Hash),
 114         HT = ht(Capacity,_,Table),
 115         Index is (Hash mod Capacity) + 1,
 116         arg(Index,Table,Bucket),
 117         nonvar(Bucket),
 118         ( Bucket = K-Vs ->
 119             K == Key,
 120             Values = Vs
 121         ;
 122             lookup(Bucket,Key,Values)
 123         ).
 124
 125 lookup_pair_eq([P | KVs],Key,Pair) :-
 126         P = K-_,
 127         ( K == Key ->
 128                 P = Pair
 129         ;
 130                 lookup_pair_eq(KVs,Key,Pair)
 131         ).
 132
 133 insert_ht(HT,Key,Value) :-
 134         term_hash(Key,Hash),
 135         HT = ht(Capacity0,Load,Table0),
 136         LookupIndex is (Hash mod Capacity0) + 1,
 137         arg(LookupIndex,Table0,LookupBucket),
 138         ( var(LookupBucket) ->
 139                 LookupBucket = Key - [Value]
 140         ; LookupBucket = K-Values ->
 141                 ( K == Key ->
 142                         setarg(2,LookupBucket,[Value|Values])
 143                 ;
 144                         setarg(LookupIndex,Table0,[Key-[Value],LookupBucket])
 145                 )
 146         ;
 147                 ( lookup_pair_eq(LookupBucket,Key,Pair) ->
 148                         Pair = _-Values,
 149                         setarg(2,Pair,[Value|Values])
 150                 ;
 151                         setarg(LookupIndex,Table0,[Key-[Value]|LookupBucket])
 152                 )
 153         ),
 154         NLoad is Load + 1,
 155         setarg(2,HT,NLoad),
 156         ( Load == Capacity0 ->
 157                 expand_ht(HT,_Capacity)
 158         ;
 159                 true
 160         ).
 161
 162 insert_ht1(HT,Key,Hash,Value) :-
 163         HT = ht(Capacity0,Load,Table0),
 164         LookupIndex is (Hash mod Capacity0) + 1,
 165         arg(LookupIndex,Table0,LookupBucket),
 166         ( var(LookupBucket) ->
 167                 LookupBucket = Key - [Value]
 168         ; LookupBucket = K-Values ->
 169                 ( K == Key ->
 170                         setarg(2,LookupBucket,[Value|Values])
 171                 ;
 172                         setarg(LookupIndex,Table0,[Key-[Value],LookupBucket])
 173                 )
 174         ;
 175                 ( lookup_pair_eq(LookupBucket,Key,Pair) ->
 176                         Pair = _-Values,
 177                         setarg(2,Pair,[Value|Values])
 178                 ;
 179                         setarg(LookupIndex,Table0,[Key-[Value]|LookupBucket])
 180                 )
 181         ),
 182         NLoad is Load + 1,
 183         setarg(2,HT,NLoad),
 184         ( Load == Capacity0 ->
 185                 expand_ht(HT,_Capacity)
 186         ;
 187                 true
 188         ).
 189
 190 % LDK: insert version with extra argument denoting result
 191
 192 insert_ht(HT,Key,Value,Result) :-
 193         HT = ht(Capacity,Load,Table),
 194         term_hash(Key,Hash),
 195         LookupIndex is (Hash mod Capacity) + 1,
 196         arg(LookupIndex,Table,LookupBucket),
 197         (   var(LookupBucket)
 198         ->  Result = [Value],
 199             LookupBucket = Key - Result,
 200             NewLoad is Load + 1
 201         ;   LookupBucket = K - V
 202         ->  (   K = Key
 203             ->  Result = [Value|V],
 204                 setarg(2,LookupBucket,Result),
 205                 NewLoad = Load
 206             ;   Result = [Value],
 207                 setarg(LookupIndex,Table,[Key - Result,LookupBucket]),
 208                 NewLoad is Load + 1
 209             )
 210         ;   (   lookup_pair_eq(LookupBucket,Key,Pair)
 211             ->  Pair = _-Values,
 212                 Result = [Value|Values],
 213                 setarg(2,Pair,Result),
 214                 NewLoad = Load
 215             ;   Result = [Value],
 216                 setarg(LookupIndex,Table,[Key - Result|LookupBucket]),
 217                 NewLoad is Load + 1
 218             )
 219         ),
 220         setarg(2,HT,NewLoad),
 221         (   NewLoad > Capacity
 222         ->  expand_ht(HT,_)
 223         ;   true
 224         ).
 225
 226 % LDK: deletion of the first element of a bucket
 227 delete_first_ht(HT,Key,Values) :-
 228         HT = ht(Capacity,Load,Table),
 229         term_hash(Key,Hash),
 230         Index is (Hash mod Capacity) + 1,
 231         arg(Index,Table,Bucket),
 232         (   Bucket = _-[_|Values]
 233         ->  (   Values = []
 234             ->  setarg(Index,Table,_),
 235                 NewLoad is Load - 1
 236             ;   setarg(2,Bucket,Values),
 237                 NewLoad = Load
 238             )
 239         ;   lookup_pair_eq(Bucket,Key,Pair)
 240         ->  Pair = _-[_|Values],
 241             (   Values = []
 242             ->  pairlist_delete_eq(Bucket,Key,NewBucket),
 243                 (   NewBucket = []
 244                 ->  setarg(Index,Table,_)
 245                 ;   NewBucket = [OtherPair]
 246                 ->  setarg(Index,Table,OtherPair)
 247                 ;   setarg(Index,Table,NewBucket)
 248                 ),
 249                 NewLoad is Load - 1
 250             ;   setarg(2,Pair,Values),
 251                 NewLoad = Load
 252             )
 253         ).
 254
 255 delete_ht(HT,Key,Value) :-
 256         HT = ht(Capacity,Load,Table),
 257         NLoad is Load - 1,
 258         term_hash(Key,Hash),
 259         Index is (Hash mod Capacity) + 1,
 260         arg(Index,Table,Bucket),
 261         ( /* var(Bucket) ->
 262                 true
 263         ; */ Bucket = _K-Vs ->
 264                 ( /* _K == Key, */
 265                   delete_first_fail(Vs,Value,NVs) ->
 266                         setarg(2,HT,NLoad),
 267                         ( NVs == [] ->
 268                                 setarg(Index,Table,_)
 269                         ;
 270                                 setarg(2,Bucket,NVs)
 271                         )
 272                 ;
 273                         true
 274                 )
 275         ;
 276                 ( lookup_pair_eq(Bucket,Key,Pair),
 277                   Pair = _-Vs,
 278                   delete_first_fail(Vs,Value,NVs) ->
 279                         setarg(2,HT,NLoad),
 280                         ( NVs == [] ->
 281                                 pairlist_delete_eq(Bucket,Key,NBucket),
 282                                 ( NBucket = [Singleton] ->
 283                                         setarg(Index,Table,Singleton)
 284                                 ;
 285                                         setarg(Index,Table,NBucket)
 286                                 )
 287                         ;
 288                                 setarg(2,Pair,NVs)
 289                         )
 290                 ;
 291                         true
 292                 )
 293         ).
 294
 295 delete_first_fail([X | Xs], Y, Zs) :-
 296         ( X == Y ->
 297                 Zs = Xs
 298         ;
 299                 Zs = [X | Zs1],
 300                 delete_first_fail(Xs, Y, Zs1)
 301         ).
 302
 303 delete_ht1(HT,Key,Value,Index) :-
 304         HT = ht(_Capacity,Load,Table),
 305         NLoad is Load - 1,
 306         % term_hash(Key,Hash),
 307         % Index is (Hash mod _Capacity) + 1,
 308         arg(Index,Table,Bucket),
 309         ( /* var(Bucket) ->
 310                 true
 311         ; */ Bucket = _K-Vs ->
 312                 ( /* _K == Key, */
 313                   delete_first_fail(Vs,Value,NVs) ->
 314                         setarg(2,HT,NLoad),
 315                         ( NVs == [] ->
 316                                 setarg(Index,Table,_)
 317                         ;
 318                                 setarg(2,Bucket,NVs)
 319                         )
 320                 ;
 321                         true
 322                 )
 323         ;
 324                 ( lookup_pair_eq(Bucket,Key,Pair),
 325                   Pair = _-Vs,
 326                   delete_first_fail(Vs,Value,NVs) ->
 327                         setarg(2,HT,NLoad),
 328                         ( NVs == [] ->
 329                                 pairlist_delete_eq(Bucket,Key,NBucket),
 330                                 ( NBucket = [Singleton] ->
 331                                         setarg(Index,Table,Singleton)
 332                                 ;
 333                                         setarg(Index,Table,NBucket)
 334                                 )
 335                         ;
 336                                 setarg(2,Pair,NVs)
 337                         )
 338                 ;
 339                         true
 340                 )
 341         ).
 342 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 343 value_ht(HT,Value) :-
 344         HT = ht(Capacity,_,Table),
 345         value_ht(1,Capacity,Table,Value).
 346
 347 value_ht(I,N,Table,Value) :-
 348         I =< N,
 349         arg(I,Table,Bucket),
 350         (
 351                 nonvar(Bucket),
 352                 ( Bucket = _-Vs ->
 353                         true
 354                 ;
 355                         member(_-Vs,Bucket)
 356                 ),
 357                 member(Value,Vs)
 358         ;
 359                 J is I + 1,
 360                 value_ht(J,N,Table,Value)
 361         ).
 362
 363 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 364
 365 expand_ht(HT,NewCapacity) :-
 366         HT = ht(Capacity,_,Table),
 367         NewCapacity is Capacity * 2 + 1,
 368         functor(NewTable,t,NewCapacity),
 369         setarg(1,HT,NewCapacity),
 370         setarg(3,HT,NewTable),
 371         expand_copy(Table,1,Capacity,NewTable,NewCapacity).
 372
 373 expand_copy(Table,I,N,NewTable,NewCapacity) :-
 374         ( I > N ->
 375                 true
 376         ;
 377                 arg(I,Table,Bucket),
 378                 ( var(Bucket) ->
 379                         true
 380                 ; Bucket = Key - Value ->
 381                         expand_insert(NewTable,NewCapacity,Key,Value)
 382                 ;
 383                         expand_inserts(Bucket,NewTable,NewCapacity)
 384                 ),
 385                 J is I + 1,
 386                 expand_copy(Table,J,N,NewTable,NewCapacity)
 387         ).
 388
 389 expand_inserts([],_,_).
 390 expand_inserts([K-V|R],Table,Capacity) :-
 391         expand_insert(Table,Capacity,K,V),
 392         expand_inserts(R,Table,Capacity).
 393
 394 expand_insert(Table,Capacity,K,V) :-
 395         term_hash(K,Hash),
 396         Index is (Hash mod Capacity) + 1,
 397         arg(Index,Table,Bucket),
 398         ( var(Bucket) ->
 399                 Bucket = K - V
 400         ; Bucket = _-_ ->
 401                 setarg(Index,Table,[K-V,Bucket])
 402         ;
 403                 setarg(Index,Table,[K-V|Bucket])
 404         ).
 405 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 406 stats_ht(HT) :-
 407         HT = ht(Capacity,Load,Table),
 408         format('HT load = ~w / ~w\n',[Load,Capacity]),
 409         ( between(1,Capacity,Index),
 410                 arg(Index,Table,Entry),
 411                 ( var(Entry)  -> Size = 0
 412                 ; Entry = _-_ -> Size = 1
 413                 ; length(Entry,Size)
 414                 ),
 415                 format('~w : ~w\n',[Index,Size]),
 416                 fail
 417         ;
 418                 true
 419         ).