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