bag_incl.sa

 
---------------------------> Sather 1.1 source file <--------------------------
-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>
-- Copyright (C) 1995, International Computer Science Institute
-- $Id: bag_incl.sa,v 1.7 1996/06/01 21:36:15 gomes Exp $
--
-- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
-- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
-- LICENSE contained in the file: Sather/Doc/License of the
-- Sather distribution. The license is also available from ICSI,
-- 1947 Center St., Suite 600, Berkeley CA 94704, USA.



partial class BAG_INCL{E} 
partial class BAG_INCL{E} is
   -- Partial class for read-only sets that implements other functions
   -- in terms of has and elt!
   -- Until we get partial classes, include using:
   -- include BAG_INCL{E} has->, elt!->,unique!->;

   include COMPARE{E};
   
   --           --------- CORE FEATURES (must define) ---------
   stub has(e:E): BOOL; 
   -- Return true if the bag has the element "e"
   
   stub elt!: E;
   -- Yield successive elements of the bag
   
   stub unique!: E;
   -- Yield unique elements of the bag (i.e. as if it were a set)
   
   stub count(e: E): INT;
   -- Return the number of times the element "e" occurs in the bag
   
   stub insert(e:E);
   -- Insert "e" into the bag
   
   stub copy: SAME;
   -- Return a copy of the bag
   
   --              ------ Initialization/Duplication -------
   private internal_create: SAME is return #BAG{E} end;
   -- Default create. Called internally 
   
   --              ------ Access/Measurement -------------
   size: INT is 
      i ::= 0; loop discard ::= elt!; i := i + 1; end;
      return i;
   end;
   
   is_empty: BOOL pre ~void(self) is  
      -- Do not do size=0. Finding size may require iteration
      -- through all elements - quite wasteful for just "is_empty"
      loop e ::= elt!; return false; end;
      return true;
   end;

   --              ------ Queries/Comparison --------------
   equals(a:$RO_BAG{E}): BOOL
      pre ~void(self) and ~void(a)
   is
      if size /= a.size then return false end;
      loop e::=unique!; if count(e) /= a.count(e) then return false end end;
      return true
   end;

   is_subset(a: $RO_BAG{E}): BOOL
   -- Returns true, if 'a' has all elements with higher occurences
   -- as self.
      pre ~void(self) and ~void(a)
   is
      loop e ::= unique!; if count(e) > a.count(e) then return false end end;
      return true
   end;

   --              ------ Conversion ----------------------
   as_array: ARRAY{E} is
      res ::= #ARRAY{E}(size);
      loop res.set!(elt!) end;
      return res;
   end;

   str: STR is
      -- Prints out a string version of the array of the components 
      -- that are under $STR
      res ::= #FSTR("{");
      loop res := res+",".separate!(elt_str(elt!));  end;
      res := res + "}";
      return(res.str);
   end;
   
   --              ------ Basic Operations ----------------
   union(a: $RO_BAG{E}): SAME
    -- Returns a set containing all elements being contained in
    -- the sets. The properties of the result are the ones from
    -- the first set.
    -- Neither of the sets may be void.
      pre ~void(self) and ~void(a)
   is
      res ::= copy;
      loop res.insert(a.elt!) end;
      return res
   end;


   intersection(a: $RO_BAG{E}): SAME
    -- Returns a set containing all elements being contained in
    -- both sets. The properties of the result are the ones from
    -- the first set.
    -- Neither of the sets may be void.
      pre ~void(self) and ~void(a)
   is
      res ::= internal_create;
      loop
	 e ::= elt!;
	 if a.has(e) then res.insert(e) end
      end;
      return res
   end;

   difference(a:$RO_BAG{E}): SAME
   -- Returns a set containing all elements being contained in
   -- self but not in a. The properties of the result are the ones
   -- from the first set.
   -- Neither of the sets may be void.
      pre ~void(self) and ~void(a)
   is
      res ::= internal_create;
      loop
	 e ::= elt!;
	 if ~a.has(e) then res.insert(e) end
      end;
      return res
   end;

   is_disjoint(a:$RO_BAG{E}): BOOL
    -- Returns 'true' if all elements of 'self' are not contained
    -- in 'a' and vice versa.
    -- Neither may be void.
	pre ~void(self) and ~void(a)
   is
      loop if has(a.elt!) then return false end end;
      loop if a.has(elt!) then return false end end;
      return true
   end;

   count_if(test:ROUT{E}:BOOL):INT is
      -- The number of elements which satisfy `test'.
      -- Self may be void.
      r::=0; 
      loop if test.call(elt!) then r:=r+1 end   end;
      return r 
   end;

   index_of(e: E):INT is
      -- Return index of leftmost element of self which  is equal to "e"
      -- or -1 if there is none. 
      i ::= 0;
      loop r ::= elt!; 
	 if elt_eq(e,r) then return i end;
	 i := i + 1;
      end; 
      return -1;
   end;

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

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

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

   -- ------------------- Implementation ------------------
   private elt_str(e: E): STR is
      -- Return a string representing the element "e"
      typecase e 
      when $STR then return e.str  else return "Unprintable Element" end;
   end;

end;