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

-- char.sa: Characters.
-------------------------------------------------------------------
immutable class CHAR < $IS_LT{CHAR}, $HASH, $STR, $FMT is
   -- Objects which represent characters.
   -- This version is for ASCII. Other implementations might use
   -- UNICODE, etc.
   
   -- AVAL isn't handled right yet, leave out for the moment.
   -- include AVAL{BOOL} asize->;

   
   const asize:=SYS::char_size;

   is_alpha:BOOL is
      -- True if self is an alphabetic character.
      case self
      when 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
	 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
	 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 
	 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z'
      then return true 
      else return false end 
   end;

   is_upper:BOOL is
      -- True if self is uppercase.
      case self
      when 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
	 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z' 
      then return true
      else return false end 
   end;
   
   is_lower:BOOL is
      -- True if self is lowercase.
      case self
      when 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
	 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z' 
      then return true
      else return false end
   end;

   is_octal_digit:BOOL is
      -- True if self is an octal digit.
      case self
      when '0', '1', '2', '3', '4', '5', '6', '7'
      then return true
      else return false end 
   end;
      
   octal_digit_value:INT is
      -- The numerical value of self as an octal digit. -1 if not.
      case self 
      when '0' then return 0   when '1' then return 1
      when '2' then return 2   when '3' then return 3
      when '4' then return 4   when '5' then return 5
      when '6' then return 6   when '7' then return 7 
      else return -1 end 
   end;
      
   is_digit:BOOL is 
      -- True if self is a digit.
      case self
      when '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' 
      then return true
      else return false end
   end;

   digit_value:INT is
      -- The numerical value of self as a decimal digit.
      -- -1 if it isn't.
      case self 
      when '0' then return 0   when '1' then return 1
      when '2' then return 2   when '3' then return 3
      when '4' then return 4   when '5' then return 5
      when '6' then return 6   when '7' then return 7
      when '8' then return 8   when '9' then return 9 
      else return -1 end
   end;
   
   is_hex_digit:BOOL is 
      -- True if self is a hexadecimal digit.
      case self
      when '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
	 'a', 'b', 'c', 'd', 'e', 'f', 'A', 'B', 'C', 'D', 'E', 'F'
      then return true
      else return false end 
   end;

   hex_digit_value:INT is
      -- The numerical value of self as a hexadecimal digit.
      -- -1 if it isn't.
      case self 
      when '0' then return 0   when '1' then return 1
      when '2' then return 2   when '3' then return 3
      when '4' then return 4   when '5' then return 5
      when '6' then return 6   when '7' then return 7
      when '8' then return 8   when '9' then return 9 
      when 'a','A' then return 10  when 'b','B' then return 11 
      when 'c','C' then return 12  when 'd','D' then return 13 
      when 'e','E' then return 14  when 'f','F' then return 15 
      else return -1 end
   end;
   
   is_alphanum:BOOL is
      -- True if self is alphanumeric.
      case self
      when 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 
	 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 
	 'z',
	 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 
	 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
	 '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' 
      then return true
      else return false end
   end;
   
   is_space:BOOL is
      -- True if self is one of the whitespace characters:
      -- space, form feed, newline, carriage return, tab, vertical tab.
      -- NOTE: temporarily Ctrl-Z will be treated as whitespace. This
      --       ensures OS/2 compatibility until FILE classes are fixed.
      case self
      when ' ', '\f', '\n', '\r', '\t', '\v', '\032'
      then return true
      else return false end
   end;

   is_print:BOOL is
      -- True if self is a printing character.
      case self
      when ' ', 
	 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
	 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
	 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 
	 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
	 '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
	 '!', '\"', '#', '$', '%', '&', '\'', '(', ')', '*', '+', 
	 '-', '.', '/', ':', ';', '<', '=', '>', '?', '@', '[', '\\', 
	 ']', '^', '_',	'`', '{', '|', '}', '~',','
      then return true
      else return false end 
   end;
   
   is_punct:BOOL is 
      -- True if self is punctuation.
      case self
      when '!', '\"', '#', '$', '%', '&', '\'', '(', ')', '*', '+', 
	 '-', '.', '/', ':', ';', '<', '=', '>', '?', '@', '[', '\\', 
	 ']', '^', '_',	'`', '{', '|', '}','~',','
      then return true
      else return false end
   end;	 

   is_control:BOOL is
      -- True if self is a control character.
      return self.int<32;
   end;

   int:INT is
      -- The integer version of self.  Returns unsigned value.  Built-in.
      builtin CHAR_INT; 
   end;

   hash:INT is
      -- A very cheap, but not very good hash value. It just returns 
      -- the hash of the integer representation of the char.
      return int.hash; 
   end;
      
   ascii_int:INT is
      -- The ASCII integer associated with each character in the
      -- minimal Sather character set. Returns -1 for other characters.
      case self
      -- This case commented out due to a bug in gdb not recognizing \a
      -- when '\a' then return 7
      when '\b' then return 8      
      when '\t' then return 9       when '\n' then return 10      
      when '\v' then return 11      when '\r' then return 13
      when ' ' then return 32       when '!' then return 33 
      when '\"' then return 34      when '#' then return 35 
      when '$' then return 36       when '%' then return 37 
      when '&' then return 38       when '\'' then return 39
      when '(' then return 40       when ')' then return 41
      when '*' then return 42       when '+' then return 43
      when ',' then return 44       when '-' then return 45
      when '.' then return 46       when '/' then return 47
      when '0' then return 48       when '1' then return 49
      when '2' then return 50       when '3' then return 51
      when '4' then return 52       when '5' then return 53
      when '6' then return 54       when '7' then return 55
      when '8' then return 56       when '9' then return 57
      when ':' then return 58       when ';' then return 59
      when '<' then return 60       when '=' then return 61
      when '>' then return 62       when '?' then return 63
      when '@' then return 64       when 'A' then return 65
      when 'B' then return 66       when 'C' then return 67
      when 'D' then return 68       when 'E' then return 69
      when 'F' then return 70       when 'G' then return 71
      when 'H' then return 72       when 'I' then return 73
      when 'J' then return 74       when 'K' then return 75
      when 'L' then return 76       when 'M' then return 77
      when 'N' then return 78       when 'O' then return 79
      when 'P' then return 80       when 'Q' then return 81
      when 'R' then return 82       when 'S' then return 83
      when 'T' then return 84       when 'U' then return 85
      when 'V' then return 86       when 'W' then return 87
      when 'X' then return 88       when 'Y' then return 89
      when 'Z' then return 90       when '[' then return 91
      when '\\' then return 92      when ']' then return 93
      when '^' then return 94       when '_' then return 95
      when '`' then return 96       when 'a' then return 97
      when 'b' then return 98       when 'c' then return 99
      when 'd' then return 100      when 'e' then return 101
      when 'f' then return 102      when 'g' then return 103
      when 'h' then return 104      when 'i' then return 105
      when 'j' then return 106      when 'k' then return 107
      when 'l' then return 108      when 'm' then return 109
      when 'n' then return 110      when 'o' then return 111
      when 'p' then return 112      when 'q' then return 113
      when 'r' then return 114      when 's' then return 115
      when 't' then return 116      when 'u' then return 117
      when 'v' then return 118      when 'w' then return 119
      when 'x' then return 120      when 'y' then return 121
      when 'z' then return 122      when '{' then return 123
      when '|' then return 124      when '}' then return 125
      when '~' then return 126      
      else return -1 end 
   end; 

   from_ascii_int(i:INT):SAME 
      -- The ASCII character corresponding to `i' for characters
      -- in the Sather set, and the character with code `i' for
      -- the remainder.
      pre i.is_bet(0,127) is
      return ("\0\1\2\3\4\5\6\a"  "\b\t\n\v\14\r\16\17"
      "\20\21\22\23\24\25\26\27" "\30\31\32\33\34\35\36\37"
      " !\"#$%&'"  "()*+,-./"  "01234567"  "89:;<=>?"  "@ABCDEFG"
      "HIJKLMNO"  "PQRSTUVW"  "XYZ[\\]^_"  "`abcdefg"  "hijklmno"
	    "pqrstuvw"  "xyz{|}~\177")[i] 
   end;      

   str:STR is
      return #STR(self); 
   end;

   fmt(f:STR):STR  is
      return BASE_FORMAT::fmt_char( self, f )
   end;
   
   pretty:STR is
      -- A pretty version of self. It includes single quotes
      -- around self and uses special codes or the octal representation
      -- for non printing characters.
      if is_print and self/='\'' and self/='\\' then 
	 return "'" + self + "'" end; 
      case self 
      when '\a' then return "'\\a'"  when '\b' then return "'\\b'"	 
      when '\f' then return "'\\f'"  when '\n' then return "'\\n'"
      when '\r' then return "'\\r'"  when '\t' then return "'\\t'"	 
      when '\v' then return "'\\v'"  when '\\' then return "'\\\\'"
      when '\'' then return "'\\''"  
      else s::=int.octal_str; return "'\\".append(s.tail(s.size-2),"'")
      end 
   end;

   upper:CHAR is 
      -- An upper case version of self. 
      -- Leaves non-alphabetic chars unchanged.
      case self
      when 'a' then return 'A'      when 'b' then return 'B'  
      when 'c' then return 'C'      when 'd' then return 'D'  
      when 'e' then return 'E'      when 'f' then return 'F'
      when 'g' then return 'G'      when 'h' then return 'H'  
      when 'i' then return 'I'      when 'j' then return 'J'  
      when 'k' then return 'K'      when 'l' then return 'L'
      when 'm' then return 'M'      when 'n' then return 'N'  
      when 'o' then return 'O'      when 'p' then return 'P'  
      when 'q' then return 'Q'      when 'r' then return 'R'
      when 's' then return 'S'      when 't' then return 'T'  
      when 'u' then return 'U'      when 'v' then return 'V'  
      when 'w' then return 'W'      when 'x' then return 'X'
      when 'y' then return 'Y'      when 'z' then return 'Z'
      else return self end 
   end;
	 
   lower:CHAR is 
      -- A lower case version of self.
      -- Leaves non-alphabetic chars unchanged.
      case self
      when 'A' then return 'a'      when 'B' then return 'b'  
      when 'C' then return 'c'      when 'D' then return 'd'  
      when 'E' then return 'e'      when 'F' then return 'f'
      when 'G' then return 'g'      when 'H' then return 'h'  
      when 'I' then return 'i'      when 'J' then return 'j'  
      when 'K' then return 'k'      when 'L' then return 'l'
      when 'M' then return 'm'      when 'N' then return 'n'  
      when 'O' then return 'o'      when 'P' then return 'p'  
      when 'Q' then return 'q'      when 'R' then return 'r'
      when 'S' then return 's'      when 'T' then return 't'  
      when 'U' then return 'u'      when 'V' then return 'v'  
      when 'W' then return 'w'      when 'X' then return 'x'
      when 'Y' then return 'y'      when 'Z' then return 'z'
      else 
	 return self 
      end 
   end;

   is_eq(c:SAME):BOOL is
      -- True if self and `c' are equal.
      builtin CHAR_IS_EQ; 
   end;
   
   is_eq(arg: $OB): BOOL is
      -- Overloaded version of the is_eq routine that works with an argument
      -- of any type. If the type of the 'arg' is not the same as they
      -- type of 'self' then return false. Otherwise, deletegate to
      -- the 'real' is_eq(SAME):BOOL routine
      typecase arg  when SAME then return is_eq(arg)  else return false end;
   end;
   
   is_lt(c:SAME):BOOL is 
      -- True if self is earlier than `c' in the ordering of
      -- characters.
      return int < c.int 
   end;

end; -- immutable class CHAR

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