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