/* 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
#include
#include
#include "grecs.h"
#include "forlan.h"
struct forlan_eval_env {
union forlan_node *parse_tree;
struct forlan_value *vartab;
struct grecs_node *tree;
struct grecs_node *last;
struct grecs_node *top_node;
struct forlan_value retval;
union forlan_node *instr;
int exit_code;
jmp_buf stop_buf;
jmp_buf loop_buf;
};
int forlan_dbg = -1;
void
forlan_init()
{
forlan_dbg = debug_register("forlan");
}
union forlan_node *
forlan_node_create(enum forlan_type type)
{
union forlan_node *p = grecs_zalloc(sizeof(*p));
p->type = type;
return p;
}
static void f_dump_node(FILE *fp, union forlan_node *p, int *num, int lev);
static unsigned long
strtots(const char *input)
{
struct tm tm;
/* 2012-06-21T10:36:48.000Z */
memset(&tm, 0, sizeof(tm));
if (sscanf(input, "%d-%2d-%2dT%2d:%2d:%2d.",
&tm.tm_year, &tm.tm_mon, &tm.tm_mday,
&tm.tm_hour, &tm.tm_min, &tm.tm_sec) != 6)
die(EX_DATAERR, "invalid timestamp: %s", input);
tm.tm_year -= 1900;
tm.tm_mon--;
return mktime(&tm);
}
static void
free_value(void *p)
{
if (p) {
struct forlan_value *val = p;
switch (val->type) {
case forlan_value_void:
case forlan_value_node:
case forlan_value_boolean:
break;
case forlan_value_literal:
free(val->v.string);
break;
default:
abort();
}
val->type = forlan_value_void;
}
}
static void
copy_value(struct forlan_value *dst, struct forlan_value *src)
{
*dst = *src;
if (dst->type == forlan_value_literal)
dst->v.string = grecs_strdup(dst->v.string);
}
static char *
valtypestr(enum forlan_value_type t)
{
switch (t) {
case forlan_value_void:
return "void";
case forlan_value_node:
return "node";
case forlan_value_literal:
return "string";
case forlan_value_boolean:
return "boolean";
default:
abort();
}
}
static int
value_boolean(struct forlan_value *val)
{
int res;
switch (val->type) {
case forlan_value_void:
err("controlling expression returned void, aborting");
abort();
case forlan_value_node:
res = val->v.node != NULL;
break;
case forlan_value_literal:
res = val->v.string != NULL && val->v.string[0] != 0;
break;
case forlan_value_boolean:
res = val->v.num;
break;
default:
abort();
}
return res;
}
int
retval_boolean(forlan_eval_env_t env)
{
return value_boolean(&env->retval);
}
static void
coerce_value(forlan_eval_env_t env, struct forlan_value *val,
enum forlan_value_type t)
{
struct grecs_node *node;
if (t == val->type)
return;
if (t == forlan_value_void) {
free_value(val);
val->type = forlan_value_void;
return;
}
if (val->type == forlan_value_void) {
err("can't coerce %s to %s",
valtypestr(val->type),
valtypestr(t));
abort();
}
if (t == forlan_value_boolean) {
int res = value_boolean(val);
free_value(val);
val->type = forlan_value_boolean;
val->v.num = res;
return;
}
/* Convert between string and node */
switch (val->type) {
case forlan_value_literal:
node = grecs_find_node(env->tree, val->v.string);
free(val->v.string);
val->v.node = node;
break;
case forlan_value_node:
if (!val->v.node)
val->v.string = NULL;
else if (val->v.node->type == grecs_node_stmt) {
struct grecs_txtacc *acc = grecs_txtacc_create();
grecs_txtacc_format_value(val->v.node->v.value,
0, acc);
grecs_txtacc_grow_char(acc, 0);
val->v.string = grecs_txtacc_finish(acc, 1);
grecs_txtacc_free(acc);
} else
val->v.string = grecs_strdup("");
break;
default:
abort();
}
val->type = t;
}
static void
coerce_retval(forlan_eval_env_t env, int c)
{
enum forlan_value_type t;
switch (c) {
case 's':
t = forlan_value_literal;
break;
case 'n':
t = forlan_value_node;
break;
case 'b':
t = forlan_value_boolean;
break;
case ' ':
t = forlan_value_void;
}
coerce_value(env, &env->retval, t);
}
#define T_E -1
#define T_V forlan_value_void
#define T_N forlan_value_node
#define T_S forlan_value_literal
#define T_B forlan_value_boolean
enum forlan_value_type convtab[FORLAN_NTYPES][FORLAN_NTYPES] = {
/* T_V T_N T_S T_B */
/* T_V */ { T_E, T_E, T_E, T_E },
/* T_N */ { T_E, T_S, T_S, T_B },
/* T_S */ { T_E, T_S, T_S, T_B },
/* T_B */ { T_E, T_B, T_B, T_B }
};
static int
values_equal(forlan_eval_env_t env,
struct forlan_value *a, struct forlan_value *b)
{
int res;
enum forlan_value_type t;
t = convtab[a->type][b->type];
if (t == T_E) {
err("incompatible values for comparison: %s, %s",
valtypestr(a->type),
valtypestr(b->type));
abort();
}
coerce_value(env, a, t);
coerce_value(env, b, t);
switch (t) {
case T_S:
if (!a->v.string || !b->v.string)
res = a->v.string == b->v.string;
else
res = strcmp(a->v.string, b->v.string) == 0;
break;
case T_B:
res = !!a->v.num == !!b->v.num;
break;
default:
abort();
}
return res;
}
void eval_func(forlan_eval_env_t env, union forlan_node *node);
void eval_last(forlan_eval_env_t env, union forlan_node *node);
static void
free_type_null(union forlan_node *p)
{
warn("freeing undefined forlan_node");
}
void
dump_null(FILE *fp, union forlan_node *p, int *num, int lev)
{
fprintf(fp, "[undefined node]\n");
}
void
eval_null(forlan_eval_env_t env, union forlan_node *node)
{
err("stumbled upon an undefined node, aborting");
abort();
}
static void
free_type_comp(union forlan_node *p)
{
int i;
for (i = 0; i < p->comp.argc; i++) {
free(p->comp.argv[i]);
if (p->comp.labelv[i]) {
free_value(p->comp.labelv[i]);
free(p->comp.labelv[i]);
}
}
free(p->comp.argv);
free(p->comp.labelv);
}
void
dump_comp(FILE *fp, union forlan_node *p, int *num, int lev)
{
int i;
fprintf(fp, "COMP");
if (p->comp.root) {
fprintf(fp, "\n");
fprintf(fp, "%04d: %*.*sROOT\n", ++*num, lev, lev, "");
forlan_dump_node(fp, p->comp.root, num, lev + 1);
fprintf(fp, "%04d: %*.*sCOMP: ", ++*num, lev, lev, "");
}
for (i = 0; i < p->comp.argc; i++) {
fprintf(fp, ".%s", p->comp.argv[i]);
if (p->comp.labelv[i]) {
fprintf(fp, "[%s]", p->comp.labelv[i]->v.string);
}
}
fputc('\n', fp);
}
grecs_match_buf_t
eval_comp0(forlan_eval_env_t env, union forlan_node *p)
{
struct grecs_node *root;
grecs_match_buf_t mb = NULL;
if (p->comp.root) {
forlan_eval(env, p->comp.root);
if (!retval_boolean(env))
return NULL;
coerce_retval(env, 'n');
root = env->retval.v.node;
} else
root = env->tree;
if (p->comp.argc) {
mb = grecs_match_buf_create(p->comp.argc, p->comp.argv,
p->comp.labelv);
if (p->comp.wildcards) {
root = grecs_match_buf_first(mb, root);
} else {
grecs_match_buf_set_root(mb, root);
if (root->type != grecs_node_root)
root = root->down;
grecs_tree_recurse(root, grecs_node_exact_match, mb);
root = grecs_match_buf_get_node(mb);
}
}
env->retval.type = forlan_value_node;
env->last = env->retval.v.node = root;
return mb;
}
void
eval_comp(forlan_eval_env_t env, union forlan_node *p)
{
free(eval_comp0(env, p));
}
static void
free_type_test(union forlan_node *p)
{
free(p->test.comp);
free(p->test.value);
}
void
dump_test(FILE *fp, union forlan_node *p, int *num, int lev)
{
fprintf(fp, "TEST: %s[%s]\n", p->test.comp, p->test.value);
}
void
eval_test(forlan_eval_env_t env, union forlan_node *node)
{
err("stumbled upon a lone test node, aborting");
abort();
}
static void
free_type_func(union forlan_node *p)
{
grecs_list_free(p->func.args);
}
void
dump_func(FILE *fp, union forlan_node *p, int *num, int lev)
{
struct grecs_list_entry *ep;
fprintf(fp, "CALL: %s\n", p->func.fp->name);
if (p->func.args)
for (ep = p->func.args->head; ep; ep = ep->next)
forlan_dump_node(fp, ep->data, num, lev + 1);
}
void
eval_func(forlan_eval_env_t env, union forlan_node *node)
{
struct grecs_list *vlist;
struct grecs_list_entry *ep;
char *type;
free_value(&env->retval);
vlist = grecs_list_create();
vlist->free_entry = free_value;
type = node->func.fp->argtypes;
for (ep = node->func.args->head; ep; ep = ep->next) {
struct forlan_value *val;
forlan_eval(env, ep->data);
if (*type)
coerce_retval(env, *type++);
val = grecs_malloc(sizeof(*val));
copy_value(val, &env->retval);
grecs_list_append(vlist, val);
}
node->func.fp->func(env, vlist);
grecs_list_free(vlist);
env->retval.type = node->func.fp->rettype;
if (env->retval.type == forlan_value_node)
env->last = env->retval.v.node;
}
static void
free_type_cond(union forlan_node *p)
{
forlan_node_free((union forlan_node *)p->cond.expr);
forlan_node_free(p->cond.iftrue);
forlan_node_free(p->cond.iffalse);
}
void
dump_cond(FILE *fp, union forlan_node *p, int *num, int lev)
{
int n = *num;
fprintf(fp, "COND\n");
forlan_dump_node(fp, p->cond.expr, num, lev + 1);
fprintf(fp, "%04d: %*.*sIFTRUE %04d\n", ++*num, lev, lev, "", n);
forlan_dump_node(fp, p->cond.iftrue, num, lev + 1);
fprintf(fp, "%04d: %*.*sIFFALSE %04d\n", ++*num, lev, lev, "", n);
forlan_dump_node(fp, p->cond.iffalse, num, lev + 1);
}
void
eval_cond(forlan_eval_env_t env, union forlan_node *node)
{
forlan_eval(env, node->cond.expr);
if (retval_boolean(env))
forlan_eval(env, node->cond.iftrue);
else if (node->cond.iffalse)
forlan_eval(env, node->cond.iffalse);
}
static void
free_type_stmt(union forlan_node *p)
{
forlan_node_free(p->stmt.stmt);
forlan_node_free(p->stmt.next);
}
void
dump_stmt(FILE *fp, union forlan_node *p, int *num, int lev)
{
f_dump_node(fp, p->stmt.stmt, num, lev);
forlan_dump_node(fp, p->stmt.next, num, lev);
}
void
eval_stmt(forlan_eval_env_t env, union forlan_node *node)
{
while (node && node->type == forlan_type_stmt) {
forlan_eval(env, node->stmt.stmt);
node = node->stmt.next;
}
if (node)
forlan_eval(env, node);
}
static void
free_type_lit(union forlan_node *p)
{
free(p->lit.string);
}
void
dump_lit(FILE *fp, union forlan_node *p, int *num, int lev)
{
fprintf(fp, "LIT: \"%s\"\n", p->lit.string);
}
void
eval_lit(forlan_eval_env_t env, union forlan_node *node)
{
free_value(&env->retval);
env->retval.type = forlan_value_literal;
env->retval.v.string = grecs_strdup(node->lit.string);
}
static void
free_type_expr(union forlan_node *p)
{
forlan_node_free(p->expr.arg[0]);
forlan_node_free(p->expr.arg[1]);
}
void
dump_expr(FILE *fp, union forlan_node *p, int *num, int lev)
{
static char *opstr[] = { "NODE", "AND", "OR", "NOT", "EQ", "NE" };
fprintf(fp, "%s\n", opstr[p->expr.opcode]);
forlan_dump_node(fp, p->expr.arg[0], num, lev + 1);
if (p->expr.arg[1])
forlan_dump_node(fp, p->expr.arg[1], num, lev + 1);
}
void
eval_expr(forlan_eval_env_t env, union forlan_node *node)
{
int res;
struct forlan_value lval;
free_value(&env->retval);
switch (node->expr.opcode) {
case forlan_opcode_node:
forlan_eval(env, node->expr.arg[0]);
break;
case forlan_opcode_and:
forlan_eval(env, node->expr.arg[0]);
if (retval_boolean(env))
forlan_eval(env, node->expr.arg[1]);
break;
case forlan_opcode_or:
forlan_eval(env, node->expr.arg[0]);
if (!retval_boolean(env))
forlan_eval(env, node->expr.arg[1]);
break;
case forlan_opcode_not:
forlan_eval(env, node->expr.arg[0]);
res = retval_boolean(env);
free_value(&env->retval);
env->retval.type = forlan_value_boolean;
env->retval.v.num = !res;
break;
case forlan_opcode_eq:
case forlan_opcode_ne:
forlan_eval(env, node->expr.arg[0]);
copy_value(&lval, &env->retval);
forlan_eval(env, node->expr.arg[1]);
res = values_equal(env, &lval, &env->retval);
free_value(&lval);
free_value(&env->retval);
env->retval.type = forlan_value_boolean;
env->retval.v.num = node->expr.opcode == forlan_opcode_eq ?
res : !res;
break;
default:
abort();
}
}
static void
free_type_last(union forlan_node *p)
{
}
void
dump_last(FILE *fp, union forlan_node *p, int *num, int lev)
{
fprintf(fp, "LAST\n");
}
void
eval_last(forlan_eval_env_t env, union forlan_node *node)
{
free_value(&env->retval);
env->retval.type = forlan_value_node;
env->retval.v.node = env->last;
}
static void
free_type_asgn(union forlan_node *p)
{
forlan_node_free(p->asgn.node);
}
void
dump_asgn(FILE *fp, union forlan_node *p, int *num, int lev)
{
fprintf(fp, "ASGN %lu\n", (unsigned long) p->asgn.idx);
forlan_dump_node(fp, p->asgn.node, num, lev + 1);
}
void
eval_asgn(forlan_eval_env_t env, union forlan_node *p)
{
forlan_eval(env, p->asgn.node);
env->vartab[p->asgn.idx] = env->retval;
}
static void
free_type_var(union forlan_node *p)
{
/* nothing */
}
void
dump_var(FILE *fp, union forlan_node *p, int *num, int lev)
{
fprintf(fp, "VAR %lu\n", (unsigned long) p->asgn.idx);
forlan_dump_node(fp, p->loop.node, num, lev + 1);
}
void
eval_var(forlan_eval_env_t env, union forlan_node *p)
{
free_value(&env->retval);
copy_value(&env->retval, &env->vartab[p->asgn.idx]);
}
static void
free_type_loop(union forlan_node *p)
{
forlan_node_free(p->loop.node);
forlan_node_free(p->loop.stmt);
}
void
dump_loop(FILE *fp, union forlan_node *p, int *num, int lev)
{
int n = *num;
fprintf(fp, "LOOP %lu\n", (unsigned long) p->loop.idx);
fprintf(fp, "%04d: %*.*sEXPR\n", ++*num, lev, lev, "");
forlan_dump_node(fp, p->loop.node, num, lev + 1);
fprintf(fp, "%04d: %*.*sSTMT %d\n", ++*num, lev, lev, "", n);
forlan_dump_node(fp, p->loop.stmt, num, lev + 1);
fprintf(fp, "%04d: %*.*sEND LOOP %d\n", ++*num, lev, lev, "", n);
}
void
eval_loop(forlan_eval_env_t env, union forlan_node *p)
{
jmp_buf save;
grecs_match_buf_t mb;
struct grecs_node *node;
mb = eval_comp0(env, p->loop.node);
memcpy(&save, &env->loop_buf, sizeof(save));
if (setjmp(env->loop_buf) < 2) {
while (retval_boolean(env)) {
copy_value(&env->vartab[p->asgn.idx], &env->retval);
forlan_eval(env, p->loop.stmt);
node = grecs_match_next(mb);
env->retval.type = forlan_value_node;
env->retval.v.node = node;
}
}
memcpy(&env->loop_buf, &save, sizeof(save));
free(mb);
}
void
dump_continue(FILE *fp, union forlan_node *p, int *num, int lev)
{
fprintf(fp, "CONTINUE\n");
}
void
eval_continue(forlan_eval_env_t env, union forlan_node *node)
{
longjmp(env->loop_buf, 1);
}
void
dump_break(FILE *fp, union forlan_node *p, int *num, int lev)
{
fprintf(fp, "BREAK\n");
}
void
eval_break(forlan_eval_env_t env, union forlan_node *node)
{
longjmp(env->loop_buf, 2);
}
void
dump_stop(FILE *fp, union forlan_node *p, int *num, int lev)
{
fprintf(fp, "STOP\n");
}
void
eval_stop(forlan_eval_env_t env, union forlan_node *node)
{
longjmp(env->stop_buf, 1);
}
struct forlan_node_method {
void (*f_free)(union forlan_node *);
void (*f_dump)(FILE *fp, union forlan_node *node, int *num, int lev);
void (*f_eval)(forlan_eval_env_t, union forlan_node *node);
};
static struct forlan_node_method f_tab[] = {
{ free_type_null, dump_null, eval_null }, /* Unknown/unset type */
{ free_type_comp, dump_comp, eval_comp }, /* A path component */
{ free_type_test, dump_test, eval_test }, /* Value test (f[X]) */
{ free_type_func, dump_func, eval_func }, /* Function call */
{ free_type_cond, dump_cond, eval_cond }, /* Conditional */
{ free_type_stmt, dump_stmt, eval_stmt }, /* Statement */
{ free_type_lit, dump_lit, eval_lit }, /* Literal */
{ free_type_expr, dump_expr, eval_expr }, /* Boolean expression */
{ free_type_last, dump_last, eval_last }, /* "last" */
{ free_type_asgn, dump_asgn, eval_asgn }, /* Variable assignment */
{ free_type_var, dump_var, eval_var }, /* Variable reference */
{ free_type_loop, dump_loop, eval_loop }, /* Loop */
{ NULL, dump_continue, eval_continue }, /* continue
statement */
{ NULL, dump_break, eval_break }, /* break
statement */
{ NULL, dump_stop, eval_stop }, /* stop
statement */
};
void
forlan_node_free(union forlan_node *p)
{
if (!p)
return;
if (p->type > sizeof(f_tab) / sizeof(f_tab[0]))
abort();
if (f_tab[p->type].f_free)
f_tab[p->type].f_free(p);
free(p);
}
static void
stmt_list_free_entry(void *p)
{
forlan_node_free(p);
}
struct grecs_list *
forlan_stmt_list()
{
struct grecs_list *lp;
lp = grecs_list_create();
lp->free_entry = stmt_list_free_entry;
return lp;
}
union forlan_node *
forlan_stmt_from_list(struct grecs_list *list)
{
union forlan_node *prev = NULL, *ret = NULL;
struct grecs_list_entry *ep;
for (ep = list->head; ep; ep = ep->next) {
union forlan_node *sp = forlan_node_create(forlan_type_stmt);
sp->stmt.stmt = ep->data;
if (prev) {
prev->stmt.next = sp;
sp->stmt.prev = prev;
} else
ret = sp;
prev = sp;
}
list->free_entry = NULL;
grecs_list_free(list);
return ret;
}
static void
f_dump_node(FILE *fp, union forlan_node *p, int *num, int lev)
{
if (p) {
if (p->type > sizeof(f_tab) / sizeof(f_tab[0]))
abort();
if (f_tab[p->type].f_dump)
f_tab[p->type].f_dump(fp, p, num, lev);
else
fprintf(fp, "type %d", p->type);
} else
fprintf(fp, "NULL");
}
void
forlan_dump_node(FILE *fp, union forlan_node *p, int *num, int lev)
{
if (!p)
return;
++*num;
fprintf(fp, "%04d: %*.*s", *num, lev, lev, "");
f_dump_node(fp, p, num, lev);
}
void
forlan_dump_tree(FILE *fp, forlan_eval_env_t env)
{
int n = 0;
forlan_dump_node(fp, env->parse_tree, &n, 0);
}
void
func_dump(forlan_eval_env_t env, struct grecs_list *list)
{
struct forlan_value *val = list->head->data;
if (val->v.node)
grecs_print_node(val->v.node, GRECS_NODE_FLAG_DEFAULT,
stdout);
fputc('\n', stdout);
}
static void
generic_print(forlan_eval_env_t env, struct grecs_list *list, FILE *fp)
{
struct grecs_list_entry *ep;
struct forlan_value *val;
for (ep = list->head; ep; ep = ep->next) {
val = ep->data;
switch (val->type) {
case forlan_value_void:
/* skip it */
break;
case forlan_value_node:
if (val->v.node)
grecs_print_node(val->v.node,
GRECS_NODE_FLAG_VALUE, fp);
break;
case forlan_value_literal:
if (val->v.string)
fwrite(val->v.string, strlen(val->v.string),
1, fp);
break;
case forlan_value_boolean:
fprintf(fp, "%d", !!val->v.num);
}
}
}
void
func_print(forlan_eval_env_t env, struct grecs_list *list)
{
generic_print(env, list, stdout);
}
void
func_error(forlan_eval_env_t env, struct grecs_list *list)
{
generic_print(env, list, stderr);
}
void
func_parent(forlan_eval_env_t env, struct grecs_list *list)
{
struct forlan_value *val = list->head->data;
if (val->v.node) {
env->retval.type = forlan_value_node;
env->retval.v.node = val->v.node->up;
}
}
/* Work over a sort of bug in GRECS: there's no way to pass user-defined
data to the comparator function */
static char *forlan_sort_key;
static int (*forlan_compar)(const char *, const char *);
static int forlan_sort_reverse;
static int
forlan_compar_string(const char *a, const char *b)
{
return strcmp(a, b);
}
static int
forlan_compar_string_ci(const char *a, const char *b)
{
return strcasecmp(a, b);
}
static int
forlan_compar_numeric(const char *a, const char *b)
{
unsigned long na, nb;
char *p;
na = strtoul(a, &p, 0);
if (*p)
return forlan_compar_string(a, b);
nb = strtoul(b, &p, 0);
if (*p)
return forlan_compar_string(a, b);
if (na < nb)
return -1;
if (na > nb)
return 1;
return 0;
}
static int
forlan_compar_timestamp(const char *a, const char *b)
{
unsigned long na = strtots(a), nb = strtots(b);
if (na < nb)
return -1;
if (na > nb)
return 1;
return 0;
}
static int
forlan_node_cmp(struct grecs_node const *a, struct grecs_node const *b)
{
int rc;
struct grecs_node const *sa, *sb;
if (!forlan_sort_key)
rc = strcmp(a->ident, b->ident);
else {
sa = grecs_find_node((struct grecs_node *)a, forlan_sort_key);
sb = grecs_find_node((struct grecs_node *)b, forlan_sort_key);
if (!sa || !sb || sa->type != grecs_node_stmt ||
sb->type != grecs_node_stmt ||
sa->v.value->type != GRECS_TYPE_STRING ||
sb->v.value->type != GRECS_TYPE_STRING)
rc = 0;
else
rc = forlan_compar(sa->v.value->v.string,
sb->v.value->v.string);
}
if (forlan_sort_reverse)
rc = -rc;
return rc;
}
static void
func_sort(forlan_eval_env_t env, struct grecs_list *list)
{
struct forlan_value *val = list->head->data;
struct forlan_value *t;
struct grecs_list_entry *ep;
if (!val->v.node)
return;
forlan_sort_key = NULL;
forlan_compar = forlan_compar_string;
forlan_sort_reverse = 0;
if ((ep = list->head->next)) {
t = ep->data;
forlan_sort_key = t->v.string;
if ((ep = ep->next)) {
char *p;
t = ep->data;
for (p = t->v.string; *p; p++) {
switch (*p) {
case 'n':
forlan_compar = forlan_compar_numeric;
break;
case 'i':
forlan_compar = forlan_compar_string_ci;
break;
case 't':
forlan_compar = forlan_compar_timestamp;
break;
case 's':
forlan_compar = forlan_compar_string;
break;
case 'r':
forlan_sort_reverse = 1;
break;
default:
/* FIXME: silently ignored */
break;
}
}
}
}
grecs_tree_sort(val->v.node, forlan_node_cmp);
}
static void
func_empty(forlan_eval_env_t env, struct grecs_list *list)
{
struct forlan_value *val = list->head->data;
env->retval.v.num = !(val->v.node && val->v.node->down);
}
static void
func_decode(forlan_eval_env_t env, struct grecs_list *list)
{
struct forlan_value *val = list->head->data;
struct grecs_txtacc *acc = grecs_txtacc_create();
char *p;
for (p = val->v.string; *p; ) {
size_t ilen, olen;
unsigned char *optr;
while (*p && isspace(*p))
p++;
if (!*p)
break;
ilen = strcspn(p, " \t\f\n");
eclat_base64_decode((unsigned char*) p, ilen, &optr, &olen);
grecs_txtacc_grow(acc, (char*)optr, olen);
free(optr);
p += ilen;
}
grecs_txtacc_grow_char(acc, 0);
env->retval.v.string = grecs_txtacc_finish(acc, 1);
grecs_txtacc_free(acc);
}
static void
func_dequote(forlan_eval_env_t env, struct grecs_list *list)
{
struct forlan_value *val = list->head->data;
char *s = val->v.string;
size_t l = strlen(s);
if (l >= 2 && s[0] == '"' && s[l-1] == '"') {
s++;
l -= 2;
}
env->retval.v.string = grecs_malloc(l + 1);
memcpy(env->retval.v.string, s, l);
env->retval.v.string[l] = 0;
}
static void
func_exit(forlan_eval_env_t env, struct grecs_list *list)
{
struct forlan_value *val = list->head->data;
unsigned long code;
char *p;
code = strtoul(val->v.string, &p, 10);
if (*p || code > 255) {
err("invalid exit code \"%s\", assuming 255",
val->v.string);
code = 255;
}
env->exit_code = code;
longjmp(env->stop_buf, 1);
}
static void
func_timestamp(forlan_eval_env_t env, struct grecs_list *list)
{
struct forlan_value *val = list->head->data;
char *buf = NULL;
size_t size = 0;
unsigned long t = strtots(val->v.string);
grecs_asprintf(&buf, &size, "%lu", (unsigned long)t);
env->retval.v.string = buf;
}
static void
func_lookup(forlan_eval_env_t env, struct grecs_list *list)
{
struct forlan_value *p;
const char *key;
char *mapname;
struct eclat_map *map;
int dir;
char *q;
p = list->head->data;
dir = eclat_map_name_split(p->v.string, &mapname, &q);
if (dir == -1)
die(EX_USAGE, "map %s: bad qualifier %s", p->v.string, q);
map = eclat_map_lookup(mapname);
free(mapname);
p = list->head->next->data;
key = p->v.string;
if (map) {
if (eclat_map_open(map) == eclat_map_ok &&
eclat_map_get(map, dir, key, &env->retval.v.string)
== eclat_map_ok)
return;
} else
err("no such map: %s", mapname);
env->retval.v.string = grecs_strdup(key);
}
static void
func_has_map(forlan_eval_env_t env, struct grecs_list *list)
{
struct forlan_value *p;
struct eclat_map *map;
p = list->head->data;
map = eclat_map_lookup(p->v.string);
env->retval.v.num = map && eclat_map_open(map) == eclat_map_ok;
}
static struct forlan_function functab[] = {
{ "dump", forlan_value_void, "n", 1, 1, func_dump },
{ "print", forlan_value_void, "", 1, -1, func_print },
{ "error", forlan_value_void, "", 1, -1, func_error },
{ "parent", forlan_value_node, "n", 1, 1, func_parent },
{ "sort", forlan_value_void, "nss", 1, 3, func_sort },
{ "decode", forlan_value_literal, "s", 1, 1, func_decode },
{ "dequote", forlan_value_literal, "s", 1, 1, func_dequote },
{ "exit", forlan_value_void, "s", 1, 1, func_exit },
{ "empty", forlan_value_boolean, "n", 1, 1, func_empty },
{ "timestamp", forlan_value_literal, "s", 1, 1, func_timestamp },
{ "lookup", forlan_value_literal, "ss", 2, 2, func_lookup },
{ "has_map",forlan_value_boolean, "s", 1, 1, func_has_map },
{ NULL }
};
struct forlan_function *
forlan_find_function(const char *name)
{
struct forlan_function *fp;
for (fp = functab; fp->name; fp++)
if (strcmp(name, fp->name) == 0)
return fp;
return NULL;
}
void
forlan_eval(struct forlan_eval_env *env, union forlan_node *p)
{
if (p->type > sizeof(f_tab) / sizeof(f_tab[0]))
abort();
if (f_tab[p->type].f_eval)
f_tab[p->type].f_eval(env, p);
}
int
forlan_run(forlan_eval_env_t env, struct grecs_node *tree)
{
env->last = NULL;
env->top_node = NULL;
env->retval.type = forlan_value_void;
env->instr = NULL;
env->tree = tree;
if (setjmp(env->stop_buf) == 0)
forlan_eval(env, env->parse_tree);
free_value(&env->retval);
return env->exit_code;
}
forlan_eval_env_t
forlan_create_environment(union forlan_node *parse_tree, size_t varcount)
{
struct forlan_eval_env *env;
env = grecs_zalloc(sizeof(*env));
env->parse_tree = parse_tree;
env->vartab = grecs_calloc(varcount, sizeof(env->vartab[0]));
return env;
}
void
forlan_free_environment(forlan_eval_env_t env)
{
forlan_node_free(env->parse_tree);
free(env->vartab);
free(env);
}