path: root/src/map/magic-interpreter-parser.ypp

%code requires {
#include "magic-interpreter.hpp"
}
%code{
#include "magic-interpreter-parser.hpp"

#include <cstdarg> // exception to "no va_list" rule, even after cxxstdio

#include "../common/cxxstdio.hpp"

#include "itemdb.hpp"
#include "magic-expr.hpp"

#define YYLEX_PARAM 0, 0

static
int intern_id(const char *id_name);


static
expr_t *fun_expr(const char *name, int args_nr, expr_t **args, int line, int column);

static
expr_t *dot_expr(expr_t *lhs, int id);

static
void BIN_EXPR(expr_t *& x, const char *name, expr_t *arg1, expr_t *arg2, int line, int column)
{
    expr_t *e[2];
    e[0] = arg1;
    e[1] = arg2;
    x = fun_expr(name, 2, e, line, column);
}

static
int failed_flag = 0;

static
void magic_frontend_error(const char *msg);

static
void fail(int line, int column, const char *fmt, ...);

static
spell_t *new_spell(spellguard_t *guard);

static
spellguard_t *spellguard_implication(spellguard_t *a, spellguard_t *b);

static
spellguard_t *new_spellguard(SPELLGUARD ty);

static
effect_t *new_effect(EFFECT ty);

static
effect_t *set_effect_continuation(effect_t *src, effect_t *continuation);

static
void add_spell(spell_t *spell, int line_nr);

static
void add_teleport_anchor(teleport_anchor_t *anchor, int line_nr);

static
effect_t *op_effect(char *name, int args_nr, expr_t **args, int line, int column);

// in magic-interpreter-lexer.cpp
int magic_frontend_lex(YYSTYPE *, YYLTYPE *);

static
void install_proc(proc_t *proc);

static
effect_t *call_proc(char *name, int args_nr, expr_t **args, int line_nr, int column);

static
void bind_constant(char *name, val_t *val, int line_nr);

static
val_t *find_constant(char *name);

}

%name-prefix="magic_frontend_"

%locations

%union {
    int i;
    SPELL_FLAG spell_flags;
    SPELLARG spell_arg;
    FOREACH_FILTER foreach_filter;
    char *s;
    int op;
    magic_conf_t *magic_conf;
    val_t value;
    expr_t *expr;
    e_location_t location;
    e_area_t area;
    args_rec_t arg_list;
    struct { int letdefs_nr; letdef_t *letdefs; } letdefs;
    spell_t *spell;
    struct { int id; SPELLARG ty; } spellarg_def;
    letdef_t vardef;
    spellguard_t *spellguard;
    component_t *components;
    struct {int id, count; } component;
    effect_t *effect;
    proc_t *proc;
};

%expect 7

%token <i> INT
%token <s> STRING
%token <s> ID
%token <i> DIR

%token '='
%token '<'
%token '>'
%token '+'
%token '-'
%token '*'
%token '/'
%token '%'
%token '@'
%token ','
%token '.'
%token ':'
%token ';'
%token '|'
%token '['
%token ']'
%token '&'
%token '^'

%token CONST
%token PROCEDURE
%token CALL
%token SILENT
%token LOCAL
%token NONMAGIC
%token SHL
%token SHR
%token EQ
%token NEQ
%token GTE
%token LTE
%token ANDAND
%token OROR
%token <s> SCRIPT_DATA
%token TO
%token TOWARDS
%token TELEPORT_ANCHOR
%token SPELL
%token LET
%token IN
%token END
%token DARROW
%token STRING_TY
%token REQUIRE
%token CATALYSTS
%token COMPONENTS
%token MANA
%token CASTTIME
%token SKIP
%token ABORT
%token BREAK
%token EFFECT_
%token ATEND
%token ATTRIGGER
%token PC_F
%token NPC_F
%token MOB_F
%token ENTITY_F
%token TARGET_F
%token IF
%token THEN
%token ELSE
%token FOREACH
%token FOR
%token DO
%token SLEEP

%type <value> value
%type <location> location
%type <area> area
%type <arg_list> arg_list
%type <arg_list> arg_list_ne
%type <letdefs> defs
%type <spell> spelldef
%type <spellarg_def> argopt
%type <vardef> def
%type <spellguard> spellbody_list
%type <spellguard> spellbody
%type <spellguard> spellguard
%type <spellguard> spellguard_list
%type <spellguard> prereq
%type <component> item
%type <components> items
%type <components> item_list
%type <i> item_name
%type <foreach_filter> selection;
%type <effect> effect
%type <effect> effect_list
%type <effect> maybe_trigger
%type <effect> maybe_end
%type <spell_flags> spell_flags;

%type <expr> expr
%type <spell_arg> arg_ty
%type <proc> proc_formals_list
%type <proc> proc_formals_list_ne

%left OROR
%left ANDAND
%left '<' '>' GTE LTE NEQ EQ
%left '+' '-'
%left '*' '/' '%'
%left SHL SHR '&' '^' '|'
%right '='
%left OR
%left DARROW
%left '.'

%%

spellconf               : /* empty */
                          {}
                        | spellconf_option semicolons spellconf
                          {}
                        ;


semicolons              : /* empty */
                          {}
                        | semicolons ';'
                          {}
                        ;


proc_formals_list       : /* empty  */
                          { CREATE($$, proc_t, 1); }
                        | proc_formals_list_ne
                          { $$ = $1; }
                        ;

proc_formals_list_ne    : ID
                          { CREATE($$, proc_t, 1);
                            $$->args_nr = 1;
                            $$->args = (int*)malloc(sizeof(int));
                            $$->args[0] = intern_id($1);
                          }
                        | proc_formals_list_ne ',' ID
                          { $$ = $1;
                            $$->args = (int*)realloc($$->args, sizeof(int) * (1 + $$->args_nr));
                            $$->args[$$->args_nr++] = intern_id($3);
                          }
                        ;

spellconf_option        : ID '=' expr
                          {
                            int var_id;
                            if (find_constant($1)) {
                                    fail(@1.first_line, 0, "Attempt to redefine constant `%s' as global\n", $1);
                                    free($1);
                            } else {
                                    var_id = intern_id($1);
                                    magic_eval(&magic_default_env, &magic_conf.vars[var_id], $3);
                            }
                          }
                        | CONST ID '=' expr
                          {
                            val_t var;
                            magic_eval(&magic_default_env, &var, $4);
                            bind_constant($2, &var, @1.first_line);
                          }
                        | TELEPORT_ANCHOR ID ':' expr '=' expr
                          {
                              teleport_anchor_t *anchor;
                              CREATE(anchor, teleport_anchor_t, 1);
                              anchor->name = $2;
                              anchor->invocation = magic_eval_str(&magic_default_env, $4);
                              anchor->location = $6;

                              if (!failed_flag)
                                  add_teleport_anchor(anchor, @1.first_line);
                              else
                                  free(anchor);
                              failed_flag = 0;
                          }
                        | PROCEDURE ID '(' proc_formals_list ')' '=' effect_list
                          {
                              proc_t *proc = $4;
                              proc->name = $2;
                              proc->body = $7;
                              if (!failed_flag)
                                  install_proc(proc);
                              failed_flag = 0;
                          }
                        | spell_flags SPELL ID argopt ':' expr '=' spelldef
                          { spell_t *spell = $8;
                            spell->name = $3;
                            spell->invocation = magic_eval_str(&magic_default_env, $6);
                            spell->arg = $4.id;
                            spell->spellarg_ty = $4.ty;
                            spell->flags = $1;
                            if (!failed_flag)
                                add_spell(spell, @1.first_line);
                            failed_flag = 0;
                          }

spell_flags             : /* empty */
                                { $$ = SPELL_FLAG::ZERO; }
                        | LOCAL spell_flags
                                { if (bool($2 & SPELL_FLAG::LOCAL))
                                        fail(@1.first_line, @1.first_column, "`LOCAL' specified more than once");
                                   $$ = $2 | SPELL_FLAG::LOCAL;
                                }
                        | NONMAGIC spell_flags
                                { if (bool($2 & SPELL_FLAG::NONMAGIC))
                                        fail(@1.first_line, @1.first_column, "`NONMAGIC' specified more than once");
                                   $$ = $2 | SPELL_FLAG::NONMAGIC;
                                }
                        | SILENT spell_flags
                                { if (bool($2 & SPELL_FLAG::SILENT))
                                        fail(@1.first_line, @1.first_column, "`SILENT' specified more than once");
                                   $$ = $2 | SPELL_FLAG::SILENT;
                                }


argopt                  : /* empty */
                          { $$.ty = SPELLARG::NONE; }
                        | '(' ID ':' arg_ty ')'
                          { $$.id = intern_id($2);
                            $$.ty = $4; }
                        ;


arg_ty                  : PC_F
                          { $$ = SPELLARG::PC; }
                        | STRING_TY
                          { $$ = SPELLARG::STRING; }
                        ;


value                   : DIR
                                { $$.ty = TYPE::DIR;
                                  $$.v.v_int = $1; }
                        | INT
                                { $$.ty = TYPE::INT;
                                  $$.v.v_int = $1; }
                        | STRING
                                { $$.ty = TYPE::STRING;
                                  $$.v.v_string = $1; }
                        ;


expr                    : value
                                { $$ = magic_new_expr(EXPR::VAL);
                                  $$->e.e_val = $1; }
                        | ID
                                {
                                        val_t *val;
                                        if ((val = find_constant($1))) {
                                                $$ = magic_new_expr(EXPR::VAL);
                                                $$->e.e_val = *val;
                                        } else {
                                                $$ = magic_new_expr(EXPR::ID);
                                                $$->e.e_id = intern_id($1);
                                        }
                                }
                        | area
                                { $$ = magic_new_expr(EXPR::AREA);
                                  $$->e.e_area = $1; }
                        | expr '+' expr
                                { BIN_EXPR($$, "+", $1, $3, @1.first_line, @1.first_column); }
                        | expr '-' expr
                                { BIN_EXPR($$, "-", $1, $3, @1.first_line, @1.first_column); }
                        | expr '*' expr
                                { BIN_EXPR($$, "*", $1, $3, @1.first_line, @1.first_column); }
                        | expr '%' expr
                                { BIN_EXPR($$, "%", $1, $3, @1.first_line, @1.first_column); }
                        | expr '/' expr
                                { BIN_EXPR($$, "/", $1, $3, @1.first_line, @1.first_column); }
                        | expr '<' expr
                                { BIN_EXPR($$, ">", $3, $1, @1.first_line, @1.first_column); }
                        | expr '>' expr
                                { BIN_EXPR($$, ">", $1, $3, @1.first_line, @1.first_column); }
                        | expr '&' expr
                                { BIN_EXPR($$, "&", $1, $3, @1.first_line, @1.first_column); }
                        | expr '^' expr
                                { BIN_EXPR($$, "^", $1, $3, @1.first_line, @1.first_column); }
                        | expr '|' expr
                                { BIN_EXPR($$, "|", $1, $3, @1.first_line, @1.first_column); }
                        | expr SHL expr
                                { BIN_EXPR($$, "<<", $1, $3, @1.first_line, @1.first_column); }
                        | expr SHR expr
                                { BIN_EXPR($$, ">>", $1, $3, @1.first_line, @1.first_column); }
                        | expr LTE expr
                                { BIN_EXPR($$, ">=", $3, $1, @1.first_line, @1.first_column); }
                        | expr GTE expr
                                { BIN_EXPR($$, ">=", $1, $3, @1.first_line, @1.first_column); }
                        | expr ANDAND expr
                                { BIN_EXPR($$, "&&", $1, $3, @1.first_line, @1.first_column); }
                        | expr OROR expr
                                { BIN_EXPR($$, "||", $1, $3, @1.first_line, @1.first_column); }
                        | expr EQ expr
                                { BIN_EXPR($$, "=", $1, $3, @1.first_line, @1.first_column); }
                        | expr '=' expr
                                { BIN_EXPR($$, "=", $1, $3, @1.first_line, @1.first_column); }
                        | expr NEQ expr
                                { BIN_EXPR($$, "=", $1, $3, @1.first_line, @1.first_column);
                                  $$ = fun_expr("not", 1, &$$, @1.first_line, @1.first_column); }
                        | ID '(' arg_list ')'
                                { $$ = fun_expr($1, $3.args_nr, $3.args, @1.first_line, @1.first_column);
                                  if ($3.args)
                                          free($3.args);
                                  free($1); }
                        | '(' expr ')'
                                { $$ = $2; }
                        | expr '.' ID
                                { $$ = dot_expr($1, intern_id($3)); }
                        ;

arg_list                : /* empty */
                                { $$.args_nr = 0; }
                        | arg_list_ne
                                { $$ = $1; }
                        ;


arg_list_ne             : expr
                                { CREATE($$.args, expr_t *, 1);
                                  $$.args_nr = 1;
                                  $$.args[0] = $1;
                                }
                        | arg_list_ne ',' expr
                                { RECREATE($$.args, expr_t *, 1 + $$.args_nr);
                                  $$.args[$$.args_nr++] = $3;
                                }
                        ;


location                : '@' '(' expr ',' expr ',' expr ')'
                                { $$.m = $3; $$.x = $5; $$.y = $7; }
                        ;

area                    : location
                                { $$.ty = AREA::LOCATION;
                                  $$.a.a_loc = $1;
                                }
                        | location '@' '+' '(' expr ',' expr ')'
                                { $$.ty = AREA::RECT;
                                  $$.a.a_rect.loc = $1;
                                  $$.a.a_rect.width = $5;
                                  $$.a.a_rect.height = $7;
                                }
                        | location TOWARDS expr ':' '(' expr ',' expr ')'
                                { $$.ty = AREA::BAR;
                                  $$.a.a_bar.loc = $1;
                                  $$.a.a_bar.width = $6;
                                  $$.a.a_bar.depth = $8;
                                  $$.a.a_bar.dir = $3;
                                }
                        ;


spelldef                : spellbody_list
                                {  $$ = new_spell($1); }
                        | LET defs IN spellbody_list
                                {  $$ = new_spell($4);
                                   $$->letdefs_nr = $2.letdefs_nr;
                                   $$->letdefs = $2.letdefs;
                                   $$->spellguard = $4;
                                }
                        ;


defs                    : semicolons
                                { $$.letdefs_nr = 0;
                                  CREATE($$.letdefs, letdef_t, 1);
                                }
                        | defs def semicolons
                                { $$ = $1;
                                  $$.letdefs_nr++;
                                  RECREATE($$.letdefs, letdef_t, $$.letdefs_nr);
                                  $$.letdefs[$1.letdefs_nr] = $2;
                                }
                        ;


def                     : ID '=' expr
                                {
                                        if (find_constant($1)) {
                                                fail(@1.first_line, @1.first_column, "Attempt to re-define constant `%s' as LET-bound variable.\n", $1);
                                                free($1);
                                        } else {
                                                $$.id = intern_id($1);
                                                $$.expr = $3;
                                        }
                                }
                        ;


spellbody_list          : spellbody
                                { $$ = $1; }
                        | spellbody '|' spellbody_list
                                { spellguard_t *sg = new_spellguard(SPELLGUARD::CHOICE);
                                  sg->next = $1;
                                  sg->s.s_alt = $3;
                                  $$ = sg;
                                }
                        ;


spellbody               : spellguard DARROW spellbody
                                { $$ = spellguard_implication($1, $3); }
                        | '(' spellbody_list ')'
                                { $$ = $2; }
                        | EFFECT_ effect_list maybe_trigger maybe_end
                                { spellguard_t *sg = new_spellguard(SPELLGUARD::EFFECT);
                                  sg->s.s_effect.effect = $2;
                                  sg->s.s_effect.at_trigger = $3;
                                  sg->s.s_effect.at_end = $4;
                                  $$ = sg;
                                }
                        ;


maybe_trigger           : /* empty */
                                { $$ = NULL; }
                        | ATTRIGGER effect_list
                                { $$ = $2; }
                        ;


maybe_end               : /* empty */
                                { $$ = NULL; }
                        | ATEND effect_list
                                { $$ = $2; }
                        ;


spellguard              : prereq
                                { $$ = $1; }
                        | spellguard OR spellguard
                                { spellguard_t *sg = new_spellguard(SPELLGUARD::CHOICE);
                                  sg->next = $1;
                                  sg->s.s_alt = $3;
                                  $$ = sg;
                                }
                        | '(' spellguard_list ')'
                                { $$ = $2; }
                        ;


spellguard_list         : spellguard
                                { $$ = $1; }
                        | spellguard ',' spellguard_list
                                { $$ = spellguard_implication($1, $3); }
                        ;


prereq                  : REQUIRE expr
                                { $$ = new_spellguard(SPELLGUARD::CONDITION);
                                  $$->s.s_condition = $2;
                                }
                        | CATALYSTS items
                                { $$ = new_spellguard(SPELLGUARD::CATALYSTS);
                                  $$->s.s_catalysts = $2;
                                }
                        | COMPONENTS items
                                { $$ = new_spellguard(SPELLGUARD::COMPONENTS);
                                  $$->s.s_components = $2;
                                }
                        | MANA expr
                                { $$ = new_spellguard(SPELLGUARD::MANA);
                                  $$->s.s_mana = $2;
                                }
                        | CASTTIME expr
                                { $$ = new_spellguard(SPELLGUARD::CASTTIME);
                                  $$->s.s_casttime = $2;
                                }
                        ;


items                   : '[' item_list ']'
                                { $$ = $2; }
                        ;


item_list               : item
                                { $$ = NULL;
                                  magic_add_component(&$$, $1.id, $1.count);
                                }
                        | item_list ',' item
                                { $$ = $1;
                                  magic_add_component(&$$, $3.id, $3.count);
                                }
                        ;


item                    : INT '*' item_name
                                { $$.id = $3; $$.count = $1; }
                        | item_name
                                { $$.id = $1; $$.count = 1; }
                        ;


item_name               : STRING
                                { struct item_data *item = itemdb_searchname($1);
                                  if (!item) {
                                          fail(@1.first_line, @1.first_column, "Unknown item `%s'\n", $1);
                                          $$ = 0;
                                  } else
                                          $$ = item->nameid;
                                  free($1);
                                }
                        | INT
                                { $$ = $1; }
                        ;


selection               : PC_F
                                { $$ = FOREACH_FILTER::PC; }
                        | MOB_F
                                { $$ = FOREACH_FILTER::MOB; }
                        | ENTITY_F
                                { $$ = FOREACH_FILTER::ENTITY; }
                        | SPELL
                                { $$ = FOREACH_FILTER::SPELL; }
                        | TARGET_F
                                { $$ = FOREACH_FILTER::TARGET; }
                        | NPC_F
                                { $$ = FOREACH_FILTER::NPC; }
                        ;


effect                  : '(' effect_list ')'
                                { $$ = $2; }
                        | SKIP ';'
                                { $$ = new_effect(EFFECT::SKIP); }
                        | ABORT ';'
                                { $$ = new_effect(EFFECT::ABORT); }
                        | END ';'
                                { $$ = new_effect(EFFECT::END); }
                        | BREAK ';'
                                { $$ = new_effect(EFFECT::BREAK); }
                        | ID '=' expr ';'
                                {
                                        if (find_constant($1)) {
                                                fail(@1.first_line, @1.first_column, "Attempt to re-define constant `%s' in assignment.", $1);
                                                free($1);
                                        } else {
                                                $$ = new_effect(EFFECT::ASSIGN);
                                                $$->e.e_assign.id = intern_id($1);
                                                $$->e.e_assign.expr = $3;
                                        }
                                }
                        | FOREACH selection ID IN expr DO effect
                                { $$ = new_effect(EFFECT::FOREACH);
                                  $$->e.e_foreach.id = intern_id($3);
                                  $$->e.e_foreach.area = $5;
                                  $$->e.e_foreach.body = $7;
                                  $$->e.e_foreach.filter = $2;
                                }
                        | FOR ID '=' expr TO expr DO effect
                                { $$ = new_effect(EFFECT::FOR);
                                  $$->e.e_for.id = intern_id($2);
                                  $$->e.e_for.start = $4;
                                  $$->e.e_for.stop = $6;
                                  $$->e.e_for.body = $8;
                                }
                        | IF expr THEN effect ELSE effect
                                { $$ = new_effect(EFFECT::IF);
                                  $$->e.e_if.cond = $2;
                                  $$->e.e_if.true_branch = $4;
                                  $$->e.e_if.false_branch = $6;
                                }
                        | IF expr THEN effect
                                { $$ = new_effect(EFFECT::IF);
                                  $$->e.e_if.cond = $2;
                                  $$->e.e_if.true_branch = $4;
                                  $$->e.e_if.false_branch = new_effect(EFFECT::SKIP);
                                }
                        | SLEEP expr ';'
                                { $$ = new_effect(EFFECT::SLEEP);
                                  $$->e.e_sleep = $2;
                                }
                        | ID '(' arg_list ')' ';'
                                { $$ = op_effect($1, $3.args_nr, $3.args, @1.first_line, @1.first_column);
                                  free($1);
                                }
                        | SCRIPT_DATA
                                { $$ = new_effect(EFFECT::SCRIPT);
                                  $$->e.e_script = parse_script($1, @1.first_line);
                                  free($1);
                                  if ($$->e.e_script == NULL)
                                      fail(@1.first_line, @1.first_column, "Failed to compile script\n");
                                }
                        | CALL ID '(' arg_list ')' ';'
                                { $$ = call_proc($2, $4.args_nr, $4.args, @1.first_line, @1.first_column);
                                  free($2);
                                }
                        ;

effect_list             : /* empty */
                                { $$ = new_effect(EFFECT::SKIP); }
                        | effect semicolons effect_list
                                { $$ = set_effect_continuation($1, $3); }
                        ;


%%

/* We do incremental realloc here to store our results.  Since this happens only once
 * during startup for a relatively manageable set of configs, it should be fine. */

static
int intern_id(const char *id_name)
{
        int i;

        for (i = 0; i < magic_conf.vars_nr; i++)
                if (!strcmp(id_name, magic_conf.var_name[i])) {
                        free((char*)id_name);
                        return i;
                }

        /* Must add new */
        i = magic_conf.vars_nr++;
        RECREATE(magic_conf.var_name, const char *, magic_conf.vars_nr);
        magic_conf.var_name[i] = id_name;
        RECREATE(magic_conf.vars, val_t, magic_conf.vars_nr);
        magic_conf.vars[i].ty = TYPE::UNDEF;

        return i;
}

static
void add_spell(spell_t *spell, int line_nr)
{
        int index = magic_conf.spells_nr;
        int i;

        for (i = 0; i < index; i++) {
                if (!strcmp(magic_conf.spells[i]->name, spell->name)) {
                        fail(line_nr, 0, "Attempt to redefine spell `%s'\n", spell->name);
                        return;
                }
                if (!strcmp(magic_conf.spells[i]->invocation, spell->invocation)) {
                        fail(line_nr, 0, "Attempt to redefine spell invocation `%s' between spells `%s' and `%s'\n",
                             spell->invocation, magic_conf.spells[i]->name, spell->name);
                        return;
                }
        }
        magic_conf.spells_nr++;

        RECREATE(magic_conf.spells, spell_t *, magic_conf.spells_nr);
        magic_conf.spells[index] = spell;


}

static
void add_teleport_anchor(teleport_anchor_t *anchor, int line_nr)
{
        int index = magic_conf.anchors_nr;
        int i;

        for (i = 0; i < index; i++) {
                if (!strcmp(magic_conf.anchors[i]->name, anchor->name)) {
                        fail(line_nr, 0, "Attempt to redefine teleport anchor `%s'\n", anchor->name);
                        return;
                }
                if (!strcmp(magic_conf.anchors[i]->invocation, anchor->invocation)) {
                        fail(line_nr, 0, "Attempt to redefine anchor invocation `%s' between anchors `%s' and `%s'\n",
                             anchor->invocation, magic_conf.anchors[i]->name, anchor->name);
                        return;
                }
        }
        magic_conf.anchors_nr++;

        RECREATE(magic_conf.anchors, teleport_anchor_t *, magic_conf.anchors_nr);
        magic_conf.anchors[index] = anchor;
}


static __attribute__((format(printf, 3, 4)))
void fail(int line, int column, const char *fmt, ...)
{
        va_list ap;
        FPRINTF(stderr, "[magic-init]  L%d:%d: ", line, column);
        va_start(ap, fmt);
        vfprintf(stderr, fmt, ap);
        failed_flag = 1;
}

static
expr_t *dot_expr(expr_t *expr, int id)
{
        expr_t *retval = magic_new_expr(EXPR::SPELLFIELD);
        retval->e.e_field.id = id;
        retval->e.e_field.expr = expr;

        return retval;
}

static
expr_t *fun_expr(const char *name, int args_nr, expr_t **args, int line, int column)
{
        int id;
        expr_t *expr;
        fun_t *fun = magic_get_fun(name, &id);

        if (!fun) {
                fail(line, column, "Unknown function `%s'\n", name);
        } else if (strlen(fun->signature) != args_nr) {
                fail(line, column, "Incorrect number of arguments to function `%s': Expected %zu, found %d\n", name, strlen(fun->signature), args_nr);
                fun = NULL;
        }

        if (fun) {
                int i;

                expr = magic_new_expr(EXPR::FUNAPP);
                expr->e.e_funapp.line_nr = line;
                expr->e.e_funapp.column = column;
                expr->e.e_funapp.id = id;
                expr->e.e_funapp.args_nr = args_nr;

                for (i = 0; i < args_nr; i++)
                        expr->e.e_funapp.args[i] = args[i];
        } else { /* failure */
                expr = magic_new_expr(EXPR::VAL);
                expr->e.e_val.ty = TYPE::FAIL;
        }

        return expr;
}

static
spell_t *new_spell(spellguard_t *guard)
{
        static int spell_counter = 0;

        spell_t *retval = (spell_t*)calloc(1, sizeof(spell_t));
        retval->index = ++spell_counter;
        retval->spellguard = guard;
        return retval;
}

static
spellguard_t *new_spellguard(SPELLGUARD ty)
{
        spellguard_t *retval = (spellguard_t *)calloc(1, sizeof(spellguard_t));
        retval->ty = ty;
        return retval;
}

static
spellguard_t *spellguard_implication(spellguard_t *a, spellguard_t *b)
{
        spellguard_t *retval = a;

        if (a == b) /* This can happen due to reference sharing:
                     * e.g.,
                     *  (R0 -> (R1 | R2)) => (R3)
                     * yields
                     *  (R0 -> (R1 -> R3 | R2 -> R3))
                     *
                     * So if we now add => R4 to that, we want
                     *  (R0 -> (R1 -> R3 -> R4 | R2 -> R3 -> R4))
                     *
                     * but we only need to add it once, because the R3 reference is shared.
                    */
                return retval;

                /* If the premise is a disjunction, b is the continuation of _all_ branches */
        if (a->ty == SPELLGUARD::CHOICE)
                spellguard_implication(a->s.s_alt, b);
        if (a->next)
                spellguard_implication(a->next, b);
        else
                a->next = b;


        return retval;
}

static
effect_t *new_effect(EFFECT ty)
{
        effect_t *effect = (effect_t *) calloc(1, sizeof(effect_t));
        effect->ty = ty;
        return effect;
}

static
effect_t *set_effect_continuation(effect_t *src, effect_t *continuation)
{
        effect_t *retval = src;
        /* This function is completely analogous to `spellguard_implication' above; read the control flow implications above first before pondering it. */

        if (src == continuation)
                return retval;

        /* For FOR and FOREACH, we use special stack handlers and thus don't have to set
         * the continuation.  It's only IF that we need to handle in this fashion. */
        if (src->ty == EFFECT::IF) {
                set_effect_continuation(src->e.e_if.true_branch, continuation);
                set_effect_continuation(src->e.e_if.false_branch, continuation);
        }
        if (src->next)
                set_effect_continuation(src->next, continuation);
        else
                src->next = continuation;

        return retval;
}

static
effect_t *op_effect(char *name, int args_nr, expr_t **args, int line, int column)
{
        int id;
        effect_t *effect;
        op_t *op = magic_get_op(name, &id);

        if (!op)
                fail(line, column, "Unknown operation `%s'\n", name);
        else if (strlen(op->signature) != args_nr) {
                fail(line, column, "Incorrect number of arguments to operation `%s': Expected %zu, found %d\n", name, strlen(op->signature), args_nr);
                op = NULL;
        }

        if (op) {
                int i;

                effect = new_effect(EFFECT::OP);
                effect->e.e_op.line_nr = line;
                effect->e.e_op.column = column;
                effect->e.e_op.id = id;
                effect->e.e_op.args_nr = args_nr;

                for (i = 0; i < args_nr; i++)
                        effect->e.e_op.args[i] = args[i];
        } else /* failure */
                effect = new_effect(EFFECT::SKIP);

        return effect;
}


proc_t *procs = NULL;
int procs_nr = 0;

// I think this is a memory leak, or undefined behavior
static
void install_proc(proc_t *proc)
{
        if (!procs) {
                procs = proc;
                procs_nr = 1;
        } else {
                RECREATE(procs, proc_t, 1 + procs_nr);
                procs[procs_nr++] = *proc;
        }
}

static
effect_t *call_proc(char *name, int args_nr, expr_t **args, int line_nr, int column)
{
        proc_t *p = NULL;
        int i;
        effect_t *retval;

        for (i = 0; i < procs_nr; i++)
                if (!strcmp(procs[i].name, name)) {
                        p = &procs[i];
                        break;
                }

        if (!p) {
                fail(line_nr, column, "Unknown procedure `%s'\n", name);
                return new_effect(EFFECT::SKIP);
        }

        if (p->args_nr != args_nr) {
                fail(line_nr, column, "Procedure %s/%d invoked with %d parameters\n", name, p->args_nr, args_nr);
                return new_effect(EFFECT::SKIP);
        }

        retval = new_effect(EFFECT::CALL);
        retval->e.e_call.body = p->body;
        retval->e.e_call.args_nr = args_nr;
        retval->e.e_call.formals = p->args;
        retval->e.e_call.actuals = args;
        return retval;
}

struct const_def_rec {
        char *name;
        val_t val;
} *const_defs = NULL;

int const_defs_nr = 0;

static
void bind_constant(char *name, val_t *val, int line_nr)
{
        if (find_constant(name)) {
                fail(line_nr, 0, "Redefinition of constant `%s'\n", name);
                return;
        }

        if (!const_defs)
                const_defs = (struct const_def_rec *)malloc(sizeof(struct const_def_rec));
        else
                const_defs = (struct const_def_rec *)realloc(const_defs,
                                                             (const_defs_nr + 1) * sizeof(struct const_def_rec));

        const_defs[const_defs_nr].name = name;
        const_defs[const_defs_nr].val = *val;
        ++const_defs_nr;
}

static
val_t *find_constant(char *name)
{
        int i;
        for (i = 0; i < const_defs_nr; i++) {
                if (!strcmp(const_defs[i].name, name)) {
                        free(name);
                        return &const_defs[i].val;
                }
        }

        return NULL;
}



// FIXME: macro capture
#define INTERN_ASSERT(name, id) \
{                               \
    int zid = intern_id(name);  \
    if (zid != id)              \
        FPRINTF(stderr,         \
            "[magic-conf] INTERNAL ERROR: Builtin special var %s interned to %d, not %d as it should be!\n",    \
            name, zid, id);     \
    error_flag = 1;             \
}

extern FILE *magic_frontend_in;

// must be called after itemdb initialisation
int magic_init(const char *conffile)
{
        int error_flag = 0;

        magic_conf.vars_nr = 0;
        // can these be left NULL ? I'm afraid to change anything.
        magic_conf.var_name = (const char **)malloc(1);
        magic_conf.vars = (val_t *)malloc(1);

        magic_conf.obscure_chance = 95;
        magic_conf.min_casttime = 100;

        magic_conf.spells_nr = 0;
        CREATE(magic_conf.spells, spell_t *, 1);

        magic_conf.anchors_nr = 0;
        CREATE(magic_conf.anchors, teleport_anchor_t *, 1);

        INTERN_ASSERT("min_casttime", VAR_MIN_CASTTIME);
        INTERN_ASSERT("obscure_chance", VAR_OBSCURE_CHANCE);
        INTERN_ASSERT("caster", VAR_CASTER);
        INTERN_ASSERT("spellpower", VAR_SPELLPOWER);
        INTERN_ASSERT("self_spell", VAR_SPELL);
        INTERN_ASSERT("self_invocation", VAR_INVOCATION);
        INTERN_ASSERT("target", VAR_TARGET);
        INTERN_ASSERT("script_target", VAR_SCRIPTTARGET);
        INTERN_ASSERT("location", VAR_LOCATION);

        magic_frontend_in = fopen(conffile, "r");
        if (!magic_frontend_in) {
                FPRINTF(stderr, "[magic-conf] Magic configuration file `%s' not found -> no magic.\n", conffile);
                return 0;
        }
        magic_frontend_parse();

        if (magic_conf.vars[VAR_MIN_CASTTIME].ty == TYPE::INT)
                magic_conf.min_casttime = magic_conf.vars[VAR_MIN_CASTTIME].v.v_int;

        if (magic_conf.vars[VAR_OBSCURE_CHANCE].ty == TYPE::INT)
                magic_conf.obscure_chance = magic_conf.vars[VAR_OBSCURE_CHANCE].v.v_int;

        PRINTF("[magic-conf] Magic initialised; obscure at %d%%.  %d spells, %d teleport anchors.\n",
               magic_conf.obscure_chance, magic_conf.spells_nr, magic_conf.anchors_nr);

        if (procs)
                free(procs);
        return error_flag;
}

extern int magic_frontend_lineno;

static
void magic_frontend_error(const char *msg)
{
    FPRINTF(stderr, "[magic-conf] Parse error: %s at line %d\n", msg, magic_frontend_lineno);
    failed_flag = 1;
}