/ifm-5.1/vars/src/vars-parser.y

/*
 * This file is part of the Vars library, copyright (C) Glenn
 * Hutchings 1996-2003.
 *
 * The Vars library comes with ABSOLUTELY NO WARRANTY.  This is free
 * software, and you are welcome to redistribute it under certain
 * conditions; see the file COPYING for details.
 */

/*!
  @defgroup parser Parsers
  @ingroup types

  A parser is an object which is used to evaluate mathematical expressions.
  It stores variables, constants and functions which are used to perform
  the evaluations.  Parsers get created with a set of builtin functions and
  constants, and you can define your own or override the builtin ones.
*/

/*!
  @defgroup parser_create Creating and destroying parsers
  @ingroup parser
*/

/*!
  @defgroup parser_exp Parsing expressions
  @ingroup parser
*/

/*!
  @defgroup parser_custom Customizing parsers
  @ingroup parser
*/

/*!
  @defgroup parser_access Accessing parser internals
  @ingroup parser
*/

/*!
  @defgroup parser_syntax Parser input syntax
  @ingroup parser

  Input to a parser consists of a number of expressions. Each expression is
  terminated by a newline.  Whitespace is ignored.  Comments may also be
  included, starting with \c # and continuing to the end of the line.

  The following types of expression are allowed (where \c exp represents
  another expression):

  - <tt>number</tt> -- A number, with optional decimal part and exponent.

  - <tt>exp + exp, exp - exp, exp * exp, exp / exp</tt> -- The four
    standard arithmetic operations.

  - <tt>exp ^ exp</tt> -- Exponentiation. This function uses the \c pow(3)
    function internally, but cannot be overridden, as can the parser
    builtin "pow" function.

  - <tt>exp % exp</tt> -- The modulo function.

  - <tt>exp == exp, exp != exp, exp < exp, exp > exp, exp <= exp, exp >=
    exp</tt> -- Various tests.  The return value is 1 if the expression is
    true, 0 if it is false.

  - <tt>exp && exp, exp || exp</tt> -- Boolean AND and OR.  The return
    value is as above.

  - <tt>exp ? exp1 : exp2</tt> -- The C ternary operator.  If \c exp is
    nonzero the return value is \c exp1, otherwise \c exp2.

  - <tt>exp ; exp</tt> -- Concatenation of expressions.  This allows more
    than one expression per line.  The return value is the rightmost
    expression.

  - <tt>(exp)</tt> -- Parentheses.

  - <tt>+ exp, - exp</tt> -- Unary plus and minus.

  - <tt>variable</tt> -- The name of a (possibly undefined) variable.  The
    return value is the value of the variable (or 0 if undefined).

  - <tt>variable = exp</tt> -- Variable assignment.  The return value is
    the value of the expression.

  - <tt>func([exp [, exp...]])</tt> -- Function call, where "func" is the
    name of a parser function.
  .
*/

/*!
  @defgroup parser_builtin Builtin functions and constants
  @ingroup parser

  The following functions are builtin, and are described in \c math(3).

  - Trigonometric functions -- <tt>sin, cos, tan, asin, acos, atan, atan2</tt>

  - Exponent and log functions -- <tt>exp, log, log10, pow, sqrt, hypot</tt>

  - Rounding functions -- <tt>ceil, floor, trunc, abs, mod</tt>
  .

  The following functions are also defined:

  - <tt>min(val1, val2 [, val3...])</tt> -- Return the minimum of a list of
    values.

  - <tt>max(val1, val2 [, val3...])</tt> -- Return the maximum of a list of
    values.
  .

  The following constants are predefined:

  - \c pi -- 3.14159265...

  - \c e -- 2.7182818...

  - \c dtor -- Degrees to radians conversion factor.

  - \c rtod -- Radians to degrees conversion factor.
  .
*/

%{
#define __NO_MATH_INLINES

#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <stdarg.h>
#include <ctype.h>
#include <errno.h>
#include <math.h>

#ifndef DOXYGEN_IGNORE
#include "vars-config.h"
#include "vars-buffer.h"
#include "vars-hash.h"
#include "vars-macros.h"
#include "vars-memory.h"
#include "vars-parser.h"
#include "vars-regex.h"
#endif

/* Internalize yacc variables */
#define	yymaxdepth                 yy_vars_maxdepth
#define	yyparse                    yy_vars_parse
#define	yylex                      yy_vars_lex
#define	yyerror                    yy_vars_error
#define	yylval                     yy_vars_lval
#define	yychar                     yy_vars_char
#define	yydebug                    yy_vars_debug
#define	yypact                     yy_vars_pact
#define	yyr1                       yy_vars_r1
#define	yyr2                       yy_vars_r2
#define	yydef                      yy_vars_def
#define	yychk                      yy_vars_chk
#define	yypgo                      yy_vars_pgo
#define	yyact                      yy_vars_act
#define	yyexca                     yy_vars_exca
#define yyerrflag                  yy_vars_errflag
#define yynerrs                    yy_vars_nerrs
#define	yyps                       yy_vars_ps
#define	yypv                       yy_vars_pv
#define	yys                        yy_vars_s
#define	yy_yys                     yy_vars_yys
#define	yystate                    yy_vars_state
#define	yytmp                      yy_vars_tmp
#define	yyv                        yy_vars_v
#define	yy_yyv                     yy_vars_yyv
#define	yyval                      yy_vars_val
#define	yylloc                     yy_vars_lloc
#define yyreds                     yy_vars_reds
#define yytoks                     yy_vars_toks
#define yylhs                      yy_vars_yylhs
#define yylen                      yy_vars_yylen
#define yydefred                   yy_vars_yydefred
#define yydgoto                    yy_vars_yydgoto
#define yysindex                   yy_vars_yysindex
#define yyrindex                   yy_vars_yyrindex
#define yygindex                   yy_vars_yygindex
#define yytable                    yy_vars_yytable
#define yycheck                    yy_vars_yycheck
#define yyname                     yy_vars_yyname
#define yyrule                     yy_vars_yyrule

/* Convenience macros */
#define COPY(s)                    vs_copy(s)
#define PUSH(s)                    vl_push(vp_stack, s) 
#define NV(s)                      vs_dget(s)
#define IV(s)                      vs_iget(s)
#define SV(s)                      vs_sget_buf(s, buf)
#define NSET(n)                    vs_dcreate(n)
#define SSET(n)                    vs_screate(n)

#define YYSTYPE                    vscalar *
#define YYPRINT(fp, type, value)   yyprint(fp, type, value)
#define YYERROR_VERBOSE            1

#define YYDEBUG 1

#define CALL_MATH_1(func) \
        vs_dcreate(func(vl_dget(args, 0)))

#define CALL_MATH_2(func) \
        vs_dcreate(func(vl_dget(args, 0), vl_dget(args, 1)))

/* Type definition */
struct v_parser {
    struct v_header id;         /* Type marker */
    struct v_hash *constants;   /* Constants */
    struct v_hash *variables;   /* Variables */
    struct v_hash *functions;   /* Functions */
    struct v_scalar *value;     /* Last parse value */
    struct v_list *errors;      /* List of parse errors */
    int undef_ok;               /* OK to refer to undefined variables? */
};

/* Function attributes */
struct v_pfunc {
    vscalar *(*func)(vlist *args);
    int minargs, maxargs;
};

/* Internal type abbreviations */
typedef struct v_pfunc vpfunc;

/* Type variable */
vtype *vparser_type = NULL;

/* Current parser for evaluation */
static vparser *vp_parser = NULL;

/* Current value stack */
static vlist *vp_stack = NULL;

/* Current function arg list */
static vlist *vp_arglist = NULL;

/* Current parse string */
static char *vp_input = NULL;

/* Current input line */
static int vp_line_number = 0;

/* Whether to report line numbers */
static int report_line = 0;

/* Internal arg list */
static vlist *args = NULL;

/* Scribble buffer */
static char buf[BUFSIZ];

/* Internal functions */
static void vp_add_builtins(vparser *p);
static vparser *vp_create_empty(void);
static int yylex(void);
static void yyprint(FILE *fp, int type, vscalar *s);
static void yyerror(char *msg);
static vscalar *builtin_acos(vlist *args);
static vscalar *builtin_asin(vlist *args);
static vscalar *builtin_atan(vlist *args);
static vscalar *builtin_atan2(vlist *args);
static vscalar *builtin_ceil(vlist *args);
static vscalar *builtin_cos(vlist *args);
static vscalar *builtin_exp(vlist *args);
static vscalar *builtin_fabs(vlist *args);
static vscalar *builtin_floor(vlist *args);
static vscalar *builtin_fmod(vlist *args);
static vscalar *builtin_hypot(vlist *args);
static vscalar *builtin_log(vlist *args);
static vscalar *builtin_log10(vlist *args);
static vscalar *builtin_max(vlist *args);
static vscalar *builtin_min(vlist *args);
static vscalar *builtin_pow(vlist *args);
static vscalar *builtin_sin(vlist *args);
static vscalar *builtin_sqrt(vlist *args);
static vscalar *builtin_tan(vlist *args);

/* List of builtin functions */
static struct builtin_func {
    char *name;
    vscalar *(*func)(vlist *args);
    int minargs, maxargs;
} builtin_functions[] = {
    "abs",   builtin_fabs,  1, 1,
    "acos",  builtin_acos,  1, 1,
    "asin",  builtin_asin,  1, 1,
    "atan",  builtin_atan,  1, 1,
    "atan2", builtin_atan2, 2, 2,
    "ceil",  builtin_ceil,  1, 1,
    "cos",   builtin_cos,   1, 1,
    "exp",   builtin_exp,   1, 1,
    "floor", builtin_floor, 1, 1,
    "hypot", builtin_hypot, 2, 2,
    "log",   builtin_log,   1, 1,
    "log10", builtin_log10, 1, 1,
    "min",   builtin_min,   2, VP_FUNC_NOLIMIT, 
    "max",   builtin_max,   2, VP_FUNC_NOLIMIT,
    "mod",   builtin_fmod,  2, 2,
    "pow",   builtin_pow,   2, 2,
    "sin",   builtin_sin,   1, 1,
    "sqrt",  builtin_sqrt,  1, 1,
    "tan",   builtin_tan,   1, 1,
    NULL,    NULL, 0
};

/* List of builtin constants */
static struct builtin_const {
    char *name;
    double value;
} builtin_constants[] = {
    "pi",    M_PI,              /* Pi */
    "e",     M_E,               /* E */
    "dtor",  M_PI / 180,        /* Degrees-to-radians */
    "rtod",  180 / M_PI,        /* Radians-to-degrees */
    NULL,    0.0
};

%}

%token          VALUE ID
%token          EQ NE GE GT LE LT
%token          AND OR

%left           ';'
%right		'='
%right		'?' ':'
%left		OR
%left		AND
%left		EQ NE
%left		LT LE GT GE
%left		'+' '-'
%left		'*' '/' '%'
%left		PLUS MINUS
%nonassoc	'!'
%right		'^'

%%

input           : /* empty */
                | input line
                ;

line            : '\n'
                | exp '\n'
                | error '\n'
                {
                    yyerrok;
                }
                ;

exp             : VALUE
                {
                    PUSH($1);
                }
                | ID
                {
                    $$ = vp_get(vp_parser, SV($1));

                    if ($$ != NULL)
                        $$ = COPY($$);
                    else
                        $$ = vs_create(V_UNDEF);

                    PUSH($1);
                    PUSH($$);
                }
                | '+' exp %prec PLUS
                {
                    $$ = NSET(NV($2)); PUSH($$);
                }
                | '-' exp %prec MINUS
                {
                    $$ = NSET(-NV($2)); PUSH($$);
                }
                | exp '+' exp
                {
                    $$ = NSET(NV($1) + NV($3)); PUSH($$);
                }
                | exp '-' exp
                {
                    $$ = NSET(NV($1) - NV($3)); PUSH($$);
                }
                | exp '*' exp
                {
                    $$ = NSET(NV($1) * NV($3)); PUSH($$);
                }
                | exp '/' exp
                {
                    $$ = NSET(NV($1) / NV($3)); PUSH($$);
                }
                | exp '^' exp
                {
                    errno = 0;
                    $$ = NSET(pow(NV($1), NV($3))); PUSH($$);
                    if (errno)
                        vp_errno("^", errno);
                }
                | exp '%' exp
                {
                    errno = 0;
                    $$ = NSET(fmod(NV($1), NV($3))); PUSH($$);
                    if (errno)
                        vp_errno("%", errno);
                }
                | exp ';' exp
                {
                    $$ = COPY($3); PUSH($$);
                }
                | '(' exp ')'
                {
                    $$ = COPY($2); PUSH($$);
                }
                | exp EQ exp
                {
                    $$ = NSET(NV($1) == NV($3)); PUSH($$);
                }
                | exp NE exp
                {
                    $$ = NSET(NV($1) != NV($3)); PUSH($$);
                } 
                | exp GT exp
                {
                    $$ = NSET(NV($1) > NV($3)); PUSH($$);
                } 
                | exp LT exp
                {
                    $$ = NSET(NV($1) < NV($3)); PUSH($$);
                } 
                | exp GE exp
                {
                    $$ = NSET(NV($1) >= NV($3)); PUSH($$);
                } 
                | exp LE exp
                {
                    $$ = NSET(NV($1) <= NV($3)); PUSH($$);
                } 
                | exp AND exp
                {
                    $$ = NSET(IV($1) && IV($3)); PUSH($$);
                } 
                | exp OR exp
                {
                    $$ = NSET(IV($1) || IV($3)); PUSH($$);
                } 
                | '!' exp
                {
                    $$ = NSET(!IV($2)); PUSH($$);
                }
                | exp '?' exp ':' exp
                {
                    $$ = COPY(IV($1) ? $3 : $5); PUSH($$);
                }
                | ID '=' exp
                {
                    $$ = COPY($3);
                    PUSH($1);
                    PUSH($$);
                    vp_store(vp_parser, SV($1), COPY($3));
                }
                | ID '('
                {
                    PUSH($1);
                    if (args != NULL)
                        vl_ppush(vp_arglist, args);
                    args = vl_create();
                }
                arglist ')'
                {
                    if (($$ = vp_call(vp_parser, SV($1), args)) == NULL)
                        $$ = vs_create(V_UNDEF);
                    PUSH($$);
                    vl_destroy(args);
                    args = vl_ppop(vp_arglist);
                }
                ;

arglist         : /* empty */
                | arg
                | arglist ',' arg
                ;

arg             : exp
                {
                    vl_push(args, COPY($1));
                }
                ;

%%

/* Add builtins to a parser */
static void
vp_add_builtins(vparser *p)
{
    int i;

    /* Install builtin constants */
    for (i = 0; builtin_constants[i].name != NULL; i++)
        vp_dconst(p,
                  builtin_constants[i].name,
                  builtin_constants[i].value);

    /* Install builtin functions */
    for (i = 0; builtin_functions[i].name != NULL; i++)
        vp_func(p,
                builtin_functions[i].name,
                builtin_functions[i].func,
                builtin_functions[i].minargs,
                builtin_functions[i].maxargs);
}

/*!
  @brief   Call a parser function.
  @ingroup parser_access
  @param   p Parser.
  @param   name Function name.
  @param   args List of arguments (or \c NULL, meaning no args).
  @return  Result.
  @retval  NULL if the call failed.
*/
vscalar *
vp_call(vparser *p, char *name, vlist *args)
{
    vscalar *result;
    int nargs = 0;
    vpfunc *f;

    VP_CHECK(p);
    if (args != NULL) {
        VL_CHECK(args);
        nargs = vl_length(args);
    }

    /* Get function info */
    if ((f = vh_pget(p->functions, name)) == NULL) {
        vp_err("function \"%s\" is undefined", name);
        return NULL;
    }

    /* Check no. of arguments */
    if (nargs < f->minargs || nargs > f->maxargs) {
        if (f->minargs == f->maxargs)
            vp_err("function \"%s\" requires %d argument%s",
                   name, f->minargs, (f->minargs == 1 ? "" : "s"));
        else if (f->maxargs == VP_FUNC_NOLIMIT)
            vp_err("function \"%s\" requires at least %d argument%s",
                   name, f->minargs, (f->minargs == 1 ? "" : "s"));
        else if (f->minargs == 0)
            vp_err("function \"%s\" requires at most %d argument%s",
                   name, f->maxargs, (f->maxargs == 1 ? "" : "s"));
        else
            vp_err("function \"%s\" requires between %d and %d arguments",
                   name, f->minargs, f->maxargs);

        return NULL;
    }

    /* Call function, checking for errors */
    errno = 0;
    result = (*f->func)(args);
    if (errno && vp_errno(name, errno)) {
        if (result != NULL)
            vs_destroy(result);
        return NULL;
    }

    return result;
}

/*!
  @brief   Declare a parser constant.
  @ingroup parser_custom
  @param   p Parser.
  @param   name Constant name.
  @param   val Its value.
*/
void
vp_const(vparser *p, char *name, vscalar *val)
{
    VP_CHECK(p);
    vh_istore(p->constants, name, 1);
    vh_store(p->variables, name, val);
}

/*!
  @brief   Return a copy of a parser.
  @ingroup parser_create
  @param   p Parser to copy.
  @return  Copy.

  Builtin functions and constants, and also current values of variables,
  are copied.
*/
vparser *
vp_copy(vparser *p)
{
    vpfunc *cf, *f;
    vparser *copy;
    vscalar *elt;
    char *name;

    VP_CHECK(p);

    copy = vp_create_empty();

    vh_destroy(copy->constants);
    copy->constants = vh_copy(p->constants);

    vh_destroy(copy->variables);
    copy->variables = vh_copy(p->variables);

    vh_foreach(name, elt, p->functions) {
        f = vs_pget(elt);
        cf = V_ALLOC(vpfunc, 1);
        cf->func = f->func;
        cf->minargs = f->minargs;
        cf->maxargs = f->maxargs;
        vh_pstore(copy->functions, name, cf);
    }

    if (V_DEBUG(V_DBG_INFO))
        v_info("Copied %s to 0x%p", v_vinfo(p), copy);

    return copy;
}

/*!
  @brief   Return a newly-created parser with builtins.
  @ingroup parser_create
  @return  New parser.
*/
vparser *
vp_create(void)
{
    vparser *p;

    p = vp_create_empty();
    vp_add_builtins(p);

    return p;
}

/* Return a newly-created empty parser */
static vparser *
vp_create_empty(void)
{
    static vheader *id = NULL;
    vparser *p;

    if (id == NULL) {
        vp_declare();
        id = vt_header(vparser_type);
    }

    p = V_ALLOC(vparser, 1);
    p->id = *id;

    p->constants = vh_create();
    p->variables = vh_create();
    p->functions = vh_create();

    p->value = NULL;
    p->errors = NULL;

    p->undef_ok = 1;

    if (V_DEBUG(V_DBG_INFO))
        v_info("Created %s", v_vinfo(p));

    return p;
}

/* Declare parser type */
vtype *
vp_declare(void)
{
    if (vparser_type == NULL) {
        vparser_type = vt_create("PARSER", "P");
        vt_copy_with(vparser_type, (void *(*)()) vp_copy);
        vt_read_with(vparser_type, (void *(*)()) vp_fread);
        vt_write_with(vparser_type, vp_fwrite);
        vt_print_with(vparser_type, vp_print);
        vt_destroy_with(vparser_type, vp_destroy);
    }

    return vparser_type;
}

/*!
  @brief   Delete a builtin constant.
  @ingroup parser_custom
  @param   p Parser.
  @param   name Constant to delete.

  Does nothing if the constant doesn't exist.
*/
void
vp_delconst(vparser *p, char *name)
{
    VP_CHECK(p);
    vh_delete(p->constants, name);
    vh_delete(p->variables, name);
}

/*!
  @brief   Delete a builtin function.
  @ingroup parser_custom
  @param   p Parser.
  @param   name Function to delete.

  Does nothing if the function doesn't exist.
*/
void
vp_delfunc(vparser *p, char *name)
{
    vpfunc *f;

    VP_CHECK(p);

    if ((f = vh_pget(p->functions, name)) != NULL) {
        vh_delete(p->functions, name);
        V_DEALLOC(f);
    }
}

/*!
  @brief   Deallocate a parser.
  @ingroup parser_create
  @param   p Parser.
*/
void
vp_destroy(vparser *p)
{
    vscalar *elt;
    char *name;
    vpfunc *f;

    VP_CHECK(p);

    if (V_DEBUG(V_DBG_INFO))
        v_info("Destroyed %s", v_vinfo(p));

    /* Destroy builtin functions */
    vh_foreach(name, elt, p->functions) {
        f = vs_pget(elt);
        V_DEALLOC(f);
    }

    /* Destroy parser */
    vh_destroy(p->constants);
    vh_destroy(p->variables);
    vh_destroy(p->functions);

    if (p->value != NULL)
        vs_destroy(p->value);
    if (p->errors != NULL)
        vl_destroy(p->errors);

    V_DEALLOC(p);
}

/*!
  @brief   Flag a parse error.
  @ingroup parser_custom
  @param   fmt Format string.

  This function is for use inside a user-defined parser function to
  indicate that an error has occurred.
*/
void
vp_err(char *fmt, ...)
{
    static vbuffer *err = NULL;
    char errbuf[BUFSIZ];

    if (err == NULL)
        err = vb_create();
    else
        vb_empty(err);

    if (vp_parser->errors == NULL)
        vp_parser->errors = vl_create();

    V_VPRINT(errbuf, fmt);

    if (report_line)
        vb_printf(err, "line %d: %s", vp_line_number, errbuf);
    else
        vb_puts(err, errbuf);

    vl_spush(vp_parser->errors, vb_get(err));
}

/* Flag an errno error */
int
vp_errno(char *name, int num)
{
    char namebuf[80];

    strcpy(namebuf, name);
    vp_err("function \"%s\": %s", namebuf, strerror(num));

    return 1;
}

/*!
  @brief   Return the last parser error.
  @ingroup parser_exp
  @param   p Parser.
  @return  Error string.
  @retval  NULL if no errors occurred.
*/
char *
vp_error(vparser *p)
{
    VP_CHECK(p);
    return (p->errors != NULL ? vl_shead(p->errors) : NULL);
}

/*!
  @brief   Set whether undefined variable references cause an error.
  @ingroup parser_custom
  @param   p Parser.
  @param   flag Yes or no.

  By default all undefined variables have the value zero.
*/
void
vp_error_undef(vparser *p, int flag)
{
    VP_CHECK(p);
    p->undef_ok = !flag;
}

/*!
  @brief   Return the list of parser errors.
  @ingroup parser_exp
  @param   p Parser.
  @return  List of error strings.
  @retval  NULL if no errors occurred.

  If an evaluation failed, then one or more errors occurred.  This
  function returns the list of errors encountered during the last
  evaluation.
*/
vlist *
vp_errors(vparser *p)
{
    VP_CHECK(p);
    return p->errors;
}

/*!
  @brief   Evaluate an expression.
  @ingroup parser_exp
  @param   p Parser.
  @param   expr Expression.
  @return  Whether successful.

  Use vp_value() to get the value of the expression.
*/
int
vp_eval(vparser *p, char *expr)
{
    VP_CHECK(p);

    /* Initialise */
    if (vp_stack == NULL) {
        vp_stack = vl_create();
        v_cleanup(vp_stack);
    } else {
        vl_empty(vp_stack);
    }

    if (vp_arglist == NULL) {
        vp_arglist = vl_create();
        v_cleanup(vp_arglist);
    }

    if (p->value != NULL)
        vs_destroy(p->value);

    if (p->errors != NULL)
        vl_destroy(p->errors);
    p->errors = NULL;

    vp_parser = p;
    vp_input = expr;
    vp_line_number = 1;
    report_line = (strchr(expr, '\n') != NULL);

    /* Let's parse! */
    yyparse();
    vp_parser = NULL;

    /* Tidy up */
    report_line = 0;

    /* Save return value */
    if (vl_length(vp_stack) > 0)
        p->value = vl_pop(vp_stack);
    else
        p->value = vs_create(V_UNDEF);

    return (p->errors == NULL);
}

/*!
  @brief   Return whether a variable exists.
  @ingroup parser_access
  @param   p Parser.
  @param   name Variable name.
  @return  Yes or no.
*/
int
vp_exists(vparser *p, char *name)
{
    VP_CHECK(p);
    return vh_exists(p->variables, name);
}

/* Read parser from a stream */
vparser *
vp_fread(FILE *fp)
{
    vparser *p;

    /* Initialise */
    p = vp_create_empty();
    vp_add_builtins(p);

    /* Read variables */
    vh_destroy(p->variables);
    if ((p->variables = vh_fread(fp)) == NULL)
        return NULL;

    /* Read constant flags */
    vh_destroy(p->constants);
    if ((p->constants = vh_fread(fp)) == NULL)
        return NULL;

    if (V_DEBUG(V_DBG_IO))
        v_info("Read %s", v_vinfo(p));

    return p;
}

/*!
  @brief   Declare a parser function.
  @ingroup parser_custom
  @param   p Parser.
  @param   name Function name.
  @param   func Function.
  @param   minargs Minimum no. of arguments.
  @param   maxargs Maximum no. of arguments.
  @see     vp_func_min(), vp_func_max(), vp_func_args(), vp_func_any()

  Declare a parser function with the given name, function and range of
  arguments.  Overrides any previous definition.

  A parser function is one that accepts a list of scalars as arguments and
  returns a single scalar, which should be of type V_INT, V_DOUBLE or
  V_STRING.  In vp_eval(), the number of arguments supplied to the function
  must be between \c minargs and \c maxargs or a parse error is given.  If
  \c maxargs is VP_FUNC_NOLIMIT, then there is no upper limit to the number
  of arguments.  If the function fails for any reason, it should call
  vp_err() and return NULL.  The function should check for the case where
  \c args is \c NULL, and treat it as if an empty list of arguments was
  passed.
*/
void
vp_func(vparser *p, char *name, vscalar *(*func)(vlist *args),
        int minargs, int maxargs)
{
    vpfunc *f, *oldf;

    VP_CHECK(p);

    f = V_ALLOC(vpfunc, 1);
    f->func = func;
    f->minargs = V_MIN(minargs, maxargs);
    f->maxargs = V_MAX(minargs, maxargs);
    
    if ((oldf = vh_pget(p->functions, name)) != NULL)
        V_DEALLOC(oldf);

    vh_pstore(p->functions, name, f);
}

/* Write parser to a stream */
int
vp_fwrite(vparser *p, FILE *fp)
{
    VP_CHECK(p);

    if (V_DEBUG(V_DBG_IO))
        v_info("Writing %s", v_vinfo(p));

    /* Write variables */
    if (!vh_fwrite(p->variables, fp))
        return 0;

    /* Write constant flags */
    if (!vh_fwrite(p->constants, fp))
        return 0;

    return 1;
}

/*!
  @brief   Return the value of a parser variable.
  @ingroup parser_access
  @param   p Parser.
  @param   name Variable name.
  @return  Its value.
*/
vscalar *
vp_get(vparser *p, char *name)
{
    vscalar *val;

    VP_CHECK(p);

    if ((val = vh_get(p->variables, name)) == NULL &&
        !p->undef_ok && vp_parser != NULL)
        vp_err("undefined variable \"%s\"", name);

    return val;
}

/*!
  @brief   Return whether a name exists as a constant.
  @ingroup parser_access
  @param   p Parser.
  @param   name Name.
  @return  Yes or no.
*/
int
vp_isconst(vparser *p, char *name)
{
    VP_CHECK(p);
    return vh_exists(p->constants, name);
}


/*!
  @brief   Return whether a name exists as a function.
  @ingroup parser_access
  @param   p Parser.
  @param   name Name.
  @return  Yes or no.
*/
int
vp_isfunc(vparser *p, char *name)
{
    VP_CHECK(p);
    return vh_exists(p->functions, name);
}

/* Print contents of a parser */
void
vp_print(vparser *p, FILE *fp)
{
    vscalar *elt;
    vlist *list;
    char *name;
    vpfunc *f;

    VP_CHECK(p);

    v_print_start();
    v_push_indent();

    v_print_type(vparser_type, p, fp);

    /* Print variables */
    v_indent(fp);
    fprintf(fp, "VARIABLES => LIST\n");
    v_push_indent();    

    list = vh_sortkeys(p->variables, NULL);
    vl_foreach(elt, list) {
        name = vs_sgetref(elt);
        v_indent(fp);
        fprintf(fp, "%s = %s", name, vh_sget(p->variables, name));
        if (vh_exists(p->constants, name))
            fprintf(fp, " (constant)");
        fprintf(fp, "\n");
    }

    v_pop_indent();

    /* Print functions */
    v_indent(fp);
    fprintf(fp, "FUNCTIONS => LIST\n");
    v_push_indent();    

    list = vh_sortkeys(p->functions, NULL);
    vl_foreach(elt, list) {
        name = vs_sgetref(elt);
        f = vh_pget(p->functions, name);
        v_indent(fp);
        fprintf(fp, "%s", name);

        if (f->minargs == f->maxargs)
            fprintf(fp, " (%d arg%s)", f->minargs,
                    (f->minargs == 1 ? "" : "s"));
        else if (f->maxargs == VP_FUNC_NOLIMIT)
            fprintf(fp, " (>= %d arg%s)", f->minargs,
                    (f->minargs == 1 ? "" : "s"));
        else if (f->minargs == 0)
            fprintf(fp, " (<= %d arg%s)", f->maxargs,
                    (f->maxargs == 1 ? "" : "s"));
        else
            fprintf(fp, " (%d-%d args)", f->minargs, f->maxargs);

        fprintf(fp, "\n");
    }

    v_pop_indent();

    /* That's it */
    v_pop_indent();
    v_print_finish();
}

/*!
  @brief   Set the value of a parser variable.
  @ingroup parser_access
  @param   p Parser.
  @param   name Variable name.
  @param   val Value to set.
*/
void
vp_store(vparser *p, char *name, vscalar *val)
{
    VP_CHECK(p);

    if (!vh_exists(p->constants, name))
        vh_store(p->variables, name, val);
    else
        vp_err("attempt to modify constant \"%s\"", name);
}

/*!
  @brief   Return the value of the last expression evaluated.
  @ingroup parser_exp
  @param   p Parser.
  @return  Expression value.
*/
vscalar *
vp_value(vparser *p)
{
    VP_CHECK(p);
    return p->value;
}

/* Lexer function */
static int
yylex(void)
{
    static vregex *re_int, *re_real, *re_intexp, *re_id, *re_token;
    extern vscalar *yylval;
    static int newline = 0;
    extern char *vp_input;
    static vhash *tokens;
    static int init = 0;
    static int eof = 0;
    vlist *keylist;
    vscalar *elt;
    vbuffer *b;
    char *key;
    int token;

    /* Initialise */
    if (!init) {
        init++;

        tokens = vh_create();
        vh_istore(tokens, "&&",   AND);
        vh_istore(tokens, "==",   EQ);
        vh_istore(tokens, ">=",   GE);
        vh_istore(tokens, ">",    GT);
        vh_istore(tokens, "<=",   LE);
        vh_istore(tokens, "<",    LT);
        vh_istore(tokens, "!=",   NE);
        vh_istore(tokens, "||",   OR);

        b = vb_create();
        vb_puts(b, "\\`\\(");
        keylist = vh_keys(tokens);
        vb_puts(b, vl_join(keylist, "\\|"));
        vl_destroy(keylist);
        vb_puts(b, "\\)");

        if ((re_token = vr_create(vb_get(b))) == NULL)
            v_fatal("invalid token regexp: %s", vr_error());
        v_cleanup(re_token);
        vb_destroy(b);

        if ((re_id = vr_create("\\`[A-Za-z_]\\w*")) == NULL)
            v_fatal("invalid ID regexp: %s", vr_error());
        v_cleanup(re_id);

        if ((re_int = vr_create("\\`[0-9]+")) == NULL)
            v_fatal("invalid integer regexp: %s", vr_error());
        v_cleanup(re_int);

        if ((re_intexp = vr_create("\\`[0-9]+[Ee]-?[0-9]+")) == NULL)
            v_fatal("invalid integer-exponent regexp: %s", vr_error());
        v_cleanup(re_intexp);

        if ((re_real = vr_create("\\`[0-9]*\\.[0-9]+\\([Ee]-?[0-9]+\\)?")) == NULL)
            v_fatal("invalid real regexp: %s", vr_error());
        v_cleanup(re_real);
    }

    /* Check for end-of-input */
    if (eof) {
        eof = 0;
        return 0;
    }

    /* Increment line number if required */
    if (newline) {
        vp_line_number++;
        newline = 0;
    }

    /* Scan input */
    while (1) {
        if        (*vp_input == '\0') {
            /* End of input -- fake a final newline */
            eof++;
            return '\n';
        } else if (*vp_input == '\n') {
            /* Newline */
            vp_input++;
            newline++;
            return '\n';
        } else if (isspace(*vp_input)) {
            /* Skip whitespace */
            vp_input++;
        } else if (*vp_input == '#') {
            /* Skip comments */
            while (*vp_input != '\n' && *vp_input != '\0')
                vp_input++;
        } else if (vr_match(vp_input, re_token)) {
            /* Token */
            char *val = vr_matched(0);
            token = vh_iget(tokens, val);
            vp_input += strlen(val);
            return token;
        } else if (vr_match(vp_input, re_id)) {
            /* ID -- variable, constant or function */
            char *val = vr_matched(0);
            yylval = vs_screate(val);
            vp_input += strlen(val);
            return ID;
        } else if (vr_match(vp_input, re_real)) {
            /* Real with decimal point and optional exponent */
            char *val = vr_matched(0);
            yylval = vs_dcreate(atof(val));
            vp_input += strlen(val);
            return VALUE;
        } else if (vr_match(vp_input, re_intexp)) {
            /* Integer with exponent */
            char *val = vr_matched(0);
            yylval = vs_dcreate(atof(val));
            vp_input += strlen(val);
            return VALUE;
        } else if (vr_match(vp_input, re_int)) {
            /* Integer */
            char *val = vr_matched(0);
            yylval = vs_icreate(atoi(val));
            vp_input += strlen(val);
            return VALUE;
        } else {
            /* Single character */
            return *vp_input++;
        }
    }

    /* NOTREACHED */
}

/* Parser print function */
static void
yyprint(FILE *fp, int type, vscalar *s)
{
    switch (type) {
    case ID:
    case VALUE:
        fprintf(fp, " %s", vs_sget(s));
        break;
    }
}

/* Parser error function */
static void
yyerror(char *msg)
{
    vp_err(msg);
}

/* Builtin functions */
static vscalar *
builtin_acos(vlist *args)
{
    return CALL_MATH_1(acos);
}

static vscalar *
builtin_asin(vlist *args)
{
    return CALL_MATH_1(asin);
}

static vscalar *
builtin_atan(vlist *args)
{
    return CALL_MATH_1(atan);
}

static vscalar *
builtin_atan2(vlist *args)
{
    return CALL_MATH_2(atan2);
}

static vscalar *
builtin_ceil(vlist *args)
{
    return CALL_MATH_1(ceil);
}

static vscalar *
builtin_cos(vlist *args)
{
    return CALL_MATH_1(cos);
}

static vscalar *
builtin_exp(vlist *args)
{
    return CALL_MATH_1(exp);
}

static vscalar *
builtin_fabs(vlist *args)
{
    return CALL_MATH_1(fabs);
}

static vscalar *
builtin_floor(vlist *args)
{
    return CALL_MATH_1(floor);
}

static vscalar *
builtin_fmod(vlist *args)
{
    return CALL_MATH_2(fmod);
}

static vscalar *
builtin_hypot(vlist *args)
{
    return CALL_MATH_2(hypot);
}

static vscalar *
builtin_log(vlist *args)
{
    return CALL_MATH_1(log);
}

static vscalar *
builtin_log10(vlist *args)
{
    return CALL_MATH_1(log10);
}

static vscalar *
builtin_max(vlist *args)
{
    double max = vl_dget(args, 0);
    vscalar *elt;

    vl_foreach(elt, args)
        max = V_MAX(max, vs_dget(elt));

    return vs_dcreate(max);
}

static vscalar *
builtin_min(vlist *args)
{
    double min = vl_dget(args, 0);
    vscalar *elt;

    vl_foreach(elt, args)
        min = V_MIN(min, vs_dget(elt));

    return vs_dcreate(min);
}

static vscalar *
builtin_pow(vlist *args)
{
    return CALL_MATH_2(pow);
}

static vscalar *
builtin_sin(vlist *args)
{
    return CALL_MATH_1(sin);
}

static vscalar *
builtin_sqrt(vlist *args)
{
    return CALL_MATH_1(sqrt);
}

static vscalar *
builtin_tan(vlist *args)
{
    return CALL_MATH_1(tan);
}