fset.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>  <--------------


class FSET{T} < $COPY

class FSET{T} < $COPY is -- This is a fast version of the set implementation which provide -- a hashed array based set of objects of type T requiring writebacks. -- The set grows by amortized doubling and so requires writeback -- when inserting and deleting elements. The load factor is kept down to -- cut down on collision snowballing. Simple collision resolution allows -- the implementation to support deletions, but makes the behaviour with -- poor hash functions quadratic. A sentinel is placed at the end of -- the table to avoid one check while searching! -- If T is a subtype of $NIL, then `nil' may not be an element, otherwise -- the type's default value may not be an element. -- If T is a subtype of $IS_EQ, then `is_eq' will be used for element -- equality (eg. string equality for STR), otherwise object equality is used. -- If T is a subtype of $HASH, then `hash' will be used for the hash -- value, otherwise the element `id' will be used. -- NOTE This class may be inherited with `elt_eq', `elt_nil', and `elt_hash' -- redefined to get a different behaviour. -- Version 1.2 Nov 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 11 Apr 94 bg Original -- 26 Mar 97 kh Changed to CARD from INT -- 11 Nov 98 kh Revised, added pre/post conditions. include AREF{T} ; include CONTAINER{T} ; ind!:CARD is loop yield aind!; end; end; private const use_map_initially : BOOL := false ; -- This indicates whether the data structure should start out with -- a map or not. private const switch_structures : BOOL := true ; -- This indicates whether the data structure should switch after -- the first allocation. private attr hsize : CARD ; -- Number of stored entries readonly attr use_map : BOOL ; -- True if using space as a map private const default_initial_size : CARD := 5 ; private const load_ratio : CARD := 4; -- Allow at most 1/load_ratio full private const Over_Run : CARD := 50 ; private const Max_Gap : CARD := (Over_Run / 3).next_exp2 * 2 + 1 ; private const Min_Elements : CARD := (Over_Run / 3).next_exp2 + 1 ; create : SAME is -- This is the primitive creation routine which returns void. return void end ; private allocate( cnt : CARD ) : SAME pre (cnt = 0) -- special case - empty set! or ((cnt - 1).next_exp2 = (cnt - 1)) post ~void(result) is -- This private routine returns a set of cnt locations (where cnt -- must be a power of two plus one. Elements are initialised to elt_nil. res : SAME := new(cnt) ; if ~void(elt_nil) then loop res.aset!(elt_nil) end end ; return res end ; private set_initial_structure is -- This private routine sets the map use attribute from the initial -- constant value. use_map := use_map_initially end ; create( cnt : CARD ) : SAME pre true post ~void(result) is -- This routine creates a new set capable of having cnt elements -- without expansion. me : SAME ; if cnt = 0 then -- empty set wanted! me := allocate(0) else me := allocate((3 * load_ratio * cnt/4).next_exp2 + 1) end ; me.set_initial_structure ; return me end ; create_from( arr : $CONTAINER{T} ) : SAME pre ~void(arr) post (result.asize = arr.size) is -- This routine creates a new set which is given the contents of -- the argument array. res : SAME := create(arr.size) ; loop res := res.insert(arr.elt!) end ; return res end ; create( arr : ARRAY{T} ) : SAME pre ~void(arr) post (result.asize = arr.size) is -- This routine creates and returns a new set which contains the -- elements in arr. return create_from(arr) end ; copy : SAME pre ~void(self) post true -- (result = self) is -- This routine returns a new copy of self. res : SAME ; loop res := res.insert(elt!) end ; return res end ; is_empty : BOOL is -- This predicate returns true if and only if the set is empty. Self -- may be void. return (void(self)) or (hsize = 0) end ; private test_map( elem : T ) : BOOL is -- This private predicate tests for the presence of elem in self when -- the structure in use is a map. True is returned if and only if elem -- has been found. hash_num : CARD := NUM_BITS::create(elt_hash(elem)).bit_and( NUM_BITS::create(asize - 2)).card ; loop temp_elem : T := [hash_num] ; if is_elt_nil(temp_elem) then break! elsif elt_eq(temp_elem,elem) then return true end ; hash_num := hash_num + 1 end ; if hash_num = (asize - 1) then -- found sentinel hash_num := 0 ; loop temp_elem : T := [hash_num] ; if is_elt_nil(temp_elem) then break! elsif elt_eq(temp_elem,elem) then return true end ; hash_num := hash_num + 1 end ; assert hash_num /= (asize - 1) -- table mustn't be filled end ; return false end ; private test_list( elem : T ) : BOOL is -- This private predicate tests for the presence of elem in self when -- the structure in use is a list. True is returned if and only if elem -- has been found. index : CARD := 0 ; sz : CARD := hsize ; loop until!(index = sz) ; if elt_eq(elem,[index]) then return true end ; index := index + 1 end ; return false end ; test( elem : T ) : BOOL is -- This predicate returns true if elem is elt_eq to any element of self. if void(self) then return false end ; if use_map then return test_map(elem) else return test_list(elem) end end ; contains( elem : T ) : BOOL is -- This predicate is a synonym for test. return test(elem) end ; equals( other : SAME ) : BOOL is -- This predicate returns true if and only if self and other have the -- same elements. loop if ~other.test(elt!) then return false end end ; loop if ~test(other.elt!) then return false end end ; return true end ; is_disjoint_from( other : SAME ) : BOOL is -- This predicate returns true if and only if self and other have no -- elements in common. loop if other.test(elt!) then return false end end ; return true end ; intersects( other : SAME ) : BOOL is -- This predicate returns true if and only if self and other have at -- least one element in common. return ~is_disjoint_from(other) end ; is_subset( other : SAME ) : BOOL is -- This routine returns true if and only if all of the elements of self -- are contained in other. loop if ~other.test(elt!) then return false end end ; return true end ; size : CARD pre true post (void(self) and (result = 0)) or (result = hsize) is -- This routine returns the number of elements in the set. Self may -- be void. if void(self) then return 0 else return hsize end end ; first_elt : T pre true post contains(result) or is_elt_nil(result) is -- This routine returns the first element in the set if any, otherwise -- elt_nil. if ~void(self) then if use_map then loop res : T := aelt! ; if ~is_elt_nil(res) then return res end end elsif hsize > 0 then return [0] end end ; return elt_nil end ; private switch_structure( is_old_map : BOOL, is_new_map : BOOL ) pre ~void(self) post (switch_structures and (use_map = is_new_map)) or (use_map = is_old_map) is -- This routine changes the map/list property according to the -- parameter values given. if switch_structures then use_map := is_new_map else use_map := is_old_map end end ; private get_list( elem : T ) : T pre ~void(self) post elt_eq(result,elem) or is_elt_nil(result) is -- This private routine implements retrieval of an element from a list -- structure. index : CARD := 0 ; sz : CARD := hsize ; loop until!(index = sz) ; if elt_eq(elem,[index]) then return [index] end ; index := index + 1 end ; return elt_nil end ; private get_map( elem : T ) : T pre ~void(self) post elt_eq(result,elem) or is_elt_nil(result) is -- This routine implements the retrieval of an element from the map -- verson of the set structure. hash_num : CARD := NUM_BITS::create(elt_hash(elem)).bit_and( NUM_BITS::create(asize - 2)).card ; loop temp : T := [hash_num] ; if is_elt_nil(temp) then break! elsif elt_eq(temp,elem) then return temp end ; hash_num := hash_num + 1 end ; if hash_num = asize - 1 then -- found the sentinal! hash_num := 0 ; loop temp : T := [hash_num] ; if is_elt_nil(temp) then break! elsif elt_eq(temp,elem) then return temp end ; hash_num := hash_num + 1 end ; assert hash_num /= (asize - 1) -- table mustn't be filled end ; return elt_nil end ; get( elem : T ) : T pre true post (void(self) and is_elt_nil(result)) or (use_map and (result = get_map(elem))) or (result = get_list(elem)) is -- This routine returns the set member which is elt_eq to elem if there -- is one, otherwise elt_nil is returned. if void(self) then return elt_nil end ; if use_map then return get_map(elem) else return get_list(elem) end end ; private double_size : SAME pre ~void(self) post (result.asize = Min_Elements) or (result.asize >= ((initial(asize) - 1) * 2 + 1)) is -- This private routine returns a new set which is twice the size of -- self, containing copies of the elements in self. Note that this routine -- may be called recursively - which leads to the inequality in the post -- condition. new_size : CARD ; if asize = 0 then new_size := Min_Elements else new_size := (asize - 1) * 2 + 1 end ; res : SAME := allocate(new_size) ; res.switch_structure(use_map,true) ; assert changed_map(self,res) ; loop assert test(elt!) ; res := res.insert(elt!) end ; SYS::destroy(self) ; -- old set should not be used now. return res end ; changed_map( old_map, new_map : SAME ) : BOOL is -- This predicate trivially returns true. Variants of this may be of -- use when debugging! return true end ; private grow_if_necessary : SAME pre ~void(self) post true -- (result = self) -- or (result.size = ((initial(asize) - 1) * 2 + 1)) is -- This private routine returns a new map if it needs enlarging, -- otherwise it returns self. if use_map then if ((hsize + 1) * load_ratio) > asize then return double_size else return self end else -- Still using list if hsize >= asize then return double_size -- growing causes a transition else return self end end end ; private insert_list( res : SAME, elem : T ) : SAME pre ~void(res) post result.contains(elem) is -- This routine returns a possibly new set which has the same contents -- as self with the exception that either a new element elem has been added -- or an element which was originally elt_eq to elem is now elem! index : CARD := 0 ; sz : CARD := res.hsize ; loop -- Check for existing element first until!(index = sz) ; if elt_eq(elem,res[index]) then res[index] := elem ; return res end ; index := index + 1 end ; -- Otherwise insert into the last position res[res.hsize] := elem ; res.hsize := res.hsize + 1 ; return res end ; private not_too_many( start, finish : CARD ) : BOOL is -- This routine is a debugging aid. It checks that serious performance -- degradation is not happening because of bad hashing. If problems arise, -- this routine should have appropriate debug writes added in order to help -- diagnose the problem! return (finish <= start + Over_Run) end ; private insert_hash( res : SAME, elem : T ) : SAME pre ~void(res) post result.contains(elem) is -- This private routine implements the map hashing version of set element -- insertion. asz : CARD := res.asize ; orig_hash : CARD := NUM_BITS::create(elt_hash(elem)).bit_and( NUM_BITS::create(asz - 2)).card ; hash_num : CARD := orig_hash ; loop temp : T := res[hash_num] ; if is_elt_nil(temp) then break! elsif elt_eq(temp,elem) then res[hash_num] := elem ; return res end ; hash_num := hash_num + 1 end ; if hash_num =asz - 1 then -- sentinel found hash_num := 0 ; loop temp : T := res[hash_num] ; if is_elt_nil(temp) then break! elsif elt_eq(temp,elem) then res[hash_num] := elem ; return res end ; hash_num := hash_num + 1 end ; assert hash_num /= (asz - 1) -- set must noy be full! end ; assert not_too_many(orig_hash,hash_num) ; -- excessive collisions? res[hash_num] := elem ; res.hsize := res.hsize + 1 ; return res end ; insert( elem : T ) : SAME pre true post result.contains(elem) is -- This routine returns a possibly new set containing the value elem. -- If an entry is elt_eq to elem then it is overwritten. Self may be void. res : SAME := self ; if void(res) then -- should never happen?????????? res := allocate(default_initial_size) ; res.set_initial_structure else res := grow_if_necessary end ; if res.use_map then return insert_hash(res,elem) else return insert_list(res,elem) end end ; private halve_size : SAME pre ~void(self) and (hsize < ((asize - 1) / 4)) post void(self) and (result.size <= ((initial(asize) - 1)/2 + 1)) is -- This routine returns a set which has half as many elements as self, -- containing copies of the elements of self. Note the inequality in the -- post condition which arises from the possible (indiret) recursive use. res : SAME := allocate((asize - 1)/2 + 1) ; res.switch_structure(use_map,true) ; loop res := res.insert(elt!) end ; SYS::destroy(self) ; -- old set should not be used now return res end ; private should_shrink : BOOL is -- This predicate returns true if and only if the set should be halved in -- size. return (asize >= Max_Gap) and (hsize < ((asize - 1)/(load_ratio * 2))) end ; private delete_list( elem : T ) : SAME pre ~void(self) post ~result.contains(elem) is -- This routine implements the list version of set element deletion. delete_elt_ind : CARD := CARD::nil ; hash_table_size : CARD := hsize ; index : CARD := 0 ; loop until!(index >= hash_table_size) ; if elt_eq(elem,[index]) then delete_elt_ind := index ; break! end ; index := index + 1 end ; if delete_elt_ind = CARD::nil then -- Isn't there! return self end ; empty_loc : CARD := delete_elt_ind ; second_to_last_index : CARD := hsize - 2 ; loop until!(empty_loc > second_to_last_index) ; next : CARD := empty_loc + 1 ; [empty_loc] := [next] ; empty_loc := next end ; hsize := hsize - 1 ; return self end ; private delete_map( elem : T ) : SAME pre ~void(self) post ~result.contains(elem) is -- This routine implements the map version of set element deletion. hash_num : CARD := NUM_BITS::create(elt_hash(elem)).bit_and( NUM_BITS::create(asize - 2)).card ; loop temp : T := [hash_num] ; if is_elt_nil(temp) then -- not in set! return self elsif elt_eq(temp,elem) then -- found break! end ; if hash_num = asize - 2 then -- sentinel found hash_num := 0 else hash_num := hash_num + 1 end end ; [hash_num] := elt_nil ; hsize := hsize - 1 ; index : CARD := hash_num ; -- hash_num is the index of arg loop -- to check for collisions if index = asize - 2 then index := 0 else index := index + 1 end ; temp : T := [index] ; if is_elt_nil(temp) then -- no collision break! end ; temp_hash : CARD := NUM_BITS::create(elt_hash(elem)).bit_and( NUM_BITS::create(asize - 2)).card ; if temp_hash <= index then -- block doesn't wrap around if hash_num < index and hash_num >= temp_hash then -- hole in the way [hash_num ] := [index] ; hash_num := index ; [index] := elt_nil end else -- block wraps if hash_num >= temp_hash or hash_num < index then -- hole in the way [hash_num] := [index] ; hash_num := index ; [index] := elt_nil end end end ; if should_shrink then return halve_size else return self end end ; delete( elem : T ) : SAME pre true post ~result.contains(elem) is -- This routine returns a possibly new table from which the element -- which is elt_eq to elem has been deleted. Self may be void. if void(self) then return void end ; if use_map then return delete_map(elem) else return delete_list(elem) end end ; clear : SAME pre true post (initial(asize) <= Min_Elements) -- and (result = self) or void(result) is -- This routine clears all of the elements of self which is then an -- empty set (which will be void if the space occupied originally is greater -- than seventeen elements. if void(self) then return void end ; if asize <= Min_Elements then res : SAME := self ; res.hsize := 0 ; loop res.aset!(elt_nil) end ; return res else return void end end ; to_union( other : SAME ) : SAME pre true post (result.size <= (initial(size) + other.size)) -- and contents are the union of self and other is -- This routine returns the set which is the union of self and other. res : SAME := self ; loop res := res.insert(other.elt!) end ; return res end ; union( other : SAME ) : SAME pre true post (result.size <= (size + other.size)) -- and contents are the union of self and other is -- This routine returns the set which is the union of self and other. -- Self may be void. return copy.to_union(other) end ; intersection( other : SAME ) : SAME pre true post (result.size = 0) or ((size > other.size) and (result.size <= other.size)) or ((size <= other.size) and (result.size <= size)) -- and contents are intersection of self and other is -- This routine returns the set which is the intersection of self and -- other. res : SAME := create(0) ; loop elem : T :=elt! ; if other.test(elem) then res := res.insert(elem) end end ; return res end ; to_intersection( other : SAME ) : SAME pre true post (result.size = 0) or ((size > other.size) and (result.size <= other.size)) or ((size <= other.size) and (result.size <= size)) -- and contents are intersection of self and other is -- This routine is a synonym for intersection. return intersection(other) end ; to_diff( other : SAME ) : SAME pre true post (result.size <= initial(size)) -- and result is set difference of self and other is -- This routine returns the set difference between self and other. -- Self may be void. res : SAME ; if self.size = 0 then return create(0) else res := self ; loop res := res.delete(other.elt!) end ; return res end end ; diff( other : SAME ) : SAME pre true post (result.size <= initial(size)) -- and result is set difference of self and other is -- This routine returns the set difference of self and other as a new -- set. res : SAME := create(0) ; loop elem : T := elt! ; if ~other.test(elem) then res := res.insert(elem) end end ; return res end ; to_sym_diff( other : SAME ) : SAME pre true post (result.size <= (initial(size) + other.size)) -- result is symmetric diff of self and other is -- This routine returns the set which is the symmetric difference of -- self and other. if size = 0 then return create(0) else res : SAME := self ; loop elem : T := other.elt! ; if res.test(elem) then res := res.delete(elem) else res := res.insert(elem) end end ; return res end end ; sym_diff( other : SAME ) : SAME pre true post (result.size <= (initial(size) + other.size)) -- result is symmetric diff of self and other is -- This routine returns a new set which is the symmetric difference -- between self and other. res : SAME := create(0) ; loop elem : T :=elt! ; if ~other.test(elem) then res := res.insert(elem) end end ; loop elem : T := other.elt! ; if ~test(elem) then res := res.insert(elem) end end ; return res end ; elt! : T pre true post contains(result) is -- This iter yields the elements of self in an arbitrary order. -- Deletion and insertion should not be carried out while this is being -- called. if self.size > 0 then if use_map then loop res : T :=aelt! ; if ~is_elt_nil(res) then yield res end end else index : CARD := 0 ; sz : CARD := hsize ; loop until!(index = hsize) ; yield [index] ; index := index + 1 end end end end ; end ; -- FSET{T}