------------------------->  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>  <--------------

-- multimap_incl.sa: Multimap include partial class
-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>

partial class RO_MULTIMAP_INCL{ITP,TTP} is
   -- Partial class that for the read only multimap abstraction, class
   -- $RO_MULTIMAP{ETP}.  For more information on the relationship between
   -- the abstract classes, partial classes and actual implementations
   -- please see the class comment class in the abstraction.
   -- 
   -- This partial class implements some of the operations required by
   -- the abstraction in terms of a set of core functions which are
   -- stubs in this partial class. These stubs must be replaced by
   -- real function in any descendant that actually implements the
   -- abstraction. Particular implementations may replace also some of
   -- the non-stub operations by substantially more efficient
   -- versions, that make use of properties of the actual
   -- implementation.
   -- 
   include COMPARE{TUP{ITP,TTP}};

   -- Please see the abstraction $RO_MULTIMAP for comments about these
   -- stubs
   stub ind!:ITP;

   stub n_targets(i:ITP):INT;
	 
   stub target!(once i:ITP):TTP;

   stub add(e:TUP{ITP,TTP}):SAME;
   
   stub delete(e:TUP{ITP,TTP}):SAME;
   
   stub delete_all(e:TUP{ITP,TTP}):SAME;
   
   stub unique!:TUP{ITP,TTP};

   stub size:INT;
   
   stub copy:SAME;

   stub has(e:TUP{ITP,TTP}):BOOL;
   
   stub elt!:TUP{ITP,TTP};

   
   -- Methods not required by the $RO_MULTIMAP abstraction. They can be safely
   -- redefined away, if not needed
   stub create:SAME;
   
   create(arg:$ELT{TUP{ITP,TTP}}):SAME is
      -- Create a new bag out of the elements of 'arg'
      res: SAME := #;
      loop res := res.add(arg.elt!) end;
      return res;
   end;

   -- Methods required by the $RO_MULTIMAP abstraction
   -- 
   add(k:ITP,e:TTP):SAME is return add(#TUP{ITP,TTP}(k,e)); end;
   -- Shortcut for for add(#TUP{ITP,TTP}(k,e))
   
   delete(k:ITP,e:TTP):SAME is
      -- Shortcut for for delete(e:TUP{ITP,TTP})
      return delete(#TUP{ITP,TTP}(k,e))
   end;

   delete_ind(k:ITP):SAME is
      -- Returns a new multimap in which all occurences of the tuple
      -- (k,_) have been deleted
      -- Introduced in $RO_MULTIMAP
      res ::= copy;
      loop res.delete(k,target!(k)); end;
      return res;
   end;

   has_ind(k:ITP):BOOL is
      -- Returns true if this map has an index equal to 'e'
      -- 
      -- result is true iff self contains a tuple (_,e)   
      return n_targets(k) > 0
   end;

   n_ind:INT is
      -- Return the number of unique indices in this multimap
      res::=0; loop discard ::= ind!; res := res+1; end; return res;
   end;
      
   pair!:TUP{ITP,TTP} is 
      -- Yields all elements of self in an unspecified order. An alias for
      -- "elt!"
      loop yield elt!; end;
   end;

   count(arg:TUP{ITP,TTP}):INT is
      -- Return the number of occurences of 'arg' in the container
      res:INT := 0;
      loop e ::= elt!;
	 if elt_eq(arg,e) then res := res + 1; end;
      end;
      return res;
   end;

   n_unique:INT is
      -- Return the number of unique pairs in 'self'
      res:INT := 0;
      loop discard ::= unique!; res := res+1; end;
      return res;
   end;

   is_subset_of(arg:$RO_BAG{TUP{ITP,TTP}}):BOOL is
      -- Returns true if 'self' is a subset of 'arg'. For elements that occur
      -- multiple times, the number of occurences of the element in 'arg'
      -- must be greater than or equal to the number of occurences in self
      -- 
      -- result=true iff for all e in self: count(e) <= arg.count(e)   
      loop e ::= unique!;
	 if count(e) > arg.count(e) then return false; end;
      end;
      return true;
   end;
   
   concat(arg:$ELT{TUP{ITP,TTP}}):SAME is
      -- Returns a bag containing all the elements of self and 'arg'.
      -- For elements that occur multiple times, the result contains
      -- the sum of the number of occurences in self and 'arg'
      -- 
      -- result=multimap of all e s.t. 
      --                  result.count(e)=self.count(e)+arg.count(e)>0 
      res ::= copy;
      loop res := res.add(arg.elt!); end;
      return res;
   end;
   
   union(arg: $RO_BAG{TUP{ITP,TTP}}):SAME is
      -- Returns a multimap containing the elements of 'self' and 'arg'. 
      -- For elements that occur multiple times, the result contains
      -- the maximum number of occurences in either self or 'arg'
      -- This definition permits the union of sets to be consistent
      -- with the union of bags.
      -- 
      -- result=bag of all e s.t. 
      --             result.count(e)= max(self.count(e),arg.count(e)) > 0
      res ::= copy;
      loop arg_elt:TUP{ITP,TTP} := arg.elt!;
	 if ~res.has(arg_elt) then res := res.add(arg_elt);
	 else
	    if arg.count(arg_elt) > res.count(arg_elt) then
	       res := res.add(arg_elt);
	    end;
	 end;
      end;
      return res
   end;
   
   intersection(arg: $RO_BAG{TUP{ITP,TTP}}):SAME is
      -- Returns a bag containing the elements common to self and 'arg'
      -- For elements that occur multiple times, the result contains
      -- the minimum number of occurrences in either self or 'arg'
      -- 
      -- result=bag of all e s.t. 
      --              result.count(e)=min(self.count(e),arg.count(e)) > 0 
      res:SAME := copy;
      loop
	 e ::= unique!;
	 num_to_delete: INT := (count(e) - arg.count(e)).max(0);
	 loop num_to_delete.times!;  res := res.delete(e); end;
      end;
      return res
   end;

   diff(arg:$RO_BAG{TUP{ITP,TTP}}):SAME is
      -- Returns a bag containing all the elements of self that are
      -- not in 'arg' For elements that occur multiple times in self,
      -- the number of occurences in the result is reduced by the
      -- number of occurences in 'arg'
      -- 
      -- result=bag of all e s.t. result.count(e)=self.count(e)-arg.count(e)>0
      res:SAME := copy;
      loop
	 e ::= unique!;
	 num_to_delete: INT := arg.count(e);
	 loop num_to_delete.times!;  res := res.delete(e); end;
      end;
      return res
   end;
   
   sym_diff(arg:$RO_BAG{TUP{ITP,TTP}}):SAME is
      -- Returns a bag containing all the elements of self that are not
      -- in 'arg' and in 'arg' but not in self.  For elements that occur
      -- in both, the result contains the absolute value fo the difference
      -- in the number of occurences.
      -- 
      -- result=bag of all e s.t. 
      --             result.count(e)=|self.count(e)-arg.count(e)|>0
      union:SAME := union(arg);
      intersect:SAME := intersection(arg);
      return union.diff(intersect);
   end;

   
   is_empty:BOOL is 
      -- Return true if the size = 0. 
      return size = 0;
   end;
   
   equals(c:$RO_BAG{TUP{ITP,TTP}}):BOOL is
      -- Return true if self contains all the elements of 'c' and vice
      -- versa. 
      if size /= c.size then return false end;
      loop if ~has(c.elt!) then return false end; end;
      return true;
   end;
   
   as_array:ARRAY{TUP{ITP,TTP}} is
      -- Return the elements of the container as an array
      res ::= #ARRAY{TUP{ITP,TTP}}(size);
      loop res.set!(elt!) end;
      return res;
   end;

   str: STR is return ELT_ALG{TUP{ITP,TTP}}::str(self); end;
   -- Return a string representation of self 
   
end;
-------------------------------------------------------------------
partial class MULTIMAP_INCL{ITP,TTP} is
   -- Partial class that for the multimap abstraction class $MULTIMAP{ITP,TTP}.
   -- For more information on the relationship between the abstract
   -- classes, partial classes and actual implementations please see
   -- the class comment class in the abstraction.
   -- 
   -- This partial class implements some of the operations required by
   -- the abstraction in terms of a set of core functions which are
   -- stubs in this partial class. These stubs must be replaced by
   -- real function in any descendant that actually implements the
   -- abstraction. Particular implementations may replace also some of
   -- the non-stub operations by substantially more efficient
   -- versions, that make use of properties of the actual
   -- implementation.
   include RO_MULTIMAP_INCL{ITP,TTP};

   -- 
   -- Please see the abstraction $MULTIMAP for comments
   -- 
   stub aset(k:ITP,e:TTP);

   stub delete(k:ITP,e:TTP);
   
   stub delete(k:ITP);
   
   stub delete_all(k:ITP,e:TTP);

   stub ind!:ITP;

   stub target!(i:ITP):TTP;

   stub unique!:TUP{ITP,TTP};
   
   stub size:INT;
   
   stub copy:SAME;
   
   stub has(e:TUP{ITP,TTP}):BOOL;

   stub elt!:TUP{ITP,TTP};
   

   -- **** To satisfy the $MULTIMAP abstraction
   as_value:VMULTIMAP{ITP,TTP} is
      -- Return the value associated with this reference type
      return #VMULTIMAP{ITP,TTP}(self);
   end;

   clear post size = 0 is
      -- Delete all elements of self
      f:ARRAY{TUP{ITP,TTP}} := #(n_unique);
      loop f.set!(unique!); end;
      loop delete_all(f.elt!); end;
      #ERR+str;
   end;
   
   delete(e:TUP{ITP,TTP}) is 
      -- Delete at most one instance of the tuple (e.t1,e.t2) from 'self'
      delete(e.t1,e.t2) 
   end;
   
   delete_all(e:TUP{ITP,TTP}) is 
      -- Delete all instances of the tuple (e.t1,e.t2) from 'self'
      delete_all(e.t1,e.t2) 
   end;
   
   to_union(arg: $RO_BAG{TUP{ITP,TTP}}) is
      -- Turn this bag into the union of self and 'arg'
      -- self <- initial(self).union(arg)
      loop arg_elt:TUP{ITP,TTP} := arg.elt!;
	 if ~has(arg_elt) then [arg_elt.t1] := arg_elt.t2;
	 else
	    if arg.count(arg_elt) > count(arg_elt) then 
	       [arg_elt.t1] := arg_elt.t2;
	    end;
	 end;
      end;
   end;

   to_intersection(arg:$RO_BAG{TUP{ITP,TTP}}) is
      -- Turn this bag into the intersection of self and 'arg'
      -- self <- initial(self).intersection(arg)
            -- Copy the unique elts so that we don't iterate while
      -- deleting
      f ::= #ARRAY{TUP{ITP,TTP}}(n_unique); loop f.set!(unique!) end;
      loop e ::= f.elt!;
	 if ~arg.has(e) then delete_all(e); end;
      end;
      -- For elements in the intersection, reduce the number
      -- of repetitions to the min number of occurences
      loop e ::= arg.unique!;
	 num_to_delete:INT := count(e) - arg.count(e);
	 if num_to_delete > 0 then
	    loop num_to_delete.times!; delete(e); end;
	 end;
      end;
   end;

   add(e:TUP{ITP,TTP}) is
      -- Add the tuple (e.t1,e.t2) to self
      [e.t1] := e.t2
   end;
      
   add(e:TUP{ITP,TTP}):SAME is
      -- Result is a new multimap containing all the elements of self and 'e'
      res ::= copy; 
      res[e.t1] := e.t2; 
      return res;
   end;
   
   delete(e:TUP{ITP,TTP}):SAME is
      -- Result is a new multimap containing all the elements of self
      -- except for an element equal to 'e', if one exists. If more
      -- than one element is equal to 'e', delete only one of them
      res ::= copy; res.delete(e); return res;
   end;
   
   delete_all(e:TUP{ITP,TTP}):SAME is
   -- Result is a new multimap ontaining all the elements of self except for
   -- any elements equal to 'e'
      res ::= copy; res.delete_all(e.t1,e.t2); return res;
   end;
   
end;
-------------------------------------------------------------------
