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;
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
return allocate(1.lshift((3*load_ratio*n/4).highest_bit+1)+1) end;
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;
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
loop r::=aelt!;
if ~is_key_nil(r.t1) then yield r end end end end;
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
loop r::=aelt!.t1;
if ~is_key_nil(r) then yield r end end end end;
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
loop e::=aelt!;
if ~is_key_nil(e.t1) then yield e.t2 end end end end;
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);
loop tk::=[h].t1;
if is_key_nil(tk) then break!
elsif key_eq(tk,k) then return true
end;
h:=h+1 end;
if h=asize-1 then h:=0; -- hit sentinel
loop tk::=[h].t1;
if is_key_nil(tk) then break!
elsif key_eq(tk,k) then return true
end;
h:=h+1 end;
assert h/=asize-1 end;
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);
loop tk::=[h].t1;
if is_key_nil(tk) then break!
elsif key_eq(tk,k) then return [h].t2
end;
h:=h+1 end;
if h=asize-1 then h:=0; -- hit sentinel
loop tk::=[h].t1;
if is_key_nil(tk) then break!
elsif key_eq(tk,k) then return [h].t2
end;
h:=h+1 end;
assert h/=asize-1 end; -- table mustn't be filled
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;
h::=key_hash(k).band(asize-2);
loop tk::=[h].t1;
if is_key_nil(tk) then break!
elsif key_eq(tk,k) then return [h]
end;
h:=h+1 end;
if h=asize-1 then h:=0; -- hit sentinel
loop tk::=[h].t1;
if is_key_nil(tk) then break!
elsif key_eq(tk,k) then return [h]
end;
h:=h+1 end;
assert h/=asize-1 end; -- table mustn't be filled
return #(key_nil,void) end;
private double_size:SAME
-- A new table of twice the size of self with self's entries
-- copied over.
pre ~void(self) is
ns::=(asize-1)*2+1; r::=allocate(ns);
loop r:=r.insert_pair(pairs!) end;
SYS::destroy(self); -- The old one should never be used now.
return r end;
private should_grow:BOOL is
return (hsize+1)*load_ratio>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)
elsif should_grow then r:=double_size end;
orig_h::=r.key_hash(k).band(r.asize-2);
h::=orig_h;
asm::=r.asize-1;
loop tk::=r[h].t1;
if is_key_nil(tk) then break! end;
if key_eq(tk,k) then r[h]:=#(k,t); return r end;
h:=h+1 end;
if h=asm then h:=0; -- hit sentinel
loop tk::=r[h].t1;
if is_key_nil(tk) then break! end;
if key_eq(tk,k) then r[h]:=#(k,t); return r end;
h:=h+1 end;
assert h/=asm end; -- table mustn't be filled
assert not_too_many(orig_h,h); -- Look for excessive collisions
r[h]:=#(k,t); r.hsize:=r.hsize+1; return r end;
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
#ERR+"Found a problem: excessive collisions in FMAP, probably\n"
+"due to a bad hash function in the class "
+SYS::str_for_tp(SYS::tp([start]))
+".\n";
k:K;
typecase k
when $STR then
#OUT + "Snowballing values:\n";
loop
i::=start.upto!(finish-1);
e::=[i].t1;
h::=key_hash(e);
typecase e
when $STR then
#OUT + i
+ '\t' + h.hex_str
+ '\t' + h.band(asize-2)
+ '\t' + e.str.pretty + '\n';
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;
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
ns::=(asize-1)/2+1; r::=allocate(ns);
loop r:=r.insert_pair(pairs!) end;
SYS::destroy(self); -- The old one should never be used now.
return r end;
private should_shrink:BOOL is
return asize>=33 and hsize<(asize-1)/(load_ratio*2);
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);
loop tk::=[h].t1;
if is_key_nil(tk) then return self
elsif key_eq(tk,k) then break! end;
if h=asize-2 then h:=0 else h:=h+1 end end;
[h]:=#(key_nil,void); -- h is the index of arg
hsize:=hsize-1; i::=h;
-- Now check the block after h for collisions.
loop
if i=asize-2 then i:=0 else i:=i+1 end;
tk::=[i].t1;
if is_key_nil(tk) then break! end;
hsh::=key_hash(tk).band(asize-2);
if hsh<=i then -- block doesn't wrap around
if h<i and h>=hsh then -- hole in way
[h]:=[i]; h:=i; [i]:=#(key_nil,void) end;
else -- block wraps
if h>=hsh or h<i then -- hole in way
[h]:=[i]; h:=i; [i]:=#(key_nil,void) end end end;
if should_shrink then return 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;
str: STR is
res: FSTR := #("{");
i ::= 0;
loop until!(i = asize);
p ::= [i];
if ~is_key_nil(p.t1) then
k::=p.t1; e ::=p.t2;
typecase k when $STR then res := res+"["+k.str+"]="; else end;
typecase e when $STR then res:= res+" "+e.str+" "; else end;
res := res+" ";
end;
i := i + 1;
end;
res := res+"}";
return(res.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}