#include "config.h"

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

#ifdef USE_NLLIBC
#include <nllibc.h>
#endif

#include "nlltypes.h"
#include "nlllib.h"
#include "memory.h"
#include "command.h"
#include "value.h"
#include "string.h"
#include "variable.h"
#include "label.h"
#include "array.h"
#include "stack.h"
#include "function.h"
#include "nll.h"
#include "formula.h"

typedef enum {
  OPERATOR_TYPE_NONE = 0 ,
  OPERATOR_TYPE_NOP      ,
  OPERATOR_TYPE_VEQ      ,
  OPERATOR_TYPE_VNE      ,
  OPERATOR_TYPE_LSHIFTEQ ,
  OPERATOR_TYPE_RSHIFTEQ ,
  OPERATOR_TYPE_INC      ,
  OPERATOR_TYPE_DEC      ,
  OPERATOR_TYPE_INCA     ,
  OPERATOR_TYPE_DECA     ,
  OPERATOR_TYPE_LSHIFT   ,
  OPERATOR_TYPE_RSHIFT   ,
  OPERATOR_TYPE_LE       ,
  OPERATOR_TYPE_GE       ,
  OPERATOR_TYPE_EQ       ,
  OPERATOR_TYPE_NE       ,
  OPERATOR_TYPE_LOGAND   ,
  OPERATOR_TYPE_LOGOR    ,
  OPERATOR_TYPE_LOGCAND  ,
  OPERATOR_TYPE_LOGCOR   ,
  OPERATOR_TYPE_ADDEQ    ,
  OPERATOR_TYPE_SUBEQ    ,
  OPERATOR_TYPE_MULEQ    ,
  OPERATOR_TYPE_DIVEQ    ,
  OPERATOR_TYPE_MODEQ    ,
  OPERATOR_TYPE_ANDEQ    ,
  OPERATOR_TYPE_XOREQ    ,
  OPERATOR_TYPE_OREQ     ,
  OPERATOR_TYPE_NOT      ,
  OPERATOR_TYPE_INV      ,
  OPERATOR_TYPE_PLUS     ,
  OPERATOR_TYPE_MINUS    ,
  OPERATOR_TYPE_PUSH     ,
  OPERATOR_TYPE_POP      ,
  OPERATOR_TYPE_POINTER  ,
  OPERATOR_TYPE_ADDRESS  ,
  OPERATOR_TYPE_SIZE     ,
  OPERATOR_TYPE_VALUES   ,
  OPERATOR_TYPE_BOOLEAN  ,
  OPERATOR_TYPE_MUL      ,
  OPERATOR_TYPE_DIV      ,
  OPERATOR_TYPE_MOD      ,
  OPERATOR_TYPE_ADD      ,
  OPERATOR_TYPE_SUB      ,
  OPERATOR_TYPE_LT       ,
  OPERATOR_TYPE_GT       ,
  OPERATOR_TYPE_XOR      ,
  OPERATOR_TYPE_AND      ,
  OPERATOR_TYPE_OR       ,
  OPERATOR_TYPE_COND     ,
  OPERATOR_TYPE_AT       ,
  OPERATOR_TYPE_SUBST    ,
  OPERATOR_TYPE_REFER    ,
  OPERATOR_TYPE_STATIC   ,
  OPERATOR_TYPE_ARROW    ,
  OPERATOR_TYPE_DOT      ,
  OPERATOR_TYPE_BRACKET  ,
  OPERATOR_TYPE_RBRACKET ,
  OPERATOR_TYPE_ARRAY    ,
  OPERATOR_TYPE_VECTOR   ,
  OPERATOR_TYPE_EXEC     ,
  OPERATOR_TYPE_COMMA    ,
  OPERATOR_TYPE_FUNCTION ,
} operator_type_t;

typedef enum {
  OPERATOR_SUBTYPE_NONE = 0,
  OPERATOR_SUBTYPE_MONADIC,
  OPERATOR_SUBTYPE_MON_BIN,
  OPERATOR_SUBTYPE_BINARY,
} operator_subtype_t;

typedef const struct operator {
  const char *word;
  const char *term;
  int priority;
  operator_type_t type;
  operator_subtype_t subtype;
  unsigned int flags;
#define OPERATOR_FLAG_RL     (1 <<  0)
#define OPERATOR_FLAG_LR     (1 <<  1)
#define OPERATOR_FLAG_EFFECT (1 <<  2)
#define OPERATOR_FLAG_FIXED  (1 <<  3)
} *operator_t;

typedef union element_param {
  struct {
    variable_t variable;
  } variable;
  struct {
    const struct operator *op;
    element_t args[2];
  } operator;
  struct {
    element_t head;
    const struct operator *op;
  } elements;
  struct {
    char name[SYMBOL_NAMELEN + 1];
  } name;
} *element_param_t;

struct element {
  struct element *next;
  element_type_t type;
  unsigned int flags;
#define ELEMENT_FLAG_FIXED (1 <<  0)
#define ELEMENT_FLAG_RAW   (1 <<  1)
  value_t value;
  union element_param param;
};

static const struct operator operators[] = {
  { "===", NULL,  6, OPERATOR_TYPE_VEQ      , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "!==", NULL,  6, OPERATOR_TYPE_VNE      , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "<<=", NULL, 12, OPERATOR_TYPE_LSHIFTEQ , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { ">>=", NULL, 12, OPERATOR_TYPE_RSHIFTEQ , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { "++" , NULL,  1, OPERATOR_TYPE_INC      , OPERATOR_SUBTYPE_MONADIC, OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { "--" , NULL,  1, OPERATOR_TYPE_DEC      , OPERATOR_SUBTYPE_MONADIC, OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { "++" , NULL,  1, OPERATOR_TYPE_INCA     , OPERATOR_SUBTYPE_MONADIC, OPERATOR_FLAG_LR|OPERATOR_FLAG_EFFECT },
  { "--" , NULL,  1, OPERATOR_TYPE_DECA     , OPERATOR_SUBTYPE_MONADIC, OPERATOR_FLAG_LR|OPERATOR_FLAG_EFFECT },
  { "<<" , NULL,  4, OPERATOR_TYPE_LSHIFT   , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { ">>" , NULL,  4, OPERATOR_TYPE_RSHIFT   , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "<=" , NULL,  5, OPERATOR_TYPE_LE       , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { ">=" , NULL,  5, OPERATOR_TYPE_GE       , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "==" , NULL,  6, OPERATOR_TYPE_EQ       , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "!=" , NULL,  6, OPERATOR_TYPE_NE       , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "<>" , NULL,  6, OPERATOR_TYPE_NE       , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "&&" , NULL, 10, OPERATOR_TYPE_LOGAND   , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "||" , NULL, 11, OPERATOR_TYPE_LOGOR    , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "&>" , NULL, 10, OPERATOR_TYPE_LOGCAND  , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "|>" , NULL, 11, OPERATOR_TYPE_LOGCOR   , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "+=" , NULL, 12, OPERATOR_TYPE_ADDEQ    , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { "-=" , NULL, 12, OPERATOR_TYPE_SUBEQ    , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { "*=" , NULL, 12, OPERATOR_TYPE_MULEQ    , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { "/=" , NULL, 12, OPERATOR_TYPE_DIVEQ    , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { "%=" , NULL, 12, OPERATOR_TYPE_MODEQ    , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { "&=" , NULL, 12, OPERATOR_TYPE_ANDEQ    , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { "^=" , NULL, 12, OPERATOR_TYPE_XOREQ    , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { "|=" , NULL, 12, OPERATOR_TYPE_OREQ     , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { "?=" , NULL, 12, OPERATOR_TYPE_STATIC   , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { "@=" , NULL, 12, OPERATOR_TYPE_REFER    , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL },
  { "->" , NULL,  0, OPERATOR_TYPE_ARROW    , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "!"  , NULL,  1, OPERATOR_TYPE_NOT      , OPERATOR_SUBTYPE_MON_BIN, OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { "~"  , NULL,  1, OPERATOR_TYPE_INV      , OPERATOR_SUBTYPE_MONADIC, OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { "+"  , NULL,  1, OPERATOR_TYPE_PLUS     , OPERATOR_SUBTYPE_MON_BIN, OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { "-"  , NULL,  1, OPERATOR_TYPE_MINUS    , OPERATOR_SUBTYPE_MON_BIN, OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { "+"  , NULL,  1, OPERATOR_TYPE_PUSH     , OPERATOR_SUBTYPE_MON_BIN, OPERATOR_FLAG_LR },
  { "-"  , NULL,  1, OPERATOR_TYPE_POP      , OPERATOR_SUBTYPE_MON_BIN, OPERATOR_FLAG_LR|OPERATOR_FLAG_EFFECT },
  { "*"  , NULL,  1, OPERATOR_TYPE_POINTER  , OPERATOR_SUBTYPE_MON_BIN, OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { "&"  , NULL,  1, OPERATOR_TYPE_ADDRESS  , OPERATOR_SUBTYPE_MON_BIN, OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { "#"  , NULL,  1, OPERATOR_TYPE_SIZE     , OPERATOR_SUBTYPE_MON_BIN, OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { "%"  , NULL,  1, OPERATOR_TYPE_VALUES   , OPERATOR_SUBTYPE_MON_BIN, OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { "?"  , NULL,  1, OPERATOR_TYPE_BOOLEAN  , OPERATOR_SUBTYPE_MON_BIN, OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { "*"  , NULL,  2, OPERATOR_TYPE_MUL      , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "/"  , NULL,  2, OPERATOR_TYPE_DIV      , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "%"  , NULL,  2, OPERATOR_TYPE_MOD      , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "+"  , NULL,  3, OPERATOR_TYPE_ADD      , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "-"  , NULL,  3, OPERATOR_TYPE_SUB      , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "<"  , NULL,  5, OPERATOR_TYPE_LT       , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { ">"  , NULL,  5, OPERATOR_TYPE_GT       , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "^"  , NULL,  8, OPERATOR_TYPE_XOR      , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "&"  , NULL,  7, OPERATOR_TYPE_AND      , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "|"  , NULL,  9, OPERATOR_TYPE_OR       , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "?"  , NULL,  2, OPERATOR_TYPE_COND     , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { "@"  , NULL,  2, OPERATOR_TYPE_AT       , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { "="  , NULL, 12, OPERATOR_TYPE_SUBST    , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_EFFECT },
  { "."  , NULL,  0, OPERATOR_TYPE_DOT      , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "("  , ")" ,  0, OPERATOR_TYPE_BRACKET  , OPERATOR_SUBTYPE_MONADIC, OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { "{"  , "}" ,  0, OPERATOR_TYPE_RBRACKET , OPERATOR_SUBTYPE_MONADIC, OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { "["  , "]" ,  0, OPERATOR_TYPE_ARRAY    , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "#"  , NULL,  1, OPERATOR_TYPE_VECTOR   , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { "!"  , NULL, 12, OPERATOR_TYPE_EXEC     , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { ","  , NULL, 13, OPERATOR_TYPE_COMMA    , OPERATOR_SUBTYPE_NONE   , 0 },
  { NULL , NULL, 13, OPERATOR_TYPE_NOP      , OPERATOR_SUBTYPE_NONE   , OPERATOR_FLAG_LR|OPERATOR_FLAG_FIXED },
  { NULL , NULL,  1, OPERATOR_TYPE_FUNCTION , OPERATOR_SUBTYPE_BINARY , OPERATOR_FLAG_RL|OPERATOR_FLAG_FIXED },
  { NULL , NULL,  0, OPERATOR_TYPE_NONE     , OPERATOR_SUBTYPE_NONE   , 0 },
};

#define OPERATOR_PRIORITY_MIN  0
#define OPERATOR_PRIORITY_MAX 13
#define OPERATOR_PRIORITY_NUM \
	(OPERATOR_PRIORITY_MAX - OPERATOR_PRIORITY_MIN + 1)

static int element_num = 0;
static int pool_num = 0;

static element_t pool = NULL;

int formula_alloc_num(void) { return element_num; }
int formula_pool_num(void)  { return pool_num; }

int formula_element_size(void)
{
  return sizeof(struct element);
}

static element_t pool_alloc(void)
{
  element_t element;

  if (!pool)
    return NULL;

  element = pool;
  pool = pool->next;
  pool_num--;

  return element;
}

static int pool_free(element_t element)
{
  element->next = pool;
  pool = element;
  pool_num++;
  return 0;
}

#ifndef NLL_MEMORY_STATIC
static int _init(void)
{
  return 0;
}

static int _done(void)
{
  while (pool)
    memory_free(pool_alloc());
  return 0;
}

static int _check(void)
{
  if (pool)
    return NLL_ERRCODE_FORMULA_NOT_EMPTY;
  return 0;
}

static element_t _alloc(void)
{
  element_t element;
  element = pool_alloc();
  if (!element)
    element = memory_alloc(sizeof(*element));
  return element;
}

static int _free(element_t element)
{
  if ((ELEMENT_MAXNUM < 0) || (pool_num < ELEMENT_MAXNUM))
    return pool_free(element);
  memory_free(element);
  return 0;
}
#else
static struct element elements[ELEMENT_MAXNUM];

static int _init(void)
{
  element_t element;
  int i;

  memset(elements, 0, sizeof(elements));

  for (i = 0; i < ELEMENT_MAXNUM; i++) {
    element = &elements[i];
    element->next = pool;
    pool = element;
    pool_num++;
  }

  return 0;
}

static int _done(void)
{
  return 0;
}

static int _check(void)
{
  element_t element;
  int n = 0;

  for (element = pool; element && (n < ELEMENT_MAXNUM); element = element->next)
    n++;

  if (element || (n != ELEMENT_MAXNUM) || (n != pool_num))
    return NLL_ERRCODE_FORMULA_NOT_EMPTY;

  return 0;
}

static element_t _alloc(void)
{
  return pool_alloc();
}

static int _free(element_t element)
{
  return pool_free(element);
}
#endif

int formula_check(void)
{
  if (element_num)
    return NLL_ERRCODE_FORMULA_NOT_EMPTY;

  return _check();
}

static operator_t operator_get(operator_type_t type)
{
  operator_t operator;
  for (operator = operators; operator->type != OPERATOR_TYPE_NONE; operator++) {
    if (operator->type == type)
      return operator;
  }
  return NULL;
}

static int element_free(element_t element)
{
  element_t next;
  int r;

  for (; element; element = next) {
    next = element->next;

    if (element->value) {
#ifdef NLL_CLEAR_VALUE
      if ((r = value_clear(element->value)) < 0) /* For link of the loop */
	return r;
#endif
      if ((r = value_free(element->value)) < 0)
	return r;
      element->value = NULL;
    }
    element->type = ELEMENT_TYPE_NONE;

    element_num--;
    if ((r = _free(element)) < 0)
      return r;
  }

  return 0;
}

static int element_alloc(element_t *elementp)
{
  element_t element;

  if ((element = _alloc()) == NULL)
    return NLL_ERRCODE_FORMULA_BUFFER_OVER;
  element_num++;

  memset(element, 0, sizeof(*element));
  element->next = NULL;
  element->type = ELEMENT_TYPE_NONE;

  *elementp = element;

  return 0;
}

static int element_clean(element_t element)
{
  value_t value;
  int r;

  for (value = element->value; value; value = value->next) {
    element->flags &= ~ELEMENT_FLAG_FIXED;
    if ((r = value_clear(value)) < 0)
      return r;
  }

  return 0;
}

static int element_init(void)
{
  element_num = 0;
  pool_num = 0;
  pool = NULL;
  return _init();
}

static int element_done(void)
{
  return _done();
}

int formula_init(void)
{
  return element_init();
}

int formula_done(void)
{
  return element_done();
}

int formula_get_symbol(char *dname, const char *name)
{
  const char *p;

  for (p = name; *p; p++) {
    if (p == name) {
      if (isalpha(*p) || (*p == '_'))
	;
#ifdef NLL_MULTIBYTE_NAME
      else if (*p & 0x80)
	;
#endif
      else
	break;
    } else {
      if (isalnum(*p) || (*p == '_'))
	;
#ifdef NLL_MULTIBYTE_NAME
      else if (*p & 0x80)
	;
#endif
      else
	break;
    }
    if (p - name >= SYMBOL_NAMELEN)
      return NLL_ERRCODE_NLL_SYMBOL_TOO_LONG;
    *(dname++) = toupper(*p);
  }

  *dname = '\0';

  return p - name;
}

element_type_t formula_get_type(element_t element)
{
  return element ? element->type : ELEMENT_TYPE_NONE;
}

value_t formula_get_value(element_t element)
{
  return element ? element->value : NULL;
}

variable_t formula_get_variable(element_t element)
{
  if (!element || (element->type != ELEMENT_TYPE_VARIABLE))
    return NULL;
  return element->param.variable.variable;
}

int formula_set_raw(element_t element)
{
  if (!element)
    return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;
  element->flags |= ELEMENT_FLAG_RAW;
  return 0;
}

union val {
  integer_t integer;
  struct {
    char *s;
    int length;
  } string;
#ifdef NLL_FLOATING_POINT
  double floating;
#endif
};

static int element_alloc_value(element_t element)
{
  return value_alloc(&element->value);
}

static int element_push(element_t *elementp, element_type_t type, unsigned int flags,
			union val *val, element_param_t param)
{
  element_t element = NULL;
  int r;

  if ((r = element_alloc(&element)) < 0)
    goto err;

  element->type = type;
  element->flags |= flags;

  switch (type) {
  case ELEMENT_TYPE_INTEGER:
    if ((r = element_alloc_value(element)) < 0)
      goto err;
    if ((r = value_set_integer(element->value, val->integer)) < 0)
      goto err;
    element->value->flags |= VALUE_FLAG_CONST;
    break;
  case ELEMENT_TYPE_STRING:
    if ((r = element_alloc_value(element)) < 0)
      goto err;
    if ((r = value_set_string(element->value, val->string.s, val->string.length)) < 0)
      goto err;
    element->value->flags |= VALUE_FLAG_CONST;
    break;
#ifdef NLL_FLOATING_POINT
  case ELEMENT_TYPE_FLOAT:
    if ((r = element_alloc_value(element)) < 0)
      goto err;
    if ((r = value_set_float(element->value, val->floating)) < 0)
      goto err;
    element->value->flags |= VALUE_FLAG_CONST;
    break;
#endif
  default:
    break;
  }

  if (param)
    memcpy(&element->param, param, sizeof(element->param));

  element->next = *elementp;
  *elementp = element;

  return 0;

err:
  if (element)
    element_free(element);
  return r;
}

static int a2val(char c)
{
  if (isdigit(c))
    return c - '0';
  else if (isalpha(c))
    return toupper(c) - 'A' + 10;
  return -1;
}

static int lex(element_t *elementp, char *formula, char **endp, const char *terminator)
{
  int r, v, scale, is_float;
  integer_t integer;
  union val val;
#ifdef NLL_FLOATING_POINT
  double fscale;
#endif
  char quat = '\0';
  int escape = 0, escape_scale = 0;
  element_t head, *tail, element;
  char *p;
  char *word, *wp = NULL;
  union element_param param;
  operator_t operator;

  word = string_buffer();

  p = formula;

  head = NULL;
  tail = &head;

  while (1) {
    if (*p == '\0')
      break;

    if (quat) {
      if (escape && escape_scale) {
	v = a2val(*p);
	if ((v < 0) || (v >= escape_scale)) {
	  *(wp++) = integer;
	  escape = 0;
	  p--;
	} else {
	  integer = integer * escape_scale + v;
	}
      } else if (escape) {
	switch (*p) {
	case '0': integer = 0; escape_scale =  8; break;
	case 'x':
	case 'X': integer = 0; escape_scale = 16; break;
	case 'b':
	case 'B': integer = 0; escape_scale =  2; break;
	case 'T':
	case 't': *(wp++) = '\t'; escape = 0; break;
	case 'N':
	case 'n': *(wp++) = '\n'; escape = 0; break;
	case 'V':
	case 'v': *(wp++) = '\v'; escape = 0; break;
	case 'F':
	case 'f': *(wp++) = '\f'; escape = 0; break;
	case 'R':
	case 'r': *(wp++) = '\r'; escape = 0; break;
	case 'A':
	case 'a': *(wp++) = '\a'; escape = 0; break;
	default:  *(wp++) = *p;   escape = 0; break;
	}
      } else if (*p == quat) {
	*wp = '\0';
	switch (quat) {
	case '\'':
	  val.integer = *(unsigned char *)word;
	  if ((r = element_push(tail, ELEMENT_TYPE_INTEGER, 0, &val, NULL)) < 0)
	    goto ret;
	  tail = &((*tail)->next);
	  break;
	case '\"':
	  val.string.s = word;
	  val.string.length = wp - word;
	  if ((r = element_push(tail, ELEMENT_TYPE_STRING, 0, &val, NULL)) < 0)
	    goto ret;
	  tail = &((*tail)->next);
	  break;
	default:
	  break;
	}
	quat = '\0';
      } else if (*p == '\\') {
	escape = 1;
	escape_scale = 0;
      } else {
	*(wp++) = *p;
      }
      p++;
    } else if (strchr(terminator, *p)) {
      break;
    } else if ((*p == '\'') || (*p == '\"')) {
      quat = *p;
      escape = 0;
      wp = word;
      p++;
    } else if (isspace(*p)) {
      p++;
      continue;
    } else if (isdigit(*p)) { /* integer or floating */
      integer = 0;
      scale = 10;
      is_float = 0;
#ifdef NLL_FLOATING_POINT
      fscale = 0;
#endif
      if (*p == '0') {
	scale = 8;
	p++;
	if ((*p == 'x') || (*p == 'X')) {
	  scale = 16;
	  p++;
	} else if ((*p == 'b') || (*p == 'B')) {
	  scale = 2;
	  p++;
	}
      }
      while (1) {
#ifdef NLL_FLOATING_POINT
	if (*p == '.') {
	  val.floating = integer;
	  scale = 10; /* 0.1 is octal by top '0' */
	  integer = 0;
	  fscale = 1;
	  is_float = 1;
	  p++;
	  continue;
	}
#endif
	v = a2val(*p);
	if (v < 0)
	  break;
	if (v >= scale)
	  break;
	integer = integer * scale + v;
#ifdef NLL_FLOATING_POINT
	if (is_float)
	  fscale *= scale;
#endif
	p++;
      }
      if (is_float) {
#ifdef NLL_FLOATING_POINT
	val.floating += integer / fscale;
	if ((r = element_push(tail, ELEMENT_TYPE_FLOAT, 0, &val, NULL)) < 0)
	  goto ret;
#endif
      } else {
	val.integer = integer;
	if ((r = element_push(tail, ELEMENT_TYPE_INTEGER, 0, &val, NULL)) < 0)
	  goto ret;
      }
      tail = &((*tail)->next);
    } else if ((r = formula_get_symbol(param.name.name, p)) != 0) { /* variable or function name */
      if (r < 0)
	goto ret;
      memcpy(p, param.name.name, r);
      p += r;
      if ((r = element_push(tail, ELEMENT_TYPE_SYMBOL, 0, NULL, &param)) < 0)
	goto ret;
      tail = &((*tail)->next);
    } else { /* operator */
      for (operator = operators; operator->type != OPERATOR_TYPE_NONE; operator++) {
	if (operator->word && !strncmp(operator->word, p, strlen(operator->word)))
	  break;
      }
      if (operator->type == OPERATOR_TYPE_NONE) {
	r = NLL_ERRCODE_FORMULA_INVALID_OPERATOR;
	goto ret;
      }
      p += strlen(operator->word);
      if ((operator->type == OPERATOR_TYPE_BRACKET) ||
	  (operator->type == OPERATOR_TYPE_RBRACKET)) {
	if ((r = lex(&element, p, &p, operator->term)) < 0)
	  goto ret;
	if (*p) p++;
	param.elements.head = element;
	param.elements.op = operator;
	if ((r = element_push(tail, ELEMENT_TYPE_ELEMENTS,
			      (operator->type == OPERATOR_TYPE_RBRACKET) ? ELEMENT_FLAG_RAW : 0,
			      NULL, &param)) < 0)
	  goto ret;
      } else {
	param.operator.op = operator;
	param.operator.args[0] = NULL;
	param.operator.args[1] = NULL;
	if ((r = element_push(tail, ELEMENT_TYPE_OPERATOR, 0, NULL, &param)) < 0)
	  goto ret;
      }
      tail = &((*tail)->next);
      if (operator->type == OPERATOR_TYPE_ARRAY) {
	if ((r = lex(&element, p, &p, operator->term)) < 0)
	  goto ret;
	if (*p) p++;
	param.elements.head = element;
	param.elements.op = operator;
	if ((r = element_push(tail, ELEMENT_TYPE_ELEMENTS, 0, NULL, &param)) < 0)
	  goto ret;
	tail = &((*tail)->next);
      }
    }
  }

  r = 0;

ret:
  if (r < 0)
    formula_free(&head);

  *elementp = head;
  if (endp)
    *endp = p;

  return r;
}

static int parse(element_t *elementp)
{
  int r, priority, i;
  unsigned int d;
  element_t e, el, er, *elp;
  operator_type_t opetype;
  variable_t variable;
  operator_t funcop;

  for (e = *elementp; e; e = e->next) {
    switch (e->type) {
    case ELEMENT_TYPE_ELEMENTS:
      if ((r = parse(&e->param.elements.head)) < 0)
	return r;
      if ((r = element_alloc_value(e)) < 0)
	return r;
      break;

    case ELEMENT_TYPE_SYMBOL:
      if ((r = variable_get(e->param.name.name, &variable)) < 0)
	return r;
      e->type = ELEMENT_TYPE_VARIABLE;
      e->param.variable.variable = variable;
      if ((r = element_alloc_value(e)) < 0)
	return r;
      break;

    default:
      break;
    }
  }

  el = NULL;
  for (e = *elementp; e; el = e, e = e->next) {
    er = e->next;

    if ((e->type != ELEMENT_TYPE_OPERATOR) ||
	(e->param.operator.op->type != OPERATOR_TYPE_COMMA))
      continue;

    if (!el ||
	((el->type == ELEMENT_TYPE_OPERATOR) &&
	 (el->param.operator.op->type == OPERATOR_TYPE_COMMA))) {
      elp = el ? &(el->next) : elementp;
      if ((r = element_alloc(&el)) < 0)
	return r;
      el->type = ELEMENT_TYPE_OPERATOR;
      el->param.operator.op = operator_get(OPERATOR_TYPE_NOP);

      el->next = e;
      *elp = el;
    }

    if (!er ||
	((er->type == ELEMENT_TYPE_OPERATOR) &&
	 (er->param.operator.op->type == OPERATOR_TYPE_COMMA))) {
      el = e;
      if ((r = element_alloc(&e)) < 0)
	return r;
      e->type = ELEMENT_TYPE_OPERATOR;
      e->param.operator.op = operator_get(OPERATOR_TYPE_NOP);

      e->next = er;
      el->next = e;
    }
  }

  funcop = operator_get(OPERATOR_TYPE_FUNCTION);

  for (i = 0; i < OPERATOR_PRIORITY_NUM; i++) {
    priority = OPERATOR_PRIORITY_MIN + i;

    for (d = OPERATOR_FLAG_RL; d != 0;
	 d = (d == OPERATOR_FLAG_RL) ? OPERATOR_FLAG_LR : 0) {

      e = *elementp;
      *elementp = NULL;
      for (; e; e = er) {
	er = e->next;
	e->next = *elementp;
	*elementp = e;
      }

      el = NULL;
      elp = NULL;
      for (e = *elementp; e; el = e, e = e->next) {
	er = e->next;

	if ((funcop->flags & d) && (funcop->priority == priority)) {
	  if (el && el->value && e->value) {
	    er = e;
	    if ((r = element_alloc(&e)) < 0)
	      return r;
	    e->type = ELEMENT_TYPE_OPERATOR;
	    e->param.operator.op = operator_get(OPERATOR_TYPE_FUNCTION);

	    e->next = er;
	    el->next = e;
	  }
	}

	if (e->type != ELEMENT_TYPE_OPERATOR)
	  goto next;
	if (!(e->param.operator.op->flags & d))
	  goto next;
	if (e->param.operator.op->priority != priority)
	  goto next;

	opetype = e->param.operator.op->type;

	switch (e->param.operator.op->subtype) {
	case OPERATOR_SUBTYPE_MON_BIN:
	  if (er && er->value) {
	    if (el && el->value) {
	      switch (opetype) {
	      case OPERATOR_TYPE_PLUS:
	      case OPERATOR_TYPE_PUSH:
		e->param.operator.op = operator_get(OPERATOR_TYPE_ADD); break;
	      case OPERATOR_TYPE_MINUS:
	      case OPERATOR_TYPE_POP:
		e->param.operator.op = operator_get(OPERATOR_TYPE_SUB); break;
	      case OPERATOR_TYPE_POINTER:
		e->param.operator.op = operator_get(OPERATOR_TYPE_MUL); break;
	      case OPERATOR_TYPE_ADDRESS:
		e->param.operator.op = operator_get(OPERATOR_TYPE_AND); break;
	      case OPERATOR_TYPE_SIZE:
		e->param.operator.op = operator_get(OPERATOR_TYPE_VECTOR); break;
	      case OPERATOR_TYPE_VALUES:
		e->param.operator.op = operator_get(OPERATOR_TYPE_MOD); break;
	      case OPERATOR_TYPE_BOOLEAN:
		e->param.operator.op = operator_get(OPERATOR_TYPE_COND); break;
	      case OPERATOR_TYPE_NOT:
		e->param.operator.op = operator_get(OPERATOR_TYPE_EXEC); break;
	      default:
		return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
	      }
	      break;
	    }
	  }
	  /* fall through */

	case OPERATOR_SUBTYPE_MONADIC:
	  if (!el || !el->value) {
	    switch (opetype) {
	    case OPERATOR_TYPE_INC:
	      e->param.operator.op = operator_get(OPERATOR_TYPE_INCA); break;
	    case OPERATOR_TYPE_DEC:
	      e->param.operator.op = operator_get(OPERATOR_TYPE_DECA); break;
	    case OPERATOR_TYPE_PLUS:
	      e->param.operator.op = operator_get(OPERATOR_TYPE_PUSH); break;
	    case OPERATOR_TYPE_MINUS:
	      e->param.operator.op = operator_get(OPERATOR_TYPE_POP); break;
	    default:
	      return NLL_ERRCODE_FORMULA_LESS_PARAMETER;
	    }
	    break;
	  }
	  *elp = e;
	  el->next = NULL;
	  e->param.operator.args[0] = el;
	  if ((r = element_alloc_value(e)) < 0)
	    return r;
	  continue;

	case OPERATOR_SUBTYPE_BINARY:
	  if (!el || !er)
	    return NLL_ERRCODE_FORMULA_LESS_PARAMETER;
	  *elp = e;
	  e->next = er->next;
	  el->next = NULL;
	  er->next = NULL;
	  switch (d) {
	  case OPERATOR_FLAG_RL:
	    e->param.operator.args[0] = er;
	    e->param.operator.args[1] = el;
	    break;
	  case OPERATOR_FLAG_LR:
	  default:
	    e->param.operator.args[0] = el;
	    e->param.operator.args[1] = er;
	    break;
	  }
	  if (opetype == OPERATOR_TYPE_FUNCTION)
	    e->param.operator.args[1]->flags |= ELEMENT_FLAG_RAW;
	  if ((r = element_alloc_value(e)) < 0)
	    return r;
	  continue;

	case OPERATOR_SUBTYPE_NONE:
	  switch (opetype) {
	  case OPERATOR_TYPE_NOP:
	    if ((r = element_alloc_value(e)) < 0)
	      return r;
	    break;
	  default:
	    break;
	  }
	  goto next;

	default:
	  return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
	}

      next:
	elp = elp ? &((*elp)->next) : elementp;
      }
    }
  }

  for (e = *elementp; e && e->next; e = e->next) {
    er = e->next;
    if ((er->type == ELEMENT_TYPE_OPERATOR) &&
	(er->param.operator.op->type == OPERATOR_TYPE_COMMA)) {
      e->next = er->next;
      er->next = NULL;
      element_free(er);
    }
  }

  return 0;
}

static int proc_monadic_integer(const struct operator *op, value_t v, value_t v0)
{
  int r;
  integer_t x;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_get_integer(v, &x)) < 0)
      return r;
  } else {
    if ((r = value_get_integer(v0, &x)) < 0)
      return r;
  }

  switch (op->type) {
  case OPERATOR_TYPE_INC: x++; break;
  case OPERATOR_TYPE_DEC: x--; break;
  case OPERATOR_TYPE_INCA: break;
  case OPERATOR_TYPE_DECA: break;

  case OPERATOR_TYPE_PLUS:          break;
  case OPERATOR_TYPE_MINUS: x = -x; break;
  case OPERATOR_TYPE_INV:   x = ~x; break;

  case OPERATOR_TYPE_NOT:
  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_integer(v, x)) < 0)
    return r;

  switch (op->type) {
  case OPERATOR_TYPE_INCA: x++; break;
  case OPERATOR_TYPE_DECA: x--; break;
  default: break;
  }

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_set_integer(v0, x)) < 0)
      return r;
  }

  return 0;
}

#ifdef NLL_FLOATING_POINT
static int proc_monadic_float(const struct operator *op, value_t v, value_t v0)
{
  int r;
  double f0;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_get_float_integer(v, &f0)) < 0)
      return r;
  } else {
    if ((r = value_get_float_integer(v0, &f0)) < 0)
      return r;
  }

  switch (op->type) {
  case OPERATOR_TYPE_INC: f0 = f0 + 1.0; break;
  case OPERATOR_TYPE_DEC: f0 = f0 - 1.0; break;
  case OPERATOR_TYPE_INCA: break;
  case OPERATOR_TYPE_DECA: break;

  case OPERATOR_TYPE_PLUS:            break;
  case OPERATOR_TYPE_MINUS: f0 = -f0; break;

  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_float(v, f0)) < 0)
    return r;

  switch (op->type) {
  case OPERATOR_TYPE_INCA: f0 = f0 + 1.0; break;
  case OPERATOR_TYPE_DECA: f0 = f0 - 1.0; break;
  default: break;
  }

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_set_float(v0, f0)) < 0)
      return r;
  }

  return 0;
}
#endif

static int proc_monadic_array(const struct operator *op, value_t v, value_t v0)
{
  int r, offset0;
  array_t a0;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_get_array(v, &a0, &offset0)) < 0)
      return r;
  } else {
    if ((r = value_get_array(v0, &a0, &offset0)) < 0)
      return r;
  }

  switch (op->type) {
  case OPERATOR_TYPE_INC: offset0++; break;
  case OPERATOR_TYPE_DEC: offset0--; break;
  case OPERATOR_TYPE_INCA: break;
  case OPERATOR_TYPE_DECA: break;

  case OPERATOR_TYPE_NOT:
  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_array(v, a0, offset0)) < 0)
    return r;

  switch (op->type) {
  case OPERATOR_TYPE_INCA: offset0++; break;
  case OPERATOR_TYPE_DECA: offset0--; break;
  default: break;
  }

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_set_array(v0, a0, offset0)) < 0)
      return r;
  }

  return 0;
}

static int proc_monadic_pointer(const struct operator *op, value_t v, value_t v0)
{
  int r, offset0;
  value_t p0;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_get_pointer(v, &p0, &offset0)) < 0)
      return r;
  } else {
    if ((r = value_get_pointer(v0, &p0, &offset0)) < 0)
      return r;
  }

  switch (op->type) {
  case OPERATOR_TYPE_INC: offset0++; break;
  case OPERATOR_TYPE_DEC: offset0--; break;
  case OPERATOR_TYPE_INCA: break;
  case OPERATOR_TYPE_DECA: break;

  case OPERATOR_TYPE_NOT:
  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_pointer(v, p0, offset0)) < 0)
    return r;

  switch (op->type) {
  case OPERATOR_TYPE_INCA: offset0++; break;
  case OPERATOR_TYPE_DECA: offset0--; break;
  default: break;
  }

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_set_pointer(v0, p0, offset0)) < 0)
      return r;
  }

  return 0;
}

static int proc_binary_null(const struct operator *op, value_t v, value_t v0, value_t v1)
{
  int r, null0 = 0, null1 = 0;
  integer_t x;

  if (value_get_type(v0) == VALUE_TYPE_NULL)
    null0 = 1;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if (value_get_type(v) == VALUE_TYPE_NULL)
      null1 = 1;
  } else {
    if (value_get_type(v1) == VALUE_TYPE_NULL)
      null1 = 1;
  }

  switch (op->type) {
  case OPERATOR_TYPE_EQ: x = (null0 == null1); break;
  case OPERATOR_TYPE_NE: x = (null0 != null1); break;

  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_integer(v, x)) < 0)
    return r;

  return 0;
}

static int proc_binary_integer(const struct operator *op, value_t v, value_t v0, value_t v1)
{
  int r;
  integer_t x, y;

  if ((r = value_get_integer(v0, &x)) < 0)
    return r;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_get_integer(v, &y)) < 0)
      return r;
  } else {
    if ((r = value_get_integer(v1, &y)) < 0)
      return r;
  }

  switch (op->type) {
  case OPERATOR_TYPE_DIV:
  case OPERATOR_TYPE_MOD:
  case OPERATOR_TYPE_DIVEQ:
  case OPERATOR_TYPE_MODEQ:
    if (y == 0)
      return NLL_ERRCODE_FORMULA_DIV_ZERO;
    break;
  default:
    break;
  }

  switch (op->type) {
  case OPERATOR_TYPE_LSHIFT: x = x << y; break;
  case OPERATOR_TYPE_RSHIFT: x = x >> y; break;
  case OPERATOR_TYPE_LE:     x = x <= y; break;
  case OPERATOR_TYPE_GE:     x = x >= y; break;
  case OPERATOR_TYPE_EQ:     x = x == y; break;
  case OPERATOR_TYPE_NE:     x = x != y; break;
  case OPERATOR_TYPE_MUL:    x = x *  y; break;
  case OPERATOR_TYPE_DIV:    x = x /  y; break;
  case OPERATOR_TYPE_MOD:    x = x %  y; break;
  case OPERATOR_TYPE_ADD:    x = x +  y; break;
  case OPERATOR_TYPE_SUB:    x = x -  y; break;
  case OPERATOR_TYPE_LT:     x = x <  y; break;
  case OPERATOR_TYPE_GT:     x = x >  y; break;
  case OPERATOR_TYPE_XOR:    x = x ^  y; break;
  case OPERATOR_TYPE_AND:    x = x &  y; break;
  case OPERATOR_TYPE_OR:     x = x |  y; break;

  case OPERATOR_TYPE_LSHIFTEQ: x <<= y; break;
  case OPERATOR_TYPE_RSHIFTEQ: x >>= y; break;
  case OPERATOR_TYPE_ADDEQ:    x  += y; break;
  case OPERATOR_TYPE_SUBEQ:    x  -= y; break;
  case OPERATOR_TYPE_MULEQ:    x  *= y; break;
  case OPERATOR_TYPE_DIVEQ:    x  /= y; break;
  case OPERATOR_TYPE_MODEQ:    x  %= y; break;
  case OPERATOR_TYPE_ANDEQ:    x  &= y; break;
  case OPERATOR_TYPE_XOREQ:    x  ^= y; break;
  case OPERATOR_TYPE_OREQ:     x  |= y; break;

  case OPERATOR_TYPE_LOGAND:  x = x && y; break;
  case OPERATOR_TYPE_LOGOR:   x = x || y; break;
  case OPERATOR_TYPE_LOGCAND: x = x && y; break;
  case OPERATOR_TYPE_LOGCOR:  x = x || y; break;

  case OPERATOR_TYPE_SUBST:
  case OPERATOR_TYPE_STATIC:
  case OPERATOR_TYPE_REFER:
  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_integer(v, x)) < 0)
    return r;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_set_integer(v0, x)) < 0)
      return r;
  }

  return 0;
}

static int string_cmp(const char *s0, int length0,
		      const char *s1, int length1)
{
  const unsigned char *p0, *p1;
  int i;

  if (!s0 || !s1) {
    if (!s0 &&  s1) return -1;
    if ( s0 && !s1) return  1;
    return 0;
  }

  p0 = (const unsigned char *)s0;
  p1 = (const unsigned char *)s1;

  for (i = 0; ((i < length0) && (i < length1)); i++) {
    if (p0[i] < p1[i]) return -1;
    if (p0[i] > p1[i]) return  1;
  }

  if (length0 < length1) return -1;
  if (length0 > length1) return  1;

  return 0;
}

static int proc_binary_string(const struct operator *op, value_t v, value_t v0, value_t v1)
{
  int r, length0, length1;
  integer_t x;
  char *s0, *s1;
  char *word;

  if ((r = value_get_string(v0, &s0, &length0)) < 0)
    return r;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_get_string(v, &s1, &length1)) < 0)
      return r;
  } else {
    if ((r = value_get_string(v1, &s1, &length1)) < 0)
      return r;
  }

  word = string_buffer();

  switch (op->type) {
  case OPERATOR_TYPE_ADD:
  case OPERATOR_TYPE_ADDEQ:
    if (!s0) {
      s0 = "";
      length0 = 0;
    }
    if (!s1) {
      s1 = "";
      length1 = 0;
    }
    if (length0 + length1 + 1 > string_buffer_size())
      return NLL_ERRCODE_STRING_TOO_LONG;
    memcpy(word, s0, length0);
    memcpy(word + length0, s1, length1);
    word[length0 + length1] = '\0';
    if ((r = value_set_string(v, word, length0 + length1)) < 0)
      return r;
    if (op->flags & OPERATOR_FLAG_EFFECT) {
      if ((r = value_set_string(v0, word, length0 + length1)) < 0)
	return r;
    }
    return 0;

  case OPERATOR_TYPE_LT: x = (string_cmp(s0, length0, s1, length1) <  0) ? 1 : 0; break;
  case OPERATOR_TYPE_GT: x = (string_cmp(s0, length0, s1, length1) >  0) ? 1 : 0; break;
  case OPERATOR_TYPE_LE: x = (string_cmp(s0, length0, s1, length1) <= 0) ? 1 : 0; break;
  case OPERATOR_TYPE_GE: x = (string_cmp(s0, length0, s1, length1) >= 0) ? 1 : 0; break;
  case OPERATOR_TYPE_EQ: x = (string_cmp(s0, length0, s1, length1) == 0) ? 1 : 0; break;
  case OPERATOR_TYPE_NE: x = (string_cmp(s0, length0, s1, length1) != 0) ? 1 : 0; break;

  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_integer(v, x)) < 0)
    return r;

  return 0;
}

#ifdef NLL_FLOATING_POINT
static int proc_binary_float(const struct operator *op, value_t v, value_t v0, value_t v1)
{
  int r;
  integer_t x;
  double f0, f1;

  if ((r = value_get_float_integer(v0, &f0)) < 0)
    return r;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_get_float_integer(v, &f1)) < 0)
      return r;
  } else {
    if ((r = value_get_float_integer(v1, &f1)) < 0)
      return r;
  }

  switch (op->type) {
  case OPERATOR_TYPE_DIV:
  case OPERATOR_TYPE_MOD:
  case OPERATOR_TYPE_DIVEQ:
  case OPERATOR_TYPE_MODEQ:
    if (f1 == 0)
      return NLL_ERRCODE_FORMULA_DIV_ZERO;
    break;
  default:
    break;
  }

  switch (op->type) {
  case OPERATOR_TYPE_LT: x = (f0 <  f1) ? 1 : 0; goto set_integer;
  case OPERATOR_TYPE_GT: x = (f0 >  f1) ? 1 : 0; goto set_integer;
  case OPERATOR_TYPE_LE: x = (f0 <= f1) ? 1 : 0; goto set_integer;
  case OPERATOR_TYPE_GE: x = (f0 >= f1) ? 1 : 0; goto set_integer;
  case OPERATOR_TYPE_EQ: x = (f0 == f1) ? 1 : 0; goto set_integer;
  case OPERATOR_TYPE_NE: x = (f0 != f1) ? 1 : 0; goto set_integer;
  set_integer:
    if ((r = value_set_integer(v, x)) < 0)
      return r;
    return 0;

  case OPERATOR_TYPE_MUL: f0 = f0 * f1; break;
  case OPERATOR_TYPE_DIV: f0 = f0 / f1; break;
  case OPERATOR_TYPE_ADD: f0 = f0 + f1; break;
  case OPERATOR_TYPE_SUB: f0 = f0 - f1; break;

  case OPERATOR_TYPE_MULEQ: f0 *= f1; break;
  case OPERATOR_TYPE_DIVEQ: f0 /= f1; break;
  case OPERATOR_TYPE_ADDEQ: f0 += f1; break;
  case OPERATOR_TYPE_SUBEQ: f0 -= f1; break;

  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_float(v, f0)) < 0)
    return r;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_set_float(v0, f0)) < 0)
      return r;
  }

  return 0;
}
#endif

static int proc_binary_area(const struct operator *op, value_t v, value_t v0, value_t v1)
{
  int r;
  integer_t x;
  area_t a0, a1;

  if ((r = value_get_area(v0, &a0)) < 0)
    return r;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_get_area(v, &a1)) < 0)
      return r;
  } else {
    if ((r = value_get_area(v1, &a1)) < 0)
      return r;
  }

  switch (op->type) {
  case OPERATOR_TYPE_EQ: x = (a0 == a1); break;
  case OPERATOR_TYPE_NE: x = (a0 != a1); break;

  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_integer(v, x)) < 0)
    return r;

  return 0;
}

static int proc_binary_array(const struct operator *op, value_t v, value_t v0, value_t v1)
{
  int r, offset0, offset1, is_int0 = 0, is_int1 = 0;
  integer_t x, integer0, integer1;
  array_t a0 = NULL, a1 = NULL;

  if ((r = value_get_array(v0, &a0, &offset0)) < 0) {
    if ((r = value_get_integer(v0, &integer0)) < 0)
      return r;
    is_int0 = 1;
  }

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_get_array(v, &a1, &offset1)) < 0) {
      if ((r = value_get_integer(v, &integer1)) < 0)
	return r;
      is_int1 = 1;
    }
  } else {
    if ((r = value_get_array(v1, &a1, &offset1)) < 0) {
      if ((r = value_get_integer(v1, &integer1)) < 0)
	return r;
      is_int1 = 1;
    }
  }

  switch (op->type) {
  case OPERATOR_TYPE_ADD:
  case OPERATOR_TYPE_ADDEQ:
    if (a0 && is_int1) {
      offset1 = integer1;
    } else if (a1 && is_int0) {
      a0 = a1;
      offset0 = integer0;
    } else {
      return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;
    }
    if (op->flags & OPERATOR_FLAG_EFFECT) {
      if ((r = value_clear(v)) < 0)
	return r;
    }
    if ((r = value_set_array(v, a0, offset0 + offset1)) < 0)
      return r;
    if (op->flags & OPERATOR_FLAG_EFFECT) {
      if ((r = value_set_array(v0, a0, offset0 + offset1)) < 0)
	return r;
    }
    return 0;

  case OPERATOR_TYPE_SUB:
  case OPERATOR_TYPE_SUBEQ:
    if (a0 && a1) {
      if (a0 != a1)
	return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;
      if ((r = value_set_integer(v, offset0 - offset1)) < 0)
	return r;
      return 0;
    } else if (a0 && is_int1) {
      offset1 = integer1;
    } else {
      return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;
    }
    if (op->flags & OPERATOR_FLAG_EFFECT) {
      if ((r = value_clear(v)) < 0)
	return r;
    }
    if ((r = value_set_array(v, a0, offset0 - offset1)) < 0)
      return r;
    if (op->flags & OPERATOR_FLAG_EFFECT) {
      if ((r = value_set_array(v0, a0, offset0 - offset1)) < 0)
	return r;
    }
    return 0;

  default:
    break;
  }

  if (is_int0 || is_int1)
    return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;

  switch (op->type) {
  case OPERATOR_TYPE_LT: x = (a0 == a1) && (offset0 <  offset1); break;
  case OPERATOR_TYPE_GT: x = (a0 == a1) && (offset0 >  offset1); break;
  case OPERATOR_TYPE_LE: x = (a0 == a1) && (offset0 <= offset1); break;
  case OPERATOR_TYPE_GE: x = (a0 == a1) && (offset0 >= offset1); break;
  case OPERATOR_TYPE_EQ: x = (a0 == a1) && (offset0 == offset1); break;
  case OPERATOR_TYPE_NE: x = (a0 != a1) || (offset0 != offset1); break;

  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_integer(v, x)) < 0)
    return r;

  return 0;
}

static int proc_binary_pointer(const struct operator *op, value_t v, value_t v0, value_t v1)
{
  int r, offset0, offset1, is_int0 = 0, is_int1 = 0;
  integer_t x, integer0, integer1;
  value_t p0 = NULL, p1 = NULL;

  if ((r = value_get_pointer(v0, &p0, &offset0)) < 0) {
    if ((r = value_get_integer(v0, &integer0)) < 0)
      return r;
    is_int0 = 1;
  }

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_get_pointer(v, &p1, &offset1)) < 0) {
      if ((r = value_get_integer(v, &integer1)) < 0)
	return r;
      is_int1 = 1;
    }
  } else {
    if ((r = value_get_pointer(v1, &p1, &offset1)) < 0) {
      if ((r = value_get_integer(v1, &integer1)) < 0)
	return r;
      is_int1 = 1;
    }
  }

  switch (op->type) {
  case OPERATOR_TYPE_ADD:
  case OPERATOR_TYPE_ADDEQ:
    if (p0 && is_int1) {
      offset1 = integer1;
    } else if (p1 && is_int0) {
      p0 = p1;
      offset0 = integer0;
    } else {
      return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;
    }
    if (op->flags & OPERATOR_FLAG_EFFECT) {
      if ((r = value_clear(v)) < 0)
	return r;
    }
    if ((r = value_set_pointer(v, p0, offset0 + offset1)) < 0)
      return r;
    if (op->flags & OPERATOR_FLAG_EFFECT) {
      if ((r = value_set_pointer(v0, p0, offset0 + offset1)) < 0)
	return r;
    }
    return 0;

  case OPERATOR_TYPE_SUB:
  case OPERATOR_TYPE_SUBEQ:
    if (p0 && p1) {
#if 0
      if (p0 != p1)
	return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;
#endif
      if ((r = value_set_integer(v, offset0 - offset1)) < 0)
	return r;
      return 0;
    } else if (p0 && is_int1) {
      offset1 = integer1;
    } else {
      return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;
    }
    if (op->flags & OPERATOR_FLAG_EFFECT) {
      if ((r = value_clear(v)) < 0)
	return r;
    }
    if ((r = value_set_pointer(v, p0, offset0 - offset1)) < 0)
      return r;
    if (op->flags & OPERATOR_FLAG_EFFECT) {
      if ((r = value_set_pointer(v0, p0, offset0 - offset1)) < 0)
	return r;
    }
    return 0;

  default:
    break;
  }

  if (is_int0 || is_int1)
    return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;

  switch (op->type) {
  case OPERATOR_TYPE_LT: x = (p0 == p1) && (offset0 <  offset1); break;
  case OPERATOR_TYPE_GT: x = (p0 == p1) && (offset0 >  offset1); break;
  case OPERATOR_TYPE_LE: x = (p0 == p1) && (offset0 <= offset1); break;
  case OPERATOR_TYPE_GE: x = (p0 == p1) && (offset0 >= offset1); break;
  case OPERATOR_TYPE_EQ: x = (p0 == p1) && (offset0 == offset1); break;
  case OPERATOR_TYPE_NE: x = (p0 != p1) || (offset0 != offset1); break;

  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_integer(v, x)) < 0)
    return r;

  return 0;
}

static int proc_binary_logical(const struct operator *op, value_t v, value_t v0, value_t v1)
{
  int r, x;

  switch (op->type) {
  case OPERATOR_TYPE_LOGAND:
    if ((r = value_is_true(v0)) < 0)
      return r;
    x = r;
    if ((r = value_is_true(v1)) < 0)
      return r;
    x = x && r;
    break;

  case OPERATOR_TYPE_LOGOR:
    if ((r = value_is_true(v0)) < 0)
      return r;
    x = r;
    if ((r = value_is_true(v1)) < 0)
      return r;
    x = x || r;
    break;

  case OPERATOR_TYPE_LOGCAND:
    if ((r = value_is_true(v0)) < 0)
      return r;
    x = r;
    if (r) {
      if ((r = value_is_true(v1)) < 0)
	return r;
      x = x && r;
    }
    break;

  case OPERATOR_TYPE_LOGCOR:
    if ((r = value_is_true(v0)) < 0)
      return r;
    x = r;
    if (!r) {
      if ((r = value_is_true(v1)) < 0)
	return r;
      x = x || r;
    }
    break;

  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_integer(v, x)) < 0)
    return r;

  return 0;
}

static int proc_binary_function(const struct operator *op, value_t v, value_t v0, value_t v1)
{
  int r;
  integer_t x;
  function_t f0, f1;

  if ((r = value_get_function(v0, &f0)) < 0)
    return r;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_get_function(v, &f1)) < 0)
      return r;
  } else {
    if ((r = value_get_function(v1, &f1)) < 0)
      return r;
  }

  switch (op->type) {
  case OPERATOR_TYPE_EQ: x = (f0 == f1); break;
  case OPERATOR_TYPE_NE: x = (f0 != f1); break;

  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_integer(v, x)) < 0)
    return r;

  return 0;
}

static int proc_binary_label(const struct operator *op, value_t v, value_t v0, value_t v1)
{
  int r;
  integer_t x;
  label_t label0, label1;

  if ((r = value_get_label(v0, &label0)) < 0)
    return r;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    if ((r = value_get_label(v, &label1)) < 0)
      return r;
  } else {
    if ((r = value_get_label(v1, &label1)) < 0)
      return r;
  }

  switch (op->type) {
  case OPERATOR_TYPE_EQ: x = (label0 == label1); break;
  case OPERATOR_TYPE_NE: x = (label0 != label1); break;

  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if ((r = value_set_integer(v, x)) < 0)
    return r;

  return 0;
}

static int proc_monadic(const struct operator *op, value_t *vp, value_t *v0p)
{
  int r, offset, n;
  value_type_t t0;
  value_t p;
  value_t v, v0;
  array_t array;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    /*
     * (a, b) = (x++, x++):
     * To avoid writing a/b before reading x, copy source to result temporarily
     * and copy result to destination later.
     */
    if ((r = value_copy_values(vp, *v0p)) < 0)
      return r;
  }

  for (; *v0p; vp = &(*vp)->next, v0p = &(*v0p)->next) {
    if ((r = value_extend_value(vp)) < 0)
      return r;

    switch (op->type) {
    case OPERATOR_TYPE_PUSH:
      if ((r = stack_push(*v0p)) < 0)
	return r;
      if ((r = value_set_value(*vp, *v0p)) < 0)
	return r;
      continue;

    case OPERATOR_TYPE_POP:
      /* arg has copied to result (OPERATOR_FLAG_EFFECT) */
      if ((r = stack_pop(*v0p)) < 0)
	return r;
      continue;

    case OPERATOR_TYPE_ADDRESS:
      if ((r = value_set_pointer(*vp, value_entity(*v0p), 0)) < 0)
	return r;
      continue;

    case OPERATOR_TYPE_SIZE:
      if ((r = value_size(*v0p)) < 0)
	return r;
      if ((r = value_set_integer(*vp, r)) < 0)
	return r;
      continue;

    case OPERATOR_TYPE_BOOLEAN:
      if ((r = value_is_true(*v0p)) < 0)
	return r;
      if ((r = value_set_integer(*vp, r)) < 0)
	return r;
      continue;

    default:
      break;
    }

    t0 = value_get_type(*v0p);

    if (t0 == VALUE_TYPE_VECTOR) {
      if (value_get_type(*vp) != VALUE_TYPE_VECTOR) {
	if ((r = value_set_vector(*vp, NULL)) < 0)
	  return r;
      }
      v = value_entity(*vp);
      v0 = value_entity(*v0p);
      if ((r = proc_monadic(op, &v->val.value, &v0->val.value)) < 0)
	return r;
      continue;
    }

    switch (op->type) {
    case OPERATOR_TYPE_NOT:
      if ((r = value_is_true(*v0p)) < 0)
	return r;
      if ((r = value_set_integer(*vp, !r)) < 0)
	return r;
      continue;

    case OPERATOR_TYPE_POINTER:
      if ((r = value_get_pointer(*v0p, &p, &offset)) < 0)
	return r;
      if (!p)
	return NLL_ERRCODE_FORMULA_NULL_POINTER;
      switch (value_get_type(p)) {
      case VALUE_TYPE_ARRAY:
	if ((r = value_get_array(p, &array, &n)) < 0)
	  return r;
	/* Clear value to prevent that a VALUE_TYPE_VALUE link */
	if ((r = value_clear(*vp)) < 0)
	  return r;
	if ((r = value_set_array(*vp, array, n + offset)) < 0)
	  return r;
	continue;
#if 0 /* for pointer access to vector */
      case VALUE_TYPE_VECTOR:
	if ((r = value_get_vector(p, &p)) < 0)
	  return r;
	for (; offset > 0; offset--) {
	  if (!p->next)
	    return NLL_ERRCODE_FORMULA_INVALID_POINTER;
	  p = p->next;
	}
	break;
#endif
      default:
	if (offset != 0)
	  return NLL_ERRCODE_FORMULA_INVALID_POINTER;
	break;
      }
      if ((r = value_set_value(*vp, p)) < 0)
	return r;
      continue;

    default:
      break;
    }

#ifdef NLL_FLOATING_POINT
    if (t0 == VALUE_TYPE_FLOAT) {
      if ((r = proc_monadic_float(op, *vp, *v0p)) < 0)
	return r;
      continue;
    }
#endif

    if (t0 == VALUE_TYPE_ARRAY) {
      if ((r = proc_monadic_array(op, *vp, *v0p)) < 0)
	return r;
      continue;
    }

    if (t0 == VALUE_TYPE_POINTER) {
      if ((r = proc_monadic_pointer(op, *vp, *v0p)) < 0)
	return r;
      continue;
    }

    if (t0 == VALUE_TYPE_INTEGER) {
      if ((r = proc_monadic_integer(op, *vp, *v0p)) < 0)
	return r;
      continue;
    }

    return NLL_ERRCODE_VALUE_INVALID_TYPE;
  }

  return 0;
}

static int proc_binary(const struct operator *op, value_t *vp, value_t *v0p, value_t *v1p)
{
  int r, x;
  value_type_t t0, t1;
  value_t v, v0, v1;

  if (op->flags & OPERATOR_FLAG_EFFECT) {
    /*
     * (x, y) = (y, x):
     * To avoid writing x before reading x, copy source to result temporarily
     * and copy result to destination later.
     */
    if ((r = value_copy_values(vp, *v1p)) < 0)
      return r;
  }

  for (; *v0p && *v1p; vp = &(*vp)->next, v0p = &(*v0p)->next, v1p = &(*v1p)->next) {
    if ((r = value_extend_value(vp)) < 0)
      return r;

    switch (op->type) {
    case OPERATOR_TYPE_STATIC:
      /* arg2 has copied to result (OPERATOR_FLAG_EFFECT) */
      if ((r = value_copy_values(v0p, *vp)) < 0)
	return r;
      if ((r = value_set_flags(*v0p, VALUE_FLAG_STATIC)) < 0)
	return r;
      continue;

    case OPERATOR_TYPE_REFER:
      v0 = value_entity(*v0p);
      for (v = *v1p; v; v = v->val.value) {
	if (v == v0)
	  return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;
	if (v->type != VALUE_TYPE_VALUE)
	  break;
      }
      if ((r = value_set_value(v0, *v1p)) < 0)
	return r;
      if ((r = value_set_value(*vp, *v0p)) < 0)
	return r;
      continue;

    case OPERATOR_TYPE_SUBST:
      /* arg2 has copied to result (OPERATOR_FLAG_EFFECT) */
      if ((r = value_copy_value(*v0p, *vp)) < 0)
	return r;
      continue;

    case OPERATOR_TYPE_VEQ:
      if ((r = value_cmp_value(*v0p, *v1p)) < 0)
	return r;
      x = !r;
      if ((r = value_set_integer(*vp, x)) < 0)
	return r;
      continue;

    case OPERATOR_TYPE_VNE:
      if ((r = value_cmp_value(*v0p, *v1p)) < 0)
	return r;
      x = r;
      if ((r = value_set_integer(*vp, x)) < 0)
	return r;
      continue;

#ifdef NLL_LOGICAL_VECTOR
    case OPERATOR_TYPE_LOGAND:
    case OPERATOR_TYPE_LOGOR:
    case OPERATOR_TYPE_LOGCAND:
    case OPERATOR_TYPE_LOGCOR:
      if ((r = proc_binary_logical(op, *vp, *v0p, *v1p)) < 0)
	return r;
      continue;
#endif

    case OPERATOR_TYPE_EXEC:
      if ((r = value_is_true(*v0p)) < 0)
	return r;
      if (!r) {
	if ((r = value_copy_value(*vp, *v0p)) < 0)
	  return r;
      } else {
	if ((r = value_copy_value(*vp, *v1p)) < 0)
	  return r;
      }
      continue;

    default:
      break;
    }

    t0 = value_get_type(*v0p);
    t1 = value_get_type(*v1p);

    if (t1 == VALUE_TYPE_VECTOR) {
      if (value_get_type(*vp) != VALUE_TYPE_VECTOR) {
	if ((r = value_set_vector(*vp, NULL)) < 0)
	  return r;
      }
      if (value_get_type(*v0p) != VALUE_TYPE_VECTOR)
	return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;
      v = value_entity(*vp);
      v0 = value_entity(*v0p);
      v1 = value_entity(*v1p);
      if ((r = proc_binary(op, &v->val.value, &v0->val.value, &v1->val.value)) < 0)
	return r;
      continue;
    }

    switch (op->type) {
    case OPERATOR_TYPE_LOGAND:
    case OPERATOR_TYPE_LOGOR:
    case OPERATOR_TYPE_LOGCAND:
    case OPERATOR_TYPE_LOGCOR:
      if ((r = proc_binary_logical(op, *vp, *v0p, *v1p)) < 0)
	return r;
      continue;

    default:
      break;
    }

    if ((t0 == VALUE_TYPE_NULL) || (t1 == VALUE_TYPE_NULL)) {
      if ((r = proc_binary_null(op, *vp, *v0p, *v1p)) < 0)
	return r;
      continue;
    }

    if ((t0 == VALUE_TYPE_STRING) || (t1 == VALUE_TYPE_STRING)) {
      if ((r = proc_binary_string(op, *vp, *v0p, *v1p)) < 0)
	return r;
      continue;
    }

#ifdef NLL_FLOATING_POINT
    /* for operation of float and integer, execute before integer */
    if ((t0 == VALUE_TYPE_FLOAT) || (t1 == VALUE_TYPE_FLOAT)) {
      if ((r = proc_binary_float(op, *vp, *v0p, *v1p)) < 0)
	return r;
      continue;
    }
#endif

    /* for operation of array and integer, execute before integer */
    if ((t0 == VALUE_TYPE_ARRAY) || (t1 == VALUE_TYPE_ARRAY)) {
      if ((r = proc_binary_array(op, *vp, *v0p, *v1p)) < 0)
	return r;
      continue;
    }

    /* for operation of pointer and integer, execute before integer */
    if ((t0 == VALUE_TYPE_POINTER) || (t1 == VALUE_TYPE_POINTER)) {
      if ((r = proc_binary_pointer(op, *vp, *v0p, *v1p)) < 0)
	return r;
      continue;
    }

    if ((t0 == VALUE_TYPE_INTEGER) || (t1 == VALUE_TYPE_INTEGER)) {
      if ((r = proc_binary_integer(op, *vp, *v0p, *v1p)) < 0)
	return r;
      continue;
    }

    if ((t0 == VALUE_TYPE_AREA) || (t1 == VALUE_TYPE_AREA)) {
      if ((r = proc_binary_area(op, *vp, *v0p, *v1p)) < 0)
	return r;
      continue;
    }

    if ((t0 == VALUE_TYPE_FUNCTION) || (t1 == VALUE_TYPE_FUNCTION)) {
      if ((r = proc_binary_function(op, *vp, *v0p, *v1p)) < 0)
	return r;
      continue;
    }

    if ((t0 == VALUE_TYPE_LABEL) || (t1 == VALUE_TYPE_LABEL)) {
      if ((r = proc_binary_label(op, *vp, *v0p, *v1p)) < 0)
	return r;
      continue;
    }

    return NLL_ERRCODE_VALUE_INVALID_TYPE;
  }

  return 0;
}

static int label_proc(label_t label, value_t value, value_t args)
{
  int r;
  struct spot s;

  if (!label->spot.line)
    return NLL_ERRCODE_LABEL_NOT_FOUND;

  s.line    = label->spot.line;
  s.command = label->spot.command;

  /* dummy return value for the return from the end of lines */
  if ((r = stack_push_type(STACK_TYPE_CALL, NULL)) < 0)
    return r;

  if (s.command->label.args) {
    if ((r = stack_push_type(STACK_TYPE_CALL, args)) < 0)
      return r;
  }

#ifndef NLL_INTERNAL_EXEC_DISABLE
  if ((r = nll_exec(&s, NULL, POSITION_TYPE_LABEL, NULL, NULL)) < 0)
    return r;
#endif

  if ((r = stack_pop_type(STACK_TYPE_CALL, value)) < 0)
    return r;

  return 0;
}

static int element_set_values(element_t element, value_t value)
{
  int r;
  value_t *valuep;

  if (value_get_type(value) == VALUE_TYPE_VECTOR) {
    if ((r = value_get_vector(value, &value)) < 0)
      return r;
  }

  valuep = &element->value;
  for (; value; value = value->next) {
    if (!*valuep) {
      if ((r = value_alloc(valuep)) < 0)
	return r;
    }
    if ((r = value_set_value(*valuep, value)) < 0)
      return r;
    valuep = &(*valuep)->next;
  }

  if ((r = value_shrink_value(valuep)) < 0)
    return r;

  return 0;
}

static int element_set_vector(element_t element)
{
  int r;
  element_t e;
  value_t value, *valuep;

  /*
   * Clear value to prevent that a VALUE_TYPE_VALUE link
   * by value_vector_to_value() becomes deep.
   */
  if ((r = value_clear(element->value)) < 0)
    return r;
  if ((r = value_set_vector(element->value, NULL)) < 0)
    return r;

  valuep = &element->value->val.value;
  for (e = element->param.elements.head; e; e = e->next) {
    for (value = e->value; value; value = value->next) {
      if (!*valuep) {
	if ((r = value_alloc(valuep)) < 0)
	  return r;
      }
      if ((r = value_set_value(*valuep, value)) < 0)
	return r;
      valuep = &(*valuep)->next;
    }
  }

  if (!(element->flags & ELEMENT_FLAG_RAW)) {
    if (element->value->val.value && !element->value->val.value->next) { /* scalar */
      if ((r = value_vector_to_value(element->value)) < 0)
	return r;
    }
  }

  return 0;
}

static int element_set_fixed(element_t element)
{
  element_t e;

  for (e = element->param.elements.head; e; e = e->next) {
    if (!(e->flags & ELEMENT_FLAG_FIXED))
      return 0;
  }

  element->flags |= ELEMENT_FLAG_FIXED;

  return 1;
}

static int proc_element(element_t element);
static int proc(element_t element, value_t *valuep);

static int proc_logical(const struct operator *op, element_t e0, element_t e1)
{
  int r;

  for (; e0 && e1; e0 = e0->next, e1 = e1->next) {
    switch (op->type) {
    case OPERATOR_TYPE_EXEC:
      if ((r = value_is_true(e0->value)) < 0)
	return r;
      if (r) {
	if ((r = proc_element(e1)) < 0)
	  return r;
      }
      continue;

    default:
      break;
    }

#ifndef NLL_LOGICAL_VECTOR
    if ((e0->type == ELEMENT_TYPE_ELEMENTS) &&
	(e1->type == ELEMENT_TYPE_ELEMENTS)) {
      if ((r = element_set_vector(e1)) < 0)
	return r;
      if ((r = element_set_fixed(e1)) < 0)
	return r;
      if ((r = proc_logical(op,
			    e0->param.elements.head,
			    e1->param.elements.head)) < 0)
	return r;
      continue;
    }
#endif

    switch (op->type) {
    case OPERATOR_TYPE_LOGCAND:
      if ((r = value_is_true(e0->value)) < 0)
	return r;
      if (r) {
	if ((r = proc_element(e1)) < 0)
	  return r;
      }
      break;

    case OPERATOR_TYPE_LOGCOR:
      if ((r = value_is_true(e0->value)) < 0)
	return r;
      if (!r) {
	if ((r = proc_element(e1)) < 0)
	  return r;
      }
      break;

    default:
      return NLL_ERRCODE_FORMULA_INVALID_OPERATOR;
    }
  }

  return 0;
}

static int proc_at(const struct operator *op, element_t element, int num)
{
  int r, n;
  element_t e;

  e = element->param.operator.args[1];
  if ((e->type != ELEMENT_TYPE_ELEMENTS) || (e->flags & ELEMENT_FLAG_RAW)) {
    /* for function call or {} */
    if ((r = proc(e, NULL)) < 0)
      return r;
  } else {
    if ((r = element_set_vector(e)) < 0)
      return r;
    e = e->param.elements.head;
    for (n = 0; e && (n < num); n++)
      e = e->next;
    if (e) {
      if ((r = proc_element(e)) < 0)
	return r;
    }
  }

  return 0;
}

static int proc_element(element_t element)
{
  int r, n;
  const struct operator *op;
  integer_t integer;
  array_t array;
  value_t value, v, args;
  function_t function;
  label_t label;

#ifndef NLL_FORMULA_NO_FIXED
  if (element->flags & ELEMENT_FLAG_FIXED) {
    if (!nll_is_nofixed())
      return 0;
  }
#endif

  switch (element->type) {
  case ELEMENT_TYPE_ELEMENTS:
    if ((r = proc(element->param.elements.head, NULL)) < 0)
      return r;
    if ((r = element_set_vector(element)) < 0)
      return r;
    if ((r = element_set_fixed(element)) < 0)
      return r;
    break;
  case ELEMENT_TYPE_VARIABLE:
    if ((r = value_set_value(element->value, element->param.variable.variable->value)) < 0)
      return r;
    if (element->param.variable.variable->value->flags & (VALUE_FLAG_CONST|VALUE_FLAG_RDONLY))
      element->flags |= ELEMENT_FLAG_FIXED;
    break;
  case ELEMENT_TYPE_INTEGER:
  case ELEMENT_TYPE_STRING:
#ifdef NLL_FLOATING_POINT
  case ELEMENT_TYPE_FLOAT:
#endif
    if (element->value->flags & (VALUE_FLAG_CONST|VALUE_FLAG_RDONLY))
      element->flags |= ELEMENT_FLAG_FIXED;
    break;
  default:
    break;
  }

  if (element->type != ELEMENT_TYPE_OPERATOR)
    return 0;

  op = element->param.operator.op;

  switch (op->subtype) {
  case OPERATOR_SUBTYPE_MON_BIN:
  case OPERATOR_SUBTYPE_MONADIC:
    if (!element->param.operator.args[0])
      return NLL_ERRCODE_FORMULA_LESS_PARAMETER;

    if ((r = proc(element->param.operator.args[0], NULL)) < 0)
      return r;

    if (op->type == OPERATOR_TYPE_VALUES) {
      if (element->value) {
	if ((r = value_clear(element->value)) < 0)
	  return r;
      }
      if ((r = element_set_values(element, element->param.operator.args[0]->value)) < 0)
	return r;
      break;
    }

    if ((r = proc_monadic(op, &element->value,
			  &element->param.operator.args[0]->value)) < 0)
      return r;

    break;

  case OPERATOR_SUBTYPE_BINARY:
    if (!element->param.operator.args[0] ||
	!element->param.operator.args[1])
      return NLL_ERRCODE_FORMULA_LESS_PARAMETER;

    if ((r = proc(element->param.operator.args[0], NULL)) < 0)
      return r;

    if ((op->type == OPERATOR_TYPE_COND) || (op->type == OPERATOR_TYPE_AT)) {
      value = element->param.operator.args[0]->value;
      switch (op->type) {
      case OPERATOR_TYPE_COND:
	if ((r = value_is_true(value)) < 0)
	  return r;
	integer = r ? 0 : 1;
	break;
      case OPERATOR_TYPE_AT:
	if ((r = value_get_integer(value, &integer)) < 0)
	  return r;
	break;
      default:
	return NLL_ERRCODE_FORMULA_INVALID_OPERATOR;
      }

      value = element->param.operator.args[1]->value;

      if (integer < 0)
	return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;
      if ((r = proc_at(op, element, integer)) < 0)
	return r;

      if (value_get_type(value) == VALUE_TYPE_VECTOR) {
	if ((r = value_get_vector(value, &value)) < 0)
	  return r;
      }
      for (n = 0; value && (n < integer); n++)
	value = value->next;
      if (!value) {
	/* Clear value to prevent that a VALUE_TYPE_VALUE link */
	if ((r = value_clear(element->value)) < 0)
	  return r;
	if ((r = value_set_null(element->value)) < 0)
	  return r;
      } else {
	if ((r = value_set_value(element->value, value)) < 0)
	  return r;
      }
      break;
    }

    switch (op->type) {
    case OPERATOR_TYPE_LOGCAND:
    case OPERATOR_TYPE_LOGCOR:
    case OPERATOR_TYPE_EXEC:
      if ((r = proc_logical(op,
			    element->param.operator.args[0],
			    element->param.operator.args[1])) < 0)
	return r;
      break;

    default:
      if ((r = proc(element->param.operator.args[1], NULL)) < 0)
	return r;
      break;
    }

    if ((op->type == OPERATOR_TYPE_DOT) || (op->type == OPERATOR_TYPE_ARROW)) {
      value = element->param.operator.args[1]->value;
      if ((r = value_get_integer(value, &integer)) < 0)
	return r;

      value = element->param.operator.args[0]->value;
      if (op->type == OPERATOR_TYPE_ARROW) {
	if ((r = value_get_pointer(value, &value, &n)) < 0)
	  return r;
	integer += n;
      }

      if (integer < 0)
	return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;

      if (value_get_type(value) == VALUE_TYPE_VECTOR) {
	if ((r = value_get_vector(value, &value)) < 0)
	  return r;
      }
      for (n = 0; value && (n < integer); n++)
	value = value->next;
      if (!value)
	return NLL_ERRCODE_FORMULA_INVALID_PARAMETER;
      if ((r = value_set_value(element->value, value)) < 0)
	return r;
      break;
    }

    if (op->type == OPERATOR_TYPE_ARRAY) {
      if ((r = value_get_integer(element->param.operator.args[1]->value, &integer)) < 0)
	return r;
      if ((r = value_get_array(element->param.operator.args[0]->value, &array, &n)) < 0)
	return r;
      if ((r = array_get_value(array, n + integer, &value)) < 0)
	return r;
      if ((r = value_set_value(element->value, value)) < 0)
	return r;
      break;
    }

    if (op->type == OPERATOR_TYPE_VECTOR) {
      if ((r = value_get_integer(element->param.operator.args[1]->value, &integer)) < 0)
	return r;
      value = element->param.operator.args[0]->value;
      n = (integer < 0) ? value_size(value) + integer : 0;
      if (value_get_type(value) == VALUE_TYPE_VECTOR) {
	if ((r = value_get_vector(value, &value)) < 0)
	  return r;
      }
      /* Clear value to prevent that a VALUE_TYPE_VALUE link */
      if ((r = value_clear(element->value)) < 0)
	return r;
      if ((r = value_set_null(element->value)) < 0)
	return r;
      for (; n > 0; n--) {
	if (!value)
	  break;
	value = value->next;
      }
      integer = (integer < 0) ? -integer : integer;
      if (integer == 1) {
	if (value) {
	  if ((r = value_set_value(element->value, value)) < 0)
	    return r;
	}
      } else {
	if ((r = value_set_vector(element->value, NULL)) < 0)
	  return r;
	if ((r = value_match_values(&element->value->val.value, integer)) < 0)
	  return r;
	v = element->value->val.value;
	for (; n < 0; n++) {
	  if (!v)
	    break;
	  v = v->next;
	}
	if ((r = value_set_values(v, value)) < 0)
	  return r;
      }
      break;
    }

    if (op->type == OPERATOR_TYPE_FUNCTION) {
      if ((r = value_get_function(element->param.operator.args[0]->value, &function)) < 0) {
	if ((r = value_get_label(element->param.operator.args[0]->value, &label)) < 0)
	  return r;
	element->param.operator.args[1]->flags &= ~ELEMENT_FLAG_FIXED;
	args = element->param.operator.args[1]->value;
	if (label) {
	  if ((r = label_proc(label, element->value, args)) < 0)
	    return r;
	}
	break;
      }
      if (!function || !(function->flags & FUNCTION_FLAG_FIXED))
	element->param.operator.args[1]->flags &= ~ELEMENT_FLAG_FIXED;
      args = element->param.operator.args[1]->value;
      if (value_get_type(args) == VALUE_TYPE_VECTOR) {
	if ((r = value_get_vector(args, &args)) < 0)
	  return r;
      }
      /*
       * Clear value to prevent that a VALUE_TYPE_VALUE link
       * by value_vector_to_value() becomes deep.
       */
      if ((r = value_clear(element->value)) < 0)
	return r;
      if ((r = value_set_vector(element->value, NULL)) < 0)
	return r;
      if (function) {
	if ((r = function_proc(function, &element->value->val.value, args)) < 0)
	  return r;
      }
      if (!(element->flags & ELEMENT_FLAG_RAW)) {
	if (element->value->val.value && !element->value->val.value->next) { /* scalar */
	  if ((r = value_vector_to_value(element->value)) < 0)
	    return r;
	}
      }
      break;
    }

    if ((r = proc_binary(op, &element->value,
			 &element->param.operator.args[0]->value,
			 &element->param.operator.args[1]->value)) < 0)
      return r;

    break;

  case OPERATOR_SUBTYPE_NONE:
    break;

  default:
    return NLL_ERRCODE_FORMULA_UNSUPPORTED_OPERATOR;
  }

  if (op->flags & OPERATOR_FLAG_FIXED) {
    switch (op->subtype) {
    case OPERATOR_SUBTYPE_MON_BIN:
    case OPERATOR_SUBTYPE_MONADIC:
      if (element->param.operator.args[0]->flags & ELEMENT_FLAG_FIXED)
	element->flags |= ELEMENT_FLAG_FIXED;
      break;
    case OPERATOR_SUBTYPE_BINARY:
      if ((element->param.operator.args[0]->flags & ELEMENT_FLAG_FIXED) &&
	  (element->param.operator.args[1]->flags & ELEMENT_FLAG_FIXED))
	element->flags |= ELEMENT_FLAG_FIXED;
      break;
    default:
      element->flags |= ELEMENT_FLAG_FIXED;
      break;
    }
  }

  return 0;
}

static int proc(element_t element, value_t *valuep)
{
  int r;
  value_t value = NULL;

  for (; element; element = element->next) {
    if ((r = proc_element(element)) < 0)
      return r;
    value = element->value;
  }

  if (valuep)
    *valuep = value;

  return 0;
}

int formula_free(element_t *elementp)
{
  element_t e;

  while (*elementp) {
    e = *elementp;
    *elementp = (*elementp)->next;
    e->next = NULL;

    switch (e->type) {
    case ELEMENT_TYPE_VARIABLE:
      if (e->param.variable.variable)
	variable_del(e->param.variable.variable);
      break;

    case ELEMENT_TYPE_ELEMENTS:
      if (e->param.elements.head)
	formula_free(&e->param.elements.head);
      break;

    case ELEMENT_TYPE_OPERATOR:
      if (e->param.operator.args[0])
	formula_free(&e->param.operator.args[0]);
      if (e->param.operator.args[1])
	formula_free(&e->param.operator.args[1]);
      break;

    default:
      break;
    }

    element_free(e);
  }

  return 0;
}

int formula_clean(element_t element)
{
  int r;

  for (; element; element = element->next) {
    if ((r = element_clean(element)) < 0)
      return r;
    switch (element->type) {
    case ELEMENT_TYPE_VARIABLE:
      if (element->param.variable.variable) {
	if ((r = value_clear(element->param.variable.variable->value)) < 0)
	  return r;
      }
      break;

    case ELEMENT_TYPE_ELEMENTS:
      if (element->param.elements.head) {
	if ((r = formula_clean(element->param.elements.head)) < 0)
	  return r;
      }
      break;

    case ELEMENT_TYPE_OPERATOR:
      if (element->param.operator.args[0]) {
	if ((r = formula_clean(element->param.operator.args[0])) < 0)
	  return r;
      }
      if (element->param.operator.args[1]) {
	if ((r = formula_clean(element->param.operator.args[1])) < 0)
	  return r;
      }
      break;

    default:
      break;
    }
  }

  return 0;
}

int formula_parse(char *formula, char **endp, element_t *elementp, const char *terminator)
{
  element_t element = NULL;
  int r;

  if (!terminator)
    terminator = ",;";

  if ((r = lex(&element, formula, endp, terminator)) < 0) {
    formula_free(&element);
    return r;
  }

  if ((r = parse(&element)) < 0) {
    formula_free(&element);
    return r;
  }

  if (elementp)
    *elementp = element;

  return 0;
}

int formula_proc(element_t element, value_t *valuep)
{
  int r;
  value_t value;

  if ((r = proc(element, &value)) < 0)
    return r;

  if (valuep)
    *valuep = value;

  return 0;
}

int formula_dump(FILE *fp, element_t element)
{
  const char *name;
  element_t left = NULL;

  for (; element; left = element, element = element->next) {
    nll_wait_output(fp);
    if (left)
      fprintf(fp, ",");
    switch (element->type) {
    case ELEMENT_TYPE_SYMBOL:
      fprintf(fp, "%s", element->param.name.name);
      break;

    case ELEMENT_TYPE_INTEGER:
    case ELEMENT_TYPE_STRING:
#ifdef NLL_FLOATING_POINT
    case ELEMENT_TYPE_FLOAT:
#endif
      value_dump(fp, element->value);
      break;

    case ELEMENT_TYPE_VARIABLE:
      fprintf(fp, "%s", element->param.variable.variable->name);
      break;

    case ELEMENT_TYPE_ELEMENTS:
      if (element->param.elements.op)
	fprintf(fp, "%s", element->param.elements.op->word);
      formula_dump(fp, element->param.elements.head);
      if (element->param.elements.op)
	fprintf(fp, "%s", element->param.elements.op->term);
      break;

    case ELEMENT_TYPE_OPERATOR:
      switch (element->param.operator.op->type) {
      case OPERATOR_TYPE_ARRAY:
	name = "";
	break;
      case OPERATOR_TYPE_NOP:
	name = "NOP";
	break;
      case OPERATOR_TYPE_FUNCTION:
	name = "";
	if (element->param.operator.args[1]->type != ELEMENT_TYPE_ELEMENTS)
	  name = " ";
	break;
      default:
	name = element->param.operator.op->word;
	name = name ? name : "";
	break;
      }

      switch (element->param.operator.op->subtype) {
      case OPERATOR_SUBTYPE_MONADIC:
      case OPERATOR_SUBTYPE_MON_BIN:
	if (element->param.operator.op->flags & OPERATOR_FLAG_RL)
	  fprintf(fp, "%s", name);
	if (element->param.operator.args[0])
	  formula_dump(fp, element->param.operator.args[0]);
	if (element->param.operator.op->flags & OPERATOR_FLAG_LR)
	  fprintf(fp, "%s", name);
	break;

      case OPERATOR_SUBTYPE_BINARY:
	if (element->param.operator.args[0])
	  formula_dump(fp, element->param.operator.args[0]);
	fprintf(fp, "%s", name);
	if (element->param.operator.args[1])
	  formula_dump(fp, element->param.operator.args[1]);
	break;

      case OPERATOR_SUBTYPE_NONE:
      default:
	fprintf(fp, "%s", name);
	break;
      }
      break;

    case ELEMENT_TYPE_NONE:
    default:
      fprintf(fp, "?");
      break;
    }
  }

  return 0;
}

int formula_operator_list(FILE *fp)
{
  operator_t operator;
  int priority, i;
  unsigned int d;

  nll_wait_output(fp);
  fprintf(fp, "Name\tPri\tType\tDir\tFlags\n");

  for (i = 0; i < OPERATOR_PRIORITY_NUM; i++) {
    priority = OPERATOR_PRIORITY_MIN + i;

    for (d = OPERATOR_FLAG_RL; d != 0;
	 d = (d == OPERATOR_FLAG_RL) ? OPERATOR_FLAG_LR : 0) {

      for (operator = operators; operator->type != OPERATOR_TYPE_NONE; operator++) {
	if (!(operator->flags & d))
	  continue;
	if (operator->priority != priority)
	  continue;

	nll_wait_output(fp);

	if (!operator->word) {
	  switch (operator->type) {
	  case OPERATOR_TYPE_NOP:       fprintf(fp, "NOP"); break;
	  case OPERATOR_TYPE_FUNCTION:  fprintf(fp, "FUNC"); break;
	  case OPERATOR_TYPE_NONE:
	  default:
	    continue;
	  }
	} else {
	  fprintf(fp, "%s", operator->word);
	}

	if (operator->term)
	  fprintf(fp, "%s", operator->term);

	fprintf(fp, "\t%d", operator->priority);
	switch (operator->subtype) {
	case OPERATOR_SUBTYPE_MONADIC:
	case OPERATOR_SUBTYPE_MON_BIN: fprintf(fp, "\tMONADIC"); break;
	case OPERATOR_SUBTYPE_BINARY:  fprintf(fp, "\tBINARY"); break;
	case OPERATOR_SUBTYPE_NONE:
	default:                       fprintf(fp, "\tNONE"); break;
	}
	switch (d) {
	case OPERATOR_FLAG_RL: fprintf(fp, "\tR->L"); break;
	case OPERATOR_FLAG_LR: fprintf(fp, "\tL->R"); break;
	}
	fprintf(fp, "\t(");

	if (operator->flags & OPERATOR_FLAG_EFFECT) fprintf(fp, " EFFECT");
	if (operator->flags & OPERATOR_FLAG_FIXED)  fprintf(fp, " FIXED");
	fprintf(fp, " )\n");
      }
    }
  }

  fflush(fp);

  return 0;
}
