/*
 * NAME:	kfuns.c
 * DESCRIPTION:	MOO "kernel" functions
 */

inherit "/std/core";
inherit "/std/data";

# include <moo/data.h>
# include <moo/verb.h>

# define KFUNDEF1(func)  \
  MOOVAL k_##func(mixed *info, MOOVAL arg1)
# define KFUNDEF2(func)  \
  MOOVAL k_##func(mixed *info, MOOVAL arg1, MOOVAL arg2)
# define KFUNDEF3(func)  \
  MOOVAL k_##func(mixed *info, MOOVAL arg1, MOOVAL arg2, MOOVAL arg3)

KFUNDEF2(plus)
{
  switch (TYPEOF(arg1))
    {
    case T_NUM:
      if (FLTP(arg2))
	{
	  float flt;

	  if (catch(flt = ((float) NUMVAL(arg1) + FLTVAL(arg2))) == 0)
	    return FLT(flt);
	  else
	    return RAISE(E_OVERFL);
	}

      return NUMP(arg2) ? NUM(NUMVAL(arg1) + NUMVAL(arg2)) : RAISE(E_TYPE);

    case T_STR:
      return STRP(arg2) ? STR(STRVAL(arg1) + STRVAL(arg2)) : RAISE(E_TYPE);

    case T_FLT:
      {
	float flt;

	if (NUMP(arg2))
	  arg2 = FLT((float) NUMVAL(arg2));
	else if (! FLTP(arg2))
	  return RAISE(E_TYPE);

	if (catch(flt = (FLTVAL(arg1) + FLTVAL(arg2))) == 0)
	  return FLT(flt);
	else
	  return RAISE(E_OVERFL);
      }

    default:
      return RAISE(E_TYPE);
    }
}

KFUNDEF2(minus)
{
  if (NUMP(arg1))
    {
      if (FLTP(arg2))
	{
	  float flt;

	  if (catch(flt = ((float) NUMVAL(arg1) - FLTVAL(arg2))) == 0)
	    return FLT(flt);
	  else
	    return RAISE(E_OVERFL);
	}

      return NUMP(arg2) ? NUM(NUMVAL(arg1) - NUMVAL(arg2)) : RAISE(E_TYPE);
    }
  else if (FLTP(arg1))
    {
      float flt;

      if (NUMP(arg2))
	arg2 = FLT((float) NUMVAL(arg2));
      else if (! FLTP(arg2))
	return RAISE(E_TYPE);

      if (catch(flt = (FLTVAL(arg1) - FLTVAL(arg2))) == 0)
	return FLT(flt);
      else
	return RAISE(E_OVERFL);
    }

  return RAISE(E_TYPE);
}

KFUNDEF2(times)
{
  if (NUMP(arg1))
    {
      if (FLTP(arg2))
	{
	  float flt;

	  if (catch(flt = ((float) NUMVAL(arg1) * FLTVAL(arg2))) == 0)
	    return FLT(flt);
	  else
	    return RAISE(E_OVERFL);
	}

      return NUMP(arg2) ? NUM(NUMVAL(arg1) * NUMVAL(arg2)) : RAISE(E_TYPE);
    }
  else if (FLTP(arg1))
    {
      float flt;

      if (NUMP(arg2))
	arg2 = FLT((float) NUMVAL(arg2));
      else if (! FLTP(arg2))
	return RAISE(E_TYPE);

      if (catch(flt = (FLTVAL(arg1) * FLTVAL(arg2))) == 0)
	return FLT(flt);
      else
	return RAISE(E_OVERFL);
    }

  return RAISE(E_TYPE);
}

KFUNDEF2(divide)
{
  if (NUMP(arg1))
    {
      if (FLTP(arg2))
	{
	  float flt;

	  if (FLTVAL(arg2) == 0.0)
	    return RAISE(E_DIV);

	  if (catch(flt = ((float) NUMVAL(arg1) / FLTVAL(arg2))) == 0)
	    return FLT(flt);
	  else
	    return RAISE(E_OVERFL);
	}

      if (! NUMP(arg2))
	return RAISE(E_TYPE);
      else if (NUMVAL(arg2) == 0)
	return RAISE(E_DIV);
      else
	return NUM(NUMVAL(arg1) / NUMVAL(arg2));
    }
  else if (FLTP(arg1))
    {
      float flt;

      if (NUMP(arg2))
	arg2 = FLT((float) NUMVAL(arg2));
      else if (! FLTP(arg2))
	return RAISE(E_TYPE);

      if (FLTVAL(arg2) == 0.0)
	return RAISE(E_DIV);

      if (catch(flt = (FLTVAL(arg1) / FLTVAL(arg2))) == 0)
	return FLT(flt);
      else
	return RAISE(E_OVERFL);
    }

  return RAISE(E_TYPE);
}

KFUNDEF2(modulus)
{
  if (NUMP(arg1))
    {
      if (FLTP(arg2))
	{
	  float flt;

	  if (FLTVAL(arg2) == 0.0)
	    return RAISE(E_DIV);

	  if (catch(flt = fmod((float) NUMVAL(arg1),
			       FLTVAL(arg2))) == 0)
	    return FLT(flt);
	  else
	    return RAISE(E_OVERFL);
	}
      if (! NUMP(arg2))
	return RAISE(E_TYPE);
      else if (NUMVAL(arg2) == 0)
	return RAISE(E_DIV);
      else
	return NUM(NUMVAL(arg1) % NUMVAL(arg2));
    }
  else if (FLTP(arg1))
    {
      float flt;

      if (NUMP(arg2))
	arg2 = FLT((float) NUMVAL(arg2));
      else if (! FLTP(arg2))
	return RAISE(E_TYPE);

      if (FLTVAL(arg2) == 0.0)
	return RAISE(E_DIV);

      if (catch(flt = fmod(FLTVAL(arg1), FLTVAL(arg2))) == 0)
	return FLT(flt);
      else
	return RAISE(E_OVERFL);
    }

  return RAISE(E_TYPE);
}

KFUNDEF2(getprop)
{
  object ob;
  MOOVAL val;

  if (! OBJP(arg1) || ! STRP(arg2))
    return RAISE(E_TYPE);

  if (! (ob = MOOOBJ(OBJVAL(arg1))))
    return RAISE(E_INVIND);

  val = ob->get_property(STRVAL(arg2), info);
  if (STWP(val))
    return RAISE(STWVAL(val));
  else
    return val;
}

KFUNDEF3(range)
{
  switch (TYPEOF(arg1))
    {
    case T_STR:
      {
	string str;
	int ind1, ind2, len;

	if (! NUMP(arg2) || ! NUMP(arg3))
	  return RAISE(E_TYPE);

	str  = STRVAL(arg1);
	len  = strlen(str);
	ind1 = NUMVAL(arg2);
	ind2 = NUMVAL(arg3);

	if (ind1 > ind2)
	  return STR("");

	if (ind1 < 1 || ind1 > len ||
	    ind2 < 1 || ind2 > len)
	  return RAISE(E_RANGE);

	return STR(str[ind1 - 1 .. ind2 - 1]);
      }

    case T_LST:
      {
	MOOVAL *list;
	int ind1, ind2, len;

	if (! NUMP(arg2) || ! NUMP(arg3))
	  return RAISE(E_TYPE);

	list = LSTVAL(arg1);
	len  = sizeof(list);
	ind1 = NUMVAL(arg2);
	ind2 = NUMVAL(arg3);

	if (ind1 > ind2)
	  return LST(LNEW());

	if (ind1 < 1 || ind1 > len ||
	    ind2 < 1 || ind2 > len)
	  return RAISE(E_RANGE);

	return LST(list[ind1 - 1 .. ind2 - 1]);
      }

    case T_BUF:
      {
	string buf;
	int ind1, ind2, len;

	if (! NUMP(arg2) || ! NUMP(arg3))
	  return RAISE(E_TYPE);

	buf  = BUFVAL(arg1);
	len  = strlen(buf);
	ind1 = NUMVAL(arg2);
	ind2 = NUMVAL(arg3);

	if (ind1 > ind2)
	  return BUF("");

	if (ind1 < 1 || ind1 > len ||
	    ind2 < 1 || ind2 > len)
	  return RAISE(E_RANGE);

	return BUF(buf[ind1 - 1 .. ind2 - 1]);
      }

    default:
      return RAISE(E_TYPE);
    }
}

KFUNDEF2(index)
{
  switch (TYPEOF(arg1))
    {
    case T_STR:
      {
	string str;
	int index;

	if (! NUMP(arg2))
	  return RAISE(E_TYPE);

	str   = STRVAL(arg1);
	index = NUMVAL(arg2);

	if (index < 1 || index > strlen(str))
	  return RAISE(E_RANGE);

	return STR(str[index - 1 .. index - 1]);
      }

    case T_LST:
      {
	MOOVAL *list;
	int index;

	if (! NUMP(arg2))
	  return RAISE(E_TYPE);

	list  = LSTVAL(arg1);
	index = NUMVAL(arg2);

	if (index < 1 || index > sizeof(list))
	  return RAISE(E_RANGE);

	return list[index - 1];
      }

    case T_TBL:
      {
	MOOVAL value;

	value = TLOOKUP(TBLVAL(arg1), arg2);
	return STWP(value) ? RAISE(E_RANGE) : value;
      }

    case T_BUF:
      {
	string buf;
	int index;

	if (! NUMP(arg2))
	  return RAISE(E_TYPE);

	buf   = BUFVAL(arg1);
	index = NUMVAL(arg2);

	if (index < 1 || index > strlen(buf))
	  return RAISE(E_RANGE);

	return NUM(buf[index - 1]);
      }

    default:
      return RAISE(E_TYPE);
    }
}

KFUNDEF1(negate)
{
  if (NUMP(arg1))
    return NUM(-NUMVAL(arg1));
  else if (FLTP(arg1))
    return FLT(-FLTVAL(arg1));
  else
    return RAISE(E_TYPE);
}

KFUNDEF2(equal)
{
  return EQUALP(arg1, arg2) ? NUM(1) : NUM(0);
}

KFUNDEF2(nequal)
{
  return EQUALP(arg1, arg2) ? NUM(0) : NUM(1);
}

KFUNDEF2(less)
{
  switch (TYPEOF(arg1))
    {
    case T_NUM:
      if (NUMP(arg2))
	return NUM(NUMVAL(arg1) < NUMVAL(arg2));
      else if (FLTP(arg2))
	return NUM((float) NUMVAL(arg1) < FLTVAL(arg2));
      else
	return RAISE(E_TYPE);

    case T_STR:
      return STRP(arg2) ? NUM(tolower(STRVAL(arg1)) <
			      tolower(STRVAL(arg2))) : RAISE(E_TYPE);

    case T_OBJ:
      return OBJP(arg2) ? NUM(OBJVAL(arg1) < OBJVAL(arg2)) : RAISE(E_TYPE);

    case T_ERR:
      return ERRP(arg2) ? NUM(ERRVAL(arg1) < ERRVAL(arg2)) : RAISE(E_TYPE);

    case T_FLT:
      if (FLTP(arg2))
	return NUM(FLTVAL(arg1) < FLTVAL(arg2));
      else if (NUMP(arg2))
	return NUM(FLTVAL(arg1) < (float) NUMVAL(arg2));
      else
	return RAISE(E_TYPE);

    case T_BUF:
      return BUFP(arg2) ? NUM(BUFVAL(arg1) < BUFVAL(arg2)) : RAISE(E_TYPE);

    default:
      return RAISE(E_TYPE);
    }
}

KFUNDEF2(lsequal)
{
  switch (TYPEOF(arg1))
    {
    case T_NUM:
      if (NUMP(arg2))
	return NUM(NUMVAL(arg1) <= NUMVAL(arg2));
      else if (FLTP(arg2))
	return NUM((float) NUMVAL(arg1) <= FLTVAL(arg2));
      else
	return RAISE(E_TYPE);

    case T_STR:
      return STRP(arg2) ? NUM(tolower(STRVAL(arg1)) <=
			      tolower(STRVAL(arg2))) : RAISE(E_TYPE);

    case T_OBJ:
      return OBJP(arg2) ? NUM(OBJVAL(arg1) <= OBJVAL(arg2)) : RAISE(E_TYPE);

    case T_ERR:
      return ERRP(arg2) ? NUM(ERRVAL(arg1) <= ERRVAL(arg2)) : RAISE(E_TYPE);

    case T_FLT:
      if (FLTP(arg2))
	return NUM(FLTVAL(arg1) <= FLTVAL(arg2));
      else if (NUMP(arg2))
	return NUM(FLTVAL(arg1) <= (float) NUMVAL(arg2));
      else
	return RAISE(E_TYPE);

    case T_BUF:
      return BUFP(arg2) ? NUM(BUFVAL(arg1) <= BUFVAL(arg2)) : RAISE(E_TYPE);

    default:
      return RAISE(E_TYPE);
    }
}

KFUNDEF2(greater)
{
  switch (TYPEOF(arg1))
    {
    case T_NUM:
      if (NUMP(arg2))
	return NUM(NUMVAL(arg1) > NUMVAL(arg2));
      else if (FLTP(arg2))
	return NUM((float) NUMVAL(arg1) > FLTVAL(arg2));
      else
	return RAISE(E_TYPE);

    case T_STR:
      return STRP(arg2) ? NUM(tolower(STRVAL(arg1)) >
			      tolower(STRVAL(arg2))) : RAISE(E_TYPE);

    case T_OBJ:
      return OBJP(arg2) ? NUM(OBJVAL(arg1) > OBJVAL(arg2)) : RAISE(E_TYPE);

    case T_ERR:
      return ERRP(arg2) ? NUM(ERRVAL(arg1) > ERRVAL(arg2)) : RAISE(E_TYPE);

    case T_FLT:
      if (FLTP(arg2))
	return NUM(FLTVAL(arg1) > FLTVAL(arg2));
      else if (NUMP(arg2))
	return NUM(FLTVAL(arg1) > (float) NUMVAL(arg2));
      else
	return RAISE(E_TYPE);

    case T_BUF:
      return BUFP(arg2) ? NUM(BUFVAL(arg1) > BUFVAL(arg2)) : RAISE(E_TYPE);

    default:
      return RAISE(E_TYPE);
    }
}

KFUNDEF2(grequal)
{
  switch (TYPEOF(arg1))
    {
    case T_NUM:
      if (NUMP(arg2))
	return NUM(NUMVAL(arg1) >= NUMVAL(arg2));
      else if (FLTP(arg2))
	return NUM((float) NUMVAL(arg1) >= FLTVAL(arg2));
      else
	return RAISE(E_TYPE);

    case T_STR:
      return STRP(arg2) ? NUM(tolower(STRVAL(arg1)) >=
			      tolower(STRVAL(arg2))) : RAISE(E_TYPE);

    case T_OBJ:
      return OBJP(arg2) ? NUM(OBJVAL(arg1) >= OBJVAL(arg2)) : RAISE(E_TYPE);

    case T_ERR:
      return ERRP(arg2) ? NUM(ERRVAL(arg1) >= ERRVAL(arg2)) : RAISE(E_TYPE);

    case T_FLT:
      if (FLTP(arg2))
	return NUM(FLTVAL(arg1) >= FLTVAL(arg2));
      else if (NUMP(arg2))
	return NUM(FLTVAL(arg1) >= (float) NUMVAL(arg2));
      else
	return RAISE(E_TYPE);

    case T_BUF:
      return BUFP(arg2) ? NUM(BUFVAL(arg1) >= BUFVAL(arg2)) : RAISE(E_TYPE);

    default:
      return RAISE(E_TYPE);
    }
}

KFUNDEF2(in)
{
  if (LSTP(arg2))
    {
      int i, sz;
      MOOVAL *list;

      list = LSTVAL(arg2);

      for (i = 0, sz = sizeof(list); i < sz; ++i)
	if (EQUALP(arg1, list[i]))
	  return NUM(i + 1);

      return NUM(0);
    }
  else if (TBLP(arg2))
    {
      MOOVAL value;

      value = TLOOKUP(TBLVAL(arg2), arg1);
      return STWP(value) ? NUM(0) : NUM(1);
    }

  return RAISE(E_TYPE);
}