------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 1995 by International Computer Science Institute            --
-- This file is part of the GNU Sather package. It is free software; you may --
-- redistribute  and/or modify it under the terms of the  GNU General Public --
-- License (GPL)  as  published  by the  Free  Software  Foundation;  either --
-- version 2 of the license, or (at your option) any later version.          --
-- This  program  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/GPL 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>  <--------------

-- ident.sa: Identifier related classes.
-------------------------------------------------------------------
-- IDENT: Representation of identifiers in the Sather compiler.
-- IDENT_TBL: A table mapping strings to identifiers.
-------------------------------------------------------------------
immutable class IDENT < $HASH, $IS_LT{IDENT} is
   -- Representation of identifiers in the Sather compiler.
   -- A immutable class with one attribute: a pointer to a string containing
   -- the identifier. The string objects are uniquely associated with
   -- the string, so SI_IDENT equality can be used to test for string
   -- equality.  Note that IDENTs use a shared (global) table, so
   -- they aren't reentrant.
   include COMPARABLE;
   
   shared tmp_count:INT;
   private shared ident_tbl:IDENT_TBL;
   
   readonly attr str:STR;		-- The string represented by self.
   
   create(s:STR):IDENT is
      -- The identifier corresonding to the string `s'.
      if void(s) then return void; end;
      i::=ident_tbl.get_query(s); 
      if void(i) then
	 i:=i.str(s);
	 ident_tbl:=ident_tbl.insert(i) end; 
      return i end;
   
   str(i:INT): STR
   -- Returns a name with a list of empty parameters.
   is
      res: STR;
      if i = 0 then return str end;
      loop i.times!;
	 res := res + ",".separate!("_");
      end;
      return str + "{" + res + "}";
   end;
   
   is_lt(i:IDENT): BOOL is
      return str < i.str;
   end;
   
   is_eq(i:SAME):BOOL is
      -- Test whether self is the same identifier as `i'.
      return SYS::ob_eq(str,i.str) end;
   
   is_iter:BOOL is
      -- True if self is the name of an iter (ends with a "!").
      return ~void(str) and str[str.size-1]='!' end;
   
   str_in(s:FSTR):FSTR is
      -- Append the string represented by self to `s'.
      return s + str end;
   
   hash:INT is
      -- MBK, SYS::id(str) by itself not that good a hash. 
      x::=SYS::id(str);
      -- Numerical Recipes in C, p 284
      return (x.mtimes(1664525)).mplus(1013904223);
   end;
   
   next_tmp(oldident:STR):STR is
      ret ::= #STR;
      ret := "_pS_"+oldident+"_"+tmp_count.str;
      tmp_count := tmp_count + 1;
      return ret;
   end;
   
end; -- immutable class IDENT

-------------------------------------------------------------------
class IDENT_TBL is
   -- A table mapping strings to identifiers.
   -- get_query(s:STR):IDENT to get identifier if present.
   -- insert(i:IDENT):SAME to add a new identifier.
   
   include FQSET{STR,IDENT};
   
   query_test(s:STR, i:IDENT):BOOL is
      -- True if `i' represents `s'.
      return s=i.str end;
   
   query_hash(s:STR):INT is
      -- Hash value for the string `s'.
      return s.hash end;
   
   elt_hash(i:IDENT):INT is
      -- Hash value for the identifier `i'.
      return i.str.hash end;
   
end; -- class IDENT_TBL

-------------------------------------------------------------------
class IDENT_BUILTIN is
   -- Cache for quick access to the built-in identifers.
   
   readonly shared dollar_OB_ident, ARR_ident, INT_ident, INTI_ident,
	 FLT_ident, 
	 FLTD_ident, FLTDX_ident, FLTX_ident, plus_ident, minus_ident, 
	 times_ident, div_ident, pow_ident, mod_ident, is_lt_ident, 
	 negate_ident, not_ident, 
	 AVAL_ident, AREF_ident, aget_ident, aset_ident, call_ident,
	 call_bang_ident, create_ident, ARRAY_ident, self_ident, 
	 ret_ident, -- Ivin.
	 invariant_ident, asize_ident, main_ident, is_eq_ident, 
	 ob_eq_ident, bang_ident,
	 SYS_ident, C_name_ident, C_header_ident,
	 ZONE_ident,
   -- FORTRAN STUFF
	 F_INTEGER_ident, F_REAL_ident, F_CHARACTER_ident, F_LOGICAL_ident,
	 F_DOUBLE_ident, F_COMPLEX_ident, F_DOUBLE_COMPLEX_ident,
	 F_STRING_ident, F_HANDLER_ident, F_ROUT_ident,
	 F_ARRAY_ident, F_ARRAY2_ident, F_ARRAY3_ident:IDENT;

   
   init is
      -- Construct the built-in identifiers.
      dollar_OB_ident:=#IDENT("$OB");
      ARR_ident:=#IDENT("ARR");
      INT_ident:=#IDENT("INT");
      INTI_ident:=#IDENT("INTI");
      FLT_ident:=#IDENT("FLT");
      FLTD_ident:=#IDENT("FLTD");
      FLTDX_ident:=#IDENT("FLTDX");
      FLTX_ident:=#IDENT("FLTX");
      
      -- FORTRAN stuff
      F_INTEGER_ident := #IDENT("F_INTEGER");
      F_REAL_ident := #IDENT("F_REAL");
      F_CHARACTER_ident := #IDENT("F_CHARACTER");      
      F_STRING_ident := #IDENT("F_STRING");            
      F_LOGICAL_ident := #IDENT("F_LOGICAL");      
      F_DOUBLE_ident := #IDENT("F_DOUBLE");      
      F_COMPLEX_ident := #IDENT("F_COMPLEX");
      F_DOUBLE_COMPLEX_ident := #IDENT("F_DOUBLE_COMPLEX");      
      F_HANDLER_ident := #IDENT("F_HANDLER");            
      F_ROUT_ident := #IDENT("F_ROUT");                  
      F_ARRAY_ident := #IDENT("F_ARRAY");
      F_ARRAY2_ident := #IDENT("F_ARRAY2");      
      F_ARRAY3_ident := #IDENT("F_ARRAY3");            
      
      
      plus_ident:=#IDENT("plus");
      minus_ident:=#IDENT("minus");
      times_ident:=#IDENT("times");
      div_ident:=#IDENT("div");
      pow_ident:=#IDENT("pow");
      mod_ident:=#IDENT("mod");
      is_lt_ident:=#IDENT("is_lt");
      negate_ident:=#IDENT("negate");
      not_ident:=#IDENT("not");
      AVAL_ident:=#IDENT("AVAL");
      AREF_ident:=#IDENT("AREF");
      aget_ident:=#IDENT("aget");      
      aset_ident:=#IDENT("aset"); 
      call_ident:=#IDENT("call"); 
      call_bang_ident:=#IDENT("call!");       
      create_ident:=#IDENT("create");       
      ARRAY_ident:=#IDENT("ARRAY");             
      ret_ident:=#IDENT("ret_val");                       
      self_ident:=#IDENT("self");                   
      invariant_ident:=#IDENT("invariant");                         
      asize_ident:=#IDENT("asize");         
      C_name_ident:=#IDENT("C_name");
      C_header_ident:=#IDENT("C_header");
      main_ident:=#IDENT("main");               
      is_eq_ident:=#IDENT("is_eq");               
      ob_eq_ident:=#IDENT("ob_eq");
      bang_ident:=#IDENT("!");
      SYS_ident:=#IDENT("SYS");
      ZONE_ident:=#IDENT("ZONE");
      
   end;   
   
end; -- class IDENT_BUILTIN

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