------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 1994 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>  <--------------

class ELT_ALG{ETP,CTP<$ELT{ETP}} is
   -- Some helper routines that may be used by classes that provide an
   -- elt! iterator.  


   unique!(c:CTP):ETP is
      -- Yield the unique elements of 'c'
      already_seen:ARRAY{ETP} := #(5);
      num_seen:INT := 0;
      arr_size:INT := 5;
      loop e ::= c.elt!;
	 is_seen:BOOL := false;
	 loop i ::= num_seen.times!;
	    if ELT_EQ{ETP}::elt_eq(already_seen[i],e) then is_seen := true end;
	 end;
	 if ~is_seen then 
	    if arr_size <= num_seen then 
	       arr_size := 2*arr_size;
	       already_seen := already_seen.resize(arr_size);
	    end;
	    already_seen[num_seen] := e;
	    num_seen := num_seen+1;
	    yield e 
	 end;
      end;
   end;

   filter!(c:CTP, once f:ROUT{ETP}:BOOL): ETP  pre ~void(c) is
      -- Yield all elements that satisfy the boolean predicate "f"
      loop
	 e ::= c.elt!;
	 if f.call(e) then yield e end
      end
   end;

   filter_not!(c:CTP, once f:ROUT{ETP}:BOOL): ETP  pre ~void(c) is
      -- Yield all elements that do not satisfy the boolean predicate "f"
      loop e ::= c.elt!; if ~f.call(e) then yield e end  end
   end;

   elt_if(c:CTP,test:ROUT{ETP}:BOOL,out res:ETP):BOOL is
      -- Return true if the container has an element that satisfies the
      -- predicate 'test'. The out argument 'res' is set to the 
      -- return value
      loop r ::= c.elt!; if test.call(r) then res:=r; return true; end;  end; 
      return false;
   end;
   
   count_if(c:CTP, test:ROUT{ETP}:BOOL):INT is
      -- The number of elements which satisfy `test'.
      r::=0; 
      loop if test.call(c.elt!) then r:=r+1 end   end;
      return r 
   end;

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

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

   notany(c:CTP,test:ROUT{ETP}:BOOL):BOOL is
      -- True if none of the elements of self satisfies `test'.
      -- Self may be void.
      loop if test.call(c.elt!) then return false end end; 
      return true 
   end;
   
   notevery(c:CTP, test:ROUT{ETP}:BOOL):BOOL is
      -- True if not every element of self satisfies `test'.
      -- Self may be void.
      loop if ~test.call(c.elt!) then return true end  end;
      return false 
   end;
   
   str(arr:$ELT{ETP}):STR is
      -- Print out a string version of the array
      res ::= #FSTR("{");
      i ::= 0;
      loop e ::= arr.elt!;
	 if i > 0 then res := res+","+elt_str(e,i);
	 else  res := res + elt_str(e,i); end;
	 i := i + 1;
      end;
      res := res+"}";
      return(res.str);
   end;
	    
   elt_str(e: $OB,i: INT): STR is
      typecase e 
      when $STR then return e.str 
      else return "Unprintable:"+i.str end;
   end;

end;
-------------------------------------------------------------------
class ELT_ALG{ETP} is
   include ELT_ALG{ETP,$ELT{ETP}};
end;
-------------------------------------------------------------------
