teapot-spreadsheet/src/common/eval.c

/* #includes */ /*{{{C}}}*//*{{{*/
#ifndef NO_POSIX_SOURCE
#undef _POSIX_SOURCE
#define _POSIX_SOURCE   1
#undef _POSIX_C_SOURCE
#define _POSIX_C_SOURCE 2
#endif

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

#include <assert.h>
#include <ctype.h>
#include <errno.h>
#include <float.h>
#include <limits.h>
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
extern char *strdup(const char* s);
#include <string.h>


#include "default.h"
#include "eval.h"
#include "func.h"
#include "main.h"
#include "misc.h"
#include "scanner.h"
#include "sheet.h"
/*}}}*/

/* tcopy     -- return copy of token */ /*{{{*/
Token tcopy(Token n)
{
  /* result */ /*{{{*/
  Token result;
  /*}}}*/

  result = n;
  switch (n.type) {
  case STRING: result.u.string = strdup(n.u.string); break;
  case LIDENT: result.u.lident = strdup(n.u.lident); break;
  case FUNCALL:
    if (n.u.funcall.argc > 0)
    {
      result.u.funcall.argv = malloc(n.u.funcall.argc*sizeof(Token));
      for (size_t ai = 0; ai < n.u.funcall.argc; ++ai)
	result.u.funcall.argv[ai] = tcopy(n.u.funcall.argv[ai]);
    } else result.u.funcall.argv = NULLTOKEN;
    break;
  case EEK: result.u.err = strdup(n.u.err); break;
  default: break;
  }
  return result;
}
/*}}}*/

/* tfree     -- free dynamic data of token */ /*{{{*/
void tfree(Token *n)
{
  Token fake;
  fake.type = INT;
  tfree_protected(n, fake);
}
/*}}}*/

/* tfree_protected     -- free dynamic data of token but not if same as protected */ /*{{{*/
void tfree_protected(Token *n, const Token dontfree)
{
  bool difftype = (dontfree.type != n->type);
  switch (n->type) {
  case STRING:
    if (difftype || n->u.string != dontfree.u.string)
    {
      free(n->u.string);
      n->u.string=(char*)0;
    }
    break;
  case LIDENT:
    if (difftype || n->u.lident != dontfree.u.lident)
    {
      free(n->u.lident);
      n->u.lident=(char*)0;
    }
    break;
  case FUNCALL:
    if (difftype || n->u.funcall.argv != dontfree.u.funcall.argv)
    {
      for (int ai = n->u.funcall.argc-1; ai >= 0; --ai)
	if (n->u.funcall.fident = FUNC_AND && ai > 0
	    && n->u.funcall.argv[ai].type == FUNCALL
	    && n->u.funcall.argv[ai-1].type == FUNCALL
	    && n->u.funcall.argv[ai].u.funcall.argc == 2
	    && n->u.funcall.argv[ai-1].u.funcall.argc == 2
	    && IS_RELATION_FUNC(n->u.funcall.argv[ai].u.funcall.fident)
	    && IS_RELATION_FUNC(n->u.funcall.argv[ai-1].u.funcall.fident))
	{
	  tfree_protected(n->u.funcall.argv + ai,
			  n->u.funcall.argv[ai-1].u.funcall.argv[1]);
	} else tfree_protected(n->u.funcall.argv + ai, dontfree);
      if (n->u.funcall.argv != NULLTOKEN) {
	free(n->u.funcall.argv);
	n->u.funcall.argv = NULLTOKEN;
      }
    }
    break;
  case EEK:
    if (difftype || n->u.err != dontfree.u.err)
    {
      free(n->u.err);
      n->u.err=(char*)0;
    }
    break;
  default:
    break;
  }
  n->type = EMPTY;
}
/*}}}*/

/* tvecfreetoks  -- free the tokens in vector of pointer to tokens */ /*{{{*/
void tvecfreetoks(Token **tvec)
{
  if (tvec!=EMPTY_TVEC)
  while (*tvec != NULLTOKEN)
  {
      tfree(*tvec);
      free(*tvec);
      *(tvec++) = NULLTOKEN;
  }
}

/*}}}*/

/* tvecfree  -- free a vector of pointer to tokens entirely */ /*{{{*/
void tvecfree(Token **tvec)
{
  tvecfreetoks(tvec);
  free(tvec);
}      
/*}}}*/

/* tveclen  -- return length of a vector of pointer to tokens */ /*{{{*/
size_t tveclen(Token **tvec)
{
  size_t len;
  if (tvec == EMPTY_TVEC) return 0;
  for (len = 0; *tvec != NULLTOKEN; ++len,++tvec);
  return len;
}
/*}}}*/

/* checkflt -- check for error conditions in floating point result */
static Token checkflt(Token res, const char* context)
{
  if (res.type != FLOAT) return res;
  const char *msg = dblfinite(res.u.flt);
  if (msg == NULL) return res;
  res.type = EEK;
  res.u.err = malloc(strlen(msg) + strlen(context) + 1);
  (void)strcpy(res.u.err, context);
  (void)strcat(res.u.err, msg);
  return res;
}
/* operand_type_error -- return an error message about operands */
static Token operand_type_error(const char* context, Type lt, Type rt)
{
  const char* templ = _("wrong operand types, %s and %s");
  size_t conlen = strlen(context);
  Token err;

  err.type = EEK;
  err.u.err = malloc(conlen + strlen(templ) + 2*MAX_TYPE_NAME_LENGTH + 1);
  strcpy(err.u.err, context);
  sprintf(err.u.err + conlen, templ, Type_Name[lt], Type_Name[rt]);
  return err;
}

/* tadd      -- + operator */ /*{{{*/
Token tadd(Token l, Token r)
{
  /* variables */ /*{{{*/
  Token result;
  const char *cntxt = "+: ";
  /*}}}*/

  if (l.type == EEK || r.type == EMPTY) return tcopy(l);
  if (r.type == EEK || l.type == EMPTY) return tcopy(r);
  if (l.type == INT && r.type == INT)
  /* result is int sum of two ints */ /*{{{*/
  {
    result.type = INT;
    result.u.integer = l.u.integer+r.u.integer;
    return result;
  }
  /*}}}*/
  if (l.type == STRING && r.type == STRING)
  /* result is concatenated strings */ /*{{{*/
  {
    result.type = STRING;
    result.u.string = malloc(strlen(l.u.string) + strlen(r.u.string) + 1);
    (void)strcpy(result.u.string, l.u.string);
    (void)strcat(result.u.string, r.u.string);
    return result;
  }
  /*}}}*/
  if (l.type == INT && r.type == FLOAT)
  /* result is float sum of int and float */ /*{{{*/
  {
    result.type = FLOAT;
    result.u.flt = ((FltT)l.u.integer) + r.u.flt;
    return checkflt(result, cntxt);
  }
  /*}}}*/
  if (l.type == FLOAT && r.type == INT)
  /* result is float sum of float and int */ /*{{{*/
  {
    result.type = FLOAT;
    result.u.flt = l.u.flt + ((FltT)r.u.integer);
    return checkflt(result, cntxt);
  }
  /*}}}*/
  if (l.type == FLOAT && r.type == FLOAT)
  /* result is float sum of float and float */ /*{{{*/
  {
    result.type = FLOAT;
    result.u.flt = l.u.flt + r.u.flt;
    return checkflt(result, cntxt);
  }
  /*}}}*/
  if (l.type == LOCATION && r.type == LOCATION)
  /* result is component-wise sum of locations */ /*{{{*/
  {
    result.type = LOCATION;
    for (size_t len = 0; len < 3; ++len)
      result.u.location[len] = l.u.location[len] + r.u.location[len];
    return result;
  }
  /*}}}*/
  return operand_type_error(cntxt, l.type, r.type);
}
/*}}}*/

/* tconcat      -- concat operands as strings */ /*{{{*/
Token tconcat(Token l, Token r)
{
  /* variables */ /*{{{*/
  static int conc_buf_len = 1024;
  Token result;
  char buf[conc_buf_len];
  const char *buferr = _("Internal string concatenation buffer too small");
  int len;
  /*}}}*/

  if (l.type == EEK) return tcopy(l);
  if (r.type == EEK) return tcopy(r);
  len = printtok(buf, conc_buf_len, 0, DIRECT_STRING,
		 DEF_FLOATFORM, def_precision, TRUNCATED_ERROR, &l);
  if (len > conc_buf_len - 2)
  {
    duperror(&result, buferr);
    return result;
  }
  len += printtok(buf + len, conc_buf_len - len - 1, 0, DIRECT_STRING,
		  DEF_FLOATFORM, def_precision, TRUNCATED_ERROR, &r);
  if (len > conc_buf_len - 2)
  {
    duperror(&result, buferr);
    return result;
  }
  buf[len] = '\0';
  result.type = STRING;
  result.u.string = strdup(buf);
  return result;
}
/*}}}*/

/* tsub      -- binary - operator */ /*{{{*/
Token tsub(Token l, Token r)
{
  /* variables */ /*{{{*/
  Token result;
  const char *cntxt = "-: ";
  /*}}}*/

  if (l.type == EEK || r.type == EMPTY) return tcopy(l);
  if (r.type == EEK) return tcopy(r);
  if (l.type == EMPTY) return tneg(r);
  if (l.type == INT && r.type == INT)
  /* result is int difference between left int and right int */ /*{{{*/
  {
    result.type = INT;
    result.u.integer = l.u.integer - r.u.integer;
  }
  /*}}}*/
  else if (l.type==FLOAT && r.type==FLOAT)
  /* result is float difference between left float and right float */ /*{{{*/
  {
    result.type=FLOAT;
    result.u.flt=l.u.flt-r.u.flt;
  }
  /*}}}*/
  else if (l.type==INT && r.type==FLOAT)
  /* result is float difference of left integer and right float */ /*{{{*/
  {
    result.type = FLOAT;
    result.u.flt = ((FltT)l.u.integer) - r.u.flt;
  }
  /*}}}*/
  else if (l.type==FLOAT && r.type==INT)
  /* result is float difference between left float and right integer */ /*{{{*/
  {
    result.type = FLOAT;
    result.u.flt = l.u.flt - ((FltT)r.u.integer);
  }
  /*}}}*/
  else if (l.type == LOCATION && r.type == LOCATION)
  /* result is component-wise difference of locations */ /*{{{*/
  {
    result.type = LOCATION;
    for (size_t len = 0; len < 3; ++len)
      result.u.location[len] = l.u.location[len] - r.u.location[len];
  }
  /*}}}*/
  else return operand_type_error(cntxt, l.type, r.type);
  return checkflt(result, cntxt);
}
/*}}}*/

/* tdiv      -- / operator */ /*{{{*/
Token tdiv(Token l, Token r)
{
  /* variables */ /*{{{*/
  Token result;
  const char *cntxt = "/: ";
  /*}}}*/

  if (l.type == EEK) return tcopy(l);
  if (r.type == EEK) return tcopy(r);
  if ((r.type == INT && r.u.integer == 0)|| (r.type == FLOAT && r.u.flt == 0.0)
      || (r.type == EMPTY))
  /* result is division by 0 error */ /*{{{*/
  {
    duperror(&result, _("division by 0"));
    return result;
  }
  /*}}}*/
  if (l.type == EMPTY && TOKISNUM(r))
    if (r.type == INT)
    {
      result.type = INT; result.u.integer = 0; return result;
    } else {
      result.type = FLOAT; result.u.flt = 0.0; return result;
    }
  if (l.type==INT && r.type==INT)
  /* result is quotient of left int and right int */ /*{{{*/
  {
    result.type = INT;
    result.u.integer = l.u.integer/r.u.integer;
    return result;
  }
  /*}}}*/
  if (l.type == FLOAT && r.type == FLOAT)
  /* result is quotient of left float and right float */ /*{{{*/
  {
    result.type = FLOAT;
    result.u.flt = l.u.flt/r.u.flt;
  }
  /*}}}*/
  else if (l.type == INT && r.type == FLOAT)
  /* result is float quotient of left int and right float */ /*{{{*/
  {
    result.type = FLOAT;
    result.u.flt = ((FltT)l.u.integer)/r.u.flt;
  }
  /*}}}*/
  else if (l.type == FLOAT && r.type == INT)
  /* result is float quotient of left float and right int */ /*{{{*/
  {
    result.type = FLOAT;
    result.u.flt = l.u.flt/((FltT)r.u.integer);
  }
  /*}}}*/
  else if (l.type == LOCATION && r.type == INT)
  /* result is divide each component of location by right */ /*{{{*/
  {
    result.type = LOCATION;
    for (size_t len = 0; len < 3; ++len)
      result.u.location[len] = l.u.location[len] / r.u.integer;
  }
  /*}}}*/
  else return operand_type_error(cntxt, l.type, r.type);
  return checkflt(result, cntxt);
}
/*}}}*/

/* tmod      -- % operator */ /*{{{*/
Token tmod(Token l, Token r)
{
  /* variables */ /*{{{*/
  Token result;
  const char *cntxt = "%: ";
  /*}}}*/

  if (l.type == EEK) return tcopy(l);
  if (r.type == EEK) return tcopy(r);
  if ((r.type == INT && r.u.integer == 0) || (r.type == FLOAT && r.u.flt == 0.0)
      || (r.type == EMPTY)) /* result is modulo 0 error */ /*{{{*/
  {
    duperror(&result, _("modulo 0"));
    return result;
  }
  if (l.type == EMPTY && TOKISNUM(r))
    if (r.type == INT)
    {
      result.type = INT; result.u.integer = 0; return result;
    } else {
      result.type = FLOAT; result.u.flt = 0.0; return result;
    }
  if (l.type == INT && r.type == INT) /* result is remainder of left int and right int */ /*{{{*/
  {
    result.type = INT;
    result.u.integer = l.u.integer % r.u.integer;
    return result;
  }
  /*}}}*/
  if (l.type == FLOAT && r.type == FLOAT) /* result is remainder of left float and right float */ /*{{{*/
  {
    result.type = FLOAT;
    result.u.flt = FMODFLT(l.u.flt, r.u.flt);
  }
  /*}}}*/
  else if (l.type == INT && r.type == FLOAT) /* result is float remainder of left int and right float */ /*{{{*/
  {
    result.type = FLOAT;
    result.u.flt = FMODFLT((FltT)l.u.integer, r.u.flt);
  }
  /*}}}*/
  else if (l.type == FLOAT && r.type == INT) /* result is float remainder of left float and right int */ /*{{{*/
  {
    result.type = FLOAT;
    result.u.flt = FMODFLT(l.u.flt, (FltT)r.u.integer);
  }
  /*}}}*/
  else if (l.type == LOCATION && r.type == LOCATION)
  /* result is component-wise mod of locations */ /*{{{*/
  {
    result.type = LOCATION;
    for (size_t len = 0; len < 3; ++len)
      result.u.location[len] = l.u.location[len] % r.u.location[len];
  }
  /*}}}*/
  else if (l.type == LOCATION && r.type == INT)
  /* result is mod each component of location by right */ /*{{{*/
  {
    result.type = LOCATION;
    for (size_t len = 0; len < 3; ++len)
      result.u.location[len] = l.u.location[len] % r.u.integer;
  }
  /*}}}*/
  else return operand_type_error(cntxt, l.type, r.type);
  return checkflt(result, cntxt);
}
/*}}}*/

/* tmul      -- * operator */ /*{{{*/
Token tmul(Token l, Token r)
{
  /* variables */ /*{{{*/
  Token result;
  const char *cntxt = "*: ";
  /*}}}*/

  if (l.type == EEK) return tcopy(l);
  if (r.type == EEK) return tcopy(r);
  if (l.type==EMPTY && r.type==EMPTY)
    /* result is empty */ /*{{{*/
  {
    result.type = EMPTY;
    return result;
  }
  /*}}}*/
  if ((l.type == EMPTY && r.type == INT) || (l.type == INT && r.type == EMPTY))
  /* result is 0 */ /*{{{*/
  {
    result.type = INT;
    result.u.integer = 0;
    return result;
  }
  /*}}}*/
  if ((l.type == EMPTY && r.type == FLOAT)
      || (l.type == FLOAT && r.type == EMPTY))
  /* result is 0.0 */ /*{{{*/
  {
    result.type = FLOAT;
    result.u.flt = 0.0;
    return result;
  }
  /*}}}*/
  if (l.type == INT && r.type == INT)
  /* result is int product of left int and right int */ /*{{{*/
  {
    result = l;
    result.u.integer = l.u.integer * r.u.integer;
    return result;
  }
  /*}}}*/
  if (l.type == FLOAT && r.type == FLOAT)
  /* result is float product of left float and right float */ /*{{{*/
  {
    result.type = FLOAT;
    result.u.flt = l.u.flt * r.u.flt;
  }
  /*}}}*/
  else if ((l.type == INT && r.type == FLOAT)
	   || (l.type == FLOAT && r.type == INT))
  /* result is float product of int and float */ /*{{{*/
  {
    result.type = FLOAT;
    if (l.type == INT) result.u.flt = ((FltT)l.u.integer) * r.u.flt;
    else result.u.flt = l.u.flt * ((FltT)r.u.integer);
  }
  /*}}}*/
  else if ((l.type == EMPTY && r.type == LOCATION)
	   || (l.type == LOCATION && r.type == EMPTY))
    /* result is 0 location */ /*{{{*/
  {
    result.type = LOCATION;
    OLOCATION(result.u.location);
  }
  /*}}}*/
  else if (l.type == LOCATION && r.type == INT)
  /* result is each component of location times right */ /*{{{*/
  {
    result.type = LOCATION;
    for (Dimensions dim = X; dim < HYPER; ++dim)
      result.u.location[dim] = l.u.location[dim] * r.u.integer;
  }
  /*}}}*/
  else if (l.type == INT && r.type == LOCATION)
  /* result is each component of right location times left */ /*{{{*/
  {
    result.type = LOCATION;
    for (Dimensions dim = X; dim < HYPER; ++dim)
      result.u.location[dim] = l.u.integer * r.u.location[dim];
  }
  /*}}}*/
  else if (l.type == LOCATION && r.type == LOCATION)
  /* result is dot product of locations */ /*{{{*/
  {
    result.type = INT;
    result.u.integer = 0;
    for (Dimensions dim = X; dim < HYPER; ++dim)
      result.u.integer += l.u.location[dim] * r.u.location[dim];
  }
  /*}}}*/
  else if ((l.type == INT && r.type == STRING)
	   || (l.type == STRING && r.type == INT))
  /* result is n copies of string concatenated together */ /*{{{*/
  {
    int copies;
    char *pat;
    char *newval = NULL;
    if (l.type == INT)
    {
      copies = l.u.integer; pat = strdup(r.u.string);
    } else {
      copies = r.u.integer; pat = strdup(l.u.string);
    }
    if (copies == 0) result.type = EMPTY;
    else
    {
      size_t len = strlen(pat);
      if (copies < 0) /* negative coefficient means reverse string */
      {
	char *tmp = strdup(pat);
	int j = 0;
	for (int i = len - 1; i >= 0; --i, ++j) tmp[j] = pat[i];
	free(pat);
	pat = tmp;
	copies = -copies;
      }
      result.type = STRING;
      result.u.string = malloc(len * copies + 1);
      for (size_t c = 0; c < copies; ++c)
	strcpy(result.u.string + c*len, pat);
      result.u.string[copies*len] = '\0';
    }
  }
  else return operand_type_error(cntxt, l.type, r.type);
  return checkflt(result, cntxt);
}
/*}}}*/

/* tneg      -- monadic - operator */ /*{{{*/
Token tneg(Token x)
{
  Token result;
  result.type = x.type;

  switch (x.type) {
    case EEK: return tcopy(x);
    case EMPTY: return x;
    case INT: result.u.integer = -x.u.integer; return result;
    case FLOAT: result.u.flt = -x.u.flt; return result;
    case LOCATION:
      for (size_t len = 0; len < 3; ++len)
	result.u.location[len] = -x.u.location[len];
      return result;
    case BOOL: result.u.bl = !x.u.bl; return result;
    default: break;
  }
  result.type = EEK;
  const char* templ = "wrong type for - operator: %s";
  result.u.err = malloc(strlen(templ) + MAX_TYPE_NAME_LENGTH + 1);
  sprintf(result.u.err, templ, Type_Name[x.type]);
  return result;
}
/*}}}*/

/* tpow      -- ^ operator */ /*{{{*/
Token tpow(Token l, Token r)
{
  /* variables */ /*{{{*/
  Token result;
  const char *cntxt = "^: ";
  /*}}}*/

  if (l.type == EEK) return tcopy(l);
  if (r.type == EEK) return tcopy(r);
  if (TOKISNUM(r) && TOKISNUM(l))
  {
    if ((l.type == INT || l.type == EMPTY)
	&& ((r.type == INT && r.u.integer >= 0) || r.type == EMPTY))
    /* int^int, return int or error if 0^0 */ /*{{{*/
    {
      IntT x,y;

      if (l.type == EMPTY) x=0;
      else x = l.u.integer;
      if (r.type == EMPTY) y=0;
      else y = r.u.integer;
      if (x == 0 && y == 0) duperror(&result, _("0^0 is not defined"));
      else
      {
        UIntT i;

        result.type = INT;
        if (x == 0) result.u.integer = 0;
        else if (y == 0) result.u.integer = 1;
        else for (result.u.integer = x,i=1; i < y; ++i) result.u.integer *= x;
      }
      return result;
    }
    /*}}}*/
    /* float^float */ /*{{{*/
    FltT x=0.0, y=0.0;

    switch (l.type)
      {
      case INT:   x = (FltT)l.u.integer; break;
      case FLOAT: x = l.u.flt; break;
      case EMPTY: x = 0.0; break;
      default: assert(0);
      }
    switch (r.type)
      {
      case INT:   y = (FltT)r.u.integer; break;
      case FLOAT: y = r.u.flt; break;
      case EMPTY: y = 0.0; break;
      default: assert(0);
      }
    result.type = FLOAT;
    errno=0; /* there is no portable EOK :( */
    result.u.flt = POWFLT(x,y);
    switch (errno)
      {
      case 0: result.type = FLOAT; break;
      case ERANGE:
      case EDOM:
	duperror(&result, _("^ caused a domain error"));
	break;
      default: assert(0);
      }
    return checkflt(result, cntxt);
  }
  return operand_type_error(cntxt, l.type, r.type);
}
/*}}}*/

/* tfuncall  -- function operator */ /*{{{*/
Token tfuncall(FunctionIdentifier fident, int argc, Token argv[])
{
  return tfunc[fident].func(fident, argc, argv);
}
/*}}}*/

static Token relational_type_mismatch(Type l, Type r)
{
  Token mismatch;
  mismatch.type = EEK;
  char *templ = _("Type mismatch: cannot compare %s and %s");
  mismatch.u.err = malloc(strlen(templ) + 2*MAX_TYPE_NAME_LENGTH + 1);
  sprintf(mismatch.u.err, templ, Type_Name[l], Type_Name[r]);
  return mismatch;
}

/* tlt       -- < operator */ /*{{{*/
Token tlt(Token l, Token r)
{
  Token result;
  result.type = BOOL;
  result.u.bl = false;
  static char empty[] = "";

  if (l.type == EEK) return tcopy(l);
  if (r.type == EEK) return tcopy(r);
  if (l.type == EMPTY) /* try to assign 0 element of r.type */ /*{{{*/
  {
    if (r.type == EMPTY) return result;
    switch (r.type)
    {
      case INT: l.u.integer = 0; break;
      case FLOAT: l.u.flt = 0.0; break;
      case STRING: l.u.string = empty; break;
      case BOOL: l.u.bl = false; break;
      default: return relational_type_mismatch(l.type, r.type);
    }
    l.type = r.type;
  }
  /*}}}*/
  if (r.type == EMPTY) /* try to assign 0 element of l.type */ /*{{{*/
  {
    switch (l.type)
    {
      case INT: r.u.integer = 0; break;
      case FLOAT: r.u.flt = 0.0; break;
      case STRING: r.u.string = empty; break;
      case BOOL: r.u.bl = false; break;
      default: return relational_type_mismatch(l.type, r.type);;
    }  
    r.type = l.type;
  }
  /*}}}*/
  if (l.type == INT) /* handle left operand integer */ /*{{{*/
  {
    if (r.type == INT) /* return left int < right int */ /*{{{*/
    {
      result.u.bl = l.u.integer < r.u.integer;
      return result;
    } /*}}}*/
    if (r.type == FLOAT) /* return left int < right float */ /*{{{*/
    {
      result.u.bl = ((FltT)l.u.integer) < r.u.flt;
      return result;
    } /*}}}*/
    return relational_type_mismatch(l.type, r.type);
  }
  /*}}}*/
  if (l.type == STRING && r.type == STRING) /* return left string < right string */ /*{{{*/
  {
    result.u.bl = (strcmp(l.u.string,r.u.string)<0);
    return result;
  }
  /*}}}*/
  if (l.type == FLOAT) /* handle left operand float */
  {
    if (r.type == FLOAT) /* return left float < right float */ /*{{{*/
    {
      result.u.bl = l.u.flt < r.u.flt;
      return result;
    }
    /*}}}*/
    if (r.type == INT) /* return left float < right float */ /*{{{*/
    {
      result.u.bl = l.u.flt < ((FltT)r.u.integer);
      return result;
    }
    /*}}}*/
    return relational_type_mismatch(l.type, r.type);
  }
  if (l.type == LOCATION && r.type == LOCATION)
  /* result is true if l is strictly in rectangle from origin to r */ /*{{{*/
  {
    Dimensions dim = X;
    while (dim < HYPER)
    {
      if (l.u.location[dim] > r.u.location[dim]) break;
      else if (l.u.location[dim] < r.u.location[dim]) result.u.bl = true;
      ++dim;
    }
    if (dim < HYPER) result.u.bl = false;
    return result;
  }
  /*}}}*/
  return relational_type_mismatch(l.type, r.type);
}
/*}}}*/

/* tle       -- <= operator */ /*{{{*/
Token tle(Token l, Token r)
{
  return tor(tlt(l, r), teq(l, r));
}
/*}}}*/

/* tge       -- >= operator */ /*{{{*/
Token tge(Token l, Token r)
{
  return tor(tgt(l, r), teq(l, r));
}
/*}}}*/

/* tgt       -- < operator */ /*{{{*/
Token tgt(Token l, Token r)
{
  return tlt(r, l);
}
/*}}}*/

/* teq       -- == operator */ /*{{{*/
Token teq(Token l, Token r)
{
  Token result;
  result.type = BOOL;
  result.u.bl = true;
  static char empty[]="";
  
  if (l.type == EEK) return tcopy(l);
  if (r.type == EEK) return tcopy(r);
  if (l.type == EMPTY)
  /* try to assign 0 element of r.type */ /*{{{*/
  {
    if (r.type == EMPTY) return result;
    switch (r.type)
    {
      case INT: l.u.integer = 0; break;
      case FLOAT: l.u.flt = 0.0; break;
      case STRING: l.u.string = empty; break;
      case BOOL: l.u.bl = false; break;
      default: return relational_type_mismatch(l.type, r.type);
    }
    l.type = r.type;
  }
  /*}}}*/
  if (r.type==EMPTY)
  /* try to assign 0 element of l.type */ /*{{{*/
  {
    switch (l.type)
    {
      case INT: r.u.integer=0; break;
      case FLOAT: r.u.flt=0.0; break;
      case STRING: r.u.string=empty; break;
      case BOOL: r.u.bl = false; break;
      default: return relational_type_mismatch(l.type, r.type);
    }  
    r.type=l.type;
  }
  /*}}}*/
  if (l.type == FLOAT && r.type == INT)
  {
    result.u.bl = (l.u.flt == ((FltT)r.u.integer));
    return result;
  }  
  if (l.type == INT && r.type == FLOAT)
  {
    result.u.bl = (((FltT)l.u.integer) == r.u.flt);
    return result;
  }
  if (l.type != r.type)
  {
    result.u.bl = false;
    return result;
  }
  switch (l.type) {
    case INT:
      result.u.bl = l.u.integer == r.u.integer; return result;
    case STRING:
      result.u.bl = (strcmp(l.u.string,r.u.string)==0); return result;
    case FLOAT:
      result.u.bl = l.u.flt == r.u.flt; return result;
    case BOOL:
      result.u.bl = l.u.bl == r.u.bl; return result;
    case LOCATION: {
      /* result is true if locations are component-wise equal */
      Dimensions dim = X;
      while (dim < HYPER && l.u.location[dim] == r.u.location[dim]) ++dim;
      if (dim < HYPER) result.u.bl = false;
      return result;
    }
    default: break;
  }
  return relational_type_mismatch(l.type, r.type);
}
/*}}}*/

static bool nearly_equal(FltT a1, FltT a2)
{
  if (a1 == 0 && a2 == 0)
    return true;

  FltT A1 = ABSFLT(a1);
  FltT A2 = ABSFLT(a2);
  FltT max = A1 > A2 ? A1 : A2;
  FltT eps = FLTEPS;
  FltT diff = ABSFLT(a1-a2);
  FltT thelog = LOG2FLT(max);
  int expn = thelog;
  FltT scale = POWFLT(2.0, expn);
  return ABSFLT(a1 - a2) <= eps * scale;
}

/* tabouteq  -- ~= operator */ /*{{{*/
Token tabouteq(Token l, Token r)
{
  Token result;
  result.type = BOOL;
  
  if (l.type == EEK) return tcopy(l);
  if (r.type == EEK) return tcopy(r);
  if (l.type == EMPTY && r.type == FLOAT)
  {
    l.type = FLOAT;
    l.u.flt = 0.0;
  }
  if (r.type == EMPTY && l.type == FLOAT)
  {
    r.type = FLOAT;
    r.u.flt = 0.0;
  }
  if (l.type == FLOAT && r.type == FLOAT)
  {
    result.u.bl = nearly_equal(l.u.flt, r.u.flt);
    return result;
  }
  return duperror(&result, _("Usage: ~= only compares float values"));
}
/*}}}*/

/* tne       -- != operator */ /*{{{*/
Token tne(Token l, Token r)
{
  return tneg(teq(l,r));
}
/*}}}*/

/* tor      -- logical or of two tokens */ /*{{{*/
Token tor(Token l, Token r)
{
  switch (l.type) {
    case EEK: return tcopy(l);
    case EMPTY : return tcopy(r);
    case BOOL:
      if (r.type == EMPTY || l.u.bl) return l;
      return r;
    default: break;
  }
  return operand_type_error("or: ", l.type, r.type);
}
/*}}}*/

/* tand      -- logical and of two tokens */ /*{{{*/
Token tand(Token l, Token r)
{
  switch (l.type) {
    case EEK: return tcopy(l);
    case EMPTY : return l;
    case BOOL:
      if (!l.u.bl) return l;
      return r;
    default: break;
  }
  return operand_type_error("and: ", l.type, r.type);
}
/*}}}*/