fmap.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> <--------------
partial class FMAP_IMPL{K,T} < $STR
partial class FMAP_IMPL{K,T} < $STR is
-- This partial class provides an implementation of maps from key
-- objects (of type K) to target objects of type T requiring write-backs.
-- In this form void may not be a key, `key_nil' may be redefined. If
-- K is a subtype of $IS_EQ, then `is_eq' will be used for key equality test
-- (eg. string equality for STR), otherwise object equality is used.
--
-- If K is a subtype of $HASH, then `hash' will be used for the hash
-- value, otherwise the element `id' will be used.
--
-- In this implementation the class may be inherited with `key_eq',
-- `key_nil' and `key_hash' redefined to get a different behaviour. The
-- tables grow by amortized doubling and so require writeback when inserting
-- and deleting elements. The load factor is kept down to cut down on
-- collision snowballing. The simple collision resolution allows deletions,
-- but makes the behaviour quadratic with poor hash functions. A sentinel
-- is put at the end of the table to avoid one check while searching.
--
-- NOTE It is not possible to include an invariant since it is occasionally
-- necessary to destroy self for efficiency!
-- Version 1.4 Sep 99. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 11 Apr 94 bg Original
-- 12 Jul 96 hk Modified for Sather 1.1
-- 23 Mar 97 kh Changed to CARD from INT
-- 9 Nov 98 kh Refined, added pre/post conditions
-- 23 Sep 99 kh Changed to FMAP_IMPL from FMAP
private include AREF{TUP{K,T}} ;
private attr hsize : CARD ; -- Number of stored entries
private const load_ratio : CARD := 4 ; -- Allow at most 1/load_ratio full
private const Spare_Min : CARD := 50 ;
private const Default_Size : CARD := 5 ;
create : SAME is
--This routine merely returns void as all insertion routines have
-- a special case for a void map.
return void
end ;
private allocate(cnt : CARD) : SAME
pre ((cnt - 1) = (cnt - 1).next_exp2)
post ~void(result)
is
--This private routine allocates cnt locations and initialises all
-- elements to a null if one is provided for the key class.
res : SAME := new(cnt) ;
if ~void(key_nil) then
loop
res.aset!(TUP{K,T}::create(key_nil,void))
end
end ;
return res
end ;
create(cnt : CARD) : SAME
pre (cnt >= 1)
post (result.asize = (cnt.next_exp2 + 1))
is
--This creation routine creates a table capable of dealing with cnt
-- elements without expansion.
size : CARD := cnt.next_exp2 + 1 ;
return allocate(size)
end ;
copy : SAME
pre ~void(self)
post true -- should be (result = self)
is
--This routine returns a new copy of self.
res : SAME := create(size) ;
loop
res := res.insert_pair(pair!)
end ;
res.hsize := hsize ;
return res
end ;
is_empty : BOOL is
--This predicate returns true if and only if the map is empty. Self may be void.
return void(self) or (hsize = 0)
end ;
test(key : K) : BOOL is
--This predicate returns true if and only if the map contains an element
-- mapped by the given key. Note that the value zero for a numeric key is
-- perfectly valid.
if void(self) then
return false
else
hash_num : CARD := NUM_BITS::create(key_hash(key)).bit_and(NUM_BITS::create(asize - 2)).card ;
loop
temp_key : K := [hash_num].t1 ;
if is_key_nil(temp_key) then
break!
elsif key_eq(temp_key,key) then
return true
end ;
hash_num := hash_num + 1
end ;
if hash_num = asize - 1 then -- sentinel hit!
hash_num := 0 ;
loop
temp_key : K := [hash_num].t1 ;
if is_key_nil(temp_key) then
break!
elsif key_eq(temp_key,key) then
return true
end ;
hash_num := hash_num + 1
end ;
assert hash_num /= asize - 1
end ;
return false
end
end ;
has_ind(key : K) : BOOL is
--This routine returns true if and only if self contains an entry with the given key.
return test(key)
end ;
equals(other : $RO_MAP{K,T}) : BOOL is
-- This routine returns true if and only if all of the elements of other
-- are identical to those of self.
-- NOTE This will only become a useful routine when FMAP can be sub-typed
-- under $RO_MAP
if other.size /= size then
return false
end ;
loop
key : K := ind! ;
elem1 : T := get(key) ;
elem2 : T := other.aget(key) ;
if ~elt_eq(elem1,elem2) then
return false
end
end ;
return true
end ;
has(elem : T) : BOOL is
--This predicate returns true if and only if the given element is in
-- the range of the map.
if void(self) then
return false
end ;
loop
if elt_eq(elt!,elem) then
return true
end
end ;
return false
end ;
size : CARD
pre true
post (void(self)and (result = 0)) or (result = hsize)
is
--This routine returns the number of entries in the map. Self may be void.
if void(self) then
return 0
else
return hsize
end
end ;
n_inds : CARD is
--This routine returns the number of 'indices' in the map. Self may be void.
if void(self) then
return 0
else
return hsize
end
end ;
get(key : K) : T
pre true
post test(key)
or (void(result)
and (void(self)
or ~test(key)))
is
--This routine searches for the item mapped from the given key.
-- If the item is found then it is returned, otherwise void is returned!
-- Self may be void.
if void(self) then
return void
end ;
hash_num : CARD := NUM_BITS::create(key_hash(key)).bit_and(NUM_BITS::create(asize - 2)).card ;
loop
temp_key : K := [hash_num].t1 ;
if is_key_nil(temp_key) then
break!
elsif key_eq(temp_key,key) then
return [hash_num].t2
end ;
hash_num := hash_num + 1
end ;
if hash_num = (asize - 1) then -- Found the sentinel!
hash_num := 0 ;
loop
temp_key : K := [hash_num].t1 ;
if is_key_nil(temp_key) then
break!
elsif key_eq(temp_key,key) then
return [hash_num].t2
end ;
hash_num := hash_num + 1
end ;
assert (hash_num /= (asize - 1)) -- map must not be full!
end ;
return void
end ;
get_pair(key : K) : TUP{K,T}
pre true
post ((result = TUP{K,T}::create(key_nil,void))
and (void(self)
or (~test(key))))
or (test(key)
and ~void(result))
is
--This routine searches for an element which has the given key. If
-- found it returns the key/value pair, otherwise a void pair. Self may be void.
if void(self) then
return TUP{K,T}::create(key_nil,void)
end ;
hash_num : CARD := NUM_BITS::create(key_hash(key)).bit_and(NUM_BITS::create(asize - 2)).card ;
loop
temp_key : K := [hash_num].t1 ;
if is_key_nil(temp_key) then
break!
elsif key_eq(temp_key,key) then
return [hash_num]
end ;
hash_num := hash_num + 1
end ;
if hash_num = (asize - 1) then -- Found the sentinel!
hash_num := 0 ;
loop
temp_key : K := [hash_num].t1 ;
if is_key_nil(temp_key) then
break!
elsif key_eq(temp_key,key) then
return [hash_num]
end ;
hash_num := hash_num + 1
end ;
assert (hash_num /= (asize - 1)) -- map must not be full!
end ;
return TUP{K,T}::create(key_nil,void)
end ;
private double_size : SAME
pre (self.size > 0)
post (result.asize = (initial(asize) - 1) * 2 + 1)
is
-- This private routine creates a new map which is twice the size of
-- self, copying entries from self into it.
new_size : CARD := (asize - 1) * 2 + 1 ;
res : SAME := allocate(new_size) ;
loop
p::=pairs!;
--
--if void(p) then #OUT+"fmap.sa double_size void(p)\n";
--elsif void(p.t1) then #OUT+"fmap.sa double_size void(p.t1)\n";
--elsif void(p.t2) then #OUT+"fmap.sa double_size void(p.t2)\n";
--end;
res := res.insert_pair(p);
end ;
SYS::destroy(self) ; -- old one should not be used now
return res
end ;
private should_grow : BOOL is
-- This private predicate returns true if and only if the size of self
-- should be increased to avoid hashing delays.
return ((hsize + 1) * load_ratio) > asize
end ;
private not_too_many(start,finish : CARD) : BOOL is
--This private predicate returns true if and only if hashing delays
-- are likely to be severely affecting performance, otherwise false.
return ~(finish > (start + Spare_Min))
end ;
insert(key : K,target : T) : SAME
pre true -- should be ~void(key)
post result.test(key)
is
-- This routine creates a new map if self is void and then inserts the
-- key/target pair into it. If the key is already present then the target
-- corresponding to the key is changed to be the new value.
res : SAME := self ;
if void(res) then
res := allocate(Default_Size)
elsif should_grow then
res := double_size
end ;
orig_hash : CARD := NUM_BITS::create(res.key_hash(key)).bit_and(NUM_BITS::create(res.asize - 2)).card ;
hash_num : CARD := orig_hash ;
size_max : CARD := res.asize - 1 ;
loop
temp_key : K := res[hash_num].t1 ;
if is_key_nil(temp_key) then
break!
end ;
if key_eq(temp_key,key) then
res[hash_num] := TUP{K,T}::create(key,target) ;
return res
end ;
hash_num := hash_num + 1
end ;
if hash_num = size_max then -- reached sentinel
hash_num := 0 ;
loop
temp_key : K := res[hash_num].t1 ;
if is_key_nil(temp_key) then
break!
end ;
if key_eq(temp_key,key) then
res[hash_num] := TUP{K,T}::create(key,target) ;
return res
end ;
hash_num := hash_num + 1
end ;
assert hash_num /= size_max -- Table must not be filled.
end ;
assert not_too_many(orig_hash,hash_num) ;
res[hash_num] := TUP{K,T}::create(key,target) ;
res.hsize := res.hsize + 1 ;
return res
end ;
insert_pair(pair : TUP{K,T}) : SAME
pre true
post result.test(pair.t1) and (void(pair.t2) or elt_eq(result.get(pair.t1),pair.t2))
is
-- This routine inserts the given pair into the map, overwriting an
-- existing one if the key is found. If void this creates a new map.
return insert(pair.t1,pair.t2)
end ;
private halve_size : SAME
pre ~void(self) and hsize < (asize - 1)/4
post void(self) and (result.asize = (asize - 1)/2 + 1)
is
--This routine creates a new map which is half the size of self with
-- all the entries in self copied into it.
new_size : CARD := (asize - 1)/2 + 1 ;
res : SAME := allocate(new_size) ;
loop
res := res.insert_pair(pairs!)
end ;
SYS::destroy(self) ; -- old one should not be used now
return res
end ;
private should_shrink : BOOL is
--This private predicate returns true if and only if the size of self
-- should be reduced.
return (asize >= ((Spare_Min / 3) * 2).next_exp2 + 1)
and (hsize < ((asize - 1)/(load_ratio * 2)))
end ;
delete(key : K) : SAME
pre true
post ~result.test(key)
is
-- This routine returns self with the element corresponding to the given
-- key omitted. The returned map may be a new one if it is appropriate to
-- shrink the total size. Self may be void.
if void(self) then
return void
end ;
hash_num : CARD := NUM_BITS::create(key_hash(key)).bit_and(NUM_BITS::create(asize - 2)).card ;
loop
temp_key : K := [hash_num].t1 ;
if is_key_nil(temp_key) then
return self
elsif key_eq(temp_key,key) then
break!
end ;
if hash_num = (asize - 2) then
hash_num := 0
else
hash_num := hash_num + 1
end
end ;
[hash_num] := TUP{K,T}::create(key_nil,void) ;
hsize := hsize - 1 ;
index : CARD := hash_num ;
loop -- check block for collisions
if index = (asize - 2) then
index := 0
else
index := index + 1
end ;
temp_key : K := [index].t1 ;
if is_key_nil(temp_key) then
break!
end ;
temp_hash : CARD := NUM_BITS::create(key_hash(temp_key)).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] := TUP{K,T}::create(key_nil,void)
end
else -- block does wrap around
if (hash_num >= temp_hash)
or (hash_num < index) then -- hole in the way
[hash_num] := [index] ;
hash_num := index ;
[index] := TUP{K,T}::create(key_nil,void)
end
end
end ;
if should_shrink then
return halve_size
else
return self
end
end ;
clear : SAME
pre true
post void(result) or (result.asize <= ((Spare_Min / 3).next_exp2 + 1))
is
--This routine clears the entire map. Space is returned if there
-- were less than eighteen entries. Self may be void.
if void(self) then
return void
end ;
if asize <= (Spare_Min / 3).next_exp2 + 1 then
res : SAME := self ;
res.hsize := 0 ;
loop
aset!(TUP{K,T}::create(key_nil,void))
end ;
return self
else
return void
end
end ;
targets! : T
pre true
post ~void(result)
is
--This iter yields the target objects contained in the map in an
-- arbitrary order. Neither insertion nor deletion should occur during
-- calls to this iter. Self may be void.
if ~void(self) then
loop
elem : TUP{K,T} := aelt! ;
if ~is_key_nil(elem.t1) then
yield elem.t2
end
end
end
end ;
target! : T
pre true
post ~void(result)
is
--This iter is a synonym for targets!
loop
yield targets!
end
end ;
elt! : T
pre true
post ~void(result)
is
--This iter is another synonym for targets! to satisfy the generic
-- sub-typing.
loop
yield targets!
end
end ;
keys! : K
pre true
post test(result)
is
--This iter yields all of the keys of self in arbitrary order. Self
-- may be void.
if ~void(self) then
loop
res : K := aelt!.t1 ;
if ~is_key_nil(res) then
yield res
end
end
end
end ;
ind! : K
pre true
post test(result)
is
--This iter is a synonym for keys! to satisfy the generic typing.
loop
yield keys!
end
end ;
pairs! : TUP{K,T}
pre true
post test(result.t1)-- and elt_eq(get(result.t1),result.t2)
is
--This iter yields the key/value pairs of self in an arbitrary order.
-- Neither insertion nor deletion should be done while calling this. Self
-- may be void.
if ~void(self) then
loop
res : TUP{K,T} := aelt! ;
if ~is_key_nil(res.t1) then
yield res
end
end
end
end ;
pair! : TUP{K,T}
pre true
post test(result.t1) -- should be - and (get(result.t1) = result.t2)
is
--This iter is a synonym for pairs!
loop
yield pairs!
end
end ;
end ; -- FMAP_IMPL{K,T}
class FMAP{K,T} < $STR
class FMAP{K,T} < $STR is
-- This class provides an implementation of maps from key
-- objects (of type K) to target objects of type T requiring write-backs.
-- In this form void may not be a key, `key_nil' may be redefined. If
-- K is a subtype of $IS_EQ, then `is_eq' will be used for key equality test
-- (eg. string equality for STR), otherwise object equality is used.
-- If K is a subtype of $HASH, then `hash' will be used for the hash
-- value, otherwise the element `id' will be used.
include CONTAINER{T}
size ->,
contains ->,
is_empty -> ;
private include COMPARE{K}
elt_eq -> key_eq,
elt_lt -> ,
elt_hash -> key_hash,
elt_nil -> key_nil,
is_elt_nil -> is_key_nil ;
include FMAP_IMPL{K,T} ; -- which contains the 'code'
end ; -- FMAP{K,T}