%{
/* This file is part of Eclat.
Copyright (C) 2012-2018 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 . */
#include "libeclat.h"
#include
#include
#include "forlangrm.h"
#include "forlan.h"
#include
int yylex();
static int yyerror(char const *);
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 IDENT
%token LAST IF ELSE LET FOR IN BREAK CONTINUE STOP
%left OR
%left AND
%nonassoc EQ NE
%left NOT
%type stmt stmt_cond stmt_expr stmt_blk cond bool node funcall arg rval
%type stmt_let stmt_for stmt_ctrl stmt_asgn
%type stmtlist arglist
%type string
%type complist
%type 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 const *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;
}