map_incl.sa

 
---------------------------> Sather 1.1 source file <--------------------------
-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>
-- Copyright (C) 1995, International Computer Science Institute
-- $Id: map_incl.sa,v 1.7 1996/06/01 21:36:27 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.


class MAP{K,E} < $MAP{K,E} 
class MAP{K,E} < $MAP{K,E} is  
   -- An alias for H_MAP{K,E}. See the ancestors list.
   include H_MAP{K,E}; 
end;


partial class MAP_INCL{ITP,ETP} 
partial class MAP_INCL{ITP,ETP} is
   -- Partial class for MAPs
   include COMPARE{ETP};

   stub size: INT; 
   -- Return the number of elements in the map
   
   stub elt!: ETP;
   -- Yield the elements (targets) of the map
   
   stub ind!: ITP;
   -- Yield the indices (keys) of the map
   
   stub aget(ind: ITP): ETP;
   -- Return the target corresponding to index "ind"
   
   stub aset(ind: ITP,e: ETP);
   -- Set the target of index "ind" to "e"

   -- ------------------- Access  -------------------------
   test_if(test:ROUT{ETP}:BOOL,out ind: ITP, out elt: ETP):BOOL is
      -- Return true if an element satisfies test "test"
      -- Arg "ind" is set to the index of the element satisfying "test"
      -- Arg "elt" is set to the element satisfying "test"
      loop r ::= ind!; 
	 e ::= aget(r);
	 if test.call(e) then ind := r; elt := e; return true end;  
      end; 
      return false;
   end;

   inds: ARRAY{ITP} is
      -- Return an index array which is the same size as self and
      -- is set to the values of the indices
      sz: INT := size;
      res: ARRAY{ITP} := #(sz);
      i: INT := 0;
      loop until!(i >= sz); res[i] := ind!; i := i + 1; end;
      return res;
   end;

   --              ------ Queries/Comparison --------------
   has(e: ETP): BOOL is return has_elt(e) end;
   
   has_elt(e:ETP):BOOL is
      -- True if the self has an element which is `elt_eq' to `e'.
      if void(self) then return false end;
      loop if elt_eq(elt!,e) then return true end  end;
      return false 
   end;

   equals(e: $RO_MAP{ITP,ETP}): BOOL is
      -- Returns true if all of "e"'s elements are equal to self's elts
      -- Ordering is an issue. Should be redefined to be more
      -- precise for particular descendants
      if e.size /= size then return false end;
      loop k ::= ind!;
	 a1 ::= aget(k); a2 ::= e.aget(k);
	 if ~elt_eq(a1,a2) then return false end 
      end;
      return true
   end;

   --              ------ Conversion ----------------------
    str: STR is
      -- Prints out a string version of the array of the components 
      -- that are under $STR, and their associated indices
      res ::= #FSTR("{");
      loop  
	 res := res+",".separate!("["+ind_str(ind!)+"]="+elt_str(elt!));  
      end;
      res := res +"}";
      return(res.str);
   end;

   elt_str: STR is
      -- Prints out a string version of the array of the components 
      -- that are under $STR, and their associated indices
      res ::= #FSTR("");
      loop res:=res+",".separate!(elt_str(elt!)); end;
      return(res.str);
   end;
				  
   --              ------ Basic Operations ----------------
   count_if( test:ROUT{ETP}: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;

   count(v:ETP):INT is
      -- The number of elements that are `elt_eq' to `v'.
      -- Self may be void.
      r::=0; 
      loop if elt_eq(elt!,v) then r:=r+1 end   end;
      return r 
   end;

   replace(o,n:ETP) is
      -- Replace elements that are `elt_eq' to `o' by `n' wherever it occurs
      loop i ::= ind!; e::=aget(i); if elt_eq(e,o) then aset(i,n); end; end;
   end;

   replace_if(test:ROUT{ETP}:BOOL, n:ETP) is
      -- Replace elements that satisfy `test' by `n'.
      loop i ::= ind!; e::=aget(i); if test.call(e) then aset(i,n); end; end;
   end;
   
   map(r:ROUT{ETP}:ETP) is
      -- Set each element of self to the result of applying `r' to it.
      loop i ::= ind!; aset(i,r.call(aget(i)))  end 
   end;

   permute_into( new_pos :$RO_MAP{ITP,ITP}, destination: $MAP{ITP,ETP}) is
      -- Copy the entries from orig_arr into self using
      -- the permutation array "new_positions" 
      loop 
	 i: ITP := ind!;
	 new_i: ITP := new_pos[i];
	 assert(destination.has_ind(new_i));
	 destination.aset(new_i,aget(i));
      end;
   end;
      
   some( test:ROUT{ETP}: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{ETP}: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{ETP}: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{ETP}: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;

   private ind_str(i: ITP): STR is
      typecase i
      when $STR then return i.str  else return "Unprintable Index" end;
   end;
   
   private elt_str(e: ETP): STR is
      typecase e 
      when $STR then return e.str  else return "Unprintable Element" end;
   end;

end;