path: root/apps/interpreters/bas/value.c

/****************************************************************************
 * Included Files
 ****************************************************************************/

#undef  _POSIX_SOURCE
#define _POSIX_SOURCE   1
#undef  _POSIX_C_SOURCE
#define _POSIX_C_SOURCE 2

#include "config.h"

#include <assert.h>
#include <ctype.h>
#include <errno.h>
#include <float.h>

#ifdef HAVE_GETTEXT
#  include <libintl.h>
#  define _(String) gettext(String)
#else
#  define _(String) String
#endif

#include <limits.h>
#include <math.h>

/* Buggy on some systems */

#if 0
#  ifdef HAVE_TGMATH_H
#    include <tgmath.h>
#  endif
#else
extern long int lrint(double x);
#endif

#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include "error.h"
#include "value.h"

#ifdef USE_DMALLOC
#  include "dmalloc.h"
#endif

/****************************************************************************
 * Private Data
 ****************************************************************************/

static const char *typestr[] =
{
  (const char *)0,
  (const char *)0,
  "integer",
  (const char *)0,
  "real",
  "string",
  "void"
};

/* for xgettext */

const enum ValueType Value_commonType[V_VOID + 1][V_VOID + 1] =
{
  { 0, 0,       0,         0,       0,       0,        0       },
  { 0, V_ERROR, V_ERROR,   V_ERROR, V_ERROR, V_ERROR,  V_ERROR },
  { 0, V_ERROR, V_INTEGER, V_ERROR, V_REAL,  V_ERROR,  V_ERROR },
  { 0, V_ERROR, V_ERROR,   V_ERROR, V_ERROR, V_ERROR,  V_ERROR },
  { 0, V_ERROR, V_REAL,    V_ERROR, V_REAL,  V_ERROR,  V_ERROR },
  { 0, V_ERROR, V_ERROR,   V_ERROR, V_ERROR, V_STRING, V_ERROR },
  { 0, V_ERROR, V_ERROR,   V_ERROR, V_ERROR, V_ERROR,  V_ERROR }
};

#ifndef HAVE_LRINT
long int lrint(double d)
{
  return d;
}
#endif

/****************************************************************************
 * Private Functions
 ****************************************************************************/

static void format_double(struct String *buf, double value, int width,
                          int precision, int exponent)
{
  if (exponent)
    {
      size_t len;
      char *e;
      int en;

      len = buf->length;
      String_appendPrintf(buf, "%.*E", width - 1 - (precision >= 0), value);
      if (buf->character[len + 1] == '.')
        String_delete(buf, len + 1, 1);

      if (precision >= 0)
        String_insertChar(buf, len + width - precision - 1, '.');

      for (e = buf->character + buf->length - 1;
           e >= buf->character && *e != 'E'; --e);

      ++e;
      en = strtol(e, (char **)0, 10);
      en = en + 2 - (width - precision);
      len = e - buf->character;
      String_delete(buf, len, buf->length - len);
      String_appendPrintf(buf, "%+0*d", exponent - 1, en);
    }
  else if (precision > 0)
    String_appendPrintf(buf, "%.*f", precision, value);
  else if (precision == 0)
    String_appendPrintf(buf, "%.f.", value);
  else if (width)
    String_appendPrintf(buf, "%.f", value);
  else
    {
      double x = value;

      if (x < 0.0001 || x >= 10000000.0)        /* print scientific notation */
        {
          String_appendPrintf(buf, "%.7g", value);
        }
      else                      /* print decimal numbers or integers, if *
                                 * possible */
        {
          int o, n, p = 6;

          while (x >= 10.0 && p > 0)
            {
              x /= 10.0;
              --p;
            }
          o = buf->length;
          String_appendPrintf(buf, "%.*f", p, value);
          n = buf->length;
          if (memchr(buf->character + o, '.', n - o))
            {
              while (buf->character[buf->length - 1] == '0')
                --buf->length;
              if (buf->character[buf->length - 1] == '.')
                --buf->length;
            }
        }
    }
}

/****************************************************************************
 * Public Functions
 ****************************************************************************/

double Value_trunc(double d)
{
  return (d < 0.0 ? ceil(d) : floor(d));
}

double Value_round(double d)
{
  return (d < 0.0 ? ceil(d - 0.5) : floor(d + 0.5));
}

long int Value_toi(double d, int *overflow)
{
  d = Value_round(d);
  *overflow = (d < LONG_MIN || d > LONG_MAX);
  return lrint(d);
}

long int Value_vali(const char *s, char **end, int *overflow)
{
  long int n;

  errno = 0;
  if (*s == '&' && tolower(*(s + 1)) == 'h')
    n = strtoul(s + 2, end, 16);
  else if (*s == '&' && tolower(*(s + 1)) == 'o')
    n = strtoul(s + 2, end, 8);
  else
    n = strtol(s, end, 10);

  *overflow = (errno == ERANGE);
  return n;
}

double Value_vald(const char *s, char **end, int *overflow)
{
  double d;

  errno = 0;
  d = strtod(s, end);
  *overflow = (errno == ERANGE);
  return d;
}

struct Value *Value_new_NIL(struct Value *this)
{
  assert(this != (struct Value *)0);
  this->type = V_NIL;
  return this;
}

struct Value *Value_new_ERROR(struct Value *this, int code, const char *error,
                              ...)
{
  va_list ap;
  char buf[128];

  assert(this != (struct Value *)0);
  va_start(ap, error);
  vsprintf(buf, error, ap);
  va_end(ap);
  this->type = V_ERROR;
  this->u.error.code = code;
  this->u.error.msg = strcpy(malloc(strlen(buf) + 1), buf);
  return this;
}

struct Value *Value_new_INTEGER(struct Value *this, int n)
{
  assert(this != (struct Value *)0);
  this->type = V_INTEGER;
  this->u.integer = n;
  return this;
}

struct Value *Value_new_REAL(struct Value *this, double n)
{
  assert(this != (struct Value *)0);
  this->type = V_REAL;
  this->u.real = n;
  return this;
}

struct Value *Value_new_STRING(struct Value *this)
{
  assert(this != (struct Value *)0);
  this->type = V_STRING;
  String_new(&this->u.string);
  return this;
}

struct Value *Value_new_VOID(struct Value *this)
{
  assert(this != (struct Value *)0);
  this->type = V_VOID;
  return this;
}

struct Value *Value_new_null(struct Value *this, enum ValueType type)
{
  assert(this != (struct Value *)0);
  switch (type)
    {
    case V_INTEGER:
      {
        this->type = V_INTEGER;
        this->u.integer = 0;
        break;
      }
    case V_REAL:
      {
        this->type = V_REAL;
        this->u.real = 0.0;
        break;
      }
    case V_STRING:
      {
        this->type = V_STRING;
        String_new(&this->u.string);
        break;
      }
    case V_VOID:
      {
        this->type = V_VOID;
        break;
      }
    default:
      assert(0);
    }

  return this;
}

int Value_isNull(const struct Value *this)
{
  switch (this->type)
    {
    case V_INTEGER:
      return (this->u.integer == 0);
    case V_REAL:
      return (this->u.real == 0.0);
    case V_STRING:
      return (this->u.string.length == 0);
    default:
      assert(0);
    }

  return -1;
}

void Value_destroy(struct Value *this)
{
  assert(this != (struct Value *)0);
  switch (this->type)
    {
    case V_ERROR:
      free(this->u.error.msg);
      break;
    case V_INTEGER:
      break;
    case V_NIL:
      break;
    case V_REAL:
      break;
    case V_STRING:
      String_destroy(&this->u.string);
      break;
    case V_VOID:
      break;
    default:
      assert(0);
    }

  this->type = 0;
}

struct Value *Value_clone(struct Value *this, const struct Value *original)
{
  assert(this != (struct Value *)0);
  assert(original != (struct Value *)0);
  switch (original->type)
    {
    case V_ERROR:
      {
        strcpy(this->u.error.msg =
               malloc(strlen(original->u.error.msg) + 1),
               original->u.error.msg);
        this->u.error.code = original->u.error.code;
        break;
      }
    case V_INTEGER:
      this->u.integer = original->u.integer;
      break;
    case V_NIL:
      break;
    case V_REAL:
      this->u.real = original->u.real;
      break;
    case V_STRING:
      String_clone(&this->u.string, &original->u.string);
      break;
    default:
      assert(0);
    }

  this->type = original->type;
  return this;
}

struct Value *Value_uplus(struct Value *this, int calc)
{
  switch (this->type)
    {
    case V_INTEGER:
    case V_REAL:
      {
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDUOPERAND);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_uneg(struct Value *this, int calc)
{
  switch (this->type)
    {
    case V_INTEGER:
      {
        if (calc)
          this->u.integer = -this->u.integer;
        break;
      }
    case V_REAL:
      {
        if (calc)
          this->u.real = -this->u.real;
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDUOPERAND);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_unot(struct Value *this, int calc)
{
  switch (this->type)
    {
    case V_INTEGER:
      {
        if (calc)
          this->u.integer = ~this->u.integer;
        break;
      }
    case V_REAL:
      {
        Value_retype(this, V_INTEGER);
        if (calc)
          this->u.integer = ~this->u.integer;
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDUOPERAND);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_add(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer += x->u.integer;
        break;
      }
    case V_REAL:
      {
        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          this->u.real += x->u.real;
        break;
      }
    case V_STRING:
      {
        if (calc)
          String_appendString(&this->u.string, &x->u.string);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_sub(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer -= x->u.integer;
        break;
      }
    case V_REAL:
      {
        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          this->u.real -= x->u.real;
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDOPERAND);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_mult(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer *= x->u.integer;
        break;
      }
    case V_REAL:
      {
        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          this->u.real *= x->u.real;
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDOPERAND);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_div(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
      {
        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          {
            if (x->u.real == 0)
              {
                Value_destroy(this);
                Value_new_ERROR(this, UNDEFINED, "Division by zero");
              }
            else
              this->u.real /= x->u.real;
          }
        break;
      }
    case V_REAL:
      {
        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          {
            if (x->u.real == 0.0)
              {
                Value_destroy(this);
                Value_new_ERROR(this, UNDEFINED, "Division by zero");
              }
            else
              this->u.real /= x->u.real;
          }
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDOPERAND);
        break;
      }
    default:
      assert(0);
    }
  return this;
}

struct Value *Value_idiv(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          {
            if (x->u.integer == 0)
              {
                Value_destroy(this);
                Value_new_ERROR(this, UNDEFINED, "Division by zero");
              }
            else
              this->u.integer /= x->u.integer;
          }
        break;
      }
    case V_REAL:
      {
        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          {
            if (x->u.real == 0.0)
              {
                Value_destroy(this);
                Value_new_ERROR(this, UNDEFINED, "Division by zero");
              }
            else
              this->u.real = Value_trunc(this->u.real / x->u.real);
          }
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDOPERAND);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_mod(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          {
            if (x->u.integer == 0)
              {
                Value_destroy(this);
                Value_new_ERROR(this, UNDEFINED, "Modulo by zero");
              }
            else
              this->u.integer %= x->u.integer;
          }
        break;
      }
    case V_REAL:
      {
        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          {
            if (x->u.real == 0.0)
              {
                Value_destroy(this);
                Value_new_ERROR(this, UNDEFINED, "Modulo by zero");
              }
            else
              this->u.real = fmod(this->u.real, x->u.real);
          }
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDOPERAND);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_pow(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          {
            if (this->u.integer == 0 && x->u.integer == 0)
              {
                Value_destroy(this);
                Value_new_ERROR(this, UNDEFINED, "0^0");
              }
            else if (x->u.integer > 0)
              this->u.integer = pow(this->u.integer, x->u.integer);
            else
              {
                long int thisi = this->u.integer;
                Value_destroy(this);
                Value_new_REAL(this, pow(thisi, x->u.integer));
              }
          }
        break;
      }
    case V_REAL:
      {
        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          {
            if (this->u.real == 0.0 && x->u.real == 0.0)
              {
                Value_destroy(this);
                Value_new_ERROR(this, UNDEFINED, "0^0");
              }
            else
              this->u.real = pow(this->u.real, x->u.real);
          }
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDOPERAND);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_and(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
    case V_REAL:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer &= x->u.integer;
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDOPERAND);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_or(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
    case V_REAL:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer |= x->u.integer;
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDOPERAND);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_xor(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
    case V_REAL:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer ^= x->u.integer;
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDOPERAND);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_eqv(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
    case V_REAL:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer = ~(this->u.integer ^ x->u.integer);
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDOPERAND);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_imp(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
    case V_REAL:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer = (~this->u.integer) | x->u.integer;
        break;
      }
    case V_STRING:
      {
        Value_destroy(this);
        Value_new_ERROR(this, INVALIDOPERAND);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_lt(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer = (this->u.integer < x->u.integer) ? -1 : 0;
        break;
      }
    case V_REAL:
      {
        int v;

        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          v = (this->u.real < x->u.real) ? -1 : 0;
        else
          v = 0;
        Value_destroy(this);
        Value_new_INTEGER(this, v);
        break;
      }
    case V_STRING:
      {
        int v;

        if (calc)
          v = (String_cmp(&this->u.string, &x->u.string) < 0) ? -1 : 0;
        else
          v = 0;
        Value_destroy(this);
        Value_new_INTEGER(this, v);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_le(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer = (this->u.integer <= x->u.integer) ? -1 : 0;
        break;
      }
    case V_REAL:
      {
        int v;

        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          v = (this->u.real <= x->u.real) ? -1 : 0;
        else
          v = 0;
        Value_destroy(this);
        Value_new_INTEGER(this, v);
        break;
      }
    case V_STRING:
      {
        int v;

        if (calc)
          v = (String_cmp(&this->u.string, &x->u.string) <= 0) ? -1 : 0;
        else
          v = 0;
        Value_destroy(this);
        Value_new_INTEGER(this, v);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_eq(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer = (this->u.integer == x->u.integer) ? -1 : 0;
        break;
      }
    case V_REAL:
      {
        int v;

        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          v = (this->u.real == x->u.real) ? -1 : 0;
        else
          v = 0;
        Value_destroy(this);
        Value_new_INTEGER(this, v);
        break;
      }
    case V_STRING:
      {
        int v;

        if (calc)
          v = (String_cmp(&this->u.string, &x->u.string) == 0) ? -1 : 0;
        else
          v = 0;
        Value_destroy(this);
        Value_new_INTEGER(this, v);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_ge(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer = (this->u.integer >= x->u.integer) ? -1 : 0;
        break;
      }
    case V_REAL:
      {
        int v;

        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          v = (this->u.real >= x->u.real) ? -1 : 0;
        else
          v = 0;
        Value_destroy(this);
        Value_new_INTEGER(this, v);
        break;
      }
    case V_STRING:
      {
        int v;

        if (calc)
          v = (String_cmp(&this->u.string, &x->u.string) >= 0) ? -1 : 0;
        else
          v = 0;
        Value_destroy(this);
        Value_new_INTEGER(this, v);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_gt(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer = (this->u.integer > x->u.integer) ? -1 : 0;
        break;
      }
    case V_REAL:
      {
        int v;

        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          v = (this->u.real > x->u.real) ? -1 : 0;
        else
          v = 0;
        Value_destroy(this);
        Value_new_INTEGER(this, v);
        break;
      }
    case V_STRING:
      {
        int v;

        if (calc)
          v = (String_cmp(&this->u.string, &x->u.string) > 0) ? -1 : 0;
        else
          v = 0;
        Value_destroy(this);
        Value_new_INTEGER(this, v);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

struct Value *Value_ne(struct Value *this, struct Value *x, int calc)
{
  switch (Value_commonType[this->type][x->type])
    {
    case V_INTEGER:
      {
        VALUE_RETYPE(this, V_INTEGER);
        VALUE_RETYPE(x, V_INTEGER);
        if (calc)
          this->u.integer = (this->u.integer != x->u.integer) ? -1 : 0;
        break;
      }
    case V_REAL:
      {
        int v;

        VALUE_RETYPE(this, V_REAL);
        VALUE_RETYPE(x, V_REAL);
        if (calc)
          v = (this->u.real != x->u.real) ? -1 : 0;
        else
          v = 0;
        Value_destroy(this);
        Value_new_INTEGER(this, v);
        break;
      }
    case V_STRING:
      {
        int v;

        if (calc)
          v = String_cmp(&this->u.string, &x->u.string) ? -1 : 0;
        else
          v = 0;
        Value_destroy(this);
        Value_new_INTEGER(this, v);
        break;
      }
    default:
      assert(0);
    }

  return this;
}

int Value_exitFor(struct Value *this, struct Value *limit, struct Value *step)
{
  switch (this->type)
    {
    case V_INTEGER:
      return
        (step->u.integer < 0
         ? (this->u.integer < limit->u.integer)
         : (this->u.integer > limit->u.integer));
    case V_REAL:
      return
        (step->u.real < 0.0
         ? (this->u.real < limit->u.real) : (this->u.real > limit->u.real));
    case V_STRING:
      return (String_cmp(&this->u.string, &limit->u.string) > 0);
    default:
      assert(0);
    }
  return -1;
}

void Value_errorPrefix(struct Value *this, const char *prefix)
{
  size_t prefixlen, msglen;

  assert(this->type == V_ERROR);
  prefixlen = strlen(prefix);
  msglen = strlen(this->u.error.msg);
  this->u.error.msg = realloc(this->u.error.msg, prefixlen + msglen + 1);
  memmove(this->u.error.msg + prefixlen, this->u.error.msg, msglen);
  memcpy(this->u.error.msg, prefix, prefixlen);
}

void Value_errorSuffix(struct Value *this, const char *suffix)
{
  size_t suffixlen, msglen;

  assert(this->type == V_ERROR);
  suffixlen = strlen(suffix);
  msglen = strlen(this->u.error.msg);
  this->u.error.msg = realloc(this->u.error.msg, suffixlen + msglen + 1);
  memcpy(this->u.error.msg + msglen, suffix, suffixlen + 1);
}

struct Value *Value_new_typeError(struct Value *this, enum ValueType t1,
                                  enum ValueType t2)
{
  assert(typestr[t1]);
  assert(typestr[t2]);
  return Value_new_ERROR(this, TYPEMISMATCH1, _(typestr[t1]), _(typestr[t2]));
}

static void retypeError(struct Value *this, enum ValueType to)
{
  enum ValueType thisType = this->type;

  assert(typestr[thisType]);
  assert(typestr[to]);
  Value_destroy(this);
  Value_new_ERROR(this, TYPEMISMATCH1, _(typestr[thisType]), _(typestr[to]));
}

struct Value *Value_retype(struct Value *this, enum ValueType type)
{
  switch (this->type)
    {
    case V_INTEGER:
      {
        switch (type)
          {
          case V_INTEGER:
            break;
          case V_REAL:
            this->u.real = this->u.integer;
            this->type = type;
            break;
          case V_VOID:
            Value_destroy(this);
            Value_new_VOID(this);
            break;
          default:
            retypeError(this, type);
            break;
          }
        break;
      }
    case V_REAL:
      {
        int overflow;

        switch (type)
          {
          case V_INTEGER:
            {
              this->u.integer = Value_toi(this->u.real, &overflow);
              this->type = V_INTEGER;
              if (overflow)
                {
                  Value_destroy(this);
                  Value_new_ERROR(this, OUTOFRANGE, typestr[V_INTEGER]);
                }
              break;
            }
          case V_REAL:
            break;
          case V_VOID:
            Value_destroy(this);
            Value_new_VOID(this);
            break;
          default:
            retypeError(this, type);
            break;
          }
        break;
      }
    case V_STRING:
      {
        switch (type)
          {
          case V_STRING:
            break;
          case V_VOID:
            Value_destroy(this);
            Value_new_VOID(this);
            break;
          default:
            retypeError(this, type);
            break;
          }
        break;
      }
    case V_VOID:
      {
        switch (type)
          {
          case V_VOID:
            break;
          default:
            retypeError(this, type);
          }
        break;
      }
    case V_ERROR:
      break;
    default:
      assert(0);
    }

  return this;
}

struct String *Value_toString(struct Value *this, struct String *s, char pad,
                              int headingsign, size_t width, int commas,
                              int dollar, int dollarleft, int precision,
                              int exponent, int trailingsign)
{
  size_t oldlength = s->length;

  switch (this->type)
    {
    case V_ERROR:
      String_appendChars(s, this->u.error.msg);
      break;
    case V_REAL:
    case V_INTEGER:
      {
        int sign;
        struct String buf;
        size_t totalwidth = width;

        String_new(&buf);
        if (this->type == V_INTEGER)
          {
            if (this->u.integer < 0)
              {
                sign = -1;
                this->u.integer = -this->u.integer;
              }
            else if (this->u.integer == 0)
              sign = 0;
            else
              sign = 1;
          }
        else
          {
            if (this->u.real < 0.0)
              {
                sign = -1;
                this->u.real = -this->u.real;
              }
            else if (this->u.real == 0.0)
              sign = 0;
            else
              sign = 1;
          }
        switch (headingsign)
          {
          case -1:
            {
              ++totalwidth;
              String_appendChar(&buf, sign = = -1 ? '-' : ' ');
              break;
            }
          case 0:
            {
              if (sign == -1)
                String_appendChar(&buf, '-');
              break;
            }
          case 1:
            {
              ++totalwidth;
              String_appendChar(&buf, sign == -1 ? '-' : '+');
              break;
            }
          case 2:
            break;
          default:
            assert(0);
          }
        totalwidth += exponent;
        if (this->type == V_INTEGER)
          {
            if (precision > 0 || exponent)
              format_double(&buf, (double)this->u.integer, width, precision,
                            exponent);
            else if (precision == 0)
              String_appendPrintf(&buf, "%lu.", this->u.integer);
            else
              String_appendPrintf(&buf, "%lu", this->u.integer);
          }
        else
          format_double(&buf, this->u.real, width, precision, exponent);
        if (commas)
          {
            size_t digits;
            int first;

            first = (headingsign ? 1 : 0);
            for (digits = first;
                 digits < buf.length && buf.character[digits] >= '0' &&
                 buf.character[digits] <= '9'; ++digits);
            while (digits > first + 3)
              {
                digits -= 3;
                String_insertChar(&buf, digits, ',');
              }
          }
        if (dollar)
          {
            String_insertChar(&buf, 0, '$');
          }
        if (trailingsign == -1)
          {
            ++totalwidth;
            String_appendChar(&buf, sign == -1 ? '-' : ' ');
          }
        else if (trailingsign == 1)
          {
            ++totalwidth;
            String_appendChar(&buf, sign == -1 ? '-' : '+');
          }
        String_size(s,
                    oldlength + (totalwidth >
                                 buf.length ? totalwidth : buf.length));
        if (totalwidth > buf.length)
          memset(s->character + oldlength, pad,
                 totalwidth - buf.length + dollarleft);
        memcpy(s->character + oldlength +
               (totalwidth >
                buf.length ? (totalwidth - buf.length) : 0) + dollarleft,
               buf.character + dollarleft, buf.length - dollarleft);
        if (dollarleft)
          s->character[oldlength] = '$';
        String_destroy(&buf);
        break;
      }
    case V_STRING:
      {
        if (width > 0)
          {
            size_t blanks =
              (this->u.string.length <
               width ? (width - this->u.string.length) : 0);

            String_size(s, oldlength + width);
            memcpy(s->character + oldlength, this->u.string.character,
                   blanks ? this->u.string.length : width);
            if (blanks)
              memset(s->character + oldlength + this->u.string.length, ' ',
                     blanks);
          }
        else
          String_appendString(s, &this->u.string);
        break;
      }
    default:
      assert(0);
      return 0;
    }

  return s;
}

struct Value *Value_toStringUsing(struct Value *this, struct String *s,
                                  struct String *using, size_t * usingpos)
{
  char pad = ' ';
  int headingsign;
  int width = 0;
  int commas = 0;
  int dollar = 0;
  int dollarleft = 0;
  int precision = -1;
  int exponent = 0;
  int trailingsign = 0;

  headingsign = (using->length ? 0 : -1);
  if (*usingpos == using->length)
    *usingpos = 0;
  while (*usingpos < using->length)
    {
      switch (using->character[*usingpos])
        {
        case '_':              /* output next char */
          {
            ++(*usingpos);
            if (*usingpos < using->length)
              String_appendChar(s, using->character[(*usingpos)++]);
            else
              {
                Value_destroy(this);
                return Value_new_ERROR(this, MISSINGCHARACTER);
              }
            break;
          }
        case '!':              /* output first character of string */
          {
            width = 1;
            ++(*usingpos);
            goto work;
          }
        case '\\':             /* output n characters of string */
          {
            width = 1;
            ++(*usingpos);
            while (*usingpos < using->length &&
                   using->character[*usingpos] == ' ')
              {
                ++(*usingpos);
                ++width;
              }
            if (*usingpos < using->length &&
                using->character[*usingpos] == '\\')
              {
                ++(*usingpos);
                ++width;
                goto work;
              }
            else
              {
                Value_destroy(this);
                return Value_new_ERROR(this, IOERROR,
                                       _("unpaired \\ in format"));
              }
            break;
          }
        case '&':              /* output string */
          {
            width = 0;
            ++(*usingpos);
            goto work;
          }
        case '*':
        case '$':
        case '0':
        case '+':
        case '#':
        case '.':
          {
            if (using->character[*usingpos] == '+')
              {
                headingsign = 1;
                ++(*usingpos);
              }
            while (*usingpos < using->length &&
                   strchr("$#*0,", using->character[*usingpos]))
              {
                switch (using->character[*usingpos])
                  {
                  case '$':
                    if (width == 0)
                      dollarleft = 1;
                    if (++dollar > 1)
                      ++width;
                    break;
                  case '*':
                    pad = '*';
                    ++width;
                    break;
                  case '0':
                    pad = '0';
                    ++width;
                    break;
                  case ',':
                    commas = 1;
                    ++width;
                    break;
                  default:
                    ++width;
                  }
                ++(*usingpos);
              }
            if (*usingpos < using->length && using->character[*usingpos] == '.')
              {
                ++(*usingpos);
                ++width;
                precision = 0;
                while (*usingpos < using->length &&
                       strchr("*#", using->character[*usingpos]))
                  {
                    ++(*usingpos);
                    ++precision;
                    ++width;
                  }
                if (width == 1 && precision == 0)
                  {
                    Value_destroy(this);
                    return Value_new_ERROR(this, BADFORMAT);
                  }
              }
            if (*usingpos < using->length && using->character[*usingpos] == '-')
              {
                ++(*usingpos);
                if (headingsign == 0)
                  headingsign = 2;
                trailingsign = -1;
              }
            else if (*usingpos < using->length &&
                     using->character[*usingpos] == '+')
              {
                ++(*usingpos);
                if (headingsign == 0)
                  headingsign = 2;
                trailingsign = 1;
              }
            while (*usingpos < using->length &&
                   using->character[*usingpos] == '^')
              {
                ++(*usingpos);
                ++exponent;
              }
            goto work;
          }
        default:
          {
            String_appendChar(s, using->character[(*usingpos)++]);
          }
        }
    }
work:
  Value_toString(this, s, pad, headingsign, width, commas, dollar, dollarleft,
                 precision, exponent, trailingsign);
  if ((this->type == V_INTEGER || this->type == V_REAL) && width == 0 &&
      precision == -1)
    String_appendChar(s, ' ');
  while (*usingpos < using->length)
    {
      switch (using->character[*usingpos])
        {
        case '_':              /* output next char */
          {
            ++(*usingpos);
            if (*usingpos < using->length)
              String_appendChar(s, using->character[(*usingpos)++]);
            else
              {
                Value_destroy(this);
                return Value_new_ERROR(this, MISSINGCHARACTER);
              }
            break;
          }
        case '!':
        case '\\':
        case '&':
        case '*':
        case '0':
        case '+':
        case '#':
        case '.':
          return this;
        default:
          {
            String_appendChar(s, using->character[(*usingpos)++]);
          }
        }
    }

  return this;
}

struct String *Value_toWrite(struct Value *this, struct String *s)
{
  switch (this->type)
    {
    case V_INTEGER:
      String_appendPrintf(s, "%ld", this->u.integer);
      break;
    case V_REAL:
      {
        double x;
        int p = DBL_DIG;
        int n, o;

        x = (this->u.real < 0.0 ? -this->u.real : this->u.real);
        while (x > 1.0 && p > 0)
          {
            x /= 10.0;
            --p;
          }
        o = s->length;
        String_appendPrintf(s, "%.*f", p, this->u.real);
        n = s->length;
        if (memchr(s->character + o, '.', n - o))
          {
            while (s->character[s->length - 1] == '0')
              --s->length;
            if (s->character[s->length - 1] == '.')
              --s->length;
          }
        break;
      }
    case V_STRING:
      {
        size_t l = this->u.string.length;
        char *data = this->u.string.character;

        String_appendChar(s, '"');
        while (l--)
          {
            if (*data == '"')
              String_appendChar(s, '"');
            String_appendChar(s, *data);
            ++data;
          }
        String_appendChar(s, '"');
        break;
      }
    default:
      assert(0);
    }

  return s;
}

struct Value *Value_nullValue(enum ValueType type)
{
  static struct Value integer = { V_INTEGER };
  static struct Value real = { V_REAL };
  static struct Value string = { V_STRING };
  static char n[] = "";
  static int init = 0;

  if (!init)
    {
      integer.u.integer = 0;
      real.u.real = 0.0;
      string.u.string.length = 0;
      string.u.string.character = n;
    }
  switch (type)
    {
    case V_INTEGER:
      return &integer;
    case V_REAL:
      return &real;
    case V_STRING:
      return &string;
    default:
      assert(0);
    }

  return (struct Value *)0;
}