h_bag.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 H_BAG_IMPL{ELT}
partial class H_BAG_IMPL{ELT} is
-- This class implements a bag by using a hash table. The table
-- 'stores' multiple elements as a count over the one data item. Iters
-- yield according to the count.
-- Version 1.2 Nov 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 9 Apr 96 hk Original
-- 3 Apr 97 kh Changed for CARD instead of INT
-- 5 Nov 98 kh Changed to partial after 1.2, added pre/posts
private include DYNAMIC_DATABUCKET_TABLE{ELT,CARD}
create -> private old_create,
map_aget -> private aget,
map_aset -> private aset,
map_key! -> unique! ; -- Make key iter public
private attr total_size : CARD ;
stub elt_eq(
first,
second : ELT
) : BOOL ;
-- This routine returns true if and only if first and second are element
-- equal.
stub elt_hash(
anything : $OB
) : CARD ;
-- This routine returns a hash value for the given object.
create : SAME is
-- This creation routine makes use of the hash table routine.
return old_create
end ;
copy : SAME
pre ~void(self)
post true
is
-- This routine creates an identical copy of self.
res : SAME := map_copy ;
res.total_size := total_size ;
return res
end ;
size : CARD
pre ~void(self)
post (result = total_size)
is
-- This routine returns the total number of elements in this bag.
return total_size
end ;
count(
elem : ELT
) : CARD
pre ~void(self)
post (result <= size)
is
-- This routine returns the number of occurrences of the given element
-- in the bag.
loop
bkt : DATABUCKET{ELT,CARD} := bucket(hash(elem)).list! ;
if elt_eq(bkt.item,elem) then
return bkt.data
end
end ;
return 0
end ;
n_unique : CARD
pre ~void(self)
post (result <= size)
is
-- This routine returns the number of unique indices.
return n_inds
end ;
add(
elem : ELT
)
pre ~void(self)
post (total_size = initial(total_size) + 1)
is
-- This routine adds the given element to self, placing it in the
-- appropriate 'bucket' [Note that the BUCKET class is defined under
-- Containers - General].
loc_hash : CARD := hash(elem) ;
loop
loc_bucket : DATABUCKET{ELT,CARD} := bucket(loc_hash).list! ;
if elt_eq(elem,loc_bucket.item) then
loc_bucket.data := loc_bucket.data + 1 ;
total_size := total_size + 1 ;
return
end
end ;
set_bucket(loc_hash,
DATABUCKET{ELT,CARD}::create(elem,1,bucket(loc_hash))) ;
total_size := total_size + 1 ;
n_inds := n_inds + 1 ;
update_insert -- private routine in included
-- class! [in the General
-- section of Containers]!
end ;
delete_and_return(
elem : ELT
) : ELT
pre ~void(self)
post true
is
-- This routine deletes one element from the bag which is elt_eq to
-- elem, returning the element deleted - or void if not present!
hash_num : CARD := hash(elem) ;
bkt : DATABUCKET{ELT,CARD} := bucket(hash_num) ;
prev : DATABUCKET{ELT,CARD} := bkt ; -- gives prev a class!!
prev := void ;
if void(bkt) then
return void
end ;
loop
until!(void(bkt)) ;
res : ELT := bkt.item ;
if elt_eq(res,elem) then
total_size := total_size - 1 ;
if bkt.data = 1 then -- last occurrence removed
if void(prev) then
set_bucket(hash_num,bkt.next)
else
prev.next(bkt.next)
end ;
n_inds := n_inds - 1 ;
update_delete -- private routine in included
-- class! [in the General
-- section of Containers]!
else -- just count down
bkt.data := bkt.data - 1
end ;
return res
end ;
prev := bkt ;
bkt := bkt.next
end ;
return void
end ;
delete(
elem : ELT
)
pre ~void(self)
post (total_size <= initial(total_size))
is
-- This routine calls delete_and_return - but then does not return
-- the item deleted.
dummy ::= delete_and_return(elem)
end ;
delete_all(
elem : ELT
)
pre ~void(self)
post (total_size <= initial(total_size))
is
-- This routine deletes all of those elements of self which are elt_eq
-- to elem.
count : CARD := count(elem) ;
if count = 0 then
return
end ;
total_size := total_size - count ;
discard : CARD := map_delete(elem)
end ;
elt! : ELT
pre ~void(self)
post contains(result)
is
-- This iter yields every element of the bag in sequence.
loop
bkt : DATABUCKET{ELT,CARD} := bucket(0.upto!(asize - 1)) ;
loop
bucket : DATABUCKET{ELT,CARD} := bkt.list! ;
loop
bucket.data.times! ;
yield bucket.item
end
end
end
end ;
end ; -- H_BAG_IMPL{ELT}
class VBAG{ELT} < $VBAG{ELT}
class VBAG{ELT} < $VBAG{ELT} is
-- This class is an implementation of bags with value semantics. All
-- modifying operations return a new object, thus eliminating the possibility
-- of aliasing problems.
-- Version 1.1 Nov 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 15 Aug 96 bg Original for 1.2 dist.
-- 5 Nov 98 kh Revised for pre/post conditions, etc
include RO_BAG_INCL{ELT}
n_unique ->,
size ->,
count -> ;
include H_BAG_IMPL{ELT}
add -> private add,
delete -> private delete,
delete_and_return -> private delete_and_return,
delete_all -> private delete_all ;
is_eq(
anything : $OB
) : BOOL
pre ~void(self)
and ~void(anything)
post true
is
-- This predicate returns true if and only if self and anything are
-- the same class and all elements are identical.
typecase anything
when $RO_BAG{ELT} then
if size /= anything.size then
return false
end ;
loop
elem : ELT := anything.unique! ;
if count(elem)/=anything.count(elem) then
return false
end
end ;
return true
else
return false
end
end ;
add(
elem : ELT
) : SAME
pre ~void(self)
post (result.size = self.size + 1)
is
-- This routine adds the given element to self, returning a new bag.
res : SAME := copy ;
res.add(elem) ;
return res
end ;
delete(
elem : ELT
) : SAME
pre ~void(self)
post true
is
-- This routine returns a copy of self with the exception of one copy
-- of elem (if present).
res : SAME := copy ;
res.delete(elem) ;
return res
end ;
delete_all(
elem : ELT
) : SAME
pre ~void(self)
post ~result.contains(elem)
and (contains(elem)
and ((result.size + count(elem)) = size))
or (~contains(elem)
and (result = self))
is
-- This routine returns a copy of self from which all occurrences of
-- those elements elt_eq to self have been deleted.
res : SAME := copy ;
res.delete_all(elem) ;
return res
end ;
hash : CARD
pre true -- irrespective of value
post true -- irrespective of result
is
-- This routine returns a hash number derived from the hash numbers of
-- all elements.
res : NUM_BITS := NUM_BITS::create ;
loop
elem : ELT := elt! ;
if res.card = 0 then
res := NUM_BITS::create(elt_hash(elem))
else
res := res.convolve(NUM_BITS::create(elt_hash(elem)))
end
end ;
return res.card
end ;
end ; -- VBAG
class BAG{ELT} < $BAG{ELT}
class BAG{ELT} < $BAG{ELT} is
-- This class implements a 'standard' bag which is an alias for the
-- class H_BAG_IMPL{ELT}.
-- Version 1.2 Nov 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 17 Jun 94 bg Original
-- 3 Apr 97 kh Changed style for commonality
-- 5 Nov 98 kh Brought up to date with 1.2 dist.
include BAG_INCL{ELT}
n_unique ->,
size ->,
count -> ;
include H_BAG_IMPL{ELT} ;
end ; -- BAG{ELT}