/*************************************************************************/
/*                                                                       */
/*                  Language Technologies Institute                      */
/*                     Carnegie Mellon University                        */
/*                        Copyright (c) 1999                             */
/*                        All Rights Reserved.                           */
/*                                                                       */
/*  Permission is hereby granted, free of charge, to use and distribute  */
/*  this software and its documentation without restriction, including   */
/*  without limitation the rights to use, copy, modify, merge, publish,  */
/*  distribute, sublicense, and/or sell copies of this work, and to      */
/*  permit persons to whom this work is furnished to do so, subject to   */
/*  the following conditions:                                            */
/*   1. The code must retain the above copyright notice, this list of    */
/*      conditions and the following disclaimer.                         */
/*   2. Any modifications must be clearly marked as such.                */
/*   3. Original authors' names are not deleted.                         */
/*   4. The authors' names are not used to endorse or promote products   */
/*      derived from this software without specific prior written        */
/*      permission.                                                      */
/*                                                                       */
/*  CARNEGIE MELLON UNIVERSITY AND THE CONTRIBUTORS TO THIS WORK         */
/*  DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING      */
/*  ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT   */
/*  SHALL CARNEGIE MELLON UNIVERSITY NOR THE CONTRIBUTORS BE LIABLE      */
/*  FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES    */
/*  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN   */
/*  AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,          */
/*  ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF       */
/*  THIS SOFTWARE.                                                       */
/*                                                                       */
/*************************************************************************/
/*             Author:  Alan W Black (awb@cs.cmu.edu)                    */
/*               Date:  December 1999                                    */
/*************************************************************************/
/*                                                                       */
/*  Typed values                                                          */
/*                                                                       */
/*************************************************************************/
#include "cst_math.h"
#include "cst_file.h"
#include "cst_val.h"
#include "cst_string.h"
#include "cst_tokenstream.h"

static cst_val *new_val()
{
    return cst_alloc(struct cst_val_struct,1);
}

cst_val *int_val(int i)
{
    cst_val *v = new_val();
    CST_VAL_TYPE(v) = CST_VAL_TYPE_INT;
    CST_VAL_INT(v) = i;
    return v;
}
    
cst_val *float_val(float f)
{
    cst_val *v = new_val();
    CST_VAL_TYPE(v) = CST_VAL_TYPE_FLOAT;
    CST_VAL_FLOAT(v) = f;
    return v;
}

cst_val *string_val(const char *s)
{
    cst_val *v = new_val();
    CST_VAL_TYPE(v) = CST_VAL_TYPE_STRING;
    /* would be nice to note if this is a deletable string or not */
    CST_VAL_STRING_LVAL(v) = cst_strdup(s);
    return v;
}

cst_val *cons_val(const cst_val *a, const cst_val *b)
{
    cst_val *v = new_val();
    CST_VAL_CAR(v)=((!a || cst_val_consp(a)) ? 
		    (cst_val *)(void *)a:val_inc_refcount(a));
    CST_VAL_CDR(v)=((!b || cst_val_consp(b)) ? 
		    (cst_val *)(void *)b:val_inc_refcount(b));
    return v;
}

cst_val *val_new_typed(int type,void *vv)
{
    cst_val *v = new_val();
    CST_VAL_TYPE(v) = type;
    CST_VAL_VOID(v) = vv;
    return v;
}

void delete_val_list(cst_val *v)
{
    if (v)
    {
	if (cst_val_consp(v))
	{
	    delete_val_list(CST_VAL_CDR(v));
	    cst_free(v);
	}
	else
	    delete_val(v);
    }
}

void delete_val(cst_val *v)
{
    if (v)
    {
	if (cst_val_consp(v))
	{
	    delete_val(CST_VAL_CAR(v));
	    delete_val(CST_VAL_CDR(v));
	    cst_free(v);
	}
	else if (val_dec_refcount(v) == 0)
	{
	    if (CST_VAL_TYPE(v) == CST_VAL_TYPE_STRING)
		cst_free(CST_VAL_VOID(v));
	    else if (CST_VAL_TYPE(v) >= CST_VAL_TYPE_FIRST_FREE)
            {
                if (cst_val_defs[CST_VAL_TYPE(v)/2].delete_function)
                    (cst_val_defs[CST_VAL_TYPE(v)/2].delete_function)
                        (CST_VAL_VOID(v));
            }
            cst_free(v);
	}
    }
}

/* Accessor functions */
int val_int(const cst_val *v)
{
    if (v && (CST_VAL_TYPE(v) == CST_VAL_TYPE_INT))
	return CST_VAL_INT(v);
    else if (v && (CST_VAL_TYPE(v) == CST_VAL_TYPE_FLOAT))
	return (int)CST_VAL_FLOAT(v);
    else if (v && (CST_VAL_TYPE(v) == CST_VAL_TYPE_STRING))
	return atoi(CST_VAL_STRING(v));
    else
    {
	cst_errmsg("VAL: tried to access int in %d typed val\n",
		   (v ? CST_VAL_TYPE(v) : -1));
	cst_error();
    }
    return 0;
}

float val_float(const cst_val *v)
{
    if (v && (CST_VAL_TYPE(v) == CST_VAL_TYPE_INT))
	return (float)CST_VAL_INT(v);
    else if (v && (CST_VAL_TYPE(v) == CST_VAL_TYPE_FLOAT))
	return CST_VAL_FLOAT(v);
    else if (v && (CST_VAL_TYPE(v) == CST_VAL_TYPE_STRING))
	return cst_atof(CST_VAL_STRING(v));
    else
    {
	cst_errmsg("VAL: tried to access float in %d typed val\n",
		   (v ? CST_VAL_TYPE(v) : -1));
	cst_error();
    }
    return 0;
}

const char *val_string(const cst_val *v)
{
    if (v && (CST_VAL_TYPE(v) == CST_VAL_TYPE_STRING))
	return CST_VAL_STRING(v);
    else
    {
	cst_errmsg("VAL: tried to access string in %d typed val\n",
		   (v ? CST_VAL_TYPE(v) : -1));
	cst_error();
    }
    return 0;
}

const cst_val *val_car(const cst_val *v)
{
    if (v && cst_val_consp(v))
	return CST_VAL_CAR(v);
    else
    {
	cst_errmsg("VAL: tried to access car in %d typed val\n",
		   (v ? CST_VAL_TYPE(v) : -1));
	cst_error();
    }
    return 0;
}

const cst_val *val_cdr(const cst_val *v)
{
    if (v && cst_val_consp(v))
	return CST_VAL_CDR(v);
    else
    {
	cst_errmsg("VAL: tried to access cdr in %d typed val\n",
		   (v ? CST_VAL_TYPE(v) : -1));
	cst_error();
    }
    return 0;
}

void *val_generic(const cst_val *v, int type, const char *stype)
{   /* a generic access function that checks the expected type */
    if (v && CST_VAL_TYPE(v) == type)
	return CST_VAL_VOID(v);
    else
    {
        cst_errmsg("VAL: tried to access %s in %d type val\n",
                       stype,
                       (v ? CST_VAL_TYPE(v) : -1));
        cst_error();
    }
    return NULL;
}

void *val_void(const cst_val *v)
{
    /* The scary, do anything function, this shouldn't be called by mortals */
    if ((v == NULL) ||
	(CST_VAL_TYPE(v) == CST_VAL_TYPE_CONS) ||
	(CST_VAL_TYPE(v) == CST_VAL_TYPE_INT) ||
	(CST_VAL_TYPE(v) == CST_VAL_TYPE_FLOAT))
    {
	cst_errmsg("VAL: tried to access void in %d typed val\n",
		   (v ? CST_VAL_TYPE(v) : -1));
	cst_error();
	return NULL;
    }
    else 
	return CST_VAL_VOID(v);
}

int cst_val_consp(const cst_val *v)
{
    /* To keep a val cell down to 8 bytes we identify non-cons cells  */
    /* with non-zero values in the least significant bit of the first */
    /* address in the cell (this is a standard technique used on Lisp */
    /* machines)                                                      */
#if 0
    void *t;
    int t1;

    /* Hmm this still isn't right (it can be) but this isn't it */
    t = CST_VAL_CAR(v);
    t1 = *(int *)&t;

    if ((t1&0x1) == 0)
	return TRUE;
    else
	return FALSE;
#endif
    const cst_val_atom *t;

    t = (const cst_val_atom *)v;
    if (t->type % 2 == 0)
      return TRUE;
    else
      return FALSE;
}

const cst_val *set_cdr(cst_val *v1, const cst_val *v2)
{
    /* destructive set cdr, be careful you have a pointer to current cdr */
    
    if (!cst_val_consp(v1))
    {
	cst_errmsg("VAL: tried to set cdr of non-consp cell\n");
	cst_error();
	return NULL;
    }
    else
    {
        if (CST_VAL_CDR(v1))
        {
            val_dec_refcount(CST_VAL_CDR(v1));
            val_inc_refcount(v1);
        }
	CST_VAL_CDR(v1) = (cst_val *)v2;
    }
    return v1;
}

const cst_val *set_car(cst_val *v1, const cst_val *v2)
{
    /* destructive set car, be careful you have a pointer to current car */
    
    if (!cst_val_consp(v1))
    {
	cst_errmsg("VAL: tried to set car of non-consp cell\n");
	cst_error();
	return NULL;
    }
    else
    {
	val_dec_refcount(CST_VAL_CAR(v1));
	val_inc_refcount(v1);
	CST_VAL_CAR(v1) = (cst_val *)v2;
    }
    return v1;
}

void val_print(cst_file fd,const cst_val *v)
{
    const cst_val *p;

    if (v == NULL)
	cst_fprintf(fd,"[null]");
    else if (CST_VAL_TYPE(v) == CST_VAL_TYPE_INT)
	cst_fprintf(fd,"%d",val_int(v));
    else if (CST_VAL_TYPE(v) == CST_VAL_TYPE_FLOAT)
	cst_fprintf(fd,"%f",val_float(v));
    else if (CST_VAL_TYPE(v) == CST_VAL_TYPE_STRING)
	cst_fprintf(fd,"%s",val_string(v));
    else if (cst_val_consp(v))
    {
	cst_fprintf(fd,"(");
	for (p=v; p; )
	{
	    val_print(fd,val_car(p));
	    p=val_cdr(p);
	    if (p)
		cst_fprintf(fd," ");
            if (p && !cst_val_consp(p))  /* dotted pairs for non-list */
            {                            
                cst_fprintf(fd,". ");
                val_print(fd,p);
                break;
            }
	}
	cst_fprintf(fd,")");
    }
    else 
	cst_fprintf(fd,"[Val %s 0x%p]",
		cst_val_defs[CST_VAL_TYPE(v)/2].name,CST_VAL_VOID(v));
}

cst_val *val_reverse(cst_val *l)
{   /* destructively reverse the list */
    cst_val *n,*np,*nl;
    for (nl=0,n=l; n; nl=n,n=np)
    {
	np=CST_VAL_CDR(n);
	CST_VAL_CDR(n) = nl;
    }
    return nl;
}

cst_val *val_append(cst_val *l1, cst_val *l2)
{
    /* Destructively add l2 to the end of l1 return l1 */
    cst_val *t;

    if (l1 == 0)
	return l2;
    else
    {
	for (t=l1; val_cdr(t); t=CST_VAL_CDR(t));
	CST_VAL_CDR(t) = l2;
	return l1;
    }
}

int val_length(const cst_val *l)
{
    const cst_val *n;
    int i;

    for (i=0,n=l; n; n=val_cdr(n))
	i++;

    return i;
}

int val_equal(const cst_val *v1, const cst_val *v2)
{
    if (v1 == v2)
	return TRUE;  /* its eq so its equal */
    else if (v1 == 0)
	return FALSE;
    else if (CST_VAL_TYPE(v1) == CST_VAL_TYPE(v2))
    {
	if (cst_val_consp(v1))
	    return ((val_equal(val_car(v1),val_car(v2))) &&
		    (val_equal(val_cdr(v1),val_cdr(v2))));
	else if (CST_VAL_TYPE(v1) == CST_VAL_TYPE_INT)
	    return (val_int(v1) == val_int(v2));
	else if (CST_VAL_TYPE(v1) == CST_VAL_TYPE_FLOAT)
	    return (val_float(v1) == val_float(v2));
	else if (CST_VAL_TYPE(v1) == CST_VAL_TYPE_STRING)
	    return (cst_streq(CST_VAL_STRING(v1),CST_VAL_STRING(v2)));
	else 
	    return CST_VAL_VOID(v1) == CST_VAL_VOID(v2);
    }
    else
	return FALSE;
}

int val_less(const cst_val *v1, const cst_val *v2)
{
    return val_float(v1) < val_float(v2);
}

int val_greater(const cst_val *v1,const cst_val *v2)
{
    return val_float(v1) > val_float(v2);
}

int val_member(const cst_val *v1,const cst_val *l)
{
    const cst_val *i;

    for (i=l; i; i=val_cdr(i))
    {
	if (val_equal(val_car(i),v1))
	    return TRUE;
    }
    return FALSE;
}

int val_member_string(const char *v1,const cst_val *l)
{
    const cst_val *i;

    for (i=l; i; i=val_cdr(i))
    {
	if (cst_streq(v1,val_string(val_car(i))))
	    return TRUE;
    }
    return FALSE;
}

cst_val *val_inc_refcount(const cst_val *b)
{
    cst_val *wb;

    /* Well I was lying, they're not really const, but this is the place */
    /* where breaking const is reasonable                              */
    wb = (cst_val *)(void *)b;

    if (CST_VAL_REFCOUNT(wb) == -1) 
	/* or is a cons cell in the text segment, how do I do that ? */
	return wb;
    else if (!cst_val_consp(wb)) /* we don't ref count cons cells */
	CST_VAL_REFCOUNT(wb) += 1;
    return wb;
}

int val_dec_refcount(const cst_val *b)
{
    cst_val *wb;

    wb = (cst_val *)(void *)b;

    if (CST_VAL_REFCOUNT(wb) == -1) 
	/* or is a cons cell in the text segment, how do I do that ? */
	return -1;
    else if (cst_val_consp(wb)) /* we don't ref count cons cells */
	return 0;
    else if (CST_VAL_REFCOUNT(wb) == 0)
    {
	/* Otherwise, trying to free a val outside an
           item/relation/etc has rather the opposite effect from what
           you might have intended... */
	return 0;
    }
    else
    {
	CST_VAL_REFCOUNT(wb) -= 1;
	return 	CST_VAL_REFCOUNT(wb);
    }
}

inline int utf8_sequence_length(char c0)
{
    // Get the expected length of UTF8 sequence given its most
    // significant byte
    return (( 0xE5000000 >> (( c0 >> 3 ) & 0x1E )) & 3 ) + 1;
}

cst_val *cst_utf8_explode(const cst_string *utf8string)
{
  // Return a list of utf8 characters as strings
  cst_val *chars=NULL;
  
  const unsigned char *str = (const unsigned char*)utf8string;
  char utf8char[5];
  char c0;
  int charlength;

  while ((c0 = *str))
  {
    charlength = utf8_sequence_length(c0);
    snprintf(utf8char, charlength + 1, "%s", str);
    chars = cons_val(string_val(utf8char),chars);
    str += charlength;
  }
  return val_reverse(chars);
}

static int utf8_ord(const char *utf8_seq) {
  unsigned int len;
  int ord;

  unsigned char c0, c1, c2, c3;  // Potential bytes in the UTF8 symbol
  c0 = utf8_seq[0];
  len = utf8_sequence_length(c0);

  // Make sure the string sequence we received matches with the
  // expected length, and that the expected length is nonzero.
  if ( (len == 0) ||
       (len != strlen(utf8_seq))) {
    return -1;
  }

  if (len == 1) {
    // ASCII sequence.
    return c0;
  }

  c1 = utf8_seq[1];
  if (len == 2) {
    ord = ((c0 & 0x1F) << 6) | (c1 & 0x3F);
    if (ord < 0x80)
      return -1;
    return ord;
  }

  c2 = utf8_seq[2];
  if (len == 3) {
    if ((c2 & 0xC0) != 0x80)
      return -1;
    ord = ((c0 & 0x0F) << 12) | ((c1 & 0x3F) << 6) | (c2 & 0x3F);
    if (ord < 0x800 ||
        (ord >= 0xD800 && ord <= 0xDFFF))
      return -1;
    return ord;
  }

  c3 = utf8_seq[3];
  if (len == 4) {
    if ((c3 & 0xC0) != 0x80)
      return -1;
    ord =
        ((c0 & 0x7) << 18) | ((c1 & 0x3F) << 12) |
        ((c2 & 0x3F) << 6) | (c3 & 0x3F);
    if (ord < 0x10000 || ord > 0x10FFFF)
      return -1;
    return ord;
  }

  return -1;
}

cst_val *cst_utf8_ord(const cst_val *utf8_char) {
  const char *ch=(const char *)val_string(utf8_char);
  return int_val(utf8_ord(ch));
}
int cst_utf8_ord_string(const char *utf8_char)
{
    return utf8_ord(utf8_char);
}

static int utf8_chr(int ord, char* utf8char) {
  unsigned int utf8len;
  int i = 0;

  if (ord < 0x80) {
    utf8len = 1;
  } else if (ord < 0x800) {
    utf8len = 2;
  } else if (ord <= 0xFFFF) {
    utf8len = 3;
  } else if (ord <= 0x200000) {
    utf8len = 4;
  } else {
    // Replace invalid character with FFFD
    utf8len = 2;
    ord = 0xFFFD;
  }

  i = utf8len;  // Index into utf8char
  utf8char[i--] = 0;

  switch (utf8len) {
    // These fallthrough deliberately
    case 6:
      utf8char[i--] = (ord | 0x80) & 0xBF;
      ord >>= 6;
    case 5:
      utf8char[i--] = (ord | 0x80) & 0xBF;
      ord >>= 6;
    case 4:
      utf8char[i--] = (ord | 0x80) & 0xBF;
      ord >>= 6;
    case 3:
      utf8char[i--] = (ord | 0x80) & 0xBF;
      ord >>= 6;
    case 2:
      utf8char[i--] = (ord | 0x80) & 0xBF;
      ord >>= 6;
    case 1:
      switch (utf8len) {
        case 0:
        case 1:
          utf8char[i--] = ord;
          break;
        case 2:
          utf8char[i--] = ord | 0xC0;
          break;
        case 3:
          utf8char[i--] = ord | 0xE0;
          break;
        case 4:
          utf8char[i--] = ord | 0xF0;
      }
  }
  return utf8len;
}

cst_val *cst_utf8_chr(const cst_val *ord) {
  char ch[5];
  int utf8len;

  utf8len = utf8_chr(val_int(ord),ch);
  if (utf8len == 0) {
    return 0;
  }

  return string_val(ch);
}

int val_stringp(const cst_val *v)
{
    if (cst_val_consp(v))
        return FALSE;
    else if (CST_VAL_TYPE(v) == CST_VAL_TYPE_STRING)
        return TRUE;
    else
        return FALSE;
}

const cst_val *val_assoc_string(const char *v1,const cst_val *al)
{
    const cst_val *i;

    for (i=al; i; i=val_cdr(i))
    {
	if (cst_streq(v1,val_string(val_car(val_car(i)))))
	    return val_car(i);
    }
    return NULL;
}

cst_string *cst_implode(const cst_val *sl)
{
    const cst_val *v;
    int l=0;
    char *s;

    for (v=sl; v; v=val_cdr(v))
    {
        if (val_stringp(val_car(v)))
            l += cst_strlen(val_string(val_car(v)));
    }

    s = cst_alloc(cst_string,l+1);

    for (v=sl; v; v=val_cdr(v))
    {
        if (val_stringp(val_car(v)))
            cst_sprintf(s,"%s%s",s,val_string(val_car(v)));

    }

    return s;
}

cst_val *val_readlist_string(const char *str)
{   /* not fully general but a good start */
    cst_tokenstream *ts;
    cst_val *v = NULL;
    const char *p;

    ts = ts_open_string(str,
                        cst_ts_default_whitespacesymbols,
                        "",
                        "",
                        "");

    while (!ts_eof(ts))
    {
        p = ts_get(ts);
        v = cons_val(string_val(p),v);
    }

    ts_close(ts);

    return val_reverse(v);
}



