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}