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           insert_ht/3,
  39           insert_ht/4,
  40           delete_ht/3,
  41           delete_first_ht/3,
  42           value_ht/2
  43         ]).
  44
  45 :- use_module(pairlist).
  46 :- use_module(hprolog).
  47 :- use_module(library(lists)).
  48
  49 :- multifile user:goal_expansion/2.
  50 :- dynamic user:goal_expansion/2.
  51
  52 user:goal_expansion(term_hash(Term,Hash),hash_term(Term,Hash)).
  53
  54 % term_hash(Term,Hash) :-
  55 %       hash_term(Term,Hash).
  56 initial_capacity(1).
  57
  58 new_ht(HT) :-
  59         initial_capacity(Capacity),
  60         new_ht(Capacity,HT).
  61
  62 new_ht(Capacity,HT) :-
  63         functor(T1,t,Capacity),
  64         HT = ht(Capacity,0,Table),
  65         Table = T1.
  66
  67 lookup_ht(HT,Key,Values) :-
  68         term_hash(Key,Hash),
  69         HT = ht(Capacity,_,Table),
  70         Index is (Hash mod Capacity) + 1,
  71         arg(Index,Table,Bucket),
  72         nonvar(Bucket),
  73         ( Bucket = K-Vs ->
  74             K == Key,
  75             Values = Vs
  76         ;
  77             lookup(Bucket,Key,Values)
  78         ).
  79
  80 lookup_pair_eq([P | KVs],Key,Pair) :-
  81         P = K-_,
  82         ( K == Key ->
  83                 P = Pair
  84         ;
  85                 lookup_pair_eq(KVs,Key,Pair)
  86         ).
  87
  88 insert_ht(HT,Key,Value) :-
  89         term_hash(Key,Hash),
  90         HT = ht(Capacity0,Load,Table0),
  91         LookupIndex is (Hash mod Capacity0) + 1,
  92         arg(LookupIndex,Table0,LookupBucket),
  93         ( var(LookupBucket) ->
  94                 LookupBucket = Key - [Value]
  95         ; LookupBucket = K-Values ->
  96                 ( K == Key ->
  97                         setarg(2,LookupBucket,[Value|Values])
  98                 ;
  99                         setarg(LookupIndex,Table0,[Key-[Value],LookupBucket])
 100                 )
 101         ;
 102                 ( lookup_pair_eq(LookupBucket,Key,Pair) ->
 103                         Pair = _-Values,
 104                         setarg(2,Pair,[Value|Values])
 105                 ;
 106                         setarg(LookupIndex,Table0,[Key-[Value]|LookupBucket])
 107                 )
 108         ),
 109         NLoad is Load + 1,
 110         setarg(2,HT,NLoad),
 111         ( Load == Capacity0 ->
 112                 expand_ht(HT,_Capacity)
 113         ;
 114                 true
 115         ).
 116
 117 % LDK: insert version with extra argument denoting result
 118
 119 insert_ht(HT,Key,Value,Result) :-
 120         HT = ht(Capacity,Load,Table),
 121         term_hash(Key,Hash),
 122         LookupIndex is (Hash mod Capacity) + 1,
 123         arg(LookupIndex,Table,LookupBucket),
 124         (   var(LookupBucket)
 125         ->  Result = [Value],
 126             LookupBucket = Key - Result,
 127             NewLoad is Load + 1
 128         ;   LookupBucket = K - V
 129         ->  (   K = Key
 130             ->  Result = [Value|V],
 131                 setarg(2,LookupBucket,Result),
 132                 NewLoad = Load
 133             ;   Result = [Value],
 134                 setarg(LookupIndex,Table,[Key - Result,LookupBucket]),
 135                 NewLoad is Load + 1
 136             )
 137         ;   (   lookup_pair_eq(LookupBucket,Key,Pair)
 138             ->  Pair = _-Values,
 139                 Result = [Value|Values],
 140                 setarg(2,Pair,Result),
 141                 NewLoad = Load
 142             ;   Result = [Value],
 143                 setarg(LookupIndex,Table,[Key - Result|LookupBucket]),
 144                 NewLoad is Load + 1
 145             )
 146         ),
 147         setarg(2,HT,NewLoad),
 148         (   NewLoad > Capacity
 149         ->  expand_ht(HT,_)
 150         ;   true
 151         ).
 152
 153 % LDK: deletion of the first element of a bucket
 154 delete_first_ht(HT,Key,Values) :-
 155         HT = ht(Capacity,Load,Table),
 156         term_hash(Key,Hash),
 157         Index is (Hash mod Capacity) + 1,
 158         arg(Index,Table,Bucket),
 159         (   Bucket = _-[_|Values]
 160         ->  (   Values = []
 161             ->  setarg(Index,Table,_),
 162                 NewLoad is Load - 1
 163             ;   setarg(2,Bucket,Values),
 164                 NewLoad = Load
 165             )
 166         ;   lookup_pair_eq(Bucket,Key,Pair)
 167         ->  Pair = _-[_|Values],
 168             (   Values = []
 169             ->  pairlist_delete_eq(Bucket,Key,NewBucket),
 170                 (   NewBucket = []
 171                 ->  setarg(Index,Table,_)
 172                 ;   NewBucket = [OtherPair]
 173                 ->  setarg(Index,Table,OtherPair)
 174                 ;   setarg(Index,Table,NewBucket)
 175                 ),
 176                 NewLoad is Load - 1
 177             ;   setarg(2,Pair,Values),
 178                 NewLoad = Load
 179             )
 180         ).
 181
 182 delete_ht(HT,Key,Value) :-
 183         HT = ht(Capacity,Load,Table),
 184         NLoad is Load - 1,
 185         term_hash(Key,Hash),
 186         Index is (Hash mod Capacity) + 1,
 187         arg(Index,Table,Bucket),
 188         ( var(Bucket) ->
 189                 true
 190         ;
 191                 ( Bucket = K-Vs ->
 192                         ( K == Key,
 193                           delete_first_fail(Vs,Value,NVs) ->
 194                                 setarg(2,HT,NLoad),
 195                                 ( NVs == [] ->
 196                                         setarg(Index,Table,_)
 197                                 ;
 198                                         setarg(2,Bucket,NVs)
 199                                 )
 200                         ;
 201                                 true
 202                         )
 203                 ;
 204                         ( lookup_pair_eq(Bucket,Key,Pair),
 205                           Pair = _-Vs,
 206                           delete_first_fail(Vs,Value,NVs) ->
 207                                 setarg(2,HT,NLoad),
 208                                 ( NVs == [] ->
 209                                         pairlist_delete_eq(Bucket,Key,NBucket),
 210                                         ( NBucket = [Singleton] ->
 211                                                 setarg(Index,Table,Singleton)
 212                                         ;
 213                                                 setarg(Index,Table,NBucket)
 214                                         )
 215                                 ;
 216                                         setarg(2,Pair,NVs)
 217                                 )
 218                         ;
 219                                 true
 220                         )
 221                 )
 222         ).
 223
 224 delete_first_fail([X | Xs], Y, Zs) :-
 225         ( X == Y ->
 226                 Zs = Xs
 227         ;
 228                 Zs = [X | Zs1],
 229                 delete_first_fail(Xs, Y, Zs1)
 230         ).
 231 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 232 value_ht(HT,Value) :-
 233         HT = ht(Capacity,_,Table),
 234         value_ht(1,Capacity,Table,Value).
 235
 236 value_ht(I,N,Table,Value) :-
 237         I =< N,
 238         arg(I,Table,Bucket),
 239         (
 240                 nonvar(Bucket),
 241                 ( Bucket = _-Vs ->
 242                         true
 243                 ;
 244                         member(_-Vs,Bucket)
 245                 ),
 246                 member(Value,Vs)
 247         ;
 248                 J is I + 1,
 249                 value_ht(J,N,Table,Value)
 250         ).
 251
 252 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 253
 254 expand_ht(HT,NewCapacity) :-
 255         HT = ht(Capacity,_,Table),
 256         NewCapacity is Capacity * 2,
 257         functor(NewTable,t,NewCapacity),
 258         setarg(1,HT,NewCapacity),
 259         setarg(3,HT,NewTable),
 260         expand_copy(Table,1,Capacity,NewTable,NewCapacity).
 261
 262 expand_copy(Table,I,N,NewTable,NewCapacity) :-
 263         ( I > N ->
 264                 true
 265         ;
 266                 arg(I,Table,Bucket),
 267                 ( var(Bucket) ->
 268                         true
 269                 ; Bucket = Key - Value ->
 270                         expand_insert(NewTable,NewCapacity,Key,Value)
 271                 ;
 272                         expand_inserts(Bucket,NewTable,NewCapacity)
 273                 ),
 274                 J is I + 1,
 275                 expand_copy(Table,J,N,NewTable,NewCapacity)
 276         ).
 277
 278 expand_inserts([],_,_).
 279 expand_inserts([K-V|R],Table,Capacity) :-
 280         expand_insert(Table,Capacity,K,V),
 281         expand_inserts(R,Table,Capacity).
 282
 283 expand_insert(Table,Capacity,K,V) :-
 284         term_hash(K,Hash),
 285         Index is (Hash mod Capacity) + 1,
 286         arg(Index,Table,Bucket),
 287         ( var(Bucket) ->
 288                 Bucket = K - V
 289         ; Bucket = _-_ ->
 290                 setarg(Index,Table,[K-V,Bucket])
 291         ;
 292                 setarg(Index,Table,[K-V|Bucket])
 293         ).
 294 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 295