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