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}