fmap.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
---------------------------> Sather 1.1 source file <--------------------------
-- Copyright (C) International Computer Science Institute, 1994. COPYRIGHT --
-- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
-- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in --
-- the file "Doc/License" of the Sather distribution. The license is also --
-- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA. --
--------> Please email comments to sather-bugs@icsi.berkeley.edu. <----------
-- fmap.sa: Hash table based maps from objects to objects.
class FMAP{K,T} < $STR
class FMAP{K,T} < $STR is
-- Hash array based maps from key objects of type K to target
-- objects of type T requiring writebacks.
-- 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.
--
-- Implementation: May be inherited with `key_eq', `key_nil', and
-- `key_hash' redefined to get a different behavior. The tables
-- grow by amortized doubling and so require writeback when
-- inserting and deleting elements. We keep down the load factor
-- to cut down on collision snowballing. The simple collision
-- resolution allows us to support deletions, but makes the
-- behavior quadratic with poor hash functions. Puts a sentinel
-- at the end of the table to avoid one check while searching.
private include COMPARE{T};
private include COMPARE{K}
elt_eq->key_eq,elt_lt->,elt_hash->key_hash,
elt_nil->key_nil,is_elt_nil->is_key_nil;
private include AREF{TUP{K,T}};
private attr hsize:INT; -- Number of stored entries.
private const load_ratio:INT:=4; -- Allow to get at most 1/load_ratio full.
-- We can't have an invariant here, because sometimes we want
-- to destroy 'self' for efficiency.
--invariant:BOOL is
-- -- Class invariant.
-- return void(self) or hsize.is_bet(0,asize) end;
copy: SAME is
res ::= #SAME(size);
loop res := res.insert_pair(pair!) end;
res.hsize := hsize;
return res;
end;
size:INT is
-- Number of entries in the table. Self may be void.
if void(self) then return 0 else return hsize end end;-- FMAP{2}::hsize
create:SAME is return void end;
create(n:INT):SAME
-- Make a table capable of dealing with `n' elements without
-- expansion. You can simply insert into a void table to create
-- one as well. Self may be void (and usually is).
pre n>=1 is -- INT::is_lt BOOL::not
return allocate(1.lshift((3*load_ratio*n/4).highest_bit+1)+1) end;-- FMAP{2}::allocate INT::lshift FMAP{2}::load_ratio INT::times INT::div INT::highest_bit INT::plus INT::plus
private allocate(n:INT):SAME is
-- Allocate `n' locations (must be power of 2 plus 1) and
-- initialize to `(elt_nil,void)'.
r::=new(n);
if ~void(key_nil) then loop r.aset!(#(key_nil,void)) end end;-- FMAP{2}::key_nil BOOL::not FMAP{2}::aset! TUP{2}::create FMAP{2}::key_nil
return r end;
target!:T is loop yield targets! end; end;
pair!:TUP{K,T} is loop yield pairs! end; end;
elt!: T is loop yield targets! end; end;
pairs!:TUP{K,T} is
-- Yield the input/output pairs of self in an arbitrary order.
-- Do not insert or delete from self while calling this.
-- Self may be void.
if ~void(self) then-- BOOL::not
loop r::=aelt!; -- FMAP{2}::aelt!
if ~is_key_nil(r.t1) then yield r end end end end; -- FMAP{2}::is_key_nil TUP{2}::t1 BOOL::not
keys!:K is
-- Yield the keys in self in an arbitrary order. Do not insert
-- or delete from self while calling this.
-- Self may be void.
if ~void(self) then-- BOOL::not
loop r::=aelt!.t1; -- FMAP{2}::aelt! TUP{2}::t1
if ~is_key_nil(r) then yield r end end end end;-- FMAP{2}::is_key_nil BOOL::not
targets!:T is
-- Yield the target objects contained in self in an arbitrary
-- order. Do not insert or delete from self while calling this.
-- Self may be void.
if ~void(self) then-- BOOL::not
loop e::=aelt!; -- FMAP{2}::aelt!
if ~is_key_nil(e.t1) then yield e.t2 end end end end;-- FMAP{2}::is_key_nil TUP{2}::t1 BOOL::not TUP{2}::t2
has_ind(k: K): BOOL is return test(k) end;
test(k:K):BOOL is
-- True if the key `k' is mapped by self.
-- Self may be void.
if void(self) then return false end;
h::=key_hash(k).band(asize-2);-- FMAP{2}::key_hash INT::band FMAP{2}::asize INT::minus
loop tk::=[h].t1; -- FMAP{2}::aget TUP{2}::t1
if is_key_nil(tk) then break!-- FMAP{2}::is_key_nil
elsif key_eq(tk,k) then return true-- FMAP{2}::key_eq
end;
h:=h+1 end;-- INT::plus
if h=asize-1 then h:=0; -- hit sentinel-- FMAP{2}::asize INT::minus
loop tk::=[h].t1; -- FMAP{2}::aget TUP{2}::t1
if is_key_nil(tk) then break!-- FMAP{2}::is_key_nil
elsif key_eq(tk,k) then return true-- FMAP{2}::key_eq
end;
h:=h+1 end;-- INT::plus
assert h/=asize-1 end;-- FMAP{2}::asize INT::minus BOOL::not
return false end;
get(k:K):T is
-- If `k' is a key, return the corresponding target, otherwise
-- return void. Self may be void.
if void(self) then return void end;
h::=key_hash(k).band(asize-2);-- FMAP{2}::key_hash INT::band FMAP{2}::asize INT::minus
loop tk::=[h].t1; -- FMAP{2}::aget TUP{2}::t1
if is_key_nil(tk) then break!-- FMAP{2}::is_key_nil
elsif key_eq(tk,k) then return [h].t2-- FMAP{2}::key_eq FMAP{2}::aget TUP{2}::t2
end;
h:=h+1 end;-- INT::plus
if h=asize-1 then h:=0; -- hit sentinel-- FMAP{2}::asize INT::minus
loop tk::=[h].t1; -- FMAP{2}::aget TUP{2}::t1
if is_key_nil(tk) then break!-- FMAP{2}::is_key_nil
elsif key_eq(tk,k) then return [h].t2-- FMAP{2}::key_eq FMAP{2}::aget TUP{2}::t2
end;
h:=h+1 end;-- INT::plus
assert h/=asize-1 end; -- table mustn't be filled-- FMAP{2}::asize INT::minus BOOL::not
return void end;
get_pair(k:K):TUP{K,T} is
-- If `k' is a key, return the corresponding key/target pair.
-- Otherwise return #(key_nil,void). Useful when different
-- objects are treated as equal by `key_eq'.
-- Self may be void.
if void(self) then return #(key_nil,void) end; -- TUP{2}::create FMAP{2}::key_nil
h::=key_hash(k).band(asize-2);-- FMAP{2}::key_hash INT::band FMAP{2}::asize INT::minus
loop tk::=[h].t1; -- FMAP{2}::aget TUP{2}::t1
if is_key_nil(tk) then break!-- FMAP{2}::is_key_nil
elsif key_eq(tk,k) then return [h]-- FMAP{2}::key_eq FMAP{2}::aget
end;
h:=h+1 end;-- INT::plus
if h=asize-1 then h:=0; -- hit sentinel-- FMAP{2}::asize INT::minus
loop tk::=[h].t1; -- FMAP{2}::aget TUP{2}::t1
if is_key_nil(tk) then break!-- FMAP{2}::is_key_nil
elsif key_eq(tk,k) then return [h]-- FMAP{2}::key_eq FMAP{2}::aget
end;
h:=h+1 end;-- INT::plus
assert h/=asize-1 end; -- table mustn't be filled-- FMAP{2}::asize INT::minus BOOL::not
return #(key_nil,void) end;-- TUP{2}::create FMAP{2}::key_nil
private double_size:SAME
-- A new table of twice the size of self with self's entries
-- copied over.
pre ~void(self) is-- BOOL::not
ns::=(asize-1)*2+1; r::=allocate(ns); -- FMAP{2}::asize INT::minus INT::times INT::plus FMAP{2}::allocate
loop r:=r.insert_pair(pairs!) end; -- FMAP{2}::insert_pair FMAP{2}::pairs!
SYS::destroy(self); -- The old one should never be used now.-- SYS::destroy
return r end;
private should_grow:BOOL is
return (hsize+1)*load_ratio>asize;-- FMAP{2}::hsize INT::plus FMAP{2}::load_ratio FMAP{2}::asize
end;
insert(k:K,t:T):SAME is
-- A possibly new table which includes the key/target pair `k',
-- `t'. If `k' is already present, replaces the current key and
-- target with `k,t'. Usage: `tbl:=tbl.insert(k,t)'. Creates a
-- new table if void(self).
r::=self;
if void(r) then r:=allocate(5)-- FMAP{2}::allocate
elsif should_grow then r:=double_size end;-- FMAP{2}::should_grow FMAP{2}::double_size
orig_h::=r.key_hash(k).band(r.asize-2);-- FMAP{2}::key_hash INT::band FMAP{2}::asize INT::minus
h::=orig_h;
asm::=r.asize-1;-- FMAP{2}::asize INT::minus
loop tk::=r[h].t1; -- FMAP{2}::aget TUP{2}::t1
if is_key_nil(tk) then break! end;-- FMAP{2}::is_key_nil
if key_eq(tk,k) then r[h]:=#(k,t); return r end;-- FMAP{2}::key_eq FMAP{2}::aset TUP{2}::create
h:=h+1 end;-- INT::plus
if h=asm then h:=0; -- hit sentinel-- INT::is_eq
loop tk::=r[h].t1; -- FMAP{2}::aget TUP{2}::t1
if is_key_nil(tk) then break! end;-- FMAP{2}::is_key_nil
if key_eq(tk,k) then r[h]:=#(k,t); return r end;-- FMAP{2}::key_eq FMAP{2}::aset TUP{2}::create
h:=h+1 end;-- INT::plus
assert h/=asm end; -- table mustn't be filled -- INT::is_eq BOOL::not
assert not_too_many(orig_h,h); -- Look for excessive collisions-- FMAP{2}::not_too_many
r[h]:=#(k,t); r.hsize:=r.hsize+1; return r end;-- FMAP{2}::aset TUP{2}::create FMAP{2}::hsize FMAP{2}::hsize INT::plus
private not_too_many(start, finish:INT):BOOL is
-- A function called in an assert to check that really
-- bad hashing isn't happening, which would probably
-- be a performance bug. Since it is in an assert, this
-- isn't called unless checking is on.
if finish>start+50 then-- INT::is_lt INT::plus
#ERR+"Found a problem: excessive collisions in FMAP, probably\n"-- ERR::create
+"due to a bad hash function in the class "-- ERR::plus
+SYS::str_for_tp(SYS::tp([start]))-- ERR::plus ERR::plus SYS::str_for_tp SYS::tp FMAP{2}::aget
+".\n";-- ERR::plus
k:K;
typecase k
when $STR then
#OUT + "Snowballing values:\n";-- OUT::create OUT::plus
loop
i::=start.upto!(finish-1);-- INT::upto! INT::minus
e::=[i].t1;-- FMAP{2}::aget TUP{2}::t1
h::=key_hash(e);-- FMAP{2}::key_hash
typecase e
when $STR then
#OUT + i -- OUT::create OUT::plus
+ '\t' + h.hex_str -- OUT::plus OUT::plus INT::hex_str
+ '\t' + h.band(asize-2) -- OUT::plus OUT::plus INT::band FMAP{2}::asize INT::minus
+ '\t' + e.str.pretty + '\n';-- OUT::plus OUT::plus STR::str STR::pretty OUT::plus
end;
end;
else
end;
return false;
end;
return true;
end;
insert_pair(p:TUP{K,T}):SAME is
-- Insert the key/target pair held by the tuple arg.
-- If the key is already present, replaces it with the new
-- key and target. `tbl:=tbl.insert(p)'. Creates a new table
-- if void(self).
return insert(p.t1,p.t2) end;-- FMAP{2}::insert TUP{2}::t1 TUP{2}::t2
private halve_size:SAME
-- A new table of half the size of self with self's entries
-- copied over.
pre ~void(self) and hsize<(asize-1)/4 is-- BOOL::not FMAP{2}::hsize INT::is_lt FMAP{2}::asize INT::minus INT::div
ns::=(asize-1)/2+1; r::=allocate(ns); -- FMAP{2}::asize INT::minus INT::div INT::plus FMAP{2}::allocate
loop r:=r.insert_pair(pairs!) end; -- FMAP{2}::insert_pair FMAP{2}::pairs!
SYS::destroy(self); -- The old one should never be used now.-- SYS::destroy
return r end;
private should_shrink:BOOL is
return asize>=33 and hsize<(asize-1)/(load_ratio*2);-- FMAP{2}::asize INT::is_lt BOOL::not FMAP{2}::hsize INT::is_lt FMAP{2}::asize INT::minus INT::div FMAP{2}::load_ratio INT::times
end;
delete(k:K):SAME is
-- A possibly new table which deletes the element with key
-- `k' if it is contained in self. Usage: `tbl:=tbl.delete(k)'.
-- Self may be void.
if void(self) then return void end;
h::=key_hash(k).band(asize-2);-- FMAP{2}::key_hash INT::band FMAP{2}::asize INT::minus
loop tk::=[h].t1; -- FMAP{2}::aget TUP{2}::t1
if is_key_nil(tk) then return self-- FMAP{2}::is_key_nil
elsif key_eq(tk,k) then break! end;-- FMAP{2}::key_eq
if h=asize-2 then h:=0 else h:=h+1 end end;-- FMAP{2}::asize INT::minus INT::plus
[h]:=#(key_nil,void); -- h is the index of arg-- FMAP{2}::aset TUP{2}::create FMAP{2}::key_nil
hsize:=hsize-1; i::=h; -- FMAP{2}::hsize FMAP{2}::hsize INT::minus
-- Now check the block after h for collisions.
loop
if i=asize-2 then i:=0 else i:=i+1 end;-- FMAP{2}::asize INT::minus INT::plus
tk::=[i].t1; -- FMAP{2}::aget TUP{2}::t1
if is_key_nil(tk) then break! end; -- FMAP{2}::is_key_nil
hsh::=key_hash(tk).band(asize-2);-- FMAP{2}::key_hash INT::band FMAP{2}::asize INT::minus
if hsh<=i then -- block doesn't wrap around-- INT::is_lt BOOL::not
if h<i and h>=hsh then -- hole in way-- INT::is_lt INT::is_lt BOOL::not
[h]:=[i]; h:=i; [i]:=#(key_nil,void) end;-- FMAP{2}::aset FMAP{2}::aget FMAP{2}::aset TUP{2}::create FMAP{2}::key_nil
else -- block wraps
if h>=hsh or h<i then -- hole in way-- INT::is_lt BOOL::not INT::is_lt
[h]:=[i]; h:=i; [i]:=#(key_nil,void) end end end;-- FMAP{2}::aset FMAP{2}::aget FMAP{2}::aset TUP{2}::create FMAP{2}::key_nil
if should_shrink then return halve_size-- FMAP{2}::should_shrink FMAP{2}::halve_size
else return self end end;
clear:SAME is
-- Clear out self, return the space if it has 17 or less entries
-- otherwise return void. Self may be void.
if void(self) then return void end;
if asize<=17 then r::=self; r.hsize:=0;
loop aset!(#(key_nil,void)) end; return self
else return void end end;
is_empty:BOOL is
-- True if the set is empty. Self may be void.
return void(self) or hsize=0 end;-- FMAP{2}::hsize INT::is_eq
str: STR is
res: FSTR := #("{");-- FSTR::create
i ::= 0;
loop until!(i = asize);-- FMAP{2}::asize
p ::= [i];-- FMAP{2}::aget
if ~is_key_nil(p.t1) then-- FMAP{2}::is_key_nil TUP{2}::t1 BOOL::not
k::=p.t1; e ::=p.t2;-- TUP{2}::t1 TUP{2}::t2
typecase k when $STR then res := res+"["+k.str+"]="; else end;-- FSTR::plus FSTR::plus SFILE_ID::str FSTR::plus
typecase e when $STR then res:= res+" "+e.str+" "; else end;-- FSTR::plus FSTR::plus FMAP{2}::str FSTR::plus
res := res+" ";-- FSTR::plus
end;
i := i + 1;-- INT::plus
end;
res := res+"}";-- FSTR::plus
return(res.str);-- FSTR::str
end;
equals(e: $RO_MAP{K,T}): BOOL is
-- Returns true if all of "e"'s elements are equal to self's elts
-- Ordering is an issue. Should be redefined to be more
-- precise for particular descendants
-- This will not be a useful routine until we can place FMAP under
-- $RO_MAP
if e.size /= size then return false end;
loop k ::= ind!;
a1 ::= get(k); a2 ::= e.aget(k);
if ~elt_eq(a1,a2) then return false end
end;
return true
end;
filter!(once f:ROUT{T}:BOOL): T pre ~void(self) is
loop e ::= elt!; if f.call(e) then yield e end end
end;
filter_not!(once f:ROUT{T}:BOOL): T pre ~void(self) is
loop e ::= elt!; if ~ f.call(e) then yield e end end
end;
ind!: K is loop yield keys! end; end;
has(e:T):BOOL is
-- True if the self has an element which is `elt_eq' to `e'.
if void(self) then return false end;
loop if elt_eq(elt!,e) then return true end end;
return false
end;
n_inds: INT is
if void(self) then return 0 else return hsize end
end;
end; -- class FMAP{K,T}