%{
/* This file is part of Eclat.
   Copyright (C) 2012, 2013 Sergey Poznyakoff.
 
   Eclat is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 3, or (at your option)
   any later version.
 
   Eclat is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.
 
   You should have received a copy of the GNU General Public License
   along with Eclat.  If not, see <http://www.gnu.org/licenses/>. */

#include "libeclat.h"
#include <grecs.h>
#include <grecs-locus.h>
#include "forlangrm.h"
#include "forlan.h"
#include <string.h>

int yylex();	
static int yyerror(char *);
union forlan_node *forlan_parse_tree;
size_t forlan_variable_count;
static struct grecs_symtab *forlan_symtab;

static size_t find_variable(const char *name);
static union forlan_node *create_comp_node(union forlan_node *root,
					   struct grecs_list *arglist,
					   int wildcards);

struct path_component {
	char *id;
	char *label;
};

%}
%error-verbose
%locations

%union {
	char *string;
	union forlan_node *node;
	struct grecs_list *list;
	struct {
		struct path_component *comp;
		int wildcard;
	} comp;
	struct {
		int wildcards;
		struct grecs_list *list;
	} complist;
};

%token <string> STRING IDENT
%token LAST IF ELSE LET FOR IN BREAK CONTINUE STOP

%left OR
%left AND
%nonassoc EQ NE
%left NOT

%type <node> stmt stmt_cond stmt_expr stmt_blk cond bool node funcall arg rval
%type <node> stmt_let stmt_for stmt_ctrl stmt_asgn
%type <list> stmtlist arglist
%type <string> string
%type <complist> complist
%type <comp> comp

%%
input     : stmtlist
            {
		    forlan_parse_tree = forlan_stmt_from_list($1);
	    }
          ;

stmtlist  : stmt
            {
		    $$ = forlan_stmt_list();
		    grecs_list_append($$, $1);
	    }
          | stmtlist stmt
	    {
		    grecs_list_append($1, $2);
		    $$ = $1;
	    }
          ;

stmt      : stmt_cond
          | stmt_expr
          | stmt_blk
          | stmt_let
          | stmt_asgn
          | stmt_for
          | stmt_ctrl
          ;

stmt_blk  : '{' stmtlist '}'
            {
		    $$ = forlan_stmt_from_list($2);
	    }
          ;

stmt_cond : IF cond stmt
            {
		    $$ = forlan_node_create(forlan_type_cond);
		    $$->cond.expr = $2;
		    $$->cond.iftrue = $3;
		    $$->cond.iffalse = NULL;
	    }
          | IF cond stmt ELSE stmt
            {
		    $$ = forlan_node_create(forlan_type_cond);
		    $$->cond.expr = $2;
		    $$->cond.iftrue = $3;
		    $$->cond.iffalse = $5;
	    }
          ;

cond      : bool
          ;

bool      : node
            {
		    $$ = forlan_node_create(forlan_type_expr);
		    $$->expr.opcode = forlan_opcode_node;
		    $$->expr.arg[0] = $1;
	    }
          | bool AND bool
            {
		    $$ = forlan_node_create(forlan_type_expr);
		    $$->expr.opcode = forlan_opcode_and;
		    $$->expr.arg[0] = $1;
		    $$->expr.arg[1] = $3;
	    }
          | bool OR bool
            {
		    $$ = forlan_node_create(forlan_type_expr);
		    $$->expr.opcode = forlan_opcode_or;
		    $$->expr.arg[0] = $1;
		    $$->expr.arg[1] = $3;
	    }
          | NOT bool
            {
		    $$ = forlan_node_create(forlan_type_expr);
		    $$->expr.opcode = forlan_opcode_not;
		    $$->expr.arg[0] = $2;
	    }
          | node EQ node
            {
		    $$ = forlan_node_create(forlan_type_expr);
		    $$->expr.opcode = forlan_opcode_eq;
		    $$->expr.arg[0] = $1;
		    $$->expr.arg[1] = $3;
	    }
          | node NE node
            {
		    $$ = forlan_node_create(forlan_type_expr);
		    $$->expr.opcode = forlan_opcode_ne;
		    $$->expr.arg[0] = $1;
		    $$->expr.arg[1] = $3;
	    }
          | '(' bool ')'
            {
		    $$ = $2;
	    }
          ;

node      : rval
          | rval '.' complist
            {
		    $$ = create_comp_node($1, $3.list, $3.wildcards);
            }
          | '.' complist
            {
		    $$ = create_comp_node(NULL, $2.list, $2.wildcards);
	    }
          | '.'
            {
		    $$ = forlan_node_create(forlan_type_comp);
	    }
          ;

complist  : comp
            {
		    $$.list = grecs_list_create();
		    grecs_list_append($$.list, $1.comp);
		    $$.wildcards = $1.wildcard;
	    }
          | complist '.' comp
	    {
		    grecs_list_append($1.list, $3.comp);
		    $$ = $1;
		    $$.wildcards |= $3.wildcard;
	    }
          ;

comp      : IDENT
            {
		    $$.comp = grecs_zalloc(sizeof(*$$.comp));
		    $$.comp->id = $1;
		    $$.wildcard = 0;
	    }
          | IDENT '[' string ']'
            {
		    $$.comp = grecs_zalloc(sizeof(*$$.comp));
		    $$.comp->id = $1;
		    $$.comp->label = $3;
		    $$.wildcard = 0;
	    }
          | '%'
	    {
		    $$.comp = grecs_zalloc(sizeof(*$$.comp));
		    $$.comp->id = grecs_strdup("%");
		    $$.wildcard = 1;
	    }
	  | '*'
	    {
		    $$.comp = grecs_zalloc(sizeof(*$$.comp));
		    $$.comp->id = grecs_strdup("*");
		    $$.wildcard = 1;
	    }
          ;

string    : IDENT
          | STRING
          ;

funcall   : IDENT '(' ')'
            {
		    struct forlan_function *fp =
			    forlan_find_function($1);
		    if (!fp) {
			    grecs_error(&@1, 0,
					"call to unknown function \"%s\"",
					$1);
			    YYERROR;
		    }

		    if (fp->minargs != 0) {
			    grecs_error(&@1, 0,
					"not enough arguments in call to \"%s\"",
					$1);
			    YYERROR;
		    }
		    
		    $$ = forlan_node_create(forlan_type_func);
		    $$->func.fp = fp;
		    $$->func.args = NULL;
	    }
          | IDENT '(' arglist ')'
            {
		    struct forlan_function *fp =
			    forlan_find_function($1);
		    if (!fp) {
			    grecs_error(&@1, 0,
					"call to unknown function \"%s\"",
					$1);
			    YYERROR;
		    }

		    if ($3->count < fp->minargs) {
			    grecs_error(&@1, 0,
					"not enough arguments in call to \"%s\"",
					$1);
			    YYERROR;
		    }
		    if (fp->maxargs >= 0 && $3->count > fp->maxargs) {
			    grecs_error(&@1, 0,
					"too many arguments in call to \"%s\"",
					$1);
			    YYERROR;
		    }

		    /* FIXME: Check data types */
		    
		    $$ = forlan_node_create(forlan_type_func);
		    $$->func.fp = fp;
		    $$->func.args = $3;
	    }
          ;

rval      : funcall
          | LAST
            {
		    $$ = forlan_node_create(forlan_type_last);
	    }
          | STRING
            {
		    $$ = forlan_node_create(forlan_type_lit);
		    $$->lit.string = $1;
	    }
          | IDENT
            {
		    $$ = forlan_node_create(forlan_type_var);
		    $$->var.idx = find_variable($1);
//		    free($1);
	    }
          ;

arglist   : arg
            {
		    $$ = forlan_stmt_list();
		    grecs_list_append($$, $1);
	    }
          | arglist ',' arg
	    {
		    grecs_list_append($1, $3);
		    $$ = $1;
	    }
          ;

arg       : node
          ;

stmt_expr : funcall ';'
          ;

stmt_let  : LET IDENT ';'
            {
		    find_variable($2);
	    }
          | LET IDENT '=' node ';'
            {
		    $$ = forlan_node_create(forlan_type_asgn);
		    $$->asgn.idx = find_variable($2);
		    $$->asgn.node = $4;
	    }
          | LET IDENT '=' funcall ';'
            {
		    $$ = forlan_node_create(forlan_type_asgn);
		    $$->asgn.idx = find_variable($2);
		    $$->asgn.node = $4;
	    }
          ;

stmt_for  : FOR '(' IDENT IN node ')' stmt
            {
		    $$ = forlan_node_create(forlan_type_loop);
		    $$->loop.idx = find_variable($3);
		    $$->loop.node = $5;
		    $$->loop.stmt = $7;
	    }
          ;


stmt_ctrl : BREAK ';'
            {
		    $$ = forlan_node_create(forlan_type_break);
	    }
          | CONTINUE ';'
            {
		    $$ = forlan_node_create(forlan_type_continue);
	    }
          | STOP ';' 
            {
		    $$ = forlan_node_create(forlan_type_stop);
	    }
          ;

stmt_asgn : IDENT '=' node ';'
            {
		    $$ = forlan_node_create(forlan_type_asgn);
		    $$->asgn.idx = find_variable($1);
		    $$->asgn.node = $3;
	    }		    
          ;
%%
static int
yyerror(char *s)
{
	grecs_error(&yylloc, 0, "%s", s);
	return 0;
}
	
int
forlan_parser()
{
	yydebug = debug_level(forlan_dbg) >= FORLAN_DBG_GRAM;
	return yyparse();
}

forlan_eval_env_t
forlan_parse_buffer(const char *input, size_t length,
		    struct grecs_locus_point *pt)
{
	int rc;
	forlan_eval_env_t env = NULL;
	
	forlan_lex_from_buffer(input, length, pt);
	rc = forlan_parser();
	forlan_lex_end();
	grecs_symtab_free(forlan_symtab);
	forlan_symtab = NULL;

	if (rc == 0)
		env = forlan_create_environment(forlan_parse_tree,
						forlan_variable_count);

	return env;
}

forlan_eval_env_t
forlan_parse_file(FILE *fp, struct grecs_locus_point *pt)
{
	int rc;
	forlan_eval_env_t env = NULL;
	
	forlan_lex_from_file(fp, pt);
	rc = forlan_parser();
	forlan_lex_end();
	grecs_symtab_free(forlan_symtab);
	forlan_symtab = NULL;

	if (rc == 0)
		env = forlan_create_environment(forlan_parse_tree,
						forlan_variable_count);

	return env;
}

static size_t
find_variable(const char *name)
{
	struct forlan_variable key;
	struct forlan_variable *ent;
	int install = 1;

	if (!forlan_symtab) {
		forlan_symtab = grecs_symtab_create_default(
			              sizeof(struct forlan_variable));
		if (!forlan_symtab)
			grecs_alloc_die();
		forlan_variable_count = 0;
	}
  
	key.name = (char*) name;
	ent = grecs_symtab_lookup_or_install(forlan_symtab, &key, &install);
	if (!ent)
		grecs_alloc_die();
	if (install)
		ent->idx = forlan_variable_count++;
	return ent->idx;
}

/* Optimize the content of "comp" node.
   
   The grecs_match_buf_create function compresses contiguous occurrences
   of the "*" wildcard into a single one, shifting the rest of elements in
   argv and labelv into the freed slots.  This can result in changing the
   number of arguments.  We create a buffer to let it do its job and update
   the argc stored in the node, so that subsequent calls to
   grecs_match_list_create get the correct number of elements.
 */
static void
optimize_comp(union forlan_node *p)
{
	grecs_match_buf_t mb;

	mb = grecs_match_buf_create(p->comp.argc, p->comp.argv, p->comp.labelv);
	p->comp.argc = grecs_match_buf_get_args(mb, NULL);
	free(mb);
}

static union forlan_node *
create_comp_node(union forlan_node *root, struct grecs_list *arglist,
		 int wildcards)
{
	union forlan_node *ret;
	int i;
	struct grecs_list_entry *ep;
		    
	ret = forlan_node_create(forlan_type_comp);
	ret->comp.root = root;
	ret->comp.wildcards = wildcards;
	ret->comp.argc = arglist->count;
	ret->comp.argv = grecs_calloc(arglist->count,
				      sizeof(ret->comp.argv[0]));
	ret->comp.labelv = grecs_calloc(arglist->count,
					sizeof(ret->comp.labelv[0]));
	for (i = 0, ep = arglist->head; ep; i++, ep = ep->next) {
		struct path_component *comp = ep->data;
		struct grecs_value *val;

		ret->comp.argv[i] = comp->id;
		if (comp->label) {
			val = grecs_malloc(sizeof(*val));
			val->type = GRECS_TYPE_STRING;
			val->v.string = comp->label;
		} else
			val = NULL;
		ret->comp.labelv[i] = val;
	}
	grecs_list_free(arglist);
	optimize_comp(ret);
	return ret;
}