buckets.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
-------------------------> GNU Sather - sourcefile <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute and/or modify it under the terms of the GNU Library General --
-- Public License (LGPL) as published by the Free Software Foundation; --
-- either version 2 of the license, or (at your option) any later version. --
-- This library is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details. --
-- The license text is also available from: Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --
--------------> Please email comments to <bug-sather@gnu.org> <--------------
abstract class $BUCKET{ELT,ME < $BUCKET{ELT,ME}} < $NEXT{ME}
abstract class $BUCKET{ELT,ME < $BUCKET{ELT,ME}} < $NEXT{ME} is
-- This abstract class models all of the common abstraction of
-- a bucket as used in hash tables.
-- Version 1.1 Apr 97. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 17 Jun 94 hk Original
-- 3 Apr 97 kh Changed style for commonality
item : ELT ;
--This is the actual contents
copy_list : SAME ;
--This returns a copy of self and all following links.
list! : SAME ;
--This iter produces the contents of the bucket one element at a time.
end; -- $BUCKET{ELT,ME}
class BUCKET{ELT} < $BUCKET{ELT,BUCKET{ELT}}
class BUCKET{ELT} < $BUCKET{ELT,BUCKET{ELT}} is
-- This class contains bucket constructors and permits the addition of
-- a linked element.
-- Version 1.2 Nov 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 17 Jun 94 hk Original
-- 3 Apr 97 kh Changed to CARD from INT
-- 6 Nov 98 kh Refined, added pre/post conditions
include NEXT{SAME} ;
attr item : ELT ;
create(elem : ELT) : SAME is
--This routine creates a new link containing the given element.
me : SAME := new ;
me.item := elem ;
return me
end ;
create(elem : ELT, next : SAME) : SAME is
--This routine creates a new link containing the given element with
-- next linked as the following element. Next may be void.
me : SAME := new ;
me.item := elem ;
me.next := next ;
return me
end ;
copy_list : SAME
pre true
post (void(self)and void(result))
or ~void(result)
is
-- This routine calls itself recursively to return a copy of self and
-- all following links. The following links are NOT copied.
if void(self) then
return void
end ;
return create(item,next.copy_list)
end ;
list! : SAME
pre true
post ~void(result) -- otherwise it quits!
is
--This iter yields self and all following elements in sequence.
res : SAME := self ;
loop
until!(void(res)) ;
yield res ;
res := res.next
end
end ;
end ; -- BUCKET{ELT}
class DATABUCKET{K,ELT} < $BUCKET{K,DATABUCKET{K,ELT}}
class DATABUCKET{K,ELT} < $BUCKET{K,DATABUCKET{K,ELT}} is
-- This bucket class adds a data component in addition to the key itself.
-- Version 1.2 Nov 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 17 Jun 94 hk Original
-- 3 Apr 97 kh Changed to CARD from INT
-- 6 Nov 98 kh Refined, added pre/post conditions
include NEXT{SAME} ;
attr item : K ;
attr data : ELT ;
create( key : K) : SAME is
--This routine creates a new list with a key but void data.
me : SAME := new ;
me.item := key ;
return me
end ;
create(key : K, elem : ELT) : SAME is
--This routine creates a bucket with both key and data present.
me : SAME := new ;
me.item := key ;
me.data := elem ;
return me
end ;
create(key : K, elem : ELT, next : SAME) : SAME is
--This routine creates a new bucket from the given key and data and
-- then attaches next to it as the following list items. Next may be void.
me : SAME := new ;
me.item := key ;
me.data := elem ;
me.next := next ;
return me
end ;
copy_list : SAME
pre true
post (void(self) and void(result))
or ~void(result)
is
--This routine creates a copy of self and attaches to it a copy of next.
if void(self) then
return void
end ;
return create(item,data,next.copy_list)
end ;
list! : SAME
pre true
post ~void(result) -- otherwise it quits!
is
--This iter yields self and all subsequent items in the bucket in sequence.
res : SAME := self ;
loop
until!(void(res)) ;
yield res ;
res := res.next
end
end ;
end ; -- DATABUCKET{K,ELT}
class DYNAMIC_BUCKET_TABLE{ELT,BKT < $BUCKET{ELT,BKT}}
class DYNAMIC_BUCKET_TABLE{ELT,BKT < $BUCKET{ELT,BKT}} is
--This class implements a hash table using dynamic buckets as described
-- in Per-Ake Larson; Communications of the ACM Vol.31 (1988) P.446-457.
-- The directory/segment structure has been changed in favour of
-- a dymnamically changing array as storage area.
-- Version 1.2 Nov 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 17 Jun 94 hk Original
-- 3 Apr 97 kh Changed to CARD from INT
-- 6 Nov 98 kh Refined, added pre/post conditions.
include COMPARE{ELT}
elt_eq -> elt_key_eq,
elt_hash -> elt_key_hash,
elt_nil -> elt_key_nil,
elt_lt ->,
is_elt_nil -> ;
private const Default_Size : CARD := 16 ;
private shared lower_fill_ratio : FLT := 0.800 ;
private shared upper_fill_ratio : FLT := 1.000 ;
--These two bounds are specified for efficient memory usage. For fast
-- access the ratio between the number of elements and the number of cells
-- should be low. For efficient memory usage the converse is true. Unless
-- the list is really small the ration should be between the above bounds.
private attr store : AREF{BKT} ;
-- The data being stored.
private attr doubles : CARD ;
--The number of times the initial table size has been doubled.
private attr split_pos : CARD ;
--This is the position of the next bucket to split.
private attr bound : CARD ;
--This gives the upper bound for split_pos. Is always initial_size * 2.pow(doubles).
private attr asize : CARD ;
--This is the size of the fraction of store which is currently in use.
-- Array access beyond this bound is illegal.
private attr minsize : CARD ;
--This is the lower bound for the store size.
readonly attr n_inds : CARD ;
--This gives the number of elements (resp. indices) in the table.
create_sized(initial_size : CARD) : SAME
pre initial_size.is_even
post ~void(result) and (result.asize = (initial_size * 2))
is
--This routine creates a hash table with the given size which must not be odd!
me : SAME := new ;
double : CARD := initial_size * 2 ;
me.store := AREF{BKT}::create(double * 2) ;
me.bound := initial_size ;
me.asize := double ;
me.minsize := double ;
return me
end ;
create : SAME is
--This routine creates a new hash table which has a default size if
-- self is void, otherwise half the size of self.
if void(self) then
return create_sized(Default_Size)
end ;
return create_sized(minsize / 2)
end ;
private hash(elem : ELT) : CARD
pre ~void(self)
post true
is
--This private routine returns the index of the bucket in which elem
-- should be stored. It is generated from the element hash value normalized
-- through the actual size of the array.
hash_num,
res : CARD ;
hash_num := elt_key_hash(elem) ;
res := hash_num % bound ;
if res >= split_pos then
return res
end ;
return hash_num % (bound * 2)
end ;
set_bucket(index : CARD, bucket : BKT)
pre index < asize and ~void(self)
post true -- (store[index] = bucket)
is
--This routine stores the given bucket in the array at the given index
-- position, replacing any value previously there.
store[index] := bucket
end ;
bucket(index : CARD) : BKT
pre index < asize and ~void(self)
post true
is
--This routine returns the indexed bucket, which may be void - having
-- not yet been given a value - although, of course, the storage exists.
return store[index]
end ;
map_copy : SAME
pre ~void(self)
post true
is
--This routine returns a copy of self with identical proerties and
-- component values.
res : SAME := new ;
res.store := store.create(store.asize) ;
res.asize := asize ;
res.n_inds := n_inds ;
res.minsize := minsize ;
res.bound := bound ;
res.doubles := doubles ;
res.split_pos := split_pos ;
loop
index : CARD := 0.upto!(asize - 1) ;
res.store[index] := store[index].copy_list
end ;
return res
end ;
--The next group of routines changes the size of the bucket
-- table. They are split into three steps.
-- (1) Splitting the next bucket into two (update_*).
-- (2) Resizing the storage area. (shrink/grow)
-- (3) Using the next storage cell for the new bucket. (update_*)
private grow
pre ~void(self)
post (asize = (initial(asize) + 1)) and store.asize>=asize
is
--This routine increases the size of the array by one, provided it is
-- less than asize. Otherwise a new 'store' which is a factor of two
-- greater than the existing one is created and the existing contents copied into it.
if store.asize = asize then
new_store : AREF{BKT} := store.create(asize * 2) ;
loop
new_store.aset!(store.aelt!)
end ;
store := new_store
end ;
asize := asize + 1;
end ;
private shrink
pre ~void(self)
post store.asize>=asize
and (
(initial(asize) = minsize)
or (store.asize<initial(asize)*2 and asize=initial(asize)-1)
)
is
--This private routine tries to reduce the size of the table. If the
-- size is already at the lower limit then nothing is done. If the size is
-- already less than half the space used then a new half-size store is
-- created and given the contents of the original.
if asize = minsize then -- nothing to do
return
end ;
if store.asize = (asize * 2) then
new_store : AREF{BKT} := store.create(asize) ;
loop
new_store.aset!(store.aelt!)
end ;
store := new_store
end ;
asize := asize - 1
end ;
private update_insert
pre ~void(self)
post true -- and organisation has been improved!
is
-- This routine is the storage update routine associated with inserting
-- a new element into a bucket. It first checks the fill ratio of the hash
-- table, adding a bucket if the ratio is high enough.
if n_inds.flt / (bound + split_pos).flt < upper_fill_ratio then
return
end ;
curr : BKT := bucket(split_pos) ;
prev : BKT := curr ; -- the correct class for prev
prev := void ; -- which is now void!
loop until!(void(curr)) ;
if (elt_key_hash(curr.item) % (bound * 2)) = split_pos then
-- keep in the bucket
prev := curr ;
curr := curr.next
else -- put into new bucket
if void(prev) then -- first one for new bucket
set_bucket(split_pos, curr.next) ;
curr.next(bucket(bound + split_pos)) ;
set_bucket(bound + split_pos,curr) ;
curr := bucket(split_pos)
else
prev.next(curr.next) ;
curr.next(bucket(bound + split_pos)) ;
set_bucket(bound + split_pos,curr) ;
curr := prev.next
end
end
end ;
grow ;
split_pos := split_pos + 1 ;
if split_pos = bound then
split_pos := 0 ;
doubles := doubles + 1 ;
bound := bound * 2
end
end ;
private update_delete
pre ~void(self)
post true -- and organisation has been improved!
is
--This is the version of update associated with deleting an element
-- from the table. It checks the fill ratio of the set, removing a bucket
-- if the ratio is low enough.
if n_inds.flt / (bound + split_pos).flt > lower_fill_ratio then
return
end ;
if split_pos = 0 then
if doubles = 0 then
split_pos := 0
else
doubles := doubles - 1 ;
bound := bound / 2 ;
split_pos := bound - 1
end
else
split_pos := split_pos - 1
end ;
shrink ;
to_merge : BKT := bucket(split_pos) ;
if void(to_merge) then -- get the other bucket
set_bucket(split_pos,bucket(bound + split_pos))
else
to_merge.append(bucket(bound + split_pos))
end ;
set_bucket(bound + split_pos,void)
end ;
end; -- DYNAMIC_BUCKET_TABLE
class DYNAMIC_DATABUCKET_TABLE{K,ELT}
class DYNAMIC_DATABUCKET_TABLE{K,ELT} is
--This class implements a version of a DYNAMIC_BUCKET_TABLE which stores
-- both keys and data seperately in each bucket.
-- Version 1.2 Nov 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 17 Jun 94 hk Original
-- 3 Apr 97 kh Changed to CARD from INT
-- 6 Nov 98 kh Refined, added pre/post conditions.
include DYNAMIC_BUCKET_TABLE{K,DATABUCKET{K,ELT}} ;
private data_nil : ELT is
--This routine provides a 'nil' for the bucket data elements.
elem : ELT ;
typecase elem
when $NIL then
temp : ELT := elem.nil ;
typecase temp
when ELT then
return temp
end
else
return void
end
end ;
map_aset(key : K, elem : ELT)
pre ~void(self)
post true -- and the number of buckets is changed only if elem is new!
is
--This routine overwrites the data if the given key exists, otherwise
-- the bucket chain associated with hash(key) grows.
hash_num : CARD := hash(key) ;
loop
bkt : DATABUCKET{K,ELT} := bucket(hash_num).list! ;
if elt_key_eq(bkt.item,key) then
bkt.data := elem ;
return
end
end ;
set_bucket(hash_num,DATABUCKET{K,ELT}::create(key,elem,bucket(hash_num))) ;
n_inds := n_inds + 1 ;
update_insert
end ;
map_delete(key : K) : ELT
pre ~void(self)
post void(result)
or (result = data_nil)
or (n_inds = initial(n_inds) - 1)
is
--This routine removes an element from the hash table if it is there,
-- otherwise nothing is done.
hash_num : CARD := hash(key) ;
bkt : DATABUCKET{K,ELT} := bucket(hash_num) ;
prev : DATABUCKET{K,ELT} := bkt ; -- force type inference on prev
prev := void ;
loop until!(void(bkt) or elt_key_eq(bkt.item,key)) ;
prev := bkt ;
bkt := bkt.next
end ;
if void(bkt) then
return data_nil
end ;
res : ELT := bkt.data ;
if void(prev) then
set_bucket(hash_num, bkt.next)
else
prev.next(bkt.next)
end ;
n_inds := n_inds - 1 ;
update_delete ;
return res
end ;
map_has_ind(key : K) : BOOL
pre ~void(self)
post true
is
--This predicate returns true if and only if the given key is contained
-- in the hash table.
loop
if elt_key_eq(bucket(hash(key)).list!.item,key) then
return true
end
end ;
return false
end ;
map_aget(key : K) : ELT
pre ~void(self) -- and map_has_ind(key)
is
--This routine returns the element with the given key from the table
-- if it exists, otherwise void. Self may not be void.
loop
bkt : DATABUCKET{K,ELT} := bucket(hash(key)).list! ;
if elt_key_eq(bkt.item,key) then
return bkt.data
end;
end;
return void;
end ;
map_key! : K
pre ~void(self)
post ~void(result)
is
--This iter yields a sequence of all of the keys in the hash table.
loop
bkt : DATABUCKET{K,ELT} := bucket(0.upto!(bound + split_pos - 1)) ;
loop
yield bkt.list!.item
end
end
end ;
map_elt! : ELT
pre ~void(self)
post ~void(result)
is
--This iter yields a sequence of all of the data items in the hash table.
loop
bkt : DATABUCKET{K,ELT} := bucket(0.upto!(bound + split_pos - 1)) ;
loop
yield bkt.list!.data
end
end
end ;
map_pair! : TUP{K,ELT}
pre ~void(self)
post ~void(result)
is
--This iter yields a sequence of key-element tuples from the table.
loop
bkt : DATABUCKET{K,ELT} := bucket(0.upto!(bound + split_pos - 1)) ;
loop
loc_bkt : DATABUCKET{K,ELT} := bkt.list! ;
yield TUP{K,ELT}::create(loc_bkt.item,loc_bkt.data)
end
end
end ;
end ; -- DYNAMIC_DATABUCKET_TABLE