/* libsizzle/char.c - character functions
 
  Copyright (C) 1999, 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
 
  This is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2, or (at your option)
  any later version.
  
  This software 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 the GNU
  General Public License for more details.
  
  You should have received a copy of the GNU General Public License
  along with this package; see the file COPYING.  If not, write to
  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  Boston, MA 02111-1307, USA.  */

#if HAVE_CONFIG_H
# include <config.h>
#endif 

#include <ctype.h>

#if ENABLE_NLS
# include <libintl.h>
# define _(String) gettext(String)
#else
# define _(String) (String)
#endif

#include "node.h"
#include "validate.h"
#include "capi.h"
#include "char.h"

/*:doc
  char?
  (char? obj) => boolean
  Return @code{#t} if @var{obj} is a character object, @code{#f} otherwise.
  doc:*/
#define FUNC_NAME "char?"
static result_t
char_p_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t * result)
{
  if (char_p (obj))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char=?
  (char=? ch1 ch2) => boolean
  Return @code{#t} if @var{ch1} is equal to @var{ch2}, @code{#f} otherwise.
  doc:*/
#define FUNC_NAME "char=?"
static result_t
char_equal_func (zzz_scm_t env, zzz_scm_t ch1, zzz_scm_t ch2,
		 zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch1), zzz_character_type_name);
  CHECK_TYPE (2, char_p (ch2), zzz_character_type_name);
  if (char_val (ch1) == char_val (ch2))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char<?
  (char<? ch1 ch2) => boolean
  Return @code{#t} if @var{ch1} is less than @var{ch2}, @code{#f} otherwise.
  doc:*/
#define FUNC_NAME "char<?"
static result_t
char_less_func (zzz_scm_t env, zzz_scm_t ch1, zzz_scm_t ch2,
		zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch1), zzz_character_type_name);
  CHECK_TYPE (2, char_p (ch2), zzz_character_type_name);
  if (char_val (ch1) < char_val (ch2))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char<=?
  (char<=? ch1 ch2) => boolean
  Return @code{#t} if @var{ch1} less or equal to @var{ch2}, @code{#f}
  otherwise.
  doc:*/
#define FUNC_NAME "char<=?"
static result_t
char_less_equal_func (zzz_scm_t env, zzz_scm_t ch1, zzz_scm_t ch2,
		      zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch1), zzz_character_type_name);
  CHECK_TYPE (2, char_p (ch2), zzz_character_type_name);
  if (char_val (ch1) <= char_val (ch2))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char>?
  (char>? ch1 ch2) => boolean
  Return @code{#t} if @var{ch1} is greater than @var{ch2}, @code{#f} otherwise.
  doc:*/
#define FUNC_NAME "char>?"
static result_t
char_greater_func (zzz_scm_t env, zzz_scm_t ch1, zzz_scm_t ch2,
		   zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch1), zzz_character_type_name);
  CHECK_TYPE (2, char_p (ch2), zzz_character_type_name);
  if (char_val (ch1) > char_val (ch2))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char>=?
  (char>=? ch1 ch2) => boolean
  Return @code{#t} if @var{ch1} is greater than or equal to @var{ch2},
  @code{#f} otherwise.
  doc:*/
#define FUNC_NAME "char>=?"
static result_t
char_greater_equal_func (zzz_scm_t env, zzz_scm_t ch1, zzz_scm_t ch2,
			 zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch1), zzz_character_type_name);
  CHECK_TYPE (2, char_p (ch2), zzz_character_type_name);
  if (char_val (ch1) >= char_val (ch2))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char-ci=?
  (char-ci=? ch1 ch2) => boolean
  Return @code{#t} if @var{ch1} is equal to @var{ch2}, @code{#f} otherwise.
  Case is ignored when comparing.
  doc:*/
#define FUNC_NAME "char-ci=?"
static result_t
char_ci_equal_func (zzz_scm_t env, zzz_scm_t ch1, zzz_scm_t ch2,
		    zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch1), zzz_character_type_name);
  CHECK_TYPE (2, char_p (ch2), zzz_character_type_name);
  if (toupper (char_val (ch1)) == toupper (char_val (ch2)))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char-ci<?
  (char-ci<? ch1 ch2) => boolean
  Return @code{#t} if @var{ch1} is less than @var{ch2}, @code{#f} otherwise.
  Case is ignored when comparing.
  doc:*/
#define FUNC_NAME "char<?"
static result_t
char_ci_less_func (zzz_scm_t env, zzz_scm_t ch1, zzz_scm_t ch2,
		   zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch1), zzz_character_type_name);
  CHECK_TYPE (2, char_p (ch2), zzz_character_type_name);
  if (toupper (char_val (ch1)) < toupper (char_val (ch2)))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char-ci<=?
  (char-ci<=? ch1 ch2) => boolean
  Return @code{#t} if @var{ch1} is less or equal to @var{ch2}, @code{#f} 
  otherwise.  Case is ignored when comparing.
  doc:*/
#define FUNC_NAME "char-ci<=?"
static result_t
char_ci_less_equal_func (zzz_scm_t env, zzz_scm_t ch1, zzz_scm_t ch2,
			 zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch1), zzz_character_type_name);
  CHECK_TYPE (2, char_p (ch2), zzz_character_type_name);
  if (toupper (char_val (ch1)) <= toupper (char_val (ch2)))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char-ci>?
  (char-ci>? ch1 ch2) => boolean
  Return @code{#t} if @var{ch1} is greater than @var{ch2}, @code{#f} otherwise.
  Case is ignored when comparing.
  doc:*/
#define FUNC_NAME "char-ci>?"
static result_t
char_ci_greater_func (zzz_scm_t env, zzz_scm_t ch1, zzz_scm_t ch2,
		      zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch1), zzz_character_type_name);
  CHECK_TYPE (2, char_p (ch2), zzz_character_type_name);
  if (toupper (char_val (ch1)) > toupper (char_val (ch2)))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char-ci>=?
  (char-ci>=? ch1 ch2) => boolean
  Return @code{#t} if @var{ch1} is greater than or equal to @var{ch2}, 
  @code{#f} otherwise.  Case is ignored when comparing.
  doc:*/
#define FUNC_NAME "char-ci>=?"
static result_t
char_ci_greater_equal_func (zzz_scm_t env, zzz_scm_t ch1, zzz_scm_t ch2,
			    zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch1), zzz_character_type_name);
  CHECK_TYPE (2, char_p (ch2), zzz_character_type_name);
  if (toupper (char_val (ch1)) >= toupper (char_val (ch2)))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char-alphabetic?
  (char-alphabetic? ch) => boolean
  Return @code{#t} if @var{ch} is an alpabetic character, @code{#f}
  otherwise.
  doc:*/
#define FUNC_NAME "char-alphabetic?"
static result_t
char_alphabetic_p_func (zzz_scm_t env, zzz_scm_t ch, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  int c;

  CHECK_TYPE (1, char_p (ch), zzz_character_type_name);
  c = char_val (ch);
  if ((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z'))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char-numeric?
  (char-numeric? ch) => boolean
  Return @code{#t} if @var{ch} is a numeric character, @code{#f}
  otherwise.
  doc:*/
#define FUNC_NAME "char-numeric?"
static result_t
char_numeric_p_func (zzz_scm_t env, zzz_scm_t ch, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  int c;

  CHECK_TYPE (1, char_p (ch), zzz_character_type_name);
  c = char_val (ch);
  if (c >= '0' && c <= '9')
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char-whitespace?
  (char-whitespace? ch) => boolean
  Return @code{#t} if @var{ch} is a whitespace character, @code{#f}
  otherwise.
  doc:*/
#define FUNC_NAME "char-whitespace?"
static result_t
char_whitespace_p_func (zzz_scm_t env, zzz_scm_t ch, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  int c;

  CHECK_TYPE (1, char_p (ch), zzz_character_type_name);
  c = char_val (ch);
  if (c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f')
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char-upper-case?
  (char-upper-case? ch) => boolean
  Return @code{#t} if @var{ch} is an upper case character, @code{#f}
  otherwise.
  doc:*/
#define FUNC_NAME "char-upper-case?"
static result_t
char_upper_case_p_func (zzz_scm_t env, zzz_scm_t ch, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  int c;

  CHECK_TYPE (1, char_p (ch), zzz_character_type_name);
  c = char_val (ch);
  if (c >= 'A' && c <= 'Z')
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char-lower-case?
  (char-lower-case? ch) => boolean
  Return @code{#t} if @var{ch} is a lower case character, @code{#f}
  otherwise.
  doc:*/
#define FUNC_NAME "char-lower-case?"
static result_t
char_lower_case_p_func (zzz_scm_t env, zzz_scm_t ch, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  int c;

  CHECK_TYPE (1, char_p (ch), zzz_character_type_name);
  c = char_val (ch);
  if (c >= 'a' && c <= 'z')
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char->integer
  (char->integer ch) => integer
  Convert the character @var{ch} to its character code.
  doc:*/
#define FUNC_NAME "char->integer"
static result_t
char_to_integer_func (zzz_scm_t env, zzz_scm_t ch, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch), zzz_character_type_name);
  *result = zzz_make_integer ((long) char_val (ch));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  integer->char
  (integer->char n) => character
  Convert the character code @var{n} to a character.
  doc:*/
#define FUNC_NAME "integer->char"
static result_t
integer_to_char_func (zzz_scm_t env, zzz_scm_t n, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  unsigned char ch;

  CHECK_TYPE (1, integer_p (n), zzz_integer_type_name);
  ch = (unsigned char) integer_val (n);
  CHECK_RANGE (1, ch == integer_val (n), _("character code"));
  *result = zzz_make_char (ch);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char-upcase
  (char-upcase ch) => character
  Convert the character @var{ch} to its uppercase equivalent, if it hase
  one, return @var{ch} otherwise.
  doc:*/
#define FUNC_NAME "char-upcase"
static result_t
char_upcase_func (zzz_scm_t env, zzz_scm_t ch, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch), zzz_character_type_name);
  *result = zzz_make_char (toupper (char_val (ch)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  char-downcase
  (char-downcase ch) => character
  Convert the character @var{ch} to its lowercase equivalent, if it hase
  one, return @var{ch} otherwise.
  doc:*/
#define FUNC_NAME "char-downcase"
static result_t
char_downcase_func (zzz_scm_t env, zzz_scm_t ch, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, char_p (ch), zzz_character_type_name);
  *result = zzz_make_char (tolower (char_val (ch)));
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

result_t
zzz_init_char (void)
{
  zzz_define_function ("char?", (zzz_prim_t) char_p_func, argv_1_0_0);
  zzz_define_function ("char=?", (zzz_prim_t) char_equal_func, argv_2_0_0);
  zzz_define_function ("char<?", (zzz_prim_t) char_less_func, argv_2_0_0);
  zzz_define_function ("char<=?", (zzz_prim_t) char_less_equal_func,
		       argv_2_0_0);
  zzz_define_function ("char>?", (zzz_prim_t) char_greater_func, argv_2_0_0);
  zzz_define_function ("char>=?", (zzz_prim_t) char_greater_equal_func,
		       argv_2_0_0);
  zzz_define_function ("char-ci=?", (zzz_prim_t) char_ci_equal_func,
		       argv_2_0_0);
  zzz_define_function ("char-ci<?", (zzz_prim_t) char_ci_less_func,
		       argv_2_0_0);
  zzz_define_function ("char-ci<=?", (zzz_prim_t) char_ci_less_equal_func,
		       argv_2_0_0);
  zzz_define_function ("char-ci>?", (zzz_prim_t) char_ci_greater_func,
		       argv_2_0_0);
  zzz_define_function ("char-ci>=?",
		       (zzz_prim_t) char_ci_greater_equal_func, argv_2_0_0);
  zzz_define_function ("char-alphabetic?",
		       (zzz_prim_t) char_alphabetic_p_func, argv_1_0_0);
  zzz_define_function ("char-numeric?",
		       (zzz_prim_t) char_numeric_p_func, argv_1_0_0);
  zzz_define_function ("char-whitespace?",
		       (zzz_prim_t) char_whitespace_p_func, argv_1_0_0);
  zzz_define_function ("char-upper-case?",
		       (zzz_prim_t) char_upper_case_p_func, argv_1_0_0);
  zzz_define_function ("char-lower-case?",
		       (zzz_prim_t) char_lower_case_p_func, argv_1_0_0);
  zzz_define_function ("char->integer", (zzz_prim_t) char_to_integer_func,
		       argv_1_0_0);
  zzz_define_function ("integer->char", (zzz_prim_t) integer_to_char_func,
		       argv_1_0_0);
  zzz_define_function ("char-upcase", (zzz_prim_t) char_upcase_func,
		       argv_1_0_0);
  zzz_define_function ("char-downcase", (zzz_prim_t) char_downcase_func,
		       argv_1_0_0);

  return RESULT_SUCCESS;
}
