OS/2 Shareware BBS: 10 Tools/10-Tools.zip/sa104os2.zip/SATHR104.ZIP/SATHER/LIBRARY/FSET.SA

Text File | 1995-02-05 | 13KB | 345 lines

-- 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 "[e-mail]". <----------

-- fset.sa: Hash-based sets of objects of type T.
-------------------------------------------------------------------
class FSET{T} is
   -- Hash array based sets of objects of type T requiring writebacks.
   --
   -- If T is a subtype of $NIL{T}, then `nil' may not be an element,
   -- otherwise the type's default value may not be a element.
   --
   -- If T is a subtype of $IS_EQ{T}, then `is_eq' will be used for
   -- element equality (eg. string equality for STR), otherwise
   -- object equality is used.  Notice that in an FMAP{$OB}, unless
   -- $IS_EQ{$OB} has been defined (_not_ $IS_EQ{K}), the equality
   -- routine will not be used.
   --
   -- If T is a subtype of $HASH, then `hash' will be used for the hash
   -- value, otherwise the element `id' will be used.
   --
   -- May be inherited with `elt_eq', `elt_nil', and `elt_hash' redefined
   -- to get a different behavior.
   --
   -- The tables grow by amortized doubling and so require writeback
   -- when inserting and deleting elements.
   -- We keep the load factor at .5 to cut down on collision snowballing.
   -- The simple collision resolution allows us to support deletions,
   -- but makes the behavior with poor hash functions quadratic.
   -- Puts a sentinel at the end of the table to avoid one check while
   -- searching.

   include AREF{T};

   private attr hsize:INT;    -- Number of stored entries.

   invariant:BOOL is
      -- Class invariant.
      return void(self) or hsize.is_bet(0,asize) end;

   elt_eq(e1,e2:T):BOOL is
      -- True if `e1' is equal to `e2' for the semantics of this set.
      -- If T descends from $IS_EQ{T}, use its `is_eq', otherwise use
      -- object equality. Often redefined in descendants.
      typecase e1
      when $IS_EQ{T} then return e1.is_eq(e2)
--    else return SYS::ob_eq(e1,e2) end end;                                    -- NLP
      else; end; return SYS::ob_eq(e1,e2); end;                                 -- NLP

   elt_nil:T is
      -- The element used to represent an empty hash entry.
      -- If T descends from $NIL{T}, use T::nil, otherwise use void.
      -- Often redefined in descendants.
      t:T;
      typecase t
      when $NIL{T} then return t.nil
--    else return void end end;                                                 -- NLP
      else; end; return void; end;                                              -- NLP

   elt_hash(e:T):INT is
      -- The hash index into self for `e'. Must have the property that
      -- two elements which are `elt_eq' have the same hash value.
      -- If T descends from $HASH use T::hash, otherwise use `id'.
      -- Often redefined in descendants. Self mustn't be void.
      typecase e
      when $HASH then return e.hash
--    else return SYS::id(e) end end;                                           -- NLP
      else; end; return SYS::id(e); end;                                        -- NLP

   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*n/2).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'.
      r::=new(n);
      if ~void(elt_nil) then loop r.aset!(elt_nil) end end;
      return r 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;                    -- NLP
      if void(self) then return 0; end; return hsize; end;                      -- NLP

   copy:SAME is
      -- A copy of self.
      r:SAME; loop r:=r.insert(elt!) end; return r end;

   elt!:T is
      -- Yield the elements 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!;
        if ~elt_eq(r,elt_nil) then yield r end end end end;

   first_elt:T is
      -- The first element in the table, if any, otherwise elt_nil.
      if ~void(self) then
     loop r::=aelt!;
        if ~elt_eq(r,elt_nil) then return r end end end;
      return elt_nil end;

   test(e:T):BOOL is
      -- True if `e' is `elt_eq' to an element contained in self.
      -- Self may be void.
      if void(self) then return false end;
      h::=elt_hash(e).band(asize-2);
      loop te::=[h];
     if elt_eq(te,e) then return true
     elsif elt_eq(te,elt_nil) then break! end;
     h:=h+1 end;
      if h=asize-1 then        -- hit sentinel
     h:=0;
     loop te::=[h];
        if elt_eq(te,e) then return true
        elsif elt_eq(te,elt_nil) then break! end;
        h:=h+1 end;
     assert h/=asize-1 end; -- table mustn't be filled
      return false end;

   get(e:T):T is
      -- If `e' is `elt_eq' to a table entry, return that entry,
      -- otherwise return `elt_nil'. Useful when different objects
      -- are treated as equal (eg. a table of strings used to get a
      -- unique representative for each class of equal strings).
      -- Self may be void.
      if void(self) then return elt_nil end;
      h::=elt_hash(e).band(asize-2);
      loop te::=[h];
     if elt_eq(te,e) then return te
     elsif elt_eq(te,elt_nil) then break! end;
     h:=h+1 end;
      if h=asize-1 then h:=0;    -- hit sentinel
     loop te::=[h];
        if elt_eq(te,e) then return te
        elsif elt_eq(te,elt_nil) then break! end;
        h:=h+1 end;
     assert h/=asize-1 end; -- table mustn't be filled
      return elt_nil end;

   private double_size:SAME
      -- A new table of twice the size of self with self's entries
      -- copied over.
      pre ~void(self) is
      r::=allocate((asize-1)*2+1);
      loop r:=r.insert(elt!) end;
      return r end;

   insert(e:T):SAME is
      -- A possibly new table which includes `e'. If an entry
      -- is `elt_eq' to `e' then overwrite it with `e'.
      -- Usage: `tbl:=tbl.insert(e)'.
      -- Creates a new table if void(self).
      r::=self;
      if void(r) then r:=allocate(5)
      elsif (hsize+1)*2>asize then r:=double_size end;
      asz::=r.asize;
      h::=r.elt_hash(e).band(asz-2);
      loop te::=r[h];
     if elt_eq(te,elt_nil) then break!
     elsif elt_eq(te,e) then r[h]:=e; return r end;
     h:=h+1 end;
      if h=asz-1 then h:=0;    -- hit sentinel
     loop te::=r[h];
        if elt_eq(te,elt_nil) then break!
        elsif elt_eq(te,e) then r[h]:=e; return r end;
        h:=h+1 end;
     assert h/=asz-1 end; -- table mustn't be filled
      r[h]:=e; r.hsize:=r.hsize+1; return r 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
      r::=allocate((asize-1)/2+1);
      loop r:=r.insert(elt!) end;
      return r end;

   delete(e:T):SAME is
      -- A possibly new table which deletes the element `e' if it
      -- is contained in self. Doesn't modify the table if arg
      -- is not contained. Usage: `tbl:=tbl.delete(e)'.
      -- Self may be void.
      if void(self) then return void end;
      h::=elt_hash(e).band(asize-2);
      loop te::=[h];
     if elt_eq(te,elt_nil) then return self
     elsif elt_eq(te,e) then break! end;
     if h=asize-2 then h:=0 else h:=h+1 end end;
      [h]:=elt_nil; hsize:=hsize-1; i::=h; -- h is the index of arg
     -- Now check the block after h for collisions.
      loop
     if i=asize-2 then i:=0 else i:=i+1 end;
     te::=[i];
     if elt_eq(te,elt_nil) then break! end;
     hsh::=elt_hash(te).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]:=elt_nil end
     else            -- block wraps
        if h>=hsh or h<i then -- hole in way
           [h]:=[i]; h:=i; [i]:=elt_nil end end end;
      if asize>=33 and hsize<(asize-1)/4 then return halve_size
--    else return self end end;                                                 -- NLP
      end; return self; end;                                                    -- NLP

   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 r.aset!(elt_nil) end; return r
--    else return void end end;                                                 -- NLP
      end; return void; end;                                                    -- NLP

   is_empty:BOOL is
      -- True if the set is empty. Self may be void.
      return (void(self)) or (hsize=0) end;

   is_eq(s:SAME):BOOL is
      -- True if `s' has the same elements as self. Self may be void.
      loop if ~s.test(elt!) then return false end end;
      loop if ~test(s.elt!) then return false end end;
      return true end;

   is_disjoint_from(s:SAME):BOOL is
      -- True if self and `s' have no elements in common.
      -- Self may be void.
      loop if s.test(elt!) then return false end end;
      return true end;

   intersects(s:SAME):BOOL is
      -- True if self and `s' have elements in common.
      -- Self may be void.
      return ~is_disjoint_from(s) end;

   is_subset(s:SAME):BOOL is
      -- True if all elements of self are contained in `s'.
      -- Self may be void.
      loop if ~s.test(elt!) then return false end end;
      return true end;

   to_union(s:SAME):SAME is
      -- The union of self and `s', modifies self.
      -- Self may be void.
      r::=self; loop r:=r.insert(s.elt!) end; return r end;

   union(s:SAME):SAME is
      -- A new set which is the union of self and `s'.
      -- Self may be void.
      return copy.to_union(s) end;

   to_intersect(s:SAME):SAME is
      -- The intersection of self and `s', modifies self.
      -- Self may be void.
      r::=self; loop r:=r.delete(s.elt!) end; return r end;

   intersect(s:SAME):SAME is
      -- A new set which is the intersection of self and s.
      -- Self may be void.
      r:SAME;
      loop e::=elt!;
     if s.test(e) then r:=r.insert(e) end end; return r end;

   to_difference(s:SAME):SAME is
      -- The difference of self and `s', modifies self.
      -- Self may be void.
      r::=self; loop r:=r.delete(s.elt!) end; return r end;

   difference(s:SAME):SAME is
      -- A new set which is the difference between self and `s'.
      -- Self may be void.
      r:SAME;
      loop e::=elt!;
     if ~s.test(e) then r:=r.insert(e) end end;
      return r end;

   to_sym_difference(s:SAME):SAME is
      -- The symmetric difference of self and `s', modifies self.
      -- Self may be void.
      r::=self;
      loop e::=s.elt!;
     if r.test(e) then r:=r.delete(e)
     else r:=r.insert(e) end end;
      return r end;

   sym_difference(s:SAME):SAME is
      -- A new set which is the symmetric difference between self
      -- and `s'. Self may be void.
      r:SAME;
      loop e::=elt!;
     if ~s.test(e) then r:=r.insert(e) end end;
      loop e::=s.elt!;
     if ~test(e) then r:=r.insert(e) end end;
      return r end;

   map(m:ROUT{T}:T):SAME is
      -- A new set whose elements are `m' applied to those of self.
      -- Self may be void.
      r:SAME; loop r:=r.insert(m.call(elt!)) end; return r end;

   filter(t:ROUT{T}:BOOL):SAME is
      -- A new set whose elements are those of self which satisfy `t'.
      -- Self may be void.
      r:SAME;
      loop e::=elt!; if t.call(e) then r:=r.insert(e) end end;
      return r end;

   some(t:ROUT{T}:BOOL):BOOL is
      -- True if some element of self satisfies `t'.
      -- Self may be void.
      loop if t.call(elt!) then return true end end;
      return false end;

   every(t:ROUT{T}:BOOL):BOOL is
      -- True if every element of self satisfies `t'.
      -- Self may be void.
      loop if ~t.call(elt!) then return false end end;
      return true end;

   notany(t:ROUT{T}:BOOL):BOOL is
      -- True if none of the elements of self satisfies `t'.
      -- Self may be void.
      loop if t.call(elt!) then return false end end;
      return true end;

   notevery(t:ROUT{T}:BOOL):BOOL is
      -- True if not every element of self satisfies `t'.
      -- Self may be void.
      loop if ~t.call(elt!) then return true end end;
      return false end;

end -- class FSET{T}

-------------------------------------------------------------------