%{
/* parser.y: the nawmrc parser */

/* Copyright (C) 1999 by the Massachusetts Institute of Technology.
 *
 * Permission to use, copy, modify, and distribute this
 * software and its documentation for any purpose and without
 * fee is hereby granted, provided that the above copyright
 * notice appear in all copies and that both that copyright
 * notice and this permission notice appear in supporting
 * documentation, and that the name of M.I.T. not be used in
 * advertising or publicity pertaining to distribution of the
 * software without specific, written prior permission.
 * M.I.T. makes no representations about the suitability of
 * this software for any purpose.  It is provided "as is"
 * without express or implied warranty.
 */

#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "nawm.h"
#include "lang.h"

node *cmds;

node *reverse(node *);
int length(node *);
node *typecheck(node *, dtype);
node *argcheck(int, void *, node *);
node *retcheck(node *);
void arraycheck(node *array);
node *typecast(node *n, dtype oldtype, dtype newtype);
void do_vardecl(dtype type, node *vars);
void start_fundecl(dtype type, char *name, node *args);
void finish_fundecl(char *name, node *body);
node *doadd(int op, node *left, node *right);
node *docomp(int op, node *left, node *right);
void parse_error(char *);

extern function STR2WIN;
extern int lineno;
dtype rettype;

#define chain(n1, n2) (n1->next=n2,n1)
#define vartype(n) (((variable*)(n->vals[0]))->type)
node *tmp;

#ifdef YYTEXT_POINTER
extern char *yytext;
#else
extern char yytext[];
#endif

#define yyerror parse_error

char *opname[] = { "+", "+", "-", "-", "*", "/", "%", "==", "!=", "<=", ">=",
		   "<", ">", "=", "&&", "||", "!", "." };

%}

%union {
  node *n;
  char *s;
  int i;
  function *f;
  variable *v;
  bindlist *b;
  dtype t;
}

%token <i> MODE INCLUDE OPTION BEGIN_ END COMMAND FUNCTION
%token <i> KEYPRESS KEYRELEASE BUTTONPRESS BUTTONRELEASE MOTION ENTER LEAVE
%token <i> IF ELSE FOR IN WHILE DO BREAK CONTINUE RETURN DEL
%token <i> ASSIGNOP ADDOP MULTOP COMPOP BOOLOP UNOP SUBSCRIPT ELEMENT
%token <i> '(' ')' '[' ']' '{' '}' ',' ';' '.'
%token <i> NUM DTYPE
%token <v> VAR
%token <f> FUN CMD
%token <s> SYM STR WIN

%type <n> commands commands1 commandlist
%type <n> syms syms1 body command forexpr exprs exprs1 expr opt_args opt_expr
%type <n> bool_expr comp_expr memb_expr add_expr mult_expr unary_expr
%type <n> primary_expr lvalue subscript_expr
%type <i> key button
%type <t> type primitivetype
%type <b> binddecl modebody
%type <s> opt_string sym

%%
nawmrc		: decls
		| commands1									{ cmds = reverse($1); }
		| error										{ die(""); }
		;

decls		: decl
		| decls decl
		;

decl		: specdecl
		| modedecl
		| vardecl
		| fundecl
		| binddecl									{ add_to_anymode($1); }
		;

specdecl	: INCLUDE STR ';'								{ load_module($2); }
		| OPTION STR ';'								{ do_option($2); }
		;

modedecl	: MODE STR { pushlexscope(0); } '{' modebody '}'				{ poplexscope(); defmode($2, $5); }
		;

modebody	:										{ $$ = NULL; }
		| modebody vardecl								{ $$ = $1; }
		| modebody binddecl								{ $$ = chain($2, $1); }
		| error										{ die("while parsing mode body."); }
		;

vardecls	:
		| vardecls vardecl
		;

vardecl		: type syms1 ';'								{ do_vardecl($1, $2); }
		;

type		: primitivetype
		| type '[' primitivetype ']'							{ $$ = array_type($1, $3); }
		;

primitivetype	: DTYPE										{ $$ = (dtype)$1; }
		;

sym		: SYM
		| VAR										{ $$ = xstrdup(yytext); }
		| FUN										{ $$ = xstrdup(yytext); }
		| CMD										{ $$ = xstrdup(yytext); }
		;

syms1		: sym										{ $$ = mknode(0, 0, 1, $1); }
		| syms1 ',' sym									{ tmp = mknode(0, 0, 1, $3); $$ = chain(tmp, $1); }
		| error										{ die("while looking for a symbol name."); }
		;

syms		:										{ $$ = NULL; }
		| syms1										{ $$ = $1; }
		;

fundecl		: COMMAND sym syms { rettype = 0; pushlexscope(1); } '{' vardecls { start_fundecl(0, $2, $3); } commands '}'							{ finish_fundecl($2, reverse($8)); }
		| FUNCTION type { rettype = $2; } SYM '(' syms ')' { pushlexscope(1); } '{' vardecls { start_fundecl($2, $4, $6); } commands '}'				{ finish_fundecl($4, reverse($12)); }
		;

binddecl	: key STR { pushlexscope(0); } body						{ poplexscope(); $$ = mkbinding($1, $2, $4); }
		| button STR { pushlexscope(0); } body						{ poplexscope(); $$ = mkbinding($1, $2, $4); }
		| MOTION { pushlexscope(0); } body						{ poplexscope(); $$ = mkbinding(MOTION, NULL, $3); }
		| ENTER opt_string { pushlexscope(0); } body					{ poplexscope(); $$ = mkbinding(ENTER, $2, $4); }
		| LEAVE opt_string { pushlexscope(0); } body					{ poplexscope(); $$ = mkbinding(LEAVE, $2, $4); }
		| BEGIN_ { pushlexscope(0); } body						{ poplexscope(); $$ = mkbinding(BEGIN_, NULL, $3); }
		| END { pushlexscope(0); } body							{ poplexscope(); $$ = mkbinding(END, NULL, $3); }
		;

key		: KEYPRESS	{ $$ = KEYPRESS; }
		| KEYRELEASE	{ $$ = KEYRELEASE; }
		;

button		: BUTTONPRESS	{ $$ = BUTTONPRESS; }
		| BUTTONRELEASE	{ $$ = BUTTONRELEASE; }
		;

opt_string	:										{ $$ = NULL; }
		| STR										{ $$ = $1; }
		;

body		: '{' vardecls commands '}'							{ $$ = reverse($3); }
		;

commandlist	: '{' commands '}'								{ $$ = reverse($2); }
		;

commands	: 										{ $$ = NULL; }
		| commands command								{ $$ = chain($2, $1); }
		;

commands1	: command									{ $$ = $1;}
		| commands1 command								{ $$ = chain($2, $1); }
		;

command		: CMD exprs ';'									{ tmp = argcheck(CMD, $1, $2); $$ = mknode(CMD, 0, 3, $1, length(tmp), tmp); }
		| IF '(' expr ')' command							{ $$ = mknode(IF, 0, 3, typecheck($3, T_INT), $5, NULL); }
		| IF '(' expr ')' command ELSE command 						{ $$ = mknode(IF, 0, 3, typecheck($3, T_INT), $5, $7); }
		| FOR '(' forexpr ')' command							{ $$ = mknode(FOR, 0, 2, $3, $5); }
		| WHILE '(' expr ')' command							{ $$ = mknode(WHILE, 0, 2, typecheck($3, T_INT), $5); }
		| DO command WHILE '(' expr ')' ';'						{ $$ = mknode(DO, 0, 2, typecheck($5, T_INT), $2); }
		| BREAK ';'									{ $$ = mknode(BREAK, 0, 0); }
		| CONTINUE ';'									{ $$ = mknode(CONTINUE, 0, 0); }
		| RETURN opt_expr ';'								{ $$ = mknode(RETURN, 0, 1, retcheck($2)); }
		| DEL primary_expr '[' expr ']' ';'						{ $$ = mknode(DEL, 0, 2, $2, $4); }
		| commandlist									{ $$ = mknode(BODY, 0, 1, $1); }
		| expr ';'									{ $$ = $1; }
		| error ';'									{ die("while parsing commands."); }
		;

forexpr		: VAR IN expr									{ arraycheck($3); $$ = mknode(IN, 0, 2, typecheck(mknode(VAR, $1->type, 1, $1), array_basetype($3->etype)), $3); }
		| expr ';' expr ';' expr							{ $$ = mknode(FOR, 0, 3, $1, typecheck($3, T_INT), $5); }
		;

exprs		:										{ $$ = NULL; }
		| exprs1
		;

exprs1		: expr
		| exprs1 ',' expr								{ $$ = chain($3, $1); }
		| error										{ die("while parsing expression list."); }
		;

opt_expr	:										{ $$ = NULL; }
		| expr
		;

expr		: bool_expr
		| lvalue ASSIGNOP expr								{ $$ = mknode($2, $1->etype, 2, $1, typecheck($3, $1->etype)); }
		;

lvalue		: VAR										{ $$ = mknode(VAR, $1->type, 1, $1); }
		| subscript_expr '[' expr ']'							{ arraycheck($1); $$ = mknode(SUBSCRIPT, array_basetype($1->etype), 2, $1, typecheck($3, array_subtype($1->etype))); }
		;

bool_expr	: comp_expr
		| bool_expr BOOLOP comp_expr							{ $$ = mknode($2, T_INT, 2, typecheck($1, T_INT), typecheck($3, T_INT)); }
		;

comp_expr	: memb_expr
		| comp_expr COMPOP memb_expr							{ $$ = docomp($2, $1, $3); }
		;

memb_expr	: add_expr
		| memb_expr IN add_expr								{ arraycheck($3); $$ = mknode(IN, T_INT, 2, typecheck($1, array_basetype($3->etype)), $3); }
		;

add_expr	: mult_expr
		| add_expr ADDOP mult_expr							{ $$ = doadd($2, $1, $3); }
		;

mult_expr	: unary_expr
		| mult_expr MULTOP unary_expr							{ $$ = mknode($2, T_INT, 2, typecheck($1, T_INT), typecheck($3, T_INT)); }
		;

unary_expr	: subscript_expr
		| ADDOP unary_expr								{ $$ = mknode($1 + 1, T_INT, 1, typecheck($2, T_INT)); }
		| UNOP unary_expr								{ $$ = mknode($1, T_INT, 1, typecheck($2, T_INT)); }
		;

subscript_expr	: primary_expr
		| subscript_expr '[' expr ']'							{ arraycheck($1); $$ = mknode(SUBSCRIPT, array_basetype($1->etype), 2, $1, typecheck($3, array_subtype($1->etype))); }
		| subscript_expr '.' sym							{ arraycheck($1); $$ = mknode(ELEMENT, T_INT, 2, $1, $3); }
		;

primary_expr	: NUM										{ $$ = mknode(NUM, T_INT, 1, $1); }
		| STR										{ $$ = mknode(STR, T_STR, 1, $1); }
		| VAR										{ $$ = mknode(VAR, $1->type, 1, $1); }
		| FUN opt_args									{ tmp = argcheck(FUN, $1, $2); $$ = mknode(FUN, $1->type, 3, $1, length(tmp), tmp); }
		| '(' expr ')'									{ $$ = $2; }
		;

opt_args	:										{ $$ = NULL; }
		| '(' exprs ')'									{ $$ = $2; }
		;
%%
node *mknode(int type, dtype etype, int nvals, ...)
{
  va_list ap;
  int v;
  node *ans;

  ans = xmalloc(sizeof(node) + ((nvals - 1) * sizeof(void *)));

  ans->type = type;
  ans->etype = etype;
  ans->next = NULL;

  va_start(ap, nvals);
  for (v = 0; v < nvals; v++)
    ans->vals[v] = va_arg(ap, void *);
  va_end(ap);

  return ans;
}

void start_fundecl(dtype type, char *name, node *args)
{
  function *f;
  variable *v;
  dtype *vartypes;
  node *arg, *atmp;
  int narg, vtype, i;

  f = xmalloc(sizeof(function) + (getscopenumvars() - 3) * sizeof(dtype));
  f->type = type;
  f->numargs = length(args);
  f->numvars = getscopenumvars();

  vartypes = getscopevartypes();
  for (i = 0; i < f->numvars; i++)
    f->vartype[i] = vartypes[i];

  /* Check that arguments were declared correctly */
  for (arg = args, narg = f->numargs - 1; arg; arg = atmp, narg--)
    {
      if (!(v = lookup((char *)arg->vals[0], &vtype, 1)) || vtype != VAR)
	{
	  die("No declaration for argument %s in %s %s", arg->vals[0],
	      f->type ? "function" : "command", name);
	}
      else if (v->slot != narg)
	{
	  die("Variable %s declared out of order in %s %s", arg->vals[0],
	      f->type ? "function" : "command", name);
	}

      atmp = arg->next;
      free(arg->vals[0]);
      free(arg);
    }

  define(type ? FUN : CMD, name, f);
}

void finish_fundecl(char *name, node *body)
{
  int type;
  function *f = lookup(name, &type, 1);

  f->body = (void (*)())body;
  poplexscope();
  define(f->type ? FUN : CMD, name, f); /* redefine in parent scope */
  free(name);
  rettype = -1;
}

void do_vardecl(dtype type, node *vars)
{
  node *tmp;
  
  while (vars)
    {
      define(VAR, (char *)vars->vals[0], mkvar(type));
      tmp = vars->next;
      free(vars->vals[0]);
      free(vars);
      vars = tmp;
    }
}

node *doadd(int op, node *left, node *right)
{
  if (op == PLUS && left->etype == T_STR)
    {
      return mknode(CONCAT, T_STR, 2, typecheck(left, T_STR),
		    typecheck(right, T_STR));
    }
  else
    {
      return mknode(op, T_INT, 2, typecheck(left, T_INT),
		    typecheck(right, T_INT));
    }
}

node *docomp(int op, node *left, node *right)
{
  if (!is_simple_type(left->etype) || !is_simple_type(right->etype))
    die("Can't compare compound types at line %d", lineno);
  if (left->etype == right->etype)
    return mknode(op, T_INT, 3, left, right, left->etype);
  else if (left->etype == T_WIN && right->etype == T_STR)
    return mknode(op, T_INT, 3, left, typecheck(right, T_WIN), T_WIN);
  else if (left->etype == T_STR && right->etype == T_WIN)
    return mknode(op, T_INT, 3, typecheck(left, T_WIN), right, T_WIN);
  else
    die("Type mismatch: %s %s %s at line %d", typename(left->etype),
	opname[op], typename(right->etype), lineno);
  return NULL;
}

node *reverse(node *list)
{
  node *prev, *next, *cur;

  for (cur = list, prev = NULL; cur; cur = next)
    {
      next = cur->next;
      cur->next = prev;
      prev = cur;
    }

  return prev;
}

int length(node *list)
{
  int len;

  for (len = 0; list; list = list->next)
    len++;
  return len;
}

/* reverse list of args and make sure they correspond to the command's
 * argument types
 */
node *argcheck(int type, void *cmd, node *args)
{
  int n, numargs, numgot;
  dtype *argtype;
  node *ans = NULL, *tmp;

  numargs = ((function *)cmd)->numargs;
  argtype = ((function *)cmd)->vartype;

  numgot = length(args);
  if (numargs > 0)
    {
      if (numgot != numargs && (numgot != numargs - 1 || argtype[0] != T_WIN))
	{
	  die("Wrong number of arguments to %s (expected %d, got %d) "
	      "at line %d", nameof(cmd), numargs, numgot, lineno);
	}
    }
  else
    {
      if (numgot < -numargs && (numgot < -numargs - 1 || argtype[0] != T_WIN))
	{
	  die("Wrong number of arguments to %s (expected at least %d, got %d) "
	      "at line %d", nameof(cmd), -numargs, numgot, lineno);
	}
      numargs = -numargs;

      for (n = numgot; n > numargs; n--)
	{
	  tmp = args;
	  args = args->next;
	  tmp->next = ans;
	  ans = tmp;
	}
    }

  for (n = numargs; n && args; n--)
    {
      tmp = typecheck(args, argtype[n - 1]);
      args = args->next;
      tmp->next = ans;
      ans = tmp;
    }

  /* default window case */
  if (n)
    {
      tmp = mknode(VAR, T_WIN, 1, lookup("currentwindow", &n, 0));
      tmp->next = ans;
      ans = tmp;
    }

  return ans;
}


node *typecheck(node *n, dtype type)
{
  if (n->etype == type)
    return n;
  else if (n->etype == T_STR && type == T_WIN)
    return mknode(FUN, T_WIN, 3, &STR2WIN, 1, n);
  else
    die("Type mismatch: expected %s, got %s, at line %d", typename(type),
	typename(n->etype), lineno);
  return NULL;
}

node *retcheck(node *n)
{
  if (rettype == -1)
    die("Found return outside function/command body at line %d.", lineno);
  else if (n && !rettype)
    die("Found return with a value inside a command body at line %d.", lineno);
  else if (!n && rettype)
    {
      die("Found return with no value inside a function body at line %d.",
	  lineno);
    }
  else if (n->etype != rettype)
    {
      die("Type mismatch in return: expected %s, got %s, at line %d.",
	  typename(rettype), typename(n->etype), lineno);
    }
  else
    return n;
}

void arraycheck(node *array)
{
  if (!is_array_type(array->etype))
    {
      die("Type mismatch: expected array type, got %s, at line %d.",
	  typename(array->etype), lineno);
    }
}

void parse_error(char *error)
{
  fprintf(stderr, "%s at line %d, token '%s' ", error, lineno, yytext);
}