h_bag.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
-------------------------> GNU Sather - sourcefile <-------------------------
-- Copyright (C) 1995 by International Computer Science Institute --
-- 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> <--------------
-- Hash table based bag implementations
-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>
class BAG{ETP} < $BAG{ETP}
class BAG{ETP} < $BAG{ETP} is
-- A standard bag is implemented using H_BAGs after making all
-- the modification functions public
--
-- Usage:
-- b ::= #BAG{INT}(|10,10,11|);
-- a: INT := 0;
-- loop a := a+b.elt!; end; -- adds the bag elemetns in some
-- -- undefined order.
--
include H_BAG_IMPL{ETP};
include BAG_INCL{ETP} n_unique->;
end;
class VBAG{ETP} < $VBAG{ETP}
class VBAG{ETP} < $VBAG{ETP} is
-- A bag with value semantics. All modifying operations return
-- a new object, thus eliminating the possibility of aliasing
-- problems
include H_BAG_IMPL{ETP}
add->private add,
delete->private delete,
delete_and_return->private delete_and_return,
delete_all->private delete_all;
include RO_BAG_INCL{ETP} n_unique->;
add(e:ETP):SAME is
res ::= copy; res.add(e); return res;
end;
delete(e:ETP):SAME is
res ::= copy; res.delete(e); return res;
end;
delete_all(e:ETP):SAME is
res ::= copy; res.delete_all(e); return res;
end;
is_eq(a:$OB):BOOL is
-- Return true if 'self' and 'v' have the same value
typecase a
when $RO_BAG{ETP} then
if size /= a.size then return false; end;
loop e:ETP := a.unique!;
if count(e)/=a.count(e) then return false; end;
end;
return true;
else return false end;
end;
hash:INT is
res:INT := 0; loop e ::= elt!; res := res.bxor(elt_hash(e)); end;
return res;
end;
end;
partial class H_BAG_IMPL{ETP}
partial class H_BAG_IMPL{ETP} is
-- An implementation of the $BAG abstraction using a bucketed hash
-- table. This bag stores its elements by counting the number of
-- occurences. If two _different but equal_ elements are inserted
-- only one of them will be stored, but this one will be yielded
-- twice.
private include DYNAMIC_DATABUCKET_TABLE{ETP,INT}
create->private old_create,
map_aget->private aget,map_aset->private aset,
map_key!->unique!; -- Make the key routine public
private attr total_size: INT;
stub elt_eq(e1,e2:ETP):BOOL;
stub elt_hash(o:$OB):INT;
create: SAME is
return old_create
end;
copy: SAME pre ~void(self) is
res ::= map_copy;
res.total_size := total_size;
return res
end;
n_unique: INT is return n_inds end;
-- Return the number of unique indicies
count(e:ETP): INT pre ~void(self) is
-- Return the number of occurences of element "e"
loop
b ::= bucket(hash(e)).list!;
if elt_eq(b.item,e) then return b.data end
end;
return 0
end;
has(e:ETP): BOOL pre ~void(self) is
return count(e) > 0
end;
add(e:ETP) pre ~void(self) is
h ::= hash(e);
loop
b ::= bucket(h).list!;
if elt_eq(e,b.item) then
b.data := b.data + 1;
total_size := total_size + 1;
return
end
end;
set_bucket(h,#DATABUCKET{ETP,INT}(e,1,bucket(h)));
-- TODO: optimize the bucket(h)
total_size := total_size + 1;
n_inds := n_inds + 1;
update_insert
end;
size:INT is return total_size end;
delete(e:ETP) pre ~void(self) is
dummy ::= delete_and_return(e)
end;
delete_and_return(e:ETP):ETP pre ~void(self) is
h ::= hash(e);
b ::= bucket(h);
prev ::= b; prev := void; -- NASTY HACK
if void(b) then return void end;
loop until!( void(b) );
res ::= b.item;
if elt_eq(res,e) then
total_size := total_size - 1;
if b.data = 1 then
-- last occurrence removed
if void(prev) then
set_bucket(h,b.next)
else
prev.next(b.next)
end;
n_inds := n_inds - 1;
update_delete
else
b.data := b.data - 1
end;
return res
end;
prev := b;
b := b.next
end;
return void
end;
delete_all(e:ETP) pre ~void(self) is
-- Delete all elements equal to "e"
anz ::= count(e);
if anz = 0 then end;
total_size := total_size - anz;
discard ::= map_delete(e);
end;
elt!:ETP pre ~void(self) is
loop
b ::= bucket( 0.upto!(asize-1) );
loop
bk ::= b.list!;
loop bk.data.times!; yield bk.item end
end
end
end;
end; -- H_BAG{ETP}