#include <stdlib.h>
#include <string.h>
#include "context.h"
#include "siod.h"
 
#define TRUEP(x) EQ(x, true_sym)
#define FALSEP(x) EQ(x, false_sym)
 
#define NTRUEP(x) NEQ(x, true_sym)
#define NFALSEP(x) NEQ(x, false_sym)

static LISP true_sym;
static LISP false_sym;
static LISP quote_sym;

static LISP
string_equal(LISP x, LISP y)
{
  long xl, yl;
  char *xs, *ys;
  xs = get_c_string_dim(x, &xl);
  ys = get_c_string_dim(y, &yl);
  if (xl != yl) {
    return false_sym;
  }
  if (!strncmp(xs, ys, xl)) {
    return (true_sym);
  }
  return false_sym;
}

static LISP
charcode2string(LISP x)
{
  char buf[2];
  if (INTNUMP(x)) {
    buf[0] = INTNM(x);
  } else {
    buf[0] = 0;
  }
  buf[1] = 0;
    return strcons (1,buf);
}

static LISP
string2charcode(LISP x)
{
  char *buf = get_c_string(x);

  if(buf) {
    return intcons(*buf);
  }
  return NIL;
}

static LISP
digit2string(LISP x)
{
  char buf[10];
  int i;

  i = get_c_int(x);

  sprintf(buf,"%d",i);
  return strcons (strlen(buf),buf);
}

static LISP
nthcdr(LISP nth_, LISP lst)
{
  int nth = get_c_int(nth_);
  int i;
  for (i = 0; i < nth; i++) {
    if (!lst) {
      /* something bad happened */
      return NIL;
    }
    lst = CDR(lst);
  }
  return lst;
}

/* may be deprecated. use uim_scm_c_str() instead */
char *
uim_get_c_string(LISP str)
{
  char *s;
  long len;
  char *buf;
  s = get_c_string_dim(str, &len);
  buf = (char *)malloc(sizeof(char)*(len + 1));
  strncpy(buf, s, len);
  buf[len] = 0;
  return buf;
}

static LISP
str_seq_equal(LISP seq, LISP rule)
{
  int sl = nlength(seq);
  int rl = nlength(rule);
  int i;
  if (sl != rl) {
    return false_sym;
  }
  for (i = 0; i < sl; i++) {
    if FALSEP(string_equal(CAR(seq), CAR(rule))) {
      return false_sym;
    }
    seq = CDR(seq);
    rule = CDR(rule);
  }
  return true_sym;
}

/*
 * Partial -> first string of remaining sequence
 *  eg. ("a" "b") ("a" "b" "c") -> "c"
 * Not partial -> #f
 *
 */
static LISP
str_seq_partial(LISP seq, LISP rule)
{
  int sl = nlength(seq);
  int rl = nlength(rule);
  int i;

  if (sl >= rl) {
    return false_sym;
  }
  /* Obviously. sl < rl */
  for (i = 0; i < sl; i++) {
    if FALSEP(string_equal(CAR(seq), CAR(rule))) {
      return false_sym;
    }
    seq = CDR(seq);
    rule = CDR(rule);
  }
  if (rule && CAR(rule)) {
    return CAR(rule);
  }
  /* never reach here */
  return false_sym;
}

static LISP
rk_find_seq(LISP s, LISP rule)
{
  for (; rule != NIL; rule = CDR(rule)) {
    if (str_seq_equal(s, CAR(CAR(CAR(rule))))) {
      return CAR(rule);
    }
  }
  return NIL;
}

static LISP
rk_find_partial_seq(LISP s, LISP rule)
{
  for (; rule != NIL; rule = CDR(rule)) {
    if NFALSEP(str_seq_partial(s, CAR(CAR(CAR(rule))))) {
      return CAR(rule);
    }
  }
  return NIL;
}

static LISP
rk_expect_seq(LISP seq, LISP rules)
{
  long flag;
  LISP cur, res = NIL;
  flag = no_interrupt(1);
  for (cur = rules; cur; cur = CDR(cur)) {
    LISP rule = CAR(cur);
    LISP e = str_seq_partial(seq, CAR(CAR(rule)));
    if NFALSEP(e) {
      res = cons(e, res);
    }
  }
  no_interrupt(flag);
  return res;
}

static LISP
c_getenv(LISP str_)
{
  char *str = get_c_string(str_);
  char *val;

  if (!str) {
    return NIL;
  }
  val = getenv(str);
  return strcons(strlen(val), val);
}

static char **
uim_strsplit(char *splittee, char *splitter)
{
  char *cur, *tmp;
  int nr_token = 0;
  int in_token = 0;
  char **res;
  int len;
  int i;

  if(!splittee || !splitter)
    return NULL;


  /* count the number of token */
  cur = splittee;
  while (*cur) {
    if (strchr(splitter, *cur)) {
      in_token = 0;
    } else {
      if (!in_token) {
	nr_token ++;
      }
      in_token = 1;
    }
    cur ++;
  }
  /* allocate buffer */
  res = (char **)malloc(sizeof(char *) * (nr_token + 1) );
  if (!res) {
    return NULL;
  }
  /**/
  cur = splittee;
  for (i = 0; i < nr_token; i++) {
    /* find current token's start */
    while (strchr(splitter, *cur)) {
      cur ++;
    }
    /* calc length */
    len = 0;
    tmp = cur;
    while (!strchr(splitter, *tmp)) {
      len ++;
      tmp ++;
    }
    /* store */
    res[i] = malloc(sizeof(char) * (len + 1));
    strncpy(res[i], cur, len);
    res[i][len] = 0;
    cur = tmp;
  }
  /**/
  res[nr_token] = NULL;

  return res;
}

static LISP
uim_split_string(LISP _splittee, LISP _splitter)
{
  char *splittee = get_c_string(_splittee);
  char *splitter = get_c_string(_splitter);
  char **strs;
  LISP l = NIL;
  int i;
  int n_strs;

  if(_splittee == NULL || _splitter == NULL)
    return NIL;

  if(splittee == NULL || splitter == NULL)
    return NIL;

  strs = uim_strsplit(splittee, splitter);

  if(!strs || !*strs)
    return NIL;

  for (n_strs = 0; strs[n_strs] != '\0'; n_strs++);

  l = uim_scm_c_strs_into_list(n_strs, strs);
  for (i = n_strs - 1; i >= 0; i--) {
    free(strs[i]);
  }
  free(strs);
  return l;
}

static LISP
eucjp_string_to_list(LISP str_)
{
  char *str = get_c_string(str_);
  unsigned char *cur = str;
  LISP res = NIL;
  while (*cur) {
    char buf[3];
    int len;
    buf[2] = 0;
    if (*cur > 127) {
      /* 2 bytes */
      buf[0] = cur[0];
      buf[1] = cur[1];
      len = 2;
      cur ++;
    } else {
      buf[0] = cur[0];
      buf[1] = 0;
      len = 1;
    }
    res = cons (strcons(len, buf), res);
    cur ++;
  }
  return res;
}

/* Scheme interpreter interface functions: "uim_scm" prefix is not
 * stable name. More discussion is required. These functions may be
 * moved to independent file (such as uim-scm.c).
 */

int
uim_scm_c_int(uim_lisp integer) {
  return get_c_int((LISP)integer);
}

int
uim_scm_symbol_value_int(const char *symbol_str)
{
  uim_lisp val_;
  int val;
  val_ = uim_scm_symbol_value(symbol_str);

  if( val_ != NIL) {
    val = uim_scm_c_int(val_);
  } else {
    val = 0;
  }
  return val;
}

uim_lisp
uim_scm_int_from_c_int(int integer) {
  return (uim_lisp)intcons(integer);
}

char *
uim_scm_c_str(uim_lisp str) {
  return strdup(get_c_string((LISP)str));
}

char *
uim_scm_symbol_value_str(const char *symbol_str)
{
  uim_lisp val_;
  char *val;
  val_ = uim_scm_symbol_value(symbol_str);

  if( val_ != NIL) {
    val = uim_scm_c_str(val_);
  } else {
    val = NULL;
  }
  return val;
}

/* backward compatibility */
char *
uim_symbol_value_str(const char *symbol_str) {
  return uim_scm_symbol_value_str(symbol_str);
}

uim_lisp
uim_scm_str_from_c_str(const char *str) {
  int unknown_strlen = -1;
  return (uim_lisp)strcons(unknown_strlen, str);
}

uim_lisp
uim_scm_c_strs_into_list(int n_strs, const char *const *strs) {
  LISP lst = NIL, str = NIL;
  const char *c_str;
  int i, unknown_strlen = -1;

  for (i = n_strs - 1; 0 <= i; i--) {
    c_str = strs[i];
    str = strcons(unknown_strlen, c_str);
    lst = cons(str, lst);
  }

  return lst;
}

uim_lisp
uim_scm_symbol_value(const char *symbol_str)
{
  LISP symbol_str_ = rintern(symbol_str);
  
  if(symbol_boundp(symbol_str_, NIL) == true_sym) {
    return (uim_lisp)symbol_value(symbol_str_, NIL);         
  } else {
    return (uim_lisp)NIL;
  }
}

uim_lisp
uim_scm_intern_c_str(const char *str) {
  return (uim_lisp)rintern(str);
}

uim_lisp
uim_scm_qintern_c_str(const char *str) {
  return uim_scm_quote(uim_scm_intern_c_str(str));
}

long
uim_scm_repl_c_string(char *str, long want_init, long want_print)
{
  return repl_c_string(str, want_init, want_print);
}

long
uim_scm_get_verbose_level(void)
{
  return siod_verbose_level;
}

void
uim_scm_set_verbose_level(long new_value)
{
  siod_verbose_level = new_value;
}

void
uim_scm_load_file(const char *fn)
{
  long want_init = 0, want_print = 0;
  char *ln = malloc(strlen(fn)+40);

  if(!fn || !ln)
    return;

  snprintf(ln, strlen(fn)+40, "(*catch 'errobj (load \"%s\" #f #f))", fn);
  uim_scm_repl_c_string(ln, want_init, want_print);
  free(ln);
}

uim_lisp
uim_scm_t(void) {
  return (uim_lisp)true_sym;
}

uim_lisp
uim_scm_f(void) {
  return (uim_lisp)NIL;
}

uim_lisp
uim_scm_null_list(void) {
  return (uim_lisp)NIL;
}

int
uim_scm_nullp(uim_lisp obj) {
  return NULLP(obj);
}

int
uim_scm_eq(uim_lisp a, uim_lisp b) {
  return EQ(a, b);
}

int
uim_scm_string_equal(uim_lisp a, uim_lisp b) {
  uim_lisp form, p;
  form = uim_scm_list3(uim_scm_intern_c_str("string=?"),
		       a,
		       b);
  p = uim_scm_eval(form);
  return NFALSEP(p);
}

uim_lisp
uim_scm_eval(uim_lisp obj) {
  return (uim_lisp)leval((LISP)obj, NIL);
}

uim_lisp
uim_scm_quote(uim_lisp obj) {
  return uim_scm_list2(quote_sym, obj);
}

uim_lisp
uim_scm_car(uim_lisp cell) {
  return (uim_lisp)car((LISP)cell);
}

uim_lisp
uim_scm_cdr(uim_lisp cell) {
  return (uim_lisp)cdr((LISP)cell);
}

uim_lisp
uim_scm_cadr(uim_lisp cell) {
  return (uim_lisp)cadr((LISP)cell);
}

uim_lisp
uim_scm_caar(uim_lisp cell) {
  return (uim_lisp)caar((LISP)cell);
}

uim_lisp
uim_scm_cdar(uim_lisp cell) {
  return (uim_lisp)cdar((LISP)cell);
}

uim_lisp
uim_scm_cddr(uim_lisp cell) {
  return (uim_lisp)cddr((LISP)cell);
}

uim_lisp
uim_scm_cons(uim_lisp car, uim_lisp cdr) {
  return (uim_lisp)cons((LISP)car, (LISP)cdr);
}

uim_lisp
uim_scm_nth(uim_lisp n, uim_lisp lst) {
  uim_lisp form;
  form = uim_scm_list3(uim_scm_intern_c_str("nth"),
		       n,
		       lst);
  return uim_scm_eval(form);
}

uim_lisp
uim_scm_list1(uim_lisp elm1) {
  uim_lisp lst;
  lst = (uim_lisp)listn(1, (LISP)elm1);
  return lst;
}

uim_lisp
uim_scm_list2(uim_lisp elm1, uim_lisp elm2) {
  uim_lisp lst;
  lst = (uim_lisp)listn(2, (LISP)elm1, (LISP)elm2);
  return lst;
}

uim_lisp
uim_scm_list3(uim_lisp elm1, uim_lisp elm2, uim_lisp elm3) {
  uim_lisp lst;
  lst = (uim_lisp)listn(3, (LISP)elm1, (LISP)elm2, (LISP)elm3);
  return lst;
}

uim_lisp
uim_scm_list4(uim_lisp elm1, uim_lisp elm2, uim_lisp elm3, uim_lisp elm4) {
  uim_lisp lst;
  lst = (uim_lisp)listn(4, (LISP)elm1, (LISP)elm2, (LISP)elm3, (LISP)elm4);
  return lst;
}

uim_lisp
uim_scm_list5(uim_lisp elm1, uim_lisp elm2, uim_lisp elm3, uim_lisp elm4,
              uim_lisp elm5)
{
  uim_lisp lst;
  lst = (uim_lisp)listn(5, (LISP)elm1, (LISP)elm2, (LISP)elm3, (LISP)elm4,
			(LISP)elm5);
  return lst;
}

/* Customize interface functions: They are not appropriate to be
 * here. More discussion is required.
 */

uim_lisp
uim_custom_value(uim_lisp custom_sym) {
  uim_lisp form;

  form = uim_scm_list2(uim_scm_intern_c_str("custom-value"),
		       uim_scm_quote(custom_sym));

  return uim_scm_eval(form);
}

int
uim_custom_value_as_bool(uim_lisp custom_sym) {
  uim_lisp val;
  int result = 0;

  if (uim_scm_eq(uim_custom_type(custom_sym),
		 uim_scm_intern_c_str("boolean")))
  {
    val = uim_custom_value(custom_sym);
    result = uim_scm_eq(val, uim_scm_f()) ? 0 : 1;
  }

  return result;
}

int
uim_custom_value_as_int(uim_lisp custom_sym) {
  uim_lisp val;
  int result = 0;

  if (uim_scm_eq(uim_custom_type(custom_sym),
		 uim_scm_intern_c_str("integer")))
  {
    val = uim_custom_value(custom_sym);
    result = uim_scm_c_int(val);
  }

  return result;
}

char *
uim_custom_value_as_str(uim_lisp custom_sym) {
  uim_lisp val;
  char *result = NULL;

  if (uim_scm_eq(uim_custom_type(custom_sym),
		 uim_scm_intern_c_str("string")))
  {
    val = uim_custom_value(custom_sym);
    result = uim_scm_c_str(val);
  }

  return result;
}

char *
uim_custom_value_as_path(uim_lisp custom_sym) {
  uim_lisp val;
  char *result = NULL;

  if (uim_scm_eq(uim_custom_type(custom_sym),
		 uim_scm_intern_c_str("pathname")))
  {
    val = uim_custom_value(custom_sym);
    result = uim_scm_c_str(val);
  }

  return result;
}

uim_lisp
uim_custom_value_as_symbol(uim_lisp custom_sym) {
  uim_lisp val;

  if (uim_scm_eq(uim_custom_type(custom_sym),
		 uim_scm_intern_c_str("symbol")))
  {
    val = uim_custom_value(custom_sym);
  }

  return val;
}

void
uim_custom_set(uim_lisp custom_sym, uim_lisp custom_val) {
  uim_lisp form;

  form = uim_scm_list3(uim_scm_intern_c_str("custom-set!"),
		       uim_scm_quote(custom_sym),
		       custom_val);
  uim_scm_eval(form);
}

char *
uim_custom_symbol_label(uim_lisp custom_sym, uim_lisp val_sym) {
  uim_lisp form, label;

  form = uim_scm_list3(uim_scm_intern_c_str("custom-symbol-label"),
		       uim_scm_quote(custom_sym),
		       uim_scm_quote(val_sym));
  label = uim_scm_eval(form);

  return uim_scm_c_str(label);
}

char *
uim_custom_symbol_desc(uim_lisp custom_sym, uim_lisp val_sym) {
  uim_lisp form, desc;

  form = uim_scm_list3(uim_scm_intern_c_str("custom-symbol-desc"),
		       uim_scm_quote(custom_sym),
		       uim_scm_quote(val_sym));
  desc = uim_scm_eval(form);

  return uim_scm_c_str(desc);
}

uim_lisp
uim_custom_type(uim_lisp custom_sym) {
  uim_lisp form;

  form = uim_scm_list2(uim_scm_intern_c_str("custom-type"),
		       uim_scm_quote(custom_sym));

  return uim_scm_eval(form);
}

int
uim_custom_ctype(uim_lisp custom_sym) {
  uim_lisp type;
  int result;

  type = uim_custom_type(custom_sym);
  if (uim_scm_eq(type,
		 uim_scm_intern_c_str("boolean")))
  {
    result = UCustom_Bool;
  } else if (uim_scm_eq(type,
			uim_scm_intern_c_str("integer")))
  {
    result = UCustom_Int;
  } else if (uim_scm_eq(type,
			uim_scm_intern_c_str("string")))
  {
    result = UCustom_Str;
  } else if (uim_scm_eq(type,
			uim_scm_intern_c_str("pathname")))
  {
    result = UCustom_Path;
  } else if (uim_scm_eq(type,
			uim_scm_intern_c_str("symbol")))
  {
    result = UCustom_Symbol;
  } else if (uim_scm_eq(type,
			uim_scm_intern_c_str("key")))
  {
    result = UCustom_Key;
  }

  return result;
}

uim_lisp
uim_custom_range(uim_lisp custom_sym) {
  uim_lisp form;

  form = uim_scm_list2(uim_scm_intern_c_str("custom-range"),
		       uim_scm_quote(custom_sym));

  return uim_scm_eval(form);
}

char *
uim_custom_group_label(uim_lisp group_sym) {
  uim_lisp form, label;

  form = uim_scm_list2(uim_scm_intern_c_str("custom-group-label"),
		       uim_scm_quote(group_sym));
  label = uim_scm_eval(form);

  return uim_scm_c_str(label);
}

char *
uim_custom_group_desc(uim_lisp group_sym) {
  uim_lisp form, desc;

  form = uim_scm_list2(uim_scm_intern_c_str("custom-group-desc"),
		       uim_scm_quote(group_sym));
  desc = uim_scm_eval(form);

  return uim_scm_c_str(desc);
}

uim_lisp
uim_custom_group_subgroups(uim_lisp group_sym) {
  uim_lisp form, subgrps;

  form = uim_scm_list2(uim_scm_intern_c_str("custom-group-subgroups"),
		       uim_scm_quote(group_sym));
  subgrps = uim_scm_eval(form);

  return subgrps;
}

uim_lisp
uim_custom_list_groups(void) {
  uim_lisp form, groups;

  form = uim_scm_list1(uim_scm_intern_c_str("custom-list-groups"));
  groups = uim_scm_eval(form);

  return groups;
}

uim_lisp
uim_custom_list_primary_groups(void) {
  uim_lisp form, groups;

  form = uim_scm_list1(uim_scm_intern_c_str("custom-list-primary-groups"));
  groups = uim_scm_eval(form);

  return groups;
}

uim_lisp
uim_custom_collect_by_group(uim_lisp group_sym) {
  uim_lisp form, customs;

  form = uim_scm_list2(uim_scm_intern_c_str("custom-collect-by-group"),
		       uim_scm_quote(group_sym));
  customs = uim_scm_eval(form);

  return customs;
}

char *
uim_custom_value_as_string(uim_lisp sym) {
  uim_lisp form, value;

  form = uim_scm_list2(uim_scm_intern_c_str("custom-canonical-value-as-string"),
		       uim_scm_quote(sym));
  value = uim_scm_eval(form);

  return uim_scm_c_str(value);
}

char *
uim_custom_definition_as_string(uim_lisp sym) {
  uim_lisp form, definition;

  form = uim_scm_list2(uim_scm_intern_c_str("custom-canonical-definition-as-string"),
		       uim_scm_quote(sym));
  definition = uim_scm_eval(form);

  return uim_scm_c_str(definition);
}

void
uim_init_util_subrs()
{
  true_sym  = siod_true_value();
#if 0
  false_sym = siod_false_value();
#else
  /* false_sym has to be NIL until bug #617 and #642 are fixed
   * -- YamaKen
   */
  false_sym = NIL;
#endif
  quote_sym = uim_scm_intern_c_str("quote");
  init_subr_2("string=?", string_equal);
  init_subr_2("nthcdr", nthcdr);
  init_subr_1("charcode->string", charcode2string);
  init_subr_1("string->charcode", string2charcode);
  init_subr_1("digit->string", digit2string);
  init_subr_2("str-seq-equal?", str_seq_equal);
  init_subr_2("str-seq-partial?", str_seq_partial);
  init_subr_2("rk-lib-find-seq", rk_find_seq);
  init_subr_2("rk-lib-find-partial-seq", rk_find_partial_seq);
  init_subr_2("rk-lib-expect-seq", rk_expect_seq);
  init_subr_1("getenv", c_getenv);
  init_subr_2("string-split", uim_split_string);
  init_subr_1("string-to-list", eucjp_string_to_list);
}
