/*
 * LPC grammar, handles construction of parse trees and type checking.
 * Currently there is one shift/reduce conflict, on else.
 * The node->mod field is used to store the type of an expression. (!)
 */

%{

# define INCLUDE_CTYPE
# include "comp.h"
# include "str.h"
# include "array.h"
# include "object.h"
# include "xfloat.h"
# include "interpret.h"
# include "macro.h"
# include "token.h"
# include "ppcontrol.h"
# include "node.h"
# include "compile.h"

# define yylex		pp_gettok
# define yyerror	c_error

int nerrors;			/* number of errors encountered so far */
static int ndeclarations;	/* number of declarations */
static int nstatements;		/* number of statements in current function */
static bool typechecking;	/* does the current function have it? */

static void  t_void	P((node*));
static bool  t_unary	P((node*, char*));
static node *uassign	P((int, node*, char*));
static node *cast	P((node*, unsigned int));
static node *idx	P((node*, node*));
static node *range	P((node*, node*, node*));
static node *bini	P((int, node*, node*, char*));
static node *bina	P((int, node*, node*, char*));
static node *mult	P((int, node*, node*, char*));
static node *mdiv	P((int, node*, node*, char*));
static node *mod	P((int, node*, node*, char*));
static node *add	P((int, node*, node*, char*));
static node *sub	P((int, node*, node*, char*));
static node *umin	P((node*));
static node *lshift	P((int, node*, node*, char*));
static node *rshift	P((int, node*, node*, char*));
static node *rel	P((int, node*, node*, char*));
static node *eq		P((node*, node*));
static node *and	P((int, node*, node*, char*));
static node *xor	P((int, node*, node*, char*));
static node *or		P((int, node*, node*, char*));
static node *land	P((node*, node*));
static node *lor	P((node*, node*));
static node *quest	P((node*, node*, node*));
static node *assign	P((node*, node*));
static node *comma	P((node*, node*));

%}


/*
 * Keywords. The order is determined in tokenz() in the lexical scanner.
 */
%token STRING NOMASK DO BREAK ELSE CASE OBJECT DEFAULT STATIC CONTINUE INT
       RLIMITS FLOAT FOR INHERIT WHILE IF CATCH SWITCH MAPPING PRIVATE VOID
       ATOMIC RETURN MIXED VARARGS

/*
 * composite tokens
 */
%token ARROW PLUS_PLUS MIN_MIN LSHIFT RSHIFT LE GE EQ NE LAND LOR
       PLUS_EQ MIN_EQ MULT_EQ DIV_EQ MOD_EQ LSHIFT_EQ RSHIFT_EQ AND_EQ
       XOR_EQ OR_EQ COLON_COLON DOT_DOT ELLIPSIS STRING_CONST IDENTIFIER

%union {
    Int number;			/* lex input */
    xfloat real;		/* lex input */
    unsigned short type;	/* internal */
    struct _node_ *node;	/* internal */
}

/*
 * token types
 */
%token <number> INT_CONST
%token <real> FLOAT_CONST

/*
 * lexical scanner tokens
 */
%token MARK HASH HASH_HASH INCL_CONST NR_TOKENS

/*
 * rule types
 */
%type <type> class_specifier_list class_specifier type_specifier star_list
%type <node> opt_inherit_label string inherit_string formals_declaration
	     formal_declaration_list formal_declaration data_dcltr
	     function_dcltr dcltr list_dcltr dcltr_or_stmt_list dcltr_or_stmt
	     stmt compound_stmt opt_caught_stmt function_name primary_p1_exp
	     primary_p2_exp postfix_exp prefix_exp cast_exp mult_oper_exp
	     add_oper_exp shift_oper_exp rel_oper_exp equ_oper_exp
	     bitand_oper_exp bitxor_oper_exp bitor_oper_exp and_oper_exp
	     or_oper_exp cond_exp exp list_exp opt_list_exp f_list_exp
	     f_opt_list_exp arg_list opt_arg_list opt_arg_list_comma assoc_exp
	     assoc_arg_list opt_assoc_arg_list_comma ident

%%

program
	:	{
		  nerrors = 0;
		  ndeclarations = 0;
		}
	  top_level_declarations
		{
		  if (nerrors > 0) {
		      YYABORT;
		  }
		}
	;

top_level_declarations
	: /* empty */
	| top_level_declarations top_level_declaration
		{
		  if (nerrors > 0) {
		      YYABORT;
		  }
		}
	;

top_level_declaration
	: INHERIT opt_inherit_label inherit_string ';'
		{
		  if (ndeclarations > 0) {
		      c_error("inherit must precede all declarations");
		  } else if (nerrors > 0 || !c_inherit($3->l.string->text, $2))
		  {
		      /*
		       * The object to be inherited may have been compiled;
		       * abort this compilation and possibly restart later.
		       */
		      YYABORT;
		  }
		}
	| data_declaration
		{ ndeclarations++; }
	| function_declaration
		{ ndeclarations++; }
	;

opt_inherit_label
	: /* empty */
		{ $$ = (node *) NULL; }
	| ident
	;

ident
	: IDENTIFIER
		{ $$ = node_str(str_new(yytext, (long) yyleng)); }
	;

inherit_string
	: string
	| inherit_string '+' string
		{ $$ = node_str(str_add($1->l.string, $3->l.string)); }
	| '(' inherit_string ')'
		{ $$ = $2; }
	;

string
	: STRING_CONST
		{ $$ = node_str(str_new(yytext, (long) yyleng)); }
	;

data_declaration
	: class_specifier_list type_specifier list_dcltr ';'
		{ c_global($1, $2, $3); }
	;

function_declaration
	: class_specifier_list type_specifier function_dcltr
		{ 
		  typechecking = TRUE;
		  c_function($1, $2, $3);
		}
	  compound_stmt
		{
		  if (nerrors == 0) {
		      c_funcbody($5);
		  }
		}
	| class_specifier_list ident '(' formals_declaration ')'
		{
		  typechecking = c_typechecking();
		  c_function($1, (typechecking) ? T_VOID : T_INVALID,
			     node_bin(N_FUNC, 0, $2, $4));
		}
	  compound_stmt
		{
		  if (nerrors == 0) {
		      c_funcbody($7);
		  }
		}
	;

local_data_declaration
	: class_specifier_list type_specifier list_dcltr ';'
		{ c_local($1, $2, $3); }
	;

formals_declaration
	: /* empty */
		{ $$ = (node *) NULL; }
	| VOID	{ $$ = (node *) NULL; }
	| formal_declaration_list
	| formal_declaration_list ELLIPSIS
		{
		  $$ = $1;
		  if ($$->type == N_PAIR) {
		      $$->r.right->mod |= T_ELLIPSIS;
		  } else {
		      $$->mod |= T_ELLIPSIS;
		  }
		}
	;

formal_declaration_list
	: formal_declaration
	| formal_declaration_list ',' formal_declaration
		{ $$ = node_bin(N_PAIR, 0, $1, $3); }
	;

formal_declaration
	: type_specifier data_dcltr
		{
		  $$ = $2;
		  $$->mod |= $1;
		}
	| ident {
		  $$ = $1;
		  $$->mod = T_INVALID;	/* only if typechecking, though */
		}
	;

class_specifier_list
	: /* empty */
		{ $$ = 0; }
	| class_specifier_list class_specifier
		{ $$ = $1 | $2; }
	;

class_specifier
	: PRIVATE
		{ $$ = C_STATIC | C_PRIVATE; }
	| STATIC
		{ $$ = C_STATIC; }
	| ATOMIC
		{ $$ = C_ATOMIC; }
	| NOMASK
		{ $$ = C_NOMASK; }
	| VARARGS
		{ $$ = C_VARARGS; }
	;

type_specifier
	: INT	{ $$ = T_INT; }
	| FLOAT	{ $$ = T_FLOAT; }
	| STRING
		{ $$ = T_STRING; }
	| OBJECT
		{ $$ = T_OBJECT; }
	| MAPPING
		{ $$ = T_MAPPING; }
	| MIXED	{ $$ = T_MIXED; }
	| VOID	{ $$ = T_VOID; }
	;

star_list
	: /* empty */
		{ $$ = 0; }
	| star_list '*'
		{
		  $$ = $1 + 1;
		  if ($$ == 1 << (8 - REFSHIFT)) {
		      c_error("too deep indirection");
		  }
		}
	;

data_dcltr
	: star_list ident
		{
		  $$ = $2;
		  $$->mod = ($1 << REFSHIFT) & T_REF;
		}
	;

function_dcltr
	: star_list ident '(' formals_declaration ')'
		{ $$ = node_bin(N_FUNC, ($1 << REFSHIFT) & T_REF, $2, $4); }
	;

dcltr
	: data_dcltr
	| function_dcltr
	;

list_dcltr
	: dcltr
	| list_dcltr ',' dcltr
		{ $$ = node_bin(N_PAIR, 0, $1, $3); }
	;

dcltr_or_stmt_list
	: /* empty */
		{ $$ = (node *) NULL; }
	| dcltr_or_stmt_list dcltr_or_stmt
		{ $$ = c_concat($1, $2); }
	;

dcltr_or_stmt
	: local_data_declaration
		{
		  if (nstatements > 0) {
		      c_error("declaration after statement");
		  }
		  $$ = (node *) NULL;
		}
	| stmt	{
		  nstatements++;
		  $$ = $1;
		}
	| error ';'
		{
		  if (nerrors >= MAX_ERRORS) {
		      YYABORT;
		  }
		  $$ = (node *) NULL;
		}
	;

stmt
	: list_exp ';'
		{ $$ = c_exp_stmt($1); }
	| compound_stmt
	| IF '(' f_list_exp ')' stmt
		{ $$ = c_if($3, $5, (node *) NULL); }
/* will cause shift/reduce conflict */
	| IF '(' f_list_exp ')' stmt ELSE stmt
		{ $$ = c_if($3, $5, $7); }
	| DO	{ c_loop(); }
	  stmt WHILE '(' f_list_exp ')' ';'
		{ $$ = c_do($6, $3); }
	| WHILE '(' f_list_exp ')'
		{ c_loop(); }
	  stmt	{ $$ = c_while($3, $6); }
	| FOR '(' opt_list_exp ';' f_opt_list_exp ';' opt_list_exp ')'
		{ c_loop(); }
	  stmt	{ $$ = c_for(c_exp_stmt($3), $5, c_exp_stmt($7), $10); }
	| RLIMITS '(' f_list_exp ';' f_list_exp ')'
		{
		  if (typechecking) {
		      if ($3->mod != T_INT && $3->mod != T_MIXED) {
			  c_error("bad type for stack rlimit (%s)",
				  i_typename($3->mod));
		      }
		      if ($5->mod != T_INT && $5->mod != T_MIXED) {
			  c_error("bad type for ticks rlimit (%s)",
				  i_typename($5->mod));
		      }
		  }
		  c_startrlimits();
		}
	  compound_stmt
		{ $$ = c_endrlimits($3, $5, $8); }
	| CATCH	{ c_startcatch(); }
	  compound_stmt
		{ c_endcatch(); }
	  opt_caught_stmt
		{ $$ = c_donecatch($3, $5); }
	| SWITCH '(' f_list_exp ')'
		{ c_startswitch($3, typechecking); }
	  compound_stmt
		{ $$ = c_endswitch($3, $6); }
	| CASE exp ':'
		{ $2 = c_case($2, (node *) NULL); }
	  stmt	{
		  $$ = $2;
		  if ($$ != (node *) NULL) {
		      $$->l.left = $5;
		  } else {
		      $$ = $5;
		  }
		}
	| CASE exp DOT_DOT exp ':'
		{ $2 = c_case($2, $4); }
	  stmt	{
		  $$ = $2;
		  if ($$ != (node *) NULL) {
		      $$->l.left = $7;
		  } else {
		      $$ = $7;
		  }
		}
	| DEFAULT ':'
		{ $<node>2 = c_default(); }
	  stmt	{
		  $$ = $<node>2;
		  if ($$ != (node *) NULL) {
		      $$->l.left = $4;
		  } else {
		      $$ = $4;
		  }
		}
	| BREAK ';'
		{
		  $$ = c_break();
		}
	| CONTINUE ';'
		{
		  $$ = c_continue();
		}
	| RETURN f_opt_list_exp ';'
		{ $$ = c_return($2, typechecking); }
	| ';'	{ $$ = (node *) NULL; }
	;

compound_stmt
	: '{'	{
		  nstatements = 0;
		  c_startcompound();
		}
	  dcltr_or_stmt_list '}'
		{
		  nstatements = 1;	/* any non-zero value will do */
		  $$ = c_endcompound($3);
		}
	;

opt_caught_stmt
	: /* empty */
		{ $$ = (node *) NULL; }
	| ':' stmt
		{ $$ = $2; }
	;

function_name
	: ident	{ $$ = c_flookup($1, typechecking); }
	| COLON_COLON ident
		{ $$ = c_iflookup($2, (node *) NULL); }
	| ident COLON_COLON ident
		{ $$ = c_iflookup($3, $1); }
	;

primary_p1_exp
	: INT_CONST
		{ $$ = node_int($1); }
	| FLOAT_CONST
		{ $$ = node_float(&$1); }
	| string
	| '(' '{' opt_arg_list_comma '}' ')'
		{ $$ = c_aggregate($3, T_MIXED | (1 << REFSHIFT)); }
	| '(' '[' opt_assoc_arg_list_comma ']' ')'
		{ $$ = c_aggregate($3, T_MAPPING); }
	| ident	{
		  $$ = c_variable($1);
		  if (typechecking) {
		      if ($$->type == N_GLOBAL && $$->mod != T_MIXED &&
			  !conf_typechecking()) {
			  /*
			   * global vars might be modified by untypechecked
			   * functions...
			   */
			  $$ = node_mon(N_CAST, $$->mod, $$);
		      }
		  } else {
		      /* the variable could be anything */
		      $$->mod = T_MIXED;
		  }
		}
	| '(' list_exp ')'
		{ $$ = $2; }
	| function_name '(' opt_arg_list ')'
		{ $$ = c_checkcall(c_funcall($1, $3), typechecking); }
	| CATCH '(' list_exp ')'
		{ $$ = node_mon(N_CATCH, T_STRING, $3); }
	| primary_p2_exp ARROW ident '(' opt_arg_list ')'
		{
		  t_void($1);
		  $$ = c_checkcall(c_arrow($1, $3, $5), typechecking);
		}
	;

primary_p2_exp
	: primary_p1_exp
	| primary_p2_exp '[' f_list_exp ']'
		{ $$ = idx($1, $3); }
	| primary_p2_exp '[' f_opt_list_exp DOT_DOT f_opt_list_exp ']'
		{ $$ = range($1, $3, $5); }
	;

postfix_exp
	: primary_p2_exp
	| postfix_exp PLUS_PLUS
		{ $$ = uassign(N_PLUS_PLUS, $1, "++"); }
	| postfix_exp MIN_MIN
		{ $$ = uassign(N_MIN_MIN, $1, "--"); }
	;

prefix_exp
	: postfix_exp
	| PLUS_PLUS cast_exp
		{ $$ = uassign(N_ADD_EQ_1, $2, "++"); }
	| MIN_MIN cast_exp
		{ $$ = uassign(N_SUB_EQ_1, $2, "--"); }
	| '-' cast_exp
		{ $$ = umin($2); }
	| '+' cast_exp
		{ $$ = node_mon(N_UPLUS, $2->mod, $2); }
	| '!' cast_exp
		{
		  t_void($2);
		  $$ = c_not($2);
		}
	| '~' cast_exp
		{
		  $$ = $2;
		  t_void($$);
		  if (typechecking && $$->mod != T_INT && $$->mod != T_MIXED) {
		      c_error("bad argument type for ~ (%s)",
			      i_typename($$->mod));
		      $$->mod = T_MIXED;
		  } else {
		      $$ = xor(N_XOR, $$, node_int((Int) -1), "^");
		  }
		}
	;

cast_exp
	: prefix_exp
	| '(' type_specifier star_list ')' cast_exp
		{ $$ = cast($5, $2 | (($3 << REFSHIFT) & T_REF)); }
	;

mult_oper_exp
	: cast_exp
	| mult_oper_exp '*' cast_exp
		{ $$ = mult(N_MULT, $1, $3, "*"); }
	| mult_oper_exp '/' cast_exp
		{ $$ = mdiv(N_DIV, $1, $3, "/"); }
	| mult_oper_exp '%' cast_exp
		{ $$ = mod(N_MOD, $1, $3, "%"); }
	;

add_oper_exp
	: mult_oper_exp
	| add_oper_exp '+' mult_oper_exp
		{ $$ = add(N_ADD, $1, $3, "+"); }
	| add_oper_exp '-' mult_oper_exp
		{ $$ = sub(N_SUB, $1, $3, "-"); }
	;

shift_oper_exp
	: add_oper_exp
	| shift_oper_exp LSHIFT add_oper_exp
		{ $$ = lshift(N_LSHIFT, $1, $3, "<<"); }
	| shift_oper_exp RSHIFT add_oper_exp
		{ $$ = rshift(N_RSHIFT, $1, $3, ">>"); }
	;

rel_oper_exp
	: shift_oper_exp
	| rel_oper_exp '<' shift_oper_exp
		{ $$ = rel(N_LT, $$, $3, "<"); }
	| rel_oper_exp '>' shift_oper_exp
		{ $$ = rel(N_GT, $$, $3, ">"); }
	| rel_oper_exp LE shift_oper_exp
		{ $$ = rel(N_LE, $$, $3, "<="); }
	| rel_oper_exp GE shift_oper_exp
		{ $$ = rel(N_GE, $$, $3, ">="); }
	;

equ_oper_exp
	: rel_oper_exp
	| equ_oper_exp EQ rel_oper_exp
		{ $$ = eq($1, $3); }
	| equ_oper_exp NE rel_oper_exp
		{ $$ = c_not(eq($1, $3)); }
	;

bitand_oper_exp
	: equ_oper_exp
	| bitand_oper_exp '&' equ_oper_exp
		{ $$ = and(N_AND, $1, $3, "&"); }
	;

bitxor_oper_exp
	: bitand_oper_exp
	| bitxor_oper_exp '^' bitand_oper_exp
		{ $$ = xor(N_XOR, $1, $3, "^"); }
	;

bitor_oper_exp
	: bitxor_oper_exp
	| bitor_oper_exp '|' bitxor_oper_exp
		{ $$ = or(N_OR, $1, $3, "|"); }
	;

and_oper_exp
	: bitor_oper_exp
	| and_oper_exp LAND bitor_oper_exp
		{ $$ = land($1, $3); }
	;

or_oper_exp
	: and_oper_exp
	| or_oper_exp LOR and_oper_exp
		{ $$ = lor($1, $3); }
	;

cond_exp
	: or_oper_exp
	| or_oper_exp '?' list_exp ':' cond_exp
		{ $$ = quest($1, $3, $5); }
	;

exp
	: cond_exp
	| cond_exp '=' exp
		{ $$ = assign(c_lvalue($1, "assignment"), $3); }
	| cond_exp PLUS_EQ exp
		{ $$ = add(N_ADD_EQ, c_lvalue($1, "+="), $3, "+="); }
	| cond_exp MIN_EQ exp
		{ $$ = sub(N_SUB_EQ, c_lvalue($1, "-="), $3, "-="); }
	| cond_exp MULT_EQ exp
		{ $$ = mult(N_MULT_EQ, c_lvalue($1, "*="), $3, "*="); }
	| cond_exp DIV_EQ exp
		{ $$ = mdiv(N_DIV_EQ, c_lvalue($1, "/="), $3, "/="); }
	| cond_exp MOD_EQ exp
		{ $$ = mod(N_MOD_EQ, c_lvalue($1, "%="), $3, "%="); }
	| cond_exp LSHIFT_EQ exp
		{ $$ = lshift(N_LSHIFT_EQ, c_lvalue($1, "<<="), $3, "<<="); }
	| cond_exp RSHIFT_EQ exp
		{ $$ = rshift(N_RSHIFT_EQ, c_lvalue($1, ">>="), $3, ">>="); }
	| cond_exp AND_EQ exp
		{ $$ = and(N_AND_EQ, c_lvalue($1, "&="), $3, "&="); }
	| cond_exp XOR_EQ exp
		{ $$ = xor(N_XOR_EQ, c_lvalue($1, "^="), $3, "^="); }
	| cond_exp OR_EQ exp
		{ $$ = or(N_OR_EQ, c_lvalue($1, "|="), $3, "|="); }
	;

list_exp
	: exp
	| list_exp ',' exp
		{ $$ = comma($1, $3); }
	;

opt_list_exp
	: /* empty */
		{ $$ = (node *) NULL; }
	| list_exp
	;

f_list_exp
	: list_exp
		{ t_void($$ = $1); }
	;

f_opt_list_exp
	: opt_list_exp
		{ t_void($$ = $1); }
	;

arg_list
	: exp	{ t_void($$ = $1); }
	| arg_list ',' exp
		{
		  t_void($3);
		  $$ = node_bin(N_PAIR, 0, $1, $3);
		}
	;

opt_arg_list
	: /* empty */
		{ $$ = (node *) NULL; }
	| arg_list
	| arg_list ELLIPSIS
		{
		  $$ = $1;
		  if ($$->type == N_PAIR) {
		      $$->r.right = node_mon(N_SPREAD, -1, $$->r.right);
		  } else {
		      $$ = node_mon(N_SPREAD, -1, $$);
		  }
		}
	;

opt_arg_list_comma
	: /* empty */
		{ $$ = (node *) NULL; }
	| arg_list
	| arg_list ','
		{ $$ = $1; }
	;

assoc_exp
	: exp ':' exp
		{
		  t_void($1);
		  t_void($3);
		  $$ = node_bin(N_COMMA, 0, $1, $3);
		}
	;

assoc_arg_list
	: assoc_exp
	| assoc_arg_list ',' assoc_exp
		{ $$ = node_bin(N_PAIR, 0, $1, $3); }
	;

opt_assoc_arg_list_comma
	: /* empty */
		{ $$ = (node *) NULL; }
	| assoc_arg_list
	| assoc_arg_list ','
		{ $$ = $1; }
	;

%%

/*
 * NAME:	t_void()
 * DESCRIPTION:	if the argument is of type void, an error will result
 */
static void t_void(n)
register node *n;
{
    if (n != (node *) NULL && n->mod == T_VOID) {
	c_error("void value not ignored");
	n->mod = T_MIXED;
    }
}

/*
 * NAME:	t_unary()
 * DESCRIPTION:	typecheck the argument of a unary operator
 */
static bool t_unary(n, name)
register node *n;
char *name;
{
    t_void(n);
    if (typechecking && !T_ARITHMETIC(n->mod) && n->mod != T_MIXED) {
	c_error("bad argument type for %s (%s)", name, i_typename(n->mod));
	n->mod = T_MIXED;
	return FALSE;
    }
    return TRUE;
}

/*
 * NAME:	uassign()
 * DESCRIPTION:	handle a unary assignment operator
 */
static node *uassign(op, n, name)
int op;
register node *n;
char *name;
{
    t_unary(n, name);
    return node_mon((n->mod == T_INT) ? op + 1 : op, n->mod, c_lvalue(n, name));
}

/*
 * NAME:	cast()
 * DESCRIPTION:	cast an expression to a type
 */
static node *cast(n, type)
register node *n;
register unsigned int type;
{
    xfloat flt;
    Int i;
    char *p, buffer[18];

    if (type != n->mod) {
	switch (type) {
	case T_INT:
	    switch (n->type) {
	    case N_FLOAT:
		/* cast float constant to int */
		NFLT_GET(n, flt);
		return node_int(flt_ftoi(&flt));

	    case N_STR:
		/* cast string to int */
		i = strtol(n->l.string->text, &p, 10);
		if (p == n->l.string->text + n->l.string->len) {
		    return node_int(i);
		} else {
		    c_error("cast of invalid string constant");
		    n->mod = T_MIXED;
		}
		break;

	    case N_TOFLOAT:
	    case N_TOSTRING:
		if (n->l.left->type == N_INT) {
		    /* (int) (float) i, (int) (string) i */
		    return n->l.left;
		}
		/* fall through */
	    default:
		if (n->mod == T_FLOAT || n->mod == T_STRING ||
		    n->mod == T_MIXED) {
		    return node_mon(N_TOINT, T_INT, n);
		}
		break;
	    }
	    break;

	case T_FLOAT:
	    switch (n->type) {
	    case N_INT:
		/* cast int constant to float */
		flt_itof(n->l.number, &flt);
		return node_float(&flt);

	    case N_STR:
		/* cast string to float */
		p = n->l.string->text;
		if (flt_atof(&p, &flt) &&
		    p == n->l.string->text + n->l.string->len) {
		    return node_float(&flt);
		} else {
		    yyerror("cast of invalid string constant");
		    n->mod = T_MIXED;
		}
		break;

	    case N_TOSTRING:
		if (n->l.left->mod == T_INT) {
		    return node_mon(N_TOFLOAT, T_FLOAT, n->l.left);
		}
		/* fall through */
	    default:
		if (n->mod == T_INT || n->mod == T_STRING || n->mod == T_MIXED)
		{
		    return node_mon(N_TOFLOAT, T_FLOAT, n);
		}
		break;
	    }
	    break;

	case T_STRING:
	    switch (n->type) {
	    case N_INT:
		/* cast int constant to string */
		sprintf(buffer, "%ld", (long) n->l.number);
		return node_str(str_new(buffer, (long) strlen(buffer)));

	    case N_FLOAT:
		/* cast float constant to string */
		NFLT_GET(n, flt);
		flt_ftoa(&flt, buffer);
		return node_str(str_new(buffer, (long) strlen(buffer)));

	    default:
		if (n->mod == T_INT || n->mod == T_FLOAT || n->mod == T_MIXED) {
		    return node_mon(N_TOSTRING, T_STRING, n);
		}
		break;
	    }
	    break;
	}

	if ((n->mod & T_TYPE) != T_MIXED) {
	    c_error("cast of invalid type (%s)", i_typename(n->mod));
	} else if ((type & T_TYPE) == T_VOID) {
	    c_error("cannot cast to %s", i_typename(type));
	    n->mod = T_MIXED;
	} else if ((type & T_REF) < (n->mod & T_REF)) {
	    c_error("illegal cast of array type (%s)", i_typename(n->mod));
	} else if ((type & T_REF) == 0 || (n->mod & T_REF) == 0) {
	    return node_mon(N_CAST, type, n);
	}
    }
    return n;
}

/*
 * NAME:	idx()
 * DESCRIPTION:	handle the [ ] operator
 */
static node *idx(n1, n2)
register node *n1, *n2;
{
    register unsigned short type;

    if (n1->type == N_STR && n2->type == N_INT) {
	/* str [ int ] */
	if (n2->l.number < 0 || n2->l.number >= (Int) n1->l.string->len) {
	    c_error("string index out of range");
	} else {
	    n2->l.number =
		    UCHAR(n1->l.string->text[str_index(n1->l.string,
						       (long) n2->l.number)]);
	}
	return n2;
    }

    if ((n1->mod & T_REF) != 0) {
	/*
	 * array
	 */
	if (typechecking) {
	    type = n1->mod - (1 << REFSHIFT);
	    if (n2->mod != T_INT && n2->mod != T_MIXED) {
		c_error("bad index type (%s)", i_typename(n2->mod));
	    }
	    if (type != T_MIXED) {
		/* you can't trust these arrays */
		return node_mon(N_CAST, type, node_bin(N_INDEX, type, n1, n2));
	    }
	}
	type = T_MIXED;
    } else if (n1->mod == T_STRING) {
	/*
	 * string
	 */
	if (typechecking && n2->mod != T_INT && n2->mod != T_MIXED) {
	    c_error("bad index type (%s)", i_typename(n2->mod));
	}
	type = T_INT;
    } else {
	if (typechecking && n1->mod != T_MAPPING && n1->mod != T_MIXED) {
	    c_error("bad indexed type (%s)", i_typename(n1->mod));
	}
	type = T_MIXED;
    }
    return node_bin(N_INDEX, type, n1, n2);
}

/*
 * NAME:	range()
 * DESCRIPTION:	handle the [ .. ] operator
 */
static node *range(n1, n2, n3)
register node *n1, *n2, *n3;
{
    if (n1->type == N_STR && (n2 == (node *) NULL || n2->type == N_INT) &&
	(n3 == (node *) NULL || n3->type == N_INT)) {
	Int from, to;

	/* str [ int .. int ] */
	from = (n2 == (node *) NULL) ? 0 : n2->l.number;
	to = (n3 == (node *) NULL) ? n1->l.string->len - 1 : n3->l.number;
	if (from < 0 || from > to + 1 || to >= n1->l.string->len) {
	    c_error("invalid string range");
	} else {
	    return node_str(str_range(n1->l.string, (long) from, (long) to));
	}
    }

    if (typechecking && n1->mod != T_MAPPING && n1->mod != T_MIXED) {
	/* indices */
	if (n2 != (node *) NULL && n2->mod != T_INT && n2->mod != T_MIXED) {
	    c_error("bad index type (%s)", i_typename(n2->mod));
	}
	if (n3 != (node *) NULL && n3->mod != T_INT && n3->mod != T_MIXED) {
	    c_error("bad index type (%s)", i_typename(n3->mod));
	}
	/* range */
	if ((n1->mod & T_REF) == 0 && n1->mod != T_STRING) {
	    c_error("bad indexed type (%s)", i_typename(n1->mod));
	}
    }

    return node_bin(N_RANGE, n1->mod, n1, node_bin(N_PAIR, 0, n2, n3));
}

/*
 * NAME:	bini()
 * DESCRIPTION:	handle a binary int operator
 */
static node *bini(op, n1, n2, name)
int op;
register node *n1, *n2;
char *name;
{
    t_void(n1);
    t_void(n2);

    if (typechecking &&
	((n1->mod != T_INT && n1->mod != T_MIXED) ||
	 (n2->mod != T_INT && n2->mod != T_MIXED))) {
	c_error("bad argument types for %s (%s, %s)", name,
		i_typename(n1->mod), i_typename(n2->mod));
    }
    if (n1->mod == T_INT && n2->mod == T_INT) {
	op++;
    }
    return node_bin(op, T_INT, n1, n2);
}

/*
 * NAME:	bina()
 * DESCRIPTION:	handle a binary arithmetic operator
 */
static node *bina(op, n1, n2, name)
int op;
register node *n1, *n2;
char *name;
{
    register unsigned short type;

    t_void(n1);
    t_void(n2);

    type = T_MIXED;
    if (typechecking &&
	((n1->mod != n2->mod && n1->mod != T_MIXED && n2->mod != T_MIXED) ||
	 (!T_ARITHMETIC(n1->mod) && n1->mod != T_MIXED) ||
	 (!T_ARITHMETIC(n2->mod) && n2->mod != T_MIXED))) {
	c_error("bad argument types for %s (%s, %s)", name,
		i_typename(n1->mod), i_typename(n2->mod));
    } else if (n1->mod == T_INT || n2->mod == T_INT) {
	if (n1->mod == T_INT && n2->mod == T_INT) {
	    op++;
	}
	type = T_INT;
    } else if (n1->mod == T_FLOAT || n2->mod == T_FLOAT) {
	type = T_FLOAT;
    }

    return node_bin(op, type, n1, n2);
}

/*
 * NAME:	mult()
 * DESCRIPTION:	handle the * *= operators
 */
static node *mult(op, n1, n2, name)
int op;
register node *n1, *n2;
char *name;
{
    xfloat f1, f2;

    if (n1->type == N_INT && n2->type == N_INT) {
	/* i * i */
	n1->l.number *= n2->l.number;
	return n1;
    }
    if (n1->type == N_FLOAT && n2->type == N_FLOAT) {
	NFLT_GET(n1, f1);
	NFLT_GET(n2, f2);
	flt_mult(&f1, &f2);
	NFLT_PUT(n1, f1);
	return n1;
    }
    return bina(op, n1, n2, name);
}

/*
 * NAME:	mdiv()
 * DESCRIPTION:	handle the / /= operators
 */
static node *mdiv(op, n1, n2, name)
int op;
register node *n1, *n2;
char *name;
{
    xfloat f1, f2;

    if (n1->type == N_INT && n2->type == N_INT) {
	register Int i, d;

	/* i / i */
	i = n1->l.number;
	d = n2->l.number;
	if (d == 0) {
	    /* i / 0 */
	    c_error("division by zero");
	    return n1;
	}
	if ((d | i) < 0) {
	    Int r;

            r = ((Uint) ((i < 0) ? -i : i)) / ((Uint) ((d < 0) ? -d : d));
            n1->l.number = ((i ^ d) < 0) ? -r : r;
	} else {
	    n1->l.number = ((Uint) i) / ((Uint) d);
	}
	return n1;
    } else if (n1->type == N_FLOAT && n2->type == N_FLOAT) {
	/* f / f */
	if (NFLT_ISZERO(n2)) {
	    /* f / 0.0 */
	    c_error("division by zero");
	    return n1;
	}
	NFLT_GET(n1, f1);
	NFLT_GET(n2, f2);
	flt_div(&f1, &f2);
	NFLT_PUT(n1, f1);
	return n1;
    }

    return bina(op, n1, n2, name);
}

/*
 * NAME:	mod()
 * DESCRIPTION:	handle the % %= operators
 */
static node *mod(op, n1, n2, name)
int op;
register node *n1, *n2;
char *name;
{
    if (n1->type == N_INT && n2->type == N_INT) {
	register Int i, d;

	/* i % i */
	i = n1->l.number;
	d = n2->l.number;
	if (d == 0) {
	    /* i % 0 */
	    c_error("modulus by zero");
	    return n1;
	}
	if ((d | i) < 0) {
	    Int r;

            r = ((Uint) ((i < 0) ? -i : i)) % ((Uint) ((d < 0) ? -d : d));
            n1->l.number = ((i ^ d) < 0) ? -r : r;
	} else {
	    n1->l.number = ((Uint) i) % ((Uint) d);
	}
	return n1;
    }

    return bini(op, n1, n2, name);
}

/*
 * NAME:	add()
 * DESCRIPTION:	handle the + += operators, possibly rearranging the order
 *		of the expression
 */
static node *add(op, n1, n2, name)
int op;
register node *n1, *n2;
char *name;
{
    xfloat f1, f2;
    register unsigned short type;

    t_void(n1);
    t_void(n2);

    if (n1->mod == T_STRING) {
	if (n2->mod == T_INT || n2->mod == T_FLOAT ||
	    (n2->mod == T_MIXED && typechecking)) {
	    n2 = cast(n2, T_STRING);
	}
    } else if (n2->mod == T_STRING && op == N_ADD) {
	if (n1->mod == T_INT || n1->mod == T_FLOAT ||
	    (n1->mod == T_MIXED && typechecking)) {
	    n1 = cast(n1, T_STRING);
	}
    }

    if (n1->type == N_INT && n2->type == N_INT) {
	/* i + i */
	n1->l.number += n2->l.number;
	return n1;
    }
    if (n1->type == N_FLOAT && n2->type == N_FLOAT) {
	/* f + f */
	NFLT_GET(n1, f1);
	NFLT_GET(n2, f2);
	flt_add(&f1, &f2);
	NFLT_PUT(n1, f1);
	return n1;
    }
    if (n1->type == N_STR && n2->type == N_STR) {
	/* s + s */
	return node_str(str_add(n1->l.string, n2->l.string));
    }

    type = c_tmatch(n1->mod, n2->mod);
    if (type == T_OBJECT || type == T_INVALID) {
	type = T_MIXED;
	if (typechecking) {
	    c_error("bad argument types for %s (%s, %s)", name,
		    i_typename(n1->mod), i_typename(n2->mod));
	}
    } else if (type == T_INT) {
	op++;
    } else if (op == N_ADD_EQ) {
	if (n1->mod == T_INT) {
	    n2 = node_mon(N_CAST, T_INT, n2);
	    type = T_INT;
	    op++;
	} else if (n1->mod == T_FLOAT && n2->mod != T_FLOAT) {
	    n2 = node_mon(N_CAST, T_FLOAT, n2);
	    type = T_FLOAT;
	}
    }
    return node_bin(op, type, n1, n2);
}

/*
 * NAME:	sub()
 * DESCRIPTION:	handle the - -= operators
 */
static node *sub(op, n1, n2, name)
int op;
register node *n1, *n2;
char *name;
{
    xfloat f1, f2;
    register unsigned short type;

    t_void(n1);
    t_void(n2);

    if (n1->type == N_INT && n2->type == N_INT) {
	/* i - i */
	n1->l.number -= n2->l.number;
	return n1;
    }
    if (n1->type == N_FLOAT && n2->type == N_FLOAT) {
	/* f - f */
	NFLT_GET(n1, f1);
	NFLT_GET(n2, f2);
	flt_sub(&f1, &f2);
	NFLT_PUT(n1, f1);
	return n1;
    }

    type = c_tmatch(n1->mod, n2->mod);
    if (type == T_STRING || type == T_OBJECT || type == T_MAPPING ||
	type == T_INVALID) {
	if ((type=n1->mod) != T_MAPPING ||
	    (n2->mod != T_MIXED && (n2->mod & T_REF) == 0)) {
	    type = T_MIXED;
	    if (typechecking) {
		c_error("bad argument types for %s (%s, %s)", name,
			i_typename(n1->mod), i_typename(n2->mod));
	    }
	}
    } else if (type == T_INT) {
	op++;
    } else if (type == T_MIXED) {
	type = (n1->mod == T_MIXED) ? n2->mod : n1->mod;
    }
    return node_bin(op, type, n1, n2);
}

/*
 * NAME:	umin()
 * DESCRIPTION:	handle unary minus
 */
static node *umin(n)
register node *n;
{
    xfloat flt;

    if (t_unary(n, "unary -")) {
	if (n->mod == T_FLOAT) {
	    FLT_ZERO(flt.high, flt.low);
	    n = sub(N_SUB, node_float(&flt), n, "-");
	} else {
	    n = sub(N_SUB, node_int((Int) 0), n, "-");
	}
    }
    return n;
}

/*
 * NAME:	lshift()
 * DESCRIPTION:	handle the << <<= operators
 */
static node *lshift(op, n1, n2, name)
int op;
register node *n1, *n2;
char *name;
{
    if (n1->type == N_INT && n2->type == N_INT) {
	/* i << i */
	n1->l.number = (Uint) n1->l.number << n2->l.number;
	return n1;
    }

    return bini(op, n1, n2, name);
}

/*
 * NAME:	rshift()
 * DESCRIPTION:	handle the >> >>= operators
 */
static node *rshift(op, n1, n2, name)
int op;
register node *n1, *n2;
char *name;
{
    if (n1->type == N_INT && n2->type == N_INT) {
	/* i >> i */
	n1->l.number = (Uint) n1->l.number >> n2->l.number;
	return n1;
    }

    return bini(op, n1, n2, name);
}

/*
 * NAME:	rel()
 * DESCRIPTION:	handle the < > <= >= operators
 */
static node *rel(op, n1, n2, name)
int op;
register node *n1, *n2;
char *name;
{
    t_void(n1);
    t_void(n2);

    if (n1->type == N_INT && n2->type == N_INT) {
	/* i . i */
	switch (op) {
	case N_GE:
	    n1->l.number = (n1->l.number >= n2->l.number);
	    break;

	case N_GT:
	    n1->l.number = (n1->l.number > n2->l.number);
	    break;

	case N_LE:
	    n1->l.number = (n1->l.number <= n2->l.number);
	    break;

	case N_LT:
	    n1->l.number = (n1->l.number < n2->l.number);
	    break;
	}
	return n1;
    }
    if (n1->type == N_FLOAT && n2->type == N_FLOAT) {
	xfloat f1, f2;

	/* f . f */
	NFLT_GET(n1, f1);
	NFLT_GET(n2, f2);

	switch (op) {
	case N_GE:
	    return node_int((Int) (flt_cmp(&f1, &f2) >= 0));

	case N_GT:
	    return node_int((Int) (flt_cmp(&f1, &f2) > 0));

	case N_LE:
	    return node_int((Int) (flt_cmp(&f1, &f2) <= 0));

	case N_LT:
	    return node_int((Int) (flt_cmp(&f1, &f2) < 0));
	}
	return n1;
    }
    if (n1->type == N_STR && n2->type == N_STR) {
	/* s . s */
	switch (op) {
	case N_GE:
	    return node_int((Int) (str_cmp(n1->l.string, n2->l.string) >= 0));

	case N_GT:
	    return node_int((Int) (str_cmp(n1->l.string, n2->l.string) > 0));

	case N_LE:
	    return node_int((Int) (str_cmp(n1->l.string, n2->l.string) <= 0));

	case N_LT:
	    return node_int((Int) (str_cmp(n1->l.string, n2->l.string) < 0));
	}
    }

    if (typechecking &&
	((n1->mod != n2->mod && n1->mod != T_MIXED && n2->mod != T_MIXED) ||
	 (!T_ARITHSTR(n1->mod) && n1->mod != T_MIXED) ||
	 (!T_ARITHSTR(n2->mod) && n2->mod != T_MIXED))) {
	c_error("bad argument types for %s (%s, %s)", name,
		i_typename(n1->mod), i_typename(n2->mod));
    } else if (n1->mod == T_INT && n2->mod == T_INT) {
	op++;
    }
    return node_bin(op, T_INT, n1, n2);
}

/*
 * NAME:	eq()
 * DESCRIPTION:	handle the == operator
 */
static node *eq(n1, n2)
register node *n1, *n2;
{
    xfloat f1, f2;
    int op;

    t_void(n1);
    t_void(n2);

    switch (n1->type) {
    case N_INT:
	if (n2->type == N_INT) {
	    /* i == i */
	    n1->l.number = (n1->l.number == n2->l.number);
	    return n1;
	}
	if (n1->l.number == 0) {
	    if (n2->type == N_FLOAT && NFLT_ISZERO(n2)) {
		/* 0 == 0.0 */
		n1->l.number = TRUE;
		return n1;
	    }
	    if (n2->type == N_STR) {
		/* 0 == s */
		return n1;	/* FALSE */
	    }
	}
	break;

    case N_FLOAT:
	if (n2->type == N_FLOAT) {
	    /* f == f */
	    NFLT_GET(n1, f1);
	    NFLT_GET(n2, f2);
	    return node_int((Int) (flt_cmp(&f1, &f2) == 0));
	}
	if (NFLT_ISZERO(n1) && n2->type == N_INT && n2->l.number == 0) {
	    /* 0.0 == 0 */
	    n2->l.number = TRUE;
	    return n2;
	}
	break;

    case N_STR:
	if (n2->type == N_STR) {
	    /* s == s */
	    return node_int((Int) (str_cmp(n1->l.string, n2->l.string) == 0));
	}
	if (n2->type == N_INT && n2->l.number == 0) {
	    /* s == 0 */
	    return n2;	/* FALSE */
	}
	break;
    }

    op = N_EQ;
    if (n1->mod != n2->mod && n1->mod != T_MIXED && n2->mod != T_MIXED &&
	(!c_zero(n1) || n2->mod == T_FLOAT) &&
	(!c_zero(n2) || n1->mod == T_FLOAT)) {
	if (typechecking) {
	    c_error("incompatible types for equality (%s, %s)",
		    i_typename(n1->mod), i_typename(n2->mod));
	}
    } else if (n1->mod == T_INT && n2->mod == T_INT) {
	op++;
    }
    return node_bin(op, T_INT, n1, n2);
}

/*
 * NAME:	and()
 * DESCRIPTION:	handle the & &= operators
 */
static node *and(op, n1, n2, name)
int op;
register node *n1, *n2;
char *name;
{
    register unsigned short type;

    if (n1->type == N_INT && n2->type == N_INT) {
	/* i & i */
	n1->l.number &= n2->l.number;
	return n1;
    }
    if ((((type=n1->mod) == T_MIXED || type == T_MAPPING) &&
	 ((n2->mod & T_REF) != 0 || n2->mod == T_MIXED)) ||
	((type=c_tmatch(n1->mod, n2->mod)) & T_REF) != 0) {
	/*
	 * possibly array & array or mapping & array
	 */
	return node_bin(op, type, n1, n2);
    }
    return bini(op, n1, n2, name);
}

/*
 * NAME:	xor()
 * DESCRIPTION:	handle the ^ ^= operators
 */
static node *xor(op, n1, n2, name)
int op;
register node *n1, *n2;
char *name;
{
    register unsigned short type;

    if (n1->type == N_INT && n2->type == N_INT) {
	/* i ^ i */
	n1->l.number ^= n2->l.number;
	return n1;
    }
    if (((type=n1->mod) == T_MIXED && n2->mod == T_MIXED) ||
	((type=c_tmatch(n1->mod, n2->mod)) & T_REF) != 0) {
	/*
	 * possibly array ^ array
	 */
	return node_bin(op, type, n1, n2);
    }
    return bini(op, n1, n2, name);
}

/*
 * NAME:	or()
 * DESCRIPTION:	handle the | |= operators
 */
static node *or(op, n1, n2, name)
int op;
register node *n1, *n2;
char *name;
{
    register unsigned short type;

    if (n1->type == N_INT && n2->type == N_INT) {
	/* i | i */
	n1->l.number |= n2->l.number;
	return n1;
    }
    if (((type=n1->mod) == T_MIXED && n2->mod == T_MIXED) ||
	((type=c_tmatch(n1->mod, n2->mod)) & T_REF) != 0) {
	/*
	 * possibly array | array
	 */
	return node_bin(op, type, n1, n2);
    }
    return bini(op, n1, n2, name);
}

/*
 * NAME:	land()
 * DESCRIPTION:	handle the && operator
 */
static node *land(n1, n2)
register node *n1, *n2;
{
    t_void(n1);
    t_void(n2);

    if ((n1->flags & F_CONST) && (n2->flags & F_CONST)) {
	n1 = c_tst(n1);
	n2 = c_tst(n2);
	n1->l.number &= n2->l.number;
	return n1;
    }

    return node_bin(N_LAND, T_INT, n1, n2);
}

/*
 * NAME:	lor()
 * DESCRIPTION:	handle the || operator
 */
static node *lor(n1, n2)
register node *n1, *n2;
{
    t_void(n1);
    t_void(n2);

    if ((n1->flags & F_CONST) && (n2->flags & F_CONST)) {
	n1 = c_tst(n1);
	n2 = c_tst(n2);
	n1->l.number |= n2->l.number;
	return n1;
    }

    return node_bin(N_LOR, T_INT, n1, n2);
}

/*
 * NAME:	quest()
 * DESCRIPTION:	handle the ? : operator
 */
static node *quest(n1, n2, n3)
register node *n1, *n2, *n3;
{
    register unsigned short type;

    t_void(n1);

    if ((n2->flags & F_CONST) && n3->type == n2->type) {
	switch (n1->type) {
	case N_INT:
	    return (n1->l.number == 0) ? n3 : n2;

	case N_FLOAT:
	    return (NFLT_ISZERO(n1)) ? n3 : n2;

	case N_STR:
	    return n2;
	}
    }

    type = T_MIXED;
    if (c_zero(n2) && n3->mod != T_FLOAT) {
	/*
	 * expr ? 0 : expr
	 */
	type = n3->mod;
    } else if (c_zero(n3) && n2->mod != T_FLOAT) {
	/*
	 * expr ? expr : 0;
	 */
	type = n2->mod;
    } else if (typechecking) {
	/*
	 * typechecked
	 */
	if (n2->mod == T_VOID || n3->mod == T_VOID) {
	    /* result can never be used */
	    type = T_VOID;
	} else {
	    type = c_tmatch(n2->mod, n3->mod);
	    if (type == T_INVALID) {
		/* no typechecking here, just let the result be mixed */
		type = T_MIXED;
	    }
	}
    }

    return node_bin(N_QUEST, type, n1, node_bin(N_PAIR, 0, n2, n3));
}

/*
 * NAME:	assign()
 * DESCRIPTION:	handle the assignment operator
 */
static node *assign(n1, n2)
register node *n1, *n2;
{
    if (typechecking && (!c_zero(n2) || n1->mod == T_FLOAT)) {
	/*
	 * typechecked
	 */
	if (c_tmatch(n1->mod, n2->mod) == T_INVALID) {
	    c_error("incompatible types for = (%s, %s)",
		    i_typename(n1->mod), i_typename(n2->mod));
	} else if (n1->mod != T_MIXED && n2->mod == T_MIXED) {
	    n2 = node_mon(N_CAST, n1->mod, n2);
	}
    }

    return node_bin(N_ASSIGN, n1->mod, n1, n2);
}

/*
 * NAME:	comma()
 * DESCRIPTION:	handle the comma operator, rearranging the order of the
 *		expression if needed
 */
static node *comma(n1, n2)
register node *n1, *n2;
{
    if (n2->type == N_COMMA) {
	/* a, (b, c) --> (a, b), c */
	n2->l.left = comma(n1, n2->l.left);
	return n2;
    } else {
	return node_bin(N_COMMA, n2->mod, n1, n2);
    }
}