chr_hashtable_store.pl

   1 % author: Tom Schrijvers
   2 % email:  Tom.Schrijvers@cs.kuleuven.ac.be
   3 % copyright: K.U.Leuven, 2004
   4
   5 :- module(chr_hashtable_store,
   6         [ new_ht/1,
   7           lookup_ht/3,
   8           insert_ht/3,
   9           delete_ht/3,
  10           value_ht/2
  11         ]).
  12
  13 :- use_module(pairlist).
  14 :- use_module(hprolog).
  15 :- use_module(library(lists)).
  16
  17 initial_capacity(1).
  18
  19 new_ht(HT) :-
  20         initial_capacity(Capacity),
  21         new_ht(Capacity,HT).
  22
  23 new_ht(Capacity,HT) :-
  24         functor(T1,t,Capacity),
  25         HT = ht(Capacity,0,Table),
  26         Table = T1.
  27
  28 lookup_ht(HT,Key,Values) :-
  29         term_hash(Key,Hash),
  30         HT = ht(Capacity,_,Table),
  31         Index is (Hash mod Capacity) + 1,
  32         arg(Index,Table,Bucket),
  33         nonvar(Bucket),
  34         ( Bucket = K-Vs ->
  35             K == Key,
  36             Values = Vs
  37         ;
  38             lookup_eq(Bucket,Key,Values)
  39         ).
  40
  41 lookup_pair_eq([P | KVs],Key,Pair) :-
  42         P = K-_,
  43         ( K == Key ->
  44                 P = Pair
  45         ;
  46                 lookup_pair_eq(KVs,Key,Pair)
  47         ).
  48
  49 insert_ht(HT,Key,Value) :-
  50         term_hash(Key,Hash),
  51         HT = ht(Capacity0,Load,Table0),
  52         LookupIndex is (Hash mod Capacity0) + 1,
  53         arg(LookupIndex,Table0,LookupBucket),
  54         ( var(LookupBucket) ->
  55                 Inc = yes,
  56                 LookupBucket = Key - [Value]
  57         ; LookupBucket = K-Values ->
  58                 ( K == Key ->
  59                         ( hprolog:memberchk_eq(Value,Values) ->
  60                                 true
  61                         ;
  62                                 Inc = yes,
  63                                 setarg(2,LookupBucket,[Value|Values])
  64                         )
  65                 ;
  66                         Inc = yes,
  67                         setarg(LookupIndex,Table0,[Key-[Value],LookupBucket])
  68                 )
  69         ;
  70                 ( lookup_pair_eq(LookupBucket,Key,Pair) ->
  71                         Pair = _-Values,
  72                         ( hprolog:memberchk_eq(Value,Values) ->
  73                                 true
  74                         ;
  75                                 Inc = yes,
  76                                 setarg(2,Pair,[Value|Values])
  77                         )
  78                 ;
  79                         Inc = yes,
  80                         setarg(LookupIndex,Table0,[Key-[Value]|LookupBucket])
  81                 )
  82         ),
  83         ( Inc == yes ->
  84                 NLoad is Load + 1,
  85                 setarg(2,HT,NLoad),
  86                 ( Load == Capacity0 ->
  87                         expand_ht(HT,_Capacity)
  88                 ;
  89                         true
  90                 )
  91         ;
  92                 true
  93         ).
  94
  95 delete_ht(HT,Key,Value) :-
  96         HT = ht(Capacity,Load,Table),
  97         NLoad is Load - 1,
  98         term_hash(Key,Hash),
  99         Index is (Hash mod Capacity) + 1,
 100         arg(Index,Table,Bucket),
 101         ( var(Bucket) ->
 102                 true
 103         ;
 104                 ( Bucket = K-Vs ->
 105                         ( K == Key,
 106                           delete_first_fail(Vs,Value,NVs) ->
 107                                 setarg(2,HT,NLoad),
 108                                 ( NVs == [] ->
 109                                         setarg(Index,Table,_)
 110                                 ;
 111                                         setarg(2,Bucket,NVs)
 112                                 )
 113                         ;
 114                                 true
 115                         )
 116                 ;
 117                         ( lookup_pair_eq(Bucket,Key,Pair),
 118                           Pair = _-Vs,
 119                           delete_first_fail(Vs,Value,NVs) ->
 120                                 setarg(2,HT,NLoad),
 121                                 ( NVs == [] ->
 122                                         pairlist:delete_eq(Bucket,Key,NBucket),
 123                                         setarg(Index,Table,NBucket)
 124                                 ;
 125                                         setarg(2,Pair,NVs)
 126                                 )
 127                         ;
 128                                 true
 129                         )
 130                 )
 131         ).
 132
 133 delete_first_fail([X | Xs], Y, Zs) :-
 134         ( X == Y ->
 135                 Zs = Xs
 136         ;
 137                 Zs = [X | Zs1],
 138                 delete_first_fail(Xs, Y, Zs1)
 139         ).
 140 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 141 value_ht(HT,Value) :-
 142         HT = ht(Capacity,_,Table),
 143         value_ht(1,Capacity,Table,Value).
 144
 145 value_ht(I,N,Table,Value) :-
 146         I =< N,
 147         arg(I,Table,Bucket),
 148         (
 149                 nonvar(Bucket),
 150                 ( Bucket = _-Vs ->
 151                         true
 152                 ;
 153                         member(_-Vs,Bucket)
 154                 ),
 155                 member(Value,Vs)
 156         ;
 157                 J is I + 1,
 158                 value_ht(J,N,Table,Value)
 159         ).
 160
 161 values_ht(HT,Values) :-
 162         HT = ht(Capacity,_,Table),
 163         values_ht(1,Capacity,Table,Values).
 164 values_ht(I,N,Table,Values) :-
 165         ( I =< N ->
 166                 arg(I,Table,Bucket),
 167                 ( nonvar(Bucket) ->
 168                         ( Bucket = _-Vs ->
 169                                 append(Vs,Tail,Values)
 170                         ;
 171                                 append_snd(Bucket,Tail,Values)
 172                         )
 173                 ;
 174                         Values = Tail
 175                 ),
 176                 J is I + 1,
 177                 values_ht(J,N,Table,Tail)
 178         ;
 179                 Values = []
 180         ).
 181
 182 append_snd([],L,L).
 183 append_snd([_-H|Ps],L,NL) :-
 184         append(H,T,NL),
 185         append_snd(Ps,L,T).
 186 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 187
 188 expand_ht(HT,NewCapacity) :-
 189         HT = ht(Capacity,_,Table),
 190         NewCapacity is Capacity * 2,
 191         functor(NewTable,t,NewCapacity),
 192         setarg(1,HT,NewCapacity),
 193         setarg(3,HT,NewTable),
 194         expand_copy(Table,1,Capacity,NewTable,NewCapacity).
 195
 196 expand_copy(Table,I,N,NewTable,NewCapacity) :-
 197         ( I > N ->
 198                 true
 199         ;
 200                 arg(I,Table,Bucket),
 201                 ( var(Bucket) ->
 202                         true
 203                 ; Bucket = Key - Value ->
 204                         expand_insert(NewTable,NewCapacity,Key,Value)
 205                 ;
 206                         expand_inserts(Bucket,NewTable,NewCapacity)
 207                 ),
 208                 J is I + 1,
 209                 expand_copy(Table,J,N,NewTable,NewCapacity)
 210         ).
 211
 212 expand_inserts([],_,_).
 213 expand_inserts([K-V|R],Table,Capacity) :-
 214         expand_insert(Table,Capacity,K,V),
 215         expand_inserts(R,Table,Capacity).
 216
 217 expand_insert(Table,Capacity,K,V) :-
 218         term_hash(K,Hash),
 219         Index is (Hash mod Capacity) + 1,
 220         arg(Index,Table,Bucket),
 221         ( var(Bucket) ->
 222                 Bucket = K - V
 223         ; Bucket = _-_ ->
 224                 setarg(Index,Table,[K-V,Bucket])
 225         ;
 226                 setarg(Index,Table,[K-V|Bucket])
 227         ).
 228 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 229 term_hash(Term,Hash) :-
 230         hash_term(Term,Hash).
 231