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,Term,Values) :-
  29         term_hash(Term,Hash),
  30         int_lookup_ht(HT,Hash,Term,Values).
  31
  32 int_lookup_ht(HT,Hash,Key,Values) :-
  33         HT = ht(Capacity,_,Table),
  34         Index is (Hash mod Capacity) + 1,
  35         arg(Index,Table,Bucket),
  36         nonvar(Bucket),
  37         ( Bucket = K-Vs,
  38           K == Key ->
  39             Values = Vs
  40         ;
  41             lookup_eq(Bucket,Key,Values)
  42         ).
  43
  44 insert_ht(HT,Term,Value) :-
  45         term_hash(Term,Hash),
  46         ( int_lookup_ht(HT,Hash,Term,Values),
  47           hprolog:memberchk_eq(Value,Values) ->
  48                 true
  49         ;
  50                 int_insert_ht(HT,Hash,Term,Value)
  51         ).
  52
  53 int_insert_ht(HT,Hash,Key,Value) :-
  54         HT = ht(Capacity0,Load,Table0),
  55         ( Load ==  Capacity0 ->
  56                 expand_ht(HT),
  57                 arg(3,HT,Table),
  58                 Capacity is Capacity0 * 2
  59         ;
  60                 Table = Table0,
  61                 Capacity = Capacity0
  62         ),
  63         NLoad is Load + 1,
  64         setarg(2,HT,NLoad),
  65         Index is (Hash mod Capacity) + 1,
  66         arg(Index,Table,Bucket),
  67         ( var(Bucket) ->
  68                 Bucket = Key-[Value]
  69         ; Bucket = K-Vs ->
  70                 ( K == Key ->
  71                         setarg(2,Bucket,[Value|Vs])
  72                 ;
  73                         setarg(Index,Table,[Key-[Value],Bucket])
  74                 )
  75         ; lookup_pair_eq(Bucket,Key,Pair) ->
  76                 Pair = _-Vs,
  77                 setarg(2,Pair,[Value|Vs])
  78         ;
  79                 setarg(Index,Table,[Key-[Value]|Bucket])
  80         ).
  81
  82
  83 lookup_pair_eq([P | KVs],Key,Pair) :-
  84         P = K-_,
  85         ( K == Key ->
  86                 P = Pair
  87         ;
  88                 lookup_pair_eq(KVs,Key,Pair)
  89         ).
  90
  91 delete_ht(HT,Term,Value) :-
  92         term_hash(Term,Hash),
  93         ( int_lookup_ht(HT,Hash,Term,Values),
  94           hprolog:memberchk_eq(Value,Values) ->
  95                 int_delete_ht(HT,Hash,Term,Value)
  96         ;
  97                 true
  98         ).
  99
 100 int_delete_ht(HT,Hash,Key,Value) :-
 101         HT = ht(Capacity,Load,Table),
 102         NLoad is Load - 1,
 103         setarg(2,HT,NLoad),
 104         Index is (Hash mod Capacity) + 1,
 105         arg(Index,Table,Bucket),
 106         ( Bucket = _-Vs ->
 107                 delete(Vs,Value,NVs),
 108                 ( NVs == [] ->
 109                         setarg(Index,Table,_)
 110                 ;
 111                         setarg(2,Bucket,NVs)
 112                 )
 113         ;
 114                 lookup_pair_eq(Bucket,Key,Pair),
 115                 Pair = _-Vs,
 116                 delete(Vs,Value,NVs),
 117                 ( NVs == [] ->
 118                         pairlist:delete_eq(Bucket,Key,NBucket),
 119                         setarg(Index,Table,NBucket)
 120                 ;
 121                         setarg(2,Pair,NVs)
 122                 )
 123         ).
 124
 125 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 126 value_ht(HT,Value) :-
 127         HT = ht(Capacity,_,Table),
 128         value_ht(1,Capacity,Table,Value).
 129
 130 value_ht(I,N,Table,Value) :-
 131         I =< N,
 132         arg(I,Table,Bucket),
 133         (
 134                 nonvar(Bucket),
 135                 ( Bucket = _-Vs ->
 136                         true
 137                 ;
 138                         member(_-Vs,Bucket)
 139                 ),
 140                 member(Value,Vs)
 141         ;
 142                 J is I + 1,
 143                 value_ht(J,N,Table,Value)
 144         ).
 145
 146 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 147
 148 expand_ht(HT) :-
 149         HT = ht(Capacity,_,Table),
 150         NewCapacity is Capacity * 2,
 151         functor(NewTable,t,NewCapacity),
 152         setarg(1,HT,NewCapacity),
 153         setarg(3,HT,NewTable),
 154         expand_copy(Table,1,Capacity,NewTable,NewCapacity).
 155
 156 expand_copy(Table,I,N,NewTable,NewCapacity) :-
 157         ( I > N ->
 158                 true
 159         ;
 160                 arg(I,Table,Bucket),
 161                 ( var(Bucket) ->
 162                         true
 163                 ; Bucket = Key - Value ->
 164                         expand_insert(NewTable,NewCapacity,Key,Value)
 165                 ;
 166                         expand_inserts(Bucket,NewTable,NewCapacity)
 167                 ),
 168                 J is I + 1,
 169                 expand_copy(Table,J,N,NewTable,NewCapacity)
 170         ).
 171
 172 expand_inserts([],_,_).
 173 expand_inserts([K-V|R],Table,Capacity) :-
 174         expand_insert(Table,Capacity,K,V),
 175         expand_inserts(R,Table,Capacity).
 176
 177 expand_insert(Table,Capacity,K,V) :-
 178         term_hash(K,Hash),
 179         Index is (Hash mod Capacity) + 1,
 180         arg(Index,Table,Bucket),
 181         ( var(Bucket) ->
 182                 Bucket = K - V
 183         ; Bucket = _-_ ->
 184                 setarg(Index,Table,[K-V,Bucket])
 185         ;
 186                 setarg(Index,Table,[K-V|Bucket])
 187         ).
 188 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 189 term_hash(Term,Hash) :-
 190         hash_term(Term,Hash).
 191
 192
 193 chr_delete([], _, []).
 194 chr_delete([H|T], X, L) :-
 195         (   H==X ->
 196             chr_delete(T, X, L)
 197         ;   L=[H|RT],
 198             chr_delete(T, X, RT)
 199         ).