X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=src%2Flanguage%2Fexpressions%2Fparse.c;h=0789fb294d39933fa1f54f2a4fc4fb92c7b72d95;hb=80ff0f10da00eae4c7b3b07266a03e403e97d640;hp=272090b17db88983700ae9c1fe952d75dc80abb1;hpb=480a0746507ce73d26f528b56dc3ed80195096e0;p=pspp diff --git a/src/language/expressions/parse.c b/src/language/expressions/parse.c index 272090b17d..0789fb294d 100644 --- a/src/language/expressions/parse.c +++ b/src/language/expressions/parse.c @@ -1,20 +1,18 @@ -/* PSPP - computes sample statistics. - Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc. +/* PSPP - a program for statistical analysis. + Copyright (C) 1997-9, 2000, 2006, 2010, 2011, 2012, 2014 Free Software Foundation, Inc. - This program 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 2 of the - License, or (at your option) any later version. + This program 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 of the License, or + (at your option) any later version. - This program 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. + This program 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 this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA - 02110-1301, USA. */ + along with this program. If not, see . */ #include @@ -25,26 +23,30 @@ #include #include -#include "helpers.h" -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include +#include "data/case.h" +#include "data/dictionary.h" +#include "data/settings.h" +#include "data/variable.h" +#include "language/expressions/helpers.h" +#include "language/lexer/format-parser.h" +#include "language/lexer/lexer.h" +#include "language/lexer/variable-parser.h" +#include "libpspp/array.h" +#include "libpspp/assertion.h" +#include "libpspp/i18n.h" +#include "libpspp/message.h" +#include "libpspp/misc.h" +#include "libpspp/pool.h" +#include "libpspp/str.h" + +#include "gl/c-strcase.h" +#include "gl/minmax.h" +#include "gl/xalloc.h" /* Declarations. */ /* Recursive descent parser in order of increasing precedence. */ -typedef union any_node *parse_recursively_func (struct lexer *, struct expression *); +typedef struct expr_node *parse_recursively_func (struct lexer *, struct expression *); static parse_recursively_func parse_or, parse_and, parse_not; static parse_recursively_func parse_rel, parse_add, parse_mul; static parse_recursively_func parse_neg, parse_exp; @@ -53,56 +55,103 @@ static parse_recursively_func parse_vector_element, parse_function; /* Utility functions. */ static struct expression *expr_create (struct dataset *ds); -atom_type expr_node_returns (const union any_node *); +atom_type expr_node_returns (const struct expr_node *); static const char *atom_type_name (atom_type); -static struct expression *finish_expression (union any_node *, +static struct expression *finish_expression (struct expr_node *, struct expression *); -static bool type_check (struct expression *, union any_node **, - enum expr_type expected_type); -static union any_node *allocate_unary_variable (struct expression *, - struct variable *); +static bool type_check (const struct expression *, const struct expr_node *, + enum val_type expected_type); +static struct expr_node *allocate_unary_variable (struct expression *, + const struct variable *); /* Public functions. */ -/* Parses an expression of the given TYPE. - If DICT is nonnull then variables and vectors within it may be - referenced within the expression; otherwise, the expression - must not reference any variables or vectors. - Returns the new expression if successful or a null pointer - otherwise. */ +static struct expr_node * +parse_expr (struct lexer *lexer, struct expression *e) +{ + struct expr_node *n = parse_or (lexer, e); + if (n && n->type == OP_VEC_ELEM_NUM_RAW) + n->type = OP_VEC_ELEM_NUM; + return n; +} + +/* Parses an expression of the given TYPE. If DS is nonnull then variables and + vectors within it may be referenced within the expression; otherwise, the + expression must not reference any variables or vectors. Returns the new + expression if successful or a null pointer otherwise. */ struct expression * -expr_parse (struct lexer *lexer, struct dataset *ds, enum expr_type type) +expr_parse (struct lexer *lexer, struct dataset *ds, enum val_type type) { - union any_node *n; - struct expression *e; + assert (val_type_is_valid (type)); - assert (type == EXPR_NUMBER || type == EXPR_STRING || type == EXPR_BOOLEAN); + struct expression *e = expr_create (ds); + struct expr_node *n = parse_expr (lexer, e); + if (!n || !type_check (e, n, type)) + { + expr_free (e); + return NULL; + } - e = expr_create (ds); - n = parse_or (lexer, e); - if (n != NULL && type_check (e, &n, type)) - return finish_expression (expr_optimize (n, e), e); - else + return finish_expression (expr_optimize (n, e), e); +} + +/* Parses a boolean expression, otherwise similar to expr_parse(). */ +struct expression * +expr_parse_bool (struct lexer *lexer, struct dataset *ds) +{ + struct expression *e = expr_create (ds); + struct expr_node *n = parse_expr (lexer, e); + if (!n) + { + expr_free (e); + return NULL; + } + + atom_type actual_type = expr_node_returns (n); + if (actual_type == OP_number) + n = expr_allocate_unary (e, OP_EXPR_TO_BOOLEAN, n); + else if (actual_type != OP_boolean) { + msg_at (SE, expr_location (e, n), + _("Type mismatch: expression has %s type, " + "but a boolean value is required here."), + atom_type_name (actual_type)); expr_free (e); - return NULL; + return NULL; } + + return finish_expression (expr_optimize (n, e), e); } -/* Parses and returns an expression of the given TYPE, as - expr_parse(), and sets up so that destroying POOL will free - the expression as well. */ +/* Parses a numeric expression that is intended to be assigned to newly created + variable NEW_VAR_NAME. (This allows for a better error message if the + expression is not numeric.) Otherwise similar to expr_parse(). */ struct expression * -expr_parse_pool (struct lexer *lexer, - struct pool *pool, - struct dataset *ds, - enum expr_type type) +expr_parse_new_variable (struct lexer *lexer, struct dataset *ds, + const char *new_var_name) { - struct expression *e = expr_parse (lexer, ds, type); - if (e != NULL) - pool_add_subpool (pool, e->expr_pool); - return e; + struct expression *e = expr_create (ds); + struct expr_node *n = parse_expr (lexer, e); + if (!n) + { + expr_free (e); + return NULL; + } + + atom_type actual_type = expr_node_returns (n); + if (actual_type != OP_number && actual_type != OP_boolean) + { + msg (SE, _("This command tries to create a new variable %s by assigning a " + "string value to it, but this is not supported. Use " + "the STRING command to create the new variable with the " + "correct width before assigning to it, e.g. STRING %s(A20)."), + new_var_name, new_var_name); + expr_free (e); + return NULL; + } + + return finish_expression (expr_optimize (n, e), e); } /* Free expression E. */ @@ -116,17 +165,17 @@ expr_free (struct expression *e) struct expression * expr_parse_any (struct lexer *lexer, struct dataset *ds, bool optimize) { - union any_node *n; + struct expr_node *n; struct expression *e; e = expr_create (ds); - n = parse_or (lexer, e); + n = parse_expr (lexer, e); if (n == NULL) { expr_free (e); return NULL; } - + if (optimize) n = expr_optimize (n, e); return finish_expression (n, e); @@ -135,7 +184,7 @@ expr_parse_any (struct lexer *lexer, struct dataset *ds, bool optimize) /* Finishing up expression building. */ /* Height of an expression's stacks. */ -struct stack_heights +struct stack_heights { int number_height; /* Height of number stack. */ int string_height; /* Height of string stack. */ @@ -152,11 +201,12 @@ static const struct stack_heights * atom_type_stack (atom_type type) { assert (is_atom (type)); - - switch (type) + + switch (type) { case OP_number: case OP_boolean: + case OP_num_vec_elem: return &on_number_stack; case OP_string: @@ -170,8 +220,9 @@ atom_type_stack (atom_type type) case OP_integer: case OP_pos_int: case OP_vector: + case OP_expr_node: return ¬_on_stack; - + default: NOT_REACHED (); } @@ -182,19 +233,19 @@ atom_type_stack (atom_type type) the final stack height. Updates *MAX, if necessary, to reflect the maximum intermediate or final height. */ static void -measure_stack (const union any_node *n, +measure_stack (const struct expr_node *n, struct stack_heights *height, struct stack_heights *max) { const struct stack_heights *return_height; - if (is_composite (n->type)) + if (is_composite (n->type)) { struct stack_heights args; int i; args = *height; - for (i = 0; i < n->composite.arg_cnt; i++) - measure_stack (n->composite.args[i], &args, max); + for (i = 0; i < n->n_args; i++) + measure_stack (n->args[i], &args, max); return_height = atom_type_stack (operations[n->type].returns); } @@ -212,7 +263,7 @@ measure_stack (const union any_node *n, /* Allocates stacks within E sufficient for evaluating node N. */ static void -allocate_stacks (union any_node *n, struct expression *e) +allocate_stacks (struct expr_node *n, struct expression *e) { struct stack_heights initial = {0, 0}; struct stack_heights max = {0, 0}; @@ -226,7 +277,7 @@ allocate_stacks (union any_node *n, struct expression *e) /* Finalizes expression E for evaluating node N. */ static struct expression * -finish_expression (union any_node *n, struct expression *e) +finish_expression (struct expr_node *n, struct expression *e) { /* Allocate stacks. */ allocate_stacks (n, e); @@ -246,31 +297,30 @@ finish_expression (union any_node *n, struct expression *e) converted to type EXPECTED_TYPE, inserting a conversion at *N if necessary. Returns true if successful, false on failure. */ static bool -type_check (struct expression *e, - union any_node **n, enum expr_type expected_type) +type_check (const struct expression *e, const struct expr_node *n, + enum val_type expected_type) { - atom_type actual_type = expr_node_returns (*n); + atom_type actual_type = expr_node_returns (n); - switch (expected_type) + switch (expected_type) { - case EXPR_BOOLEAN: - case EXPR_NUMBER: + case VAL_NUMERIC: if (actual_type != OP_number && actual_type != OP_boolean) { - msg (SE, _("Type mismatch: expression has %s type, " - "but a numeric value is required here."), + msg_at (SE, expr_location (e, n), + _("Type mismatch: expression has type '%s', " + "but a numeric value is required."), atom_type_name (actual_type)); return false; } - if (actual_type == OP_number && expected_type == OP_boolean) - *n = expr_allocate_unary (e, OP_NUM_TO_BOOLEAN, *n); break; - - case EXPR_STRING: + + case VAL_STRING: if (actual_type != OP_string) { - msg (SE, _("Type mismatch: expression has %s type, " - "but a string value is required here."), + msg_at (SE, expr_location (e, n), + _("Type mismatch: expression has type '%s', " + "but a string value is required."), atom_type_name (actual_type)); return false; } @@ -279,60 +329,131 @@ type_check (struct expression *e, default: NOT_REACHED (); } - + return true; } /* Recursive-descent expression parser. */ -/* Considers whether *NODE may be coerced to type REQUIRED_TYPE. - Returns true if possible, false if disallowed. +static void +free_msg_location (void *loc_) +{ + struct msg_location *loc = loc_; + msg_location_destroy (loc); +} - If DO_COERCION is false, then *NODE is not modified and there - are no side effects. +static void +expr_location__ (struct expression *e, + const struct expr_node *node, + const struct msg_location **minp, + const struct msg_location **maxp) +{ + struct msg_location *loc = node->location; + if (loc) + { + const struct msg_location *min = *minp; + if (loc->start.line + && (!min + || loc->start.line < min->start.line + || (loc->start.line == min->start.line + && loc->start.column < min->start.column))) + *minp = loc; + + const struct msg_location *max = *maxp; + if (loc->end.line + && (!max + || loc->end.line > max->end.line + || (loc->end.line == max->end.line + && loc->end.column > max->end.column))) + *maxp = loc; + + return; + } - If DO_COERCION is true, we perform the coercion if possible, - modifying *NODE if necessary. If the coercion is not possible - then we free *NODE and set *NODE to a null pointer. + if (is_composite (node->type)) + for (size_t i = 0; i < node->n_args; i++) + expr_location__ (e, node->args[i], minp, maxp); +} - This function's interface is somewhat awkward. Use one of the - wrapper functions type_coercion(), type_coercion_assert(), or - is_coercible() instead. */ -static bool -type_coercion_core (struct expression *e, - atom_type required_type, - union any_node **node, - const char *operator_name, - bool do_coercion) +/* Returns the source code location corresponding to expression NODE, computing + it lazily if needed. */ +const struct msg_location * +expr_location (const struct expression *e_, const struct expr_node *node_) { - atom_type actual_type; + struct expr_node *node = CONST_CAST (struct expr_node *, node_); + if (!node) + return NULL; - assert (!!do_coercion == (e != NULL)); - if (*node == NULL) + if (!node->location) { - /* Propagate error. Whatever caused the original error - already emitted an error message. */ - return false; + struct expression *e = CONST_CAST (struct expression *, e_); + const struct msg_location *min = NULL; + const struct msg_location *max = NULL; + expr_location__ (e, node, &min, &max); + if (min && max) + { + node->location = msg_location_dup (min); + node->location->end = max->end; + pool_register (e->expr_pool, free_msg_location, node->location); + } + } + return node->location; +} + +/* Sets e->location to the tokens in S's lexer from offset START_OFS to the + token before the current one. Has no effect if E already has a location or + if E is null. */ +static void +expr_add_location (struct lexer *lexer, struct expression *e, + int start_ofs, struct expr_node *node) +{ + if (node && !node->location) + { + node->location = lex_ofs_location (lexer, start_ofs, lex_ofs (lexer) - 1); + pool_register (e->expr_pool, free_msg_location, node->location); } +} - actual_type = expr_node_returns (*node); - if (actual_type == required_type) +static bool +type_coercion__ (struct expression *e, struct expr_node *node, size_t arg_idx, + bool do_coercion) +{ + assert (!!do_coercion == (e != NULL)); + + if (!node) + return false; + + struct expr_node **argp = &node->args[arg_idx]; + struct expr_node *arg = *argp; + if (!arg) + return false; + + const struct operation *op = &operations[node->type]; + atom_type required_type = op->args[MIN (arg_idx, op->n_args - 1)]; + atom_type actual_type = expr_node_returns (arg); + if (actual_type == required_type) { /* Type match. */ - return true; + return true; } - switch (required_type) + switch (required_type) { case OP_number: - if (actual_type == OP_boolean) + if (actual_type == OP_boolean) { /* To enforce strict typing rules, insert Boolean to numeric "conversion". This conversion is a no-op, so it will be removed later. */ if (do_coercion) - *node = expr_allocate_unary (e, OP_BOOLEAN_TO_NUM, *node); - return true; + *argp = expr_allocate_unary (e, OP_BOOLEAN_TO_NUM, arg); + return true; + } + else if (actual_type == OP_num_vec_elem) + { + if (do_coercion) + arg->type = OP_VEC_ELEM_NUM; + return true; } break; @@ -345,23 +466,35 @@ type_coercion_core (struct expression *e, { /* Convert numeric to boolean. */ if (do_coercion) - *node = expr_allocate_unary (e, OP_NUM_TO_BOOLEAN, *node); + *argp = expr_allocate_binary (e, OP_OPERAND_TO_BOOLEAN, arg, + expr_allocate_expr_node (e, node)); + return true; + } + break; + + case OP_integer: + if (actual_type == OP_number) + { + /* Convert number to integer. */ + if (do_coercion) + *argp = expr_allocate_unary (e, OP_NUM_TO_INTEGER, arg); return true; } break; case OP_format: + /* We never coerce to OP_format, only to OP_ni_format or OP_no_format. */ NOT_REACHED (); case OP_ni_format: msg_disable (); - if ((*node)->type == OP_format - && fmt_check_input (&(*node)->format.f) - && fmt_check_type_compat (&(*node)->format.f, VAR_NUMERIC)) + if (arg->type == OP_format + && fmt_check_input (&arg->format) + && fmt_check_type_compat (&arg->format, VAL_NUMERIC)) { msg_enable (); if (do_coercion) - (*node)->type = OP_ni_format; + arg->type = OP_ni_format; return true; } msg_enable (); @@ -369,52 +502,52 @@ type_coercion_core (struct expression *e, case OP_no_format: msg_disable (); - if ((*node)->type == OP_format - && fmt_check_output (&(*node)->format.f) - && fmt_check_type_compat (&(*node)->format.f, VAR_NUMERIC)) + if (arg->type == OP_format + && fmt_check_output (&arg->format) + && fmt_check_type_compat (&arg->format, VAL_NUMERIC)) { msg_enable (); if (do_coercion) - (*node)->type = OP_no_format; + arg->type = OP_no_format; return true; } msg_enable (); break; case OP_num_var: - if ((*node)->type == OP_NUM_VAR) + if (arg->type == OP_NUM_VAR) { if (do_coercion) - *node = (*node)->composite.args[0]; + *argp = arg->args[0]; return true; } break; case OP_str_var: - if ((*node)->type == OP_STR_VAR) + if (arg->type == OP_STR_VAR) { if (do_coercion) - *node = (*node)->composite.args[0]; + *argp = arg->args[0]; return true; } break; case OP_var: - if ((*node)->type == OP_NUM_VAR || (*node)->type == OP_STR_VAR) + if (arg->type == OP_NUM_VAR || arg->type == OP_STR_VAR) { if (do_coercion) - *node = (*node)->composite.args[0]; + *argp = arg->args[0]; return true; } break; case OP_pos_int: - if ((*node)->type == OP_number - && floor ((*node)->number.n) == (*node)->number.n - && (*node)->number.n > 0 && (*node)->number.n < INT_MAX) + if (arg->type == OP_number + && floor (arg->number) == arg->number + && arg->number > 0 && arg->number < INT_MAX) { if (do_coercion) - *node = expr_allocate_pos_int (e, (*node)->number.n); + *argp = expr_allocate_pos_int (e, arg->number); return true; } break; @@ -422,359 +555,332 @@ type_coercion_core (struct expression *e, default: NOT_REACHED (); } - - if (do_coercion) - { - msg (SE, _("Type mismatch while applying %s operator: " - "cannot convert %s to %s."), - operator_name, - atom_type_name (actual_type), atom_type_name (required_type)); - *node = NULL; - } return false; } -/* Coerces *NODE to type REQUIRED_TYPE, and returns success. If - *NODE cannot be coerced to the desired type then we issue an - error message about operator OPERATOR_NAME and free *NODE. */ static bool -type_coercion (struct expression *e, - atom_type required_type, union any_node **node, - const char *operator_name) -{ - return type_coercion_core (e, required_type, node, operator_name, true); -} - -/* Coerces *NODE to type REQUIRED_TYPE. - Assert-fails if the coercion is disallowed. */ -static void -type_coercion_assert (struct expression *e, - atom_type required_type, union any_node **node) +type_coercion (struct expression *e, struct expr_node *node, size_t arg_idx) { - int success = type_coercion_core (e, required_type, node, NULL, true); - assert (success); + return type_coercion__ (e, node, arg_idx, true); } -/* Returns true if *NODE may be coerced to type REQUIRED_TYPE, - false otherwise. */ static bool -is_coercible (atom_type required_type, union any_node *const *node) +is_coercible (const struct expr_node *node_, size_t arg_idx) { - return type_coercion_core (NULL, required_type, - (union any_node **) node, NULL, false); + struct expr_node *node = CONST_CAST (struct expr_node *, node_); + return type_coercion__ (NULL, node, arg_idx, false); } -/* Returns true if ACTUAL_TYPE is a kind of REQUIRED_TYPE, false - otherwise. */ -static bool -is_compatible (atom_type required_type, atom_type actual_type) -{ - return (required_type == actual_type - || (required_type == OP_var - && (actual_type == OP_num_var || actual_type == OP_str_var))); -} +/* How to parse an operator. -/* How to parse an operator. */ + Some operators support both numeric and string operators. For those, + 'num_op' and 'str_op' are both nonzero. Otherwise, only one 'num_op' is + nonzero. (PSPP doesn't have any string-only operators.) */ struct operator { - int token; /* Token representing operator. */ - operation_type type; /* Operation type representing operation. */ - const char *name; /* Name of operator. */ + enum token_type token; /* Operator token. */ + operation_type num_op; /* Operation for numeric operands (or 0). */ + operation_type str_op; /* Operation for string operands (or 0). */ }; -/* Attempts to match the current token against the tokens for the - OP_CNT operators in OPS[]. If successful, returns true - and, if OPERATOR is non-null, sets *OPERATOR to the operator. - On failure, returns false and, if OPERATOR is non-null, sets - *OPERATOR to a null pointer. */ -static bool -match_operator (struct lexer *lexer, const struct operator ops[], size_t op_cnt, - const struct operator **operator) +static operation_type +match_operator (struct lexer *lexer, const struct operator ops[], size_t n_ops, + const struct expr_node *lhs) { - const struct operator *op; + bool lhs_is_numeric = operations[lhs->type].returns != OP_string; + for (const struct operator *op = ops; op < ops + n_ops; op++) + if (lex_token (lexer) == op->token) + { + if (op->token != T_NEG_NUM) + lex_get (lexer); - for (op = ops; op < ops + op_cnt; op++) - { - if (op->token == '-') - lex_negative_to_dash (lexer); - if (lex_match (lexer, op->token)) - { - if (operator != NULL) - *operator = op; - return true; - } - } - if (operator != NULL) - *operator = NULL; - return false; + return op->str_op && !lhs_is_numeric ? op->str_op : op->num_op; + } + return 0; } -static bool -check_operator (const struct operator *op, int arg_cnt, atom_type arg_type) +static const char * +operator_name (enum token_type token) { - const struct operation *o; - size_t i; - - assert (op != NULL); - o = &operations[op->type]; - assert (o->arg_cnt == arg_cnt); - assert ((o->flags & OPF_ARRAY_OPERAND) == 0); - for (i = 0; i < arg_cnt; i++) - assert (is_compatible (arg_type, o->args[i])); - return true; + return token == T_NEG_NUM ? "-" : token_type_to_string (token); } -static bool -check_binary_operators (const struct operator ops[], size_t op_cnt, - atom_type arg_type) +static struct expr_node * +parse_binary_operators__ (struct lexer *lexer, struct expression *e, + const struct operator ops[], size_t n_ops, + parse_recursively_func *parse_next_level, + const char *chain_warning, struct expr_node *lhs) { - size_t i; + for (int op_count = 0; ; op_count++) + { + enum token_type token = lex_token (lexer); + operation_type optype = match_operator (lexer, ops, n_ops, lhs); + if (!optype) + { + if (op_count > 1 && chain_warning) + msg_at (SW, expr_location (e, lhs), "%s", chain_warning); - for (i = 0; i < op_cnt; i++) - check_operator (&ops[i], 2, arg_type); - return true; -} + return lhs; + } -static atom_type -get_operand_type (const struct operator *op) -{ - return operations[op->type].args[0]; -} + struct expr_node *rhs = parse_next_level (lexer, e); + if (!rhs) + return NULL; -/* Parses a chain of left-associative operator/operand pairs. - There are OP_CNT operators, specified in OPS[]. The - operators' operands must all be the same type. The next - higher level is parsed by PARSE_NEXT_LEVEL. If CHAIN_WARNING - is non-null, then it will be issued as a warning if more than - one operator/operand pair is parsed. */ -static union any_node * -parse_binary_operators (struct lexer *lexer, struct expression *e, union any_node *node, - const struct operator ops[], size_t op_cnt, - parse_recursively_func *parse_next_level, - const char *chain_warning) -{ - atom_type operand_type = get_operand_type (&ops[0]); - int op_count; - const struct operator *operator; + struct expr_node *node = expr_allocate_binary (e, optype, lhs, rhs); + if (!is_coercible (node, 0) || !is_coercible (node, 1)) + { + bool both = false; + for (size_t i = 0; i < n_ops; i++) + if (ops[i].token == token) + both = ops[i].num_op && ops[i].str_op; + + const char *name = operator_name (token); + if (both) + msg_at (SE, expr_location (e, node), + _("Both operands of %s must have the same type."), name); + else if (operations[node->type].args[0] != OP_string) + msg_at (SE, expr_location (e, node), + _("Both operands of %s must be numeric."), name); + else + NOT_REACHED (); - assert (check_binary_operators (ops, op_cnt, operand_type)); - if (node == NULL) - return node; + msg_at (SN, expr_location (e, node->args[0]), + _("This operand has type '%s'."), + atom_type_name (expr_node_returns (node->args[0]))); + msg_at (SN, expr_location (e, node->args[1]), + _("This operand has type '%s'."), + atom_type_name (expr_node_returns (node->args[1]))); - for (op_count = 0; match_operator (lexer, ops, op_cnt, &operator); op_count++) - { - union any_node *rhs; + return NULL; + } - /* Convert the left-hand side to type OPERAND_TYPE. */ - if (!type_coercion (e, operand_type, &node, operator->name)) - return NULL; + if (!type_coercion (e, node, 0) || !type_coercion (e, node, 1)) + NOT_REACHED (); - /* Parse the right-hand side and coerce to type - OPERAND_TYPE. */ - rhs = parse_next_level (lexer, e); - if (!type_coercion (e, operand_type, &rhs, operator->name)) - return NULL; - node = expr_allocate_binary (e, operator->type, node, rhs); + lhs = node; } +} - if (op_count > 1 && chain_warning != NULL) - msg (SW, chain_warning); +static struct expr_node * +parse_binary_operators (struct lexer *lexer, struct expression *e, + const struct operator ops[], size_t n_ops, + parse_recursively_func *parse_next_level, + const char *chain_warning) +{ + struct expr_node *lhs = parse_next_level (lexer, e); + if (!lhs) + return NULL; - return node; + return parse_binary_operators__ (lexer, e, ops, n_ops, parse_next_level, + chain_warning, lhs); } -static union any_node * +static struct expr_node * parse_inverting_unary_operator (struct lexer *lexer, struct expression *e, const struct operator *op, - parse_recursively_func *parse_next_level) + parse_recursively_func *parse_next_level) { - union any_node *node; - unsigned op_count; + int start_ofs = lex_ofs (lexer); + unsigned int op_count = 0; + while (lex_match (lexer, op->token)) + op_count++; - check_operator (op, 1, get_operand_type (op)); + struct expr_node *inner = parse_next_level (lexer, e); + if (!inner || !op_count) + return inner; - op_count = 0; - while (match_operator (lexer, op, 1, NULL)) - op_count++; + struct expr_node *outer = expr_allocate_unary (e, op->num_op, inner); + expr_add_location (lexer, e, start_ofs, outer); - node = parse_next_level (lexer, e); - if (op_count > 0 - && type_coercion (e, get_operand_type (op), &node, op->name) - && op_count % 2 != 0) - return expr_allocate_unary (e, op->type, node); - else - return node; + if (!type_coercion (e, outer, 0)) + { + assert (operations[outer->type].args[0] != OP_string); + + const char *name = operator_name (op->token); + msg_at (SE, expr_location (e, outer), + _("The unary %s operator requires a numeric operand."), name); + + msg_at (SN, expr_location (e, outer->args[0]), + _("The operand of %s has type '%s'."), + name, atom_type_name (expr_node_returns (outer->args[0]))); + + return NULL; + } + + return op_count % 2 ? outer : outer->args[0]; } /* Parses the OR level. */ -static union any_node * +static struct expr_node * parse_or (struct lexer *lexer, struct expression *e) { - static const struct operator op = - { T_OR, OP_OR, "logical disjunction (\"OR\")" }; - - return parse_binary_operators (lexer, e, parse_and (lexer, e), &op, 1, parse_and, NULL); + static const struct operator op = { .token = T_OR, .num_op = OP_OR }; + return parse_binary_operators (lexer, e, &op, 1, parse_and, NULL); } /* Parses the AND level. */ -static union any_node * +static struct expr_node * parse_and (struct lexer *lexer, struct expression *e) { - static const struct operator op = - { T_AND, OP_AND, "logical conjunction (\"AND\")" }; - - return parse_binary_operators (lexer, e, parse_not (lexer, e), - &op, 1, parse_not, NULL); + static const struct operator op = { .token = T_AND, .num_op = OP_AND }; + + return parse_binary_operators (lexer, e, &op, 1, parse_not, NULL); } /* Parses the NOT level. */ -static union any_node * +static struct expr_node * parse_not (struct lexer *lexer, struct expression *e) { - static const struct operator op - = { T_NOT, OP_NOT, "logical negation (\"NOT\")" }; + static const struct operator op = { .token = T_NOT, .num_op = OP_NOT }; return parse_inverting_unary_operator (lexer, e, &op, parse_rel); } /* Parse relational operators. */ -static union any_node * +static struct expr_node * parse_rel (struct lexer *lexer, struct expression *e) { - const char *chain_warning = - _("Chaining relational operators (e.g. \"a < b < c\") will " + const char *chain_warning = + _("Chaining relational operators (e.g. `a < b < c') will " "not produce the mathematically expected result. " "Use the AND logical operator to fix the problem " - "(e.g. \"a < b AND b < c\"). " - "If chaining is really intended, parentheses will disable " - "this warning (e.g. \"(a < b) < c\".)"); - - union any_node *node = parse_add (lexer, e); + "(e.g. `a < b AND b < c'). " + "To disable this warning, insert parentheses."); - if (node == NULL) - return NULL; - - switch (expr_node_returns (node)) + static const struct operator ops[] = { - case OP_number: - case OP_boolean: - { - static const struct operator ops[] = - { - { '=', OP_EQ, "numeric equality (\"=\")" }, - { T_EQ, OP_EQ, "numeric equality (\"EQ\")" }, - { T_GE, OP_GE, "numeric greater-than-or-equal-to (\">=\")" }, - { T_GT, OP_GT, "numeric greater than (\">\")" }, - { T_LE, OP_LE, "numeric less-than-or-equal-to (\"<=\")" }, - { T_LT, OP_LT, "numeric less than (\"<\")" }, - { T_NE, OP_NE, "numeric inequality (\"<>\")" }, - }; - - return parse_binary_operators (lexer, e, node, ops, - sizeof ops / sizeof *ops, - parse_add, chain_warning); - } - - case OP_string: - { - static const struct operator ops[] = - { - { '=', OP_EQ_STRING, "string equality (\"=\")" }, - { T_EQ, OP_EQ_STRING, "string equality (\"EQ\")" }, - { T_GE, OP_GE_STRING, "string greater-than-or-equal-to (\">=\")" }, - { T_GT, OP_GT_STRING, "string greater than (\">\")" }, - { T_LE, OP_LE_STRING, "string less-than-or-equal-to (\"<=\")" }, - { T_LT, OP_LT_STRING, "string less than (\"<\")" }, - { T_NE, OP_NE_STRING, "string inequality (\"<>\")" }, - }; - - return parse_binary_operators (lexer, e, node, ops, - sizeof ops / sizeof *ops, - parse_add, chain_warning); - } - - default: - return node; - } + { .token = T_EQUALS, .num_op = OP_EQ, .str_op = OP_EQ_STRING }, + { .token = T_EQ, .num_op = OP_EQ, .str_op = OP_EQ_STRING }, + { .token = T_GE, .num_op = OP_GE, .str_op = OP_GE_STRING }, + { .token = T_GT, .num_op = OP_GT, .str_op = OP_GT_STRING }, + { .token = T_LE, .num_op = OP_LE, .str_op = OP_LE_STRING }, + { .token = T_LT, .num_op = OP_LT, .str_op = OP_LT_STRING }, + { .token = T_NE, .num_op = OP_NE, .str_op = OP_NE_STRING }, + }; + + return parse_binary_operators (lexer, e, ops, sizeof ops / sizeof *ops, + parse_add, chain_warning); } /* Parses the addition and subtraction level. */ -static union any_node * +static struct expr_node * parse_add (struct lexer *lexer, struct expression *e) { - static const struct operator ops[] = + static const struct operator ops[] = { - { '+', OP_ADD, "addition (\"+\")" }, - { '-', OP_SUB, "subtraction (\"-\")" }, + { .token = T_PLUS, .num_op = OP_ADD }, + { .token = T_DASH, .num_op = OP_SUB }, + { .token = T_NEG_NUM, .num_op = OP_ADD }, }; - - return parse_binary_operators (lexer, e, parse_mul (lexer, e), - ops, sizeof ops / sizeof *ops, + + return parse_binary_operators (lexer, e, ops, sizeof ops / sizeof *ops, parse_mul, NULL); } /* Parses the multiplication and division level. */ -static union any_node * +static struct expr_node * parse_mul (struct lexer *lexer, struct expression *e) { - static const struct operator ops[] = + static const struct operator ops[] = { - { '*', OP_MUL, "multiplication (\"*\")" }, - { '/', OP_DIV, "division (\"/\")" }, + { .token = T_ASTERISK, .num_op = OP_MUL }, + { .token = T_SLASH, .num_op = OP_DIV }, }; - - return parse_binary_operators (lexer, e, parse_neg (lexer, e), - ops, sizeof ops / sizeof *ops, + + return parse_binary_operators (lexer, e, ops, sizeof ops / sizeof *ops, parse_neg, NULL); } /* Parses the unary minus level. */ -static union any_node * +static struct expr_node * parse_neg (struct lexer *lexer, struct expression *e) { - static const struct operator op = { '-', OP_NEG, "negation (\"-\")" }; + static const struct operator op = { .token = T_DASH, .num_op = OP_NEG }; return parse_inverting_unary_operator (lexer, e, &op, parse_exp); } -static union any_node * +static struct expr_node * parse_exp (struct lexer *lexer, struct expression *e) { - static const struct operator op = - { T_EXP, OP_POW, "exponentiation (\"**\")" }; - - const char *chain_warning = - _("The exponentiation operator (\"**\") is left-associative, " - "even though right-associative semantics are more useful. " - "That is, \"a**b**c\" equals \"(a**b)**c\", not as \"a**(b**c)\". " + static const struct operator op = { .token = T_EXP, .num_op = OP_POW }; + + const char *chain_warning = + _("The exponentiation operator (`**') is left-associative: " + "`a**b**c' equals `(a**b)**c', not `a**(b**c)'. " "To disable this warning, insert parentheses."); - return parse_binary_operators (lexer, e, parse_primary (lexer, e), &op, 1, - parse_primary, chain_warning); + if (lex_token (lexer) != T_NEG_NUM || lex_next_token (lexer, 1) != T_EXP) + return parse_binary_operators (lexer, e, &op, 1, + parse_primary, chain_warning); + + /* Special case for situations like "-5**6", which must be parsed as + -(5**6). */ + + int start_ofs = lex_ofs (lexer); + struct expr_node *lhs = expr_allocate_number (e, -lex_tokval (lexer)); + lex_get (lexer); + expr_add_location (lexer, e, start_ofs, lhs); + + struct expr_node *node = parse_binary_operators__ ( + lexer, e, &op, 1, parse_primary, chain_warning, lhs); + if (!node) + return NULL; + + node = expr_allocate_unary (e, OP_NEG, node); + expr_add_location (lexer, e, start_ofs, node); + return node; +} + +static double +ymd_to_offset (int y, int m, int d) +{ + char *error; + double retval = calendar_gregorian_to_offset ( + y, m, d, settings_get_fmt_settings (), &error); + if (error) + { + msg (SE, "%s", error); + free (error); + } + return retval; +} + +static struct expr_node * +expr_date (struct expression *e, int year_digits) +{ + static const char *months[12] = + { + "JAN", "FEB", "MAR", "APR", "MAY", "JUN", + "JUL", "AUG", "SEP", "OCT", "NOV", "DEC", + }; + + time_t last_proc_time = time_of_last_procedure (e->ds); + struct tm *time = localtime (&last_proc_time); + + char *tmp = (year_digits == 2 + ? xasprintf ("%02d-%s-%02d", time->tm_mday, months[time->tm_mon], + time->tm_year % 100) + : xasprintf ("%02d-%s-%04d", time->tm_mday, months[time->tm_mon], + time->tm_year + 1900)); + + struct substring s; + ss_alloc_substring_pool (&s, ss_cstr (tmp), e->expr_pool); + + free (tmp); + + return expr_allocate_string (e, s); } /* Parses system variables. */ -static union any_node * +static struct expr_node * parse_sysvar (struct lexer *lexer, struct expression *e) { if (lex_match_id (lexer, "$CASENUM")) return expr_allocate_nullary (e, OP_CASENUM); else if (lex_match_id (lexer, "$DATE")) - { - static const char *months[12] = - { - "JAN", "FEB", "MAR", "APR", "MAY", "JUN", - "JUL", "AUG", "SEP", "OCT", "NOV", "DEC", - }; - - time_t last_proc_time = time_of_last_procedure (e->ds); - struct tm *time; - char temp_buf[10]; - - time = localtime (&last_proc_time); - sprintf (temp_buf, "%02d %s %02d", abs (time->tm_mday) % 100, - months[abs (time->tm_mon) % 12], abs (time->tm_year) % 100); - - return expr_allocate_string_buffer (e, temp_buf, strlen (temp_buf)); - } + return expr_date (e, 2); + else if (lex_match_id (lexer, "$DATE11")) + return expr_date (e, 4); else if (lex_match_id (lexer, "$TRUE")) return expr_allocate_boolean (e, 1.0); else if (lex_match_id (lexer, "$FALSE")) @@ -785,16 +891,15 @@ parse_sysvar (struct lexer *lexer, struct expression *e) { time_t time = time_of_last_procedure (e->ds); struct tm *tm = localtime (&time); - return expr_allocate_number (e, expr_ymd_to_ofs (tm->tm_year + 1900, - tm->tm_mon + 1, - tm->tm_mday)); + return expr_allocate_number (e, ymd_to_offset (tm->tm_year + 1900, + tm->tm_mon + 1, + tm->tm_mday)); } else if (lex_match_id (lexer, "$TIME")) { time_t time = time_of_last_procedure (e->ds); struct tm *tm = localtime (&time); - return expr_allocate_number (e, - expr_ymd_to_date (tm->tm_year + 1900, + return expr_allocate_number (e, ymd_to_offset (tm->tm_year + 1900, tm->tm_mon + 1, tm->tm_mday) + tm->tm_hour * 60 * 60. @@ -802,51 +907,51 @@ parse_sysvar (struct lexer *lexer, struct expression *e) + tm->tm_sec); } else if (lex_match_id (lexer, "$LENGTH")) - return expr_allocate_number (e, get_viewlength ()); + return expr_allocate_number (e, settings_get_viewlength ()); else if (lex_match_id (lexer, "$WIDTH")) - return expr_allocate_number (e, get_viewwidth ()); + return expr_allocate_number (e, settings_get_viewwidth ()); else { - msg (SE, _("Unknown system variable %s."), lex_tokid (lexer)); + msg (SE, _("Unknown system variable %s."), lex_tokcstr (lexer)); return NULL; } } /* Parses numbers, varnames, etc. */ -static union any_node * -parse_primary (struct lexer *lexer, struct expression *e) +static struct expr_node * +parse_primary__ (struct lexer *lexer, struct expression *e) { switch (lex_token (lexer)) { case T_ID: - if (lex_look_ahead (lexer) == '(') + if (lex_next_token (lexer, 1) == T_LPAREN) { /* An identifier followed by a left parenthesis may be a vector element reference. If not, it's a function call. */ - if (e->ds != NULL && dict_lookup_vector (dataset_dict (e->ds), lex_tokid (lexer)) != NULL) + if (e->ds != NULL && dict_lookup_vector (dataset_dict (e->ds), lex_tokcstr (lexer)) != NULL) return parse_vector_element (lexer, e); else return parse_function (lexer, e); } - else if (lex_tokid (lexer)[0] == '$') + else if (lex_tokcstr (lexer)[0] == '$') { /* $ at the beginning indicates a system variable. */ return parse_sysvar (lexer, e); } - else if (e->ds != NULL && dict_lookup_var (dataset_dict (e->ds), lex_tokid (lexer))) + else if (e->ds != NULL && dict_lookup_var (dataset_dict (e->ds), lex_tokcstr (lexer))) { /* It looks like a user variable. (It could be a format specifier, but we'll assume it's a variable unless proven otherwise. */ return allocate_unary_variable (e, parse_variable (lexer, dataset_dict (e->ds))); } - else + else { /* Try to parse it as a format specifier. */ struct fmt_spec fmt; bool ok; - + msg_disable (); ok = parse_format_specifier (lexer, &fmt); msg_enable (); @@ -855,94 +960,126 @@ parse_primary (struct lexer *lexer, struct expression *e) return expr_allocate_format (e, &fmt); /* All attempts failed. */ - msg (SE, _("Unknown identifier %s."), lex_tokid (lexer)); + msg (SE, _("Unknown identifier %s."), lex_tokcstr (lexer)); return NULL; } break; - - case T_POS_NUM: - case T_NEG_NUM: + + case T_POS_NUM: + case T_NEG_NUM: { - union any_node *node = expr_allocate_number (e, lex_tokval (lexer) ); + struct expr_node *node = expr_allocate_number (e, lex_tokval (lexer)); lex_get (lexer); - return node; + return node; } case T_STRING: { - union any_node *node = expr_allocate_string_buffer ( - e, ds_cstr (lex_tokstr (lexer) ), ds_length (lex_tokstr (lexer) )); + const char *dict_encoding; + struct expr_node *node; + char *s; + + dict_encoding = (e->ds != NULL + ? dict_get_encoding (dataset_dict (e->ds)) + : "UTF-8"); + s = recode_string_pool (dict_encoding, "UTF-8", lex_tokcstr (lexer), + ss_length (lex_tokss (lexer)), e->expr_pool); + node = expr_allocate_string (e, ss_cstr (s)); + lex_get (lexer); return node; } - case '(': + case T_LPAREN: { - union any_node *node; - lex_get (lexer); - node = parse_or (lexer, e); - if (node != NULL && !lex_match (lexer, ')')) - { - lex_error (lexer, _("expecting `)'")); - return NULL; - } - return node; + lex_get (lexer); + struct expr_node *node = parse_or (lexer, e); + return !node || !lex_force_match (lexer, T_RPAREN) ? NULL : node; } default: - lex_error (lexer, _("in expression")); + lex_error (lexer, NULL); return NULL; } } -static union any_node * +static struct expr_node * +parse_primary (struct lexer *lexer, struct expression *e) +{ + int start_ofs = lex_ofs (lexer); + struct expr_node *node = parse_primary__ (lexer, e); + expr_add_location (lexer, e, start_ofs, node); + return node; +} + +static struct expr_node * parse_vector_element (struct lexer *lexer, struct expression *e) { - const struct vector *vector; - union any_node *element; + int vector_start_ofs = lex_ofs (lexer); /* Find vector, skip token. The caller must already have verified that the current token is the name of a vector. */ - vector = dict_lookup_vector (dataset_dict (e->ds), lex_tokid (lexer)); + const struct vector *vector = dict_lookup_vector (dataset_dict (e->ds), + lex_tokcstr (lexer)); assert (vector != NULL); lex_get (lexer); /* Skip left parenthesis token. The caller must have verified that the lookahead is a left parenthesis. */ - assert (lex_token (lexer) == '('); + assert (lex_token (lexer) == T_LPAREN); lex_get (lexer); - element = parse_or (lexer, e); - if (!type_coercion (e, OP_number, &element, "vector indexing") - || !lex_match (lexer, ')')) + int element_start_ofs = lex_ofs (lexer); + struct expr_node *element = parse_or (lexer, e); + if (!element) + return NULL; + expr_add_location (lexer, e, element_start_ofs, element); + + if (!lex_match (lexer, T_RPAREN)) return NULL; - return expr_allocate_binary (e, (vector_get_type (vector) == VAR_NUMERIC - ? OP_VEC_ELEM_NUM : OP_VEC_ELEM_STR), - element, expr_allocate_vector (e, vector)); + operation_type type = (vector_get_type (vector) == VAL_NUMERIC + ? OP_VEC_ELEM_NUM_RAW : OP_VEC_ELEM_STR); + struct expr_node *node = expr_allocate_binary ( + e, type, element, expr_allocate_vector (e, vector)); + expr_add_location (lexer, e, vector_start_ofs, node); + + if (!type_coercion (e, node, 0)) + { + msg_at (SE, expr_location (e, node), + _("A vector index must be numeric.")); + + msg_at (SN, expr_location (e, node->args[0]), + _("This vector index has type '%s'."), + atom_type_name (expr_node_returns (node->args[0]))); + + return NULL; + } + + return node; } /* Individual function parsing. */ -const struct operation operations[OP_first + OP_cnt] = { +const struct operation operations[OP_first + n_OP] = { #include "parse.inc" }; - + static bool -word_matches (const char **test, const char **name) +word_matches (const char **test, const char **name) { size_t test_len = strcspn (*test, "."); size_t name_len = strcspn (*name, "."); - if (test_len == name_len) + if (test_len == name_len) { if (buf_compare_case (*test, *name, test_len)) return false; } else if (test_len < 3 || test_len > name_len) return false; - else + else { if (buf_compare_case (*test, *name, test_len)) return false; @@ -961,65 +1098,57 @@ word_matches (const char **test, const char **name) return true; } +/* Returns 0 if TOKEN and FUNC do not match, + 1 if TOKEN is an acceptable abbreviation for FUNC, + 2 if TOKEN equals FUNC. */ static int -compare_names (const char *test, const char *name, bool abbrev_ok) +compare_function_names (const char *token_, const char *func_) { - if (!abbrev_ok) - return true; - - for (;;) - { - if (!word_matches (&test, &name)) - return true; - if (*name == '\0' && *test == '\0') - return false; - } + const char *token = token_; + const char *func = func_; + while (*token || *func) + if (!word_matches (&token, &func)) + return 0; + return !c_strcasecmp (token_, func_) ? 2 : 1; } -static int -compare_strings (const char *test, const char *name, bool abbrev_ok UNUSED) +static bool +lookup_function (const char *token, + const struct operation **first, + const struct operation **last) { - return strcasecmp (test, name); -} + *first = *last = NULL; + const struct operation *best = NULL; -static bool -lookup_function_helper (const char *name, - int (*compare) (const char *test, const char *name, - bool abbrev_ok), - const struct operation **first, - const struct operation **last) -{ - const struct operation *f; - - for (f = operations + OP_function_first; - f <= operations + OP_function_last; f++) - if (!compare (name, f->name, !(f->flags & OPF_NO_ABBREV))) - { - *first = f; + for (const struct operation *f = operations + OP_function_first; + f <= operations + OP_function_last; f++) + { + int score = compare_function_names (token, f->name); + if (score == 2) + { + best = f; + break; + } + else if (score == 1 && !(f->flags & OPF_NO_ABBREV) && !best) + best = f; + } - while (f <= operations + OP_function_last - && !compare (name, f->name, !(f->flags & OPF_NO_ABBREV))) - f++; - *last = f; + if (!best) + return false; - return true; - } + *first = best; - return false; -} + const struct operation *f = best; + while (f <= operations + OP_function_last + && !c_strcasecmp (f->name, best->name)) + f++; + *last = f; -static bool -lookup_function (const char *name, - const struct operation **first, - const struct operation **last) -{ - *first = *last = NULL; - return (lookup_function_helper (name, compare_strings, first, last) - || lookup_function_helper (name, compare_names, first, last)); + return true; } static int -extract_min_valid (char *s) +extract_min_valid (const char *s) { char *p = strrchr (s, '.'); if (p == NULL @@ -1030,89 +1159,75 @@ extract_min_valid (char *s) return atoi (p + 1); } -static atom_type -function_arg_type (const struct operation *f, size_t arg_idx) -{ - assert (arg_idx < f->arg_cnt || (f->flags & OPF_ARRAY_OPERAND)); - - return f->args[arg_idx < f->arg_cnt ? arg_idx : f->arg_cnt - 1]; -} - static bool -match_function (union any_node **args, int arg_cnt, const struct operation *f) +match_function__ (struct expr_node *node, const struct operation *f) { - size_t i; - - if (arg_cnt < f->arg_cnt - || (arg_cnt > f->arg_cnt && (f->flags & OPF_ARRAY_OPERAND) == 0) - || arg_cnt - (f->arg_cnt - 1) < f->array_min_elems) + if (node->n_args < f->n_args + || (node->n_args > f->n_args && (f->flags & OPF_ARRAY_OPERAND) == 0) + || node->n_args - (f->n_args - 1) < f->array_min_elems) return false; - for (i = 0; i < arg_cnt; i++) - if (!is_coercible (function_arg_type (f, i), &args[i])) - return false; + node->type = f - operations; + for (size_t i = 0; i < node->n_args; i++) + if (!is_coercible (node, i)) + return false; return true; } -static void -coerce_function_args (struct expression *e, const struct operation *f, - union any_node **args, size_t arg_cnt) +static const struct operation * +match_function (struct expr_node *node, + const struct operation *first, const struct operation *last) { - int i; - - for (i = 0; i < arg_cnt; i++) - type_coercion_assert (e, function_arg_type (f, i), &args[i]); + for (const struct operation *f = first; f < last; f++) + if (match_function__ (node, f)) + return f; + return NULL; } static bool -validate_function_args (const struct operation *f, int arg_cnt, int min_valid) +validate_function_args (const struct expression *e, const struct expr_node *n, + const struct operation *f, int n_args, int min_valid) { - int array_arg_cnt = arg_cnt - (f->arg_cnt - 1); - if (array_arg_cnt < f->array_min_elems) - { - msg (SE, _("%s must have at least %d arguments in list."), - f->prototype, f->array_min_elems); - return false; - } + /* Count the function arguments that go into the trailing array (if any). We + know that there must be at least the minimum number because + match_function() already checked. */ + int array_n_args = n_args - (f->n_args - 1); + assert (array_n_args >= f->array_min_elems); if ((f->flags & OPF_ARRAY_OPERAND) - && array_arg_cnt % f->array_granularity != 0) + && array_n_args % f->array_granularity != 0) { - if (f->array_granularity == 2) - msg (SE, _("%s must have even number of arguments in list."), - f->prototype); - else - msg (SE, _("%s must have multiple of %d arguments in list."), - f->prototype, f->array_granularity); + /* RANGE is the only case we have so far. It has paired arguments with + one initial argument, and that's the only special case we deal with + here. */ + assert (f->array_granularity == 2); + assert (n_args % 2 == 0); + msg_at (SE, expr_location (e, n), + _("%s must have an odd number of arguments."), f->prototype); return false; } - - if (min_valid != -1) + + if (min_valid != -1) { - if (f->array_min_elems == 0) + if (f->array_min_elems == 0) { assert ((f->flags & OPF_MIN_VALID) == 0); - msg (SE, _("%s function does not accept a minimum valid " - "argument count."), f->prototype); + msg_at (SE, expr_location (e, n), + _("%s function cannot accept suffix .%d to specify the " + "minimum number of valid arguments."), + f->prototype, min_valid); return false; } - else + else { assert (f->flags & OPF_MIN_VALID); - if (array_arg_cnt < f->array_min_elems) - { - msg (SE, _("%s requires at least %d valid arguments in list."), - f->prototype, f->array_min_elems); - return false; - } - else if (min_valid > array_arg_cnt) + if (min_valid > array_n_args) { - msg (SE, _("With %s, " - "using minimum valid argument count of %d " - "does not make sense when passing only %d " - "arguments in list."), - f->prototype, min_valid, array_arg_cnt); + msg_at (SE, expr_location (e, n), + _("For %s with %d arguments, at most %d (not %d) may be " + "required to be valid."), + f->prototype, n_args, array_n_args, min_valid); return false; } } @@ -1122,176 +1237,202 @@ validate_function_args (const struct operation *f, int arg_cnt, int min_valid) } static void -add_arg (union any_node ***args, int *arg_cnt, int *arg_cap, - union any_node *arg) +add_arg (struct expr_node ***args, size_t *n_args, size_t *allocated_args, + struct expr_node *arg, + struct expression *e, struct lexer *lexer, int arg_start_ofs) { - if (*arg_cnt >= *arg_cap) - { - *arg_cap += 8; - *args = xrealloc (*args, sizeof **args * *arg_cap); - } + if (*n_args >= *allocated_args) + *args = x2nrealloc (*args, allocated_args, sizeof **args); - (*args)[(*arg_cnt)++] = arg; + expr_add_location (lexer, e, arg_start_ofs, arg); + (*args)[(*n_args)++] = arg; } static void put_invocation (struct string *s, - const char *func_name, union any_node **args, size_t arg_cnt) + const char *func_name, struct expr_node *node) { size_t i; ds_put_format (s, "%s(", func_name); - for (i = 0; i < arg_cnt; i++) + for (i = 0; i < node->n_args; i++) { if (i > 0) ds_put_cstr (s, ", "); - ds_put_cstr (s, operations[expr_node_returns (args[i])].prototype); + ds_put_cstr (s, operations[expr_node_returns (node->args[i])].prototype); } - ds_put_char (s, ')'); + ds_put_byte (s, ')'); } static void -no_match (const char *func_name, - union any_node **args, size_t arg_cnt, - const struct operation *first, const struct operation *last) +no_match (struct expression *e, const char *func_name, struct expr_node *node, + const struct operation *ops, size_t n) { struct string s; - const struct operation *f; ds_init_empty (&s); - if (last - first == 1) + if (n == 1) { - ds_put_format (&s, _("Type mismatch invoking %s as "), first->prototype); - put_invocation (&s, func_name, args, arg_cnt); + ds_put_format (&s, _("Type mismatch invoking %s as "), ops->prototype); + put_invocation (&s, func_name, node); } - else + else { ds_put_cstr (&s, _("Function invocation ")); - put_invocation (&s, func_name, args, arg_cnt); + put_invocation (&s, func_name, node); ds_put_cstr (&s, _(" does not match any known function. Candidates are:")); - for (f = first; f < last; f++) - ds_put_format (&s, "\n%s", f->prototype); + for (size_t i = 0; i < n; i++) + ds_put_format (&s, "\n%s", ops[i].prototype); } - ds_put_char (&s, '.'); + ds_put_byte (&s, '.'); + + msg_at (SE, expr_location (e, node), "%s", ds_cstr (&s)); + + if (n == 1 && ops->n_args == node->n_args) + { + for (size_t i = 0; i < node->n_args; i++) + if (!is_coercible (node, i)) + { + atom_type expected = ops->args[i]; + atom_type actual = expr_node_returns (node->args[i]); + if ((expected == OP_ni_format || expected == OP_no_format) + && actual == OP_format) + { + const struct fmt_spec *f = &node->args[i]->format; + char *error = fmt_check__ (f, (ops->args[i] == OP_ni_format + ? FMT_FOR_INPUT : FMT_FOR_OUTPUT)); + if (!error) + error = fmt_check_type_compat__ (f, VAL_NUMERIC); + if (error) + { + msg_at (SN, expr_location (e, node->args[i]), "%s", error); + free (error); + } + } + else + msg_at (SN, expr_location (e, node->args[i]), + _("This argument has type '%s' but '%s' is required."), + atom_type_name (actual), atom_type_name (expected)); + } + } - msg (SE, "%s", ds_cstr (&s)); - ds_destroy (&s); } -static union any_node * +static struct expr_node * parse_function (struct lexer *lexer, struct expression *e) { - int min_valid; - const struct operation *f, *first, *last; - - union any_node **args = NULL; - int arg_cnt = 0; - int arg_cap = 0; - struct string func_name; + ds_init_substring (&func_name, lex_tokss (lexer)); - union any_node *n; + int min_valid = extract_min_valid (lex_tokcstr (lexer)); - ds_init_string (&func_name, lex_tokstr (lexer)); - min_valid = extract_min_valid (ds_cstr (lex_tokstr (lexer))); - if (!lookup_function (ds_cstr (lex_tokstr (lexer)), &first, &last)) + const struct operation *first, *last; + if (!lookup_function (lex_tokcstr (lexer), &first, &last)) { - msg (SE, _("No function or vector named %s."), ds_cstr (lex_tokstr (lexer))); + msg (SE, _("No function or vector named %s."), lex_tokcstr (lexer)); ds_destroy (&func_name); return NULL; } + int func_start_ofs = lex_ofs (lexer); lex_get (lexer); - if (!lex_force_match (lexer, '(')) + if (!lex_force_match (lexer, T_LPAREN)) { ds_destroy (&func_name); - return NULL; + return NULL; } - - args = NULL; - arg_cnt = arg_cap = 0; - if (lex_token (lexer) != ')') + + struct expr_node **args = NULL; + size_t n_args = 0; + size_t allocated_args = 0; + if (lex_token (lexer) != T_RPAREN) for (;;) { - if (lex_token (lexer) == T_ID && lex_look_ahead (lexer) == 'T') + int arg_start_ofs = lex_ofs (lexer); + if (lex_token (lexer) == T_ID + && lex_next_token (lexer, 1) == T_TO) { - struct variable **vars; - size_t var_cnt; - size_t i; + const struct variable **vars; + size_t n_vars; - if (!parse_variables (lexer, dataset_dict (e->ds), &vars, &var_cnt, PV_SINGLE)) + if (!parse_variables_const (lexer, dataset_dict (e->ds), + &vars, &n_vars, PV_SINGLE)) goto fail; - for (i = 0; i < var_cnt; i++) - add_arg (&args, &arg_cnt, &arg_cap, - allocate_unary_variable (e, vars[i])); + for (size_t i = 0; i < n_vars; i++) + add_arg (&args, &n_args, &allocated_args, + allocate_unary_variable (e, vars[i]), + e, lexer, arg_start_ofs); free (vars); } else { - union any_node *arg = parse_or (lexer, e); + struct expr_node *arg = parse_or (lexer, e); if (arg == NULL) goto fail; - add_arg (&args, &arg_cnt, &arg_cap, arg); + add_arg (&args, &n_args, &allocated_args, arg, + e, lexer, arg_start_ofs); } - if (lex_match (lexer, ')')) + if (lex_match (lexer, T_RPAREN)) break; - else if (!lex_match (lexer, ',')) + else if (!lex_match (lexer, T_COMMA)) { - lex_error (lexer, _("expecting `,' or `)' invoking %s function"), - first->name); + lex_error_expecting (lexer, "`,'", "`)'"); goto fail; } } - for (f = first; f < last; f++) - if (match_function (args, arg_cnt, f)) - break; - if (f >= last) + struct expr_node *n = expr_allocate_composite (e, first - operations, + args, n_args); + expr_add_location (lexer, e, func_start_ofs, n); + const struct operation *f = match_function (n, first, last); + if (!f) { - no_match (ds_cstr (&func_name), args, arg_cnt, first, last); + no_match (e, ds_cstr (&func_name), n, first, last - first); goto fail; } + n->type = f - operations; + n->min_valid = min_valid != -1 ? min_valid : f->array_min_elems; - coerce_function_args (e, f, args, arg_cnt); - if (!validate_function_args (f, arg_cnt, min_valid)) + for (size_t i = 0; i < n_args; i++) + if (!type_coercion (e, n, i)) + { + /* Unreachable because match_function already checked that the + arguments were coercible. */ + NOT_REACHED (); + } + if (!validate_function_args (e, n, f, n_args, min_valid)) goto fail; - if ((f->flags & OPF_EXTENSION) && get_syntax () == COMPATIBLE) - msg (SW, _("%s is a PSPP extension."), f->prototype); - if (f->flags & OPF_UNIMPLEMENTED) + if ((f->flags & OPF_EXTENSION) && settings_get_syntax () == COMPATIBLE) + msg_at (SW, expr_location (e, n), + _("%s is a PSPP extension."), f->prototype); + if (f->flags & OPF_UNIMPLEMENTED) { - msg (SE, _("%s is not yet implemented."), f->prototype); + msg_at (SE, expr_location (e, n), + _("%s is not available in this version of PSPP."), f->prototype); goto fail; } - if ((f->flags & OPF_PERM_ONLY) && - proc_in_temporary_transformations (e->ds)) + if ((f->flags & OPF_PERM_ONLY) && + proc_in_temporary_transformations (e->ds)) { - msg (SE, _("%s may not appear after TEMPORARY."), f->prototype); + msg_at (SE, expr_location (e, n), + _("%s may not appear after %s."), f->prototype, "TEMPORARY"); goto fail; } - - n = expr_allocate_composite (e, f - operations, args, arg_cnt); - n->composite.min_valid = min_valid != -1 ? min_valid : f->array_min_elems; - if (n->type == OP_LAG_Vn || n->type == OP_LAG_Vs) - { - if (dataset_n_lag (e->ds) < 1) - dataset_set_n_lag (e->ds, 1); - } + if (n->type == OP_LAG_Vn || n->type == OP_LAG_Vs) + dataset_need_lag (e->ds, 1); else if (n->type == OP_LAG_Vnn || n->type == OP_LAG_Vsn) { - int n_before; - assert (n->composite.arg_cnt == 2); - assert (n->composite.args[1]->type == OP_pos_int); - n_before = n->composite.args[1]->integer.i; - if ( dataset_n_lag (e->ds) < n_before) - dataset_set_n_lag (e->ds, n_before); + assert (n->n_args == 2); + assert (n->args[1]->type == OP_pos_int); + dataset_need_lag (e->ds, n->args[1]->integer); } - + free (args); ds_destroy (&func_name); return n; @@ -1309,21 +1450,20 @@ expr_create (struct dataset *ds) { struct pool *pool = pool_create (); struct expression *e = pool_alloc (pool, sizeof *e); - e->expr_pool = pool; - e->ds = ds; - e->eval_pool = pool_create_subpool (e->expr_pool); - e->ops = NULL; - e->op_types = NULL; - e->op_cnt = e->op_cap = 0; + *e = (struct expression) { + .expr_pool = pool, + .ds = ds, + .eval_pool = pool_create_subpool (pool), + }; return e; } atom_type -expr_node_returns (const union any_node *n) +expr_node_returns (const struct expr_node *n) { assert (n != NULL); assert (is_operation (n->type)); - if (is_atom (n->type)) + if (is_atom (n->type)) return n->type; else if (is_composite (n->type)) return operations[n->type].returns; @@ -1335,178 +1475,178 @@ static const char * atom_type_name (atom_type type) { assert (is_atom (type)); - return operations[type].name; + + /* The Boolean type is purely an internal concept that the documentation + doesn't mention, so it might confuse users if we talked about them in + diagnostics. */ + return type == OP_boolean ? "number" : operations[type].name; } -union any_node * +struct expr_node * expr_allocate_nullary (struct expression *e, operation_type op) { return expr_allocate_composite (e, op, NULL, 0); } -union any_node * +struct expr_node * expr_allocate_unary (struct expression *e, operation_type op, - union any_node *arg0) + struct expr_node *arg0) { return expr_allocate_composite (e, op, &arg0, 1); } -union any_node * +struct expr_node * expr_allocate_binary (struct expression *e, operation_type op, - union any_node *arg0, union any_node *arg1) + struct expr_node *arg0, struct expr_node *arg1) { - union any_node *args[2]; + struct expr_node *args[2]; args[0] = arg0; args[1] = arg1; return expr_allocate_composite (e, op, args, 2); } -static bool -is_valid_node (union any_node *n) -{ - const struct operation *op; - size_t i; - - assert (n != NULL); - assert (is_operation (n->type)); - op = &operations[n->type]; - - if (!is_atom (n->type)) - { - struct composite_node *c = &n->composite; - - assert (is_composite (n->type)); - assert (c->arg_cnt >= op->arg_cnt); - for (i = 0; i < op->arg_cnt; i++) - assert (is_compatible (op->args[i], expr_node_returns (c->args[i]))); - if (c->arg_cnt > op->arg_cnt && !is_operator (n->type)) - { - assert (op->flags & OPF_ARRAY_OPERAND); - for (i = 0; i < c->arg_cnt; i++) - assert (is_compatible (op->args[op->arg_cnt - 1], - expr_node_returns (c->args[i]))); - } - } - - return true; -} - -union any_node * +struct expr_node * expr_allocate_composite (struct expression *e, operation_type op, - union any_node **args, size_t arg_cnt) + struct expr_node **args, size_t n_args) { - union any_node *n; - size_t i; + for (size_t i = 0; i < n_args; i++) + if (!args[i]) + return NULL; - n = pool_alloc (e->expr_pool, sizeof n->composite); - n->type = op; - n->composite.arg_cnt = arg_cnt; - n->composite.args = pool_alloc (e->expr_pool, - sizeof *n->composite.args * arg_cnt); - for (i = 0; i < arg_cnt; i++) - { - if (args[i] == NULL) - return NULL; - n->composite.args[i] = args[i]; - } - memcpy (n->composite.args, args, sizeof *n->composite.args * arg_cnt); - n->composite.min_valid = 0; - assert (is_valid_node (n)); + struct expr_node *n = pool_alloc (e->expr_pool, sizeof *n); + *n = (struct expr_node) { + .type = op, + .n_args = n_args, + .args = pool_clone (e->expr_pool, args, sizeof *n->args * n_args), + }; return n; } -union any_node * +struct expr_node * expr_allocate_number (struct expression *e, double d) { - union any_node *n = pool_alloc (e->expr_pool, sizeof n->number); - n->type = OP_number; - n->number.n = d; + struct expr_node *n = pool_alloc (e->expr_pool, sizeof *n); + *n = (struct expr_node) { .type = OP_number, .number = d }; return n; } -union any_node * +struct expr_node * expr_allocate_boolean (struct expression *e, double b) { - union any_node *n = pool_alloc (e->expr_pool, sizeof n->number); assert (b == 0.0 || b == 1.0 || b == SYSMIS); - n->type = OP_boolean; - n->number.n = b; + + struct expr_node *n = pool_alloc (e->expr_pool, sizeof *n); + *n = (struct expr_node) { .type = OP_boolean, .number = b }; return n; } -union any_node * +struct expr_node * expr_allocate_integer (struct expression *e, int i) { - union any_node *n = pool_alloc (e->expr_pool, sizeof n->integer); - n->type = OP_integer; - n->integer.i = i; + struct expr_node *n = pool_alloc (e->expr_pool, sizeof *n); + *n = (struct expr_node) { .type = OP_integer, .integer = i }; return n; } -union any_node * +struct expr_node * expr_allocate_pos_int (struct expression *e, int i) { - union any_node *n = pool_alloc (e->expr_pool, sizeof n->integer); assert (i > 0); - n->type = OP_pos_int; - n->integer.i = i; + + struct expr_node *n = pool_alloc (e->expr_pool, sizeof *n); + *n = (struct expr_node) { .type = OP_pos_int, .integer = i }; return n; } -union any_node * +struct expr_node * expr_allocate_vector (struct expression *e, const struct vector *vector) { - union any_node *n = pool_alloc (e->expr_pool, sizeof n->vector); - n->type = OP_vector; - n->vector.v = vector; + struct expr_node *n = pool_alloc (e->expr_pool, sizeof *n); + *n = (struct expr_node) { .type = OP_vector, .vector = vector }; return n; } -union any_node * -expr_allocate_string_buffer (struct expression *e, - const char *string, size_t length) +struct expr_node * +expr_allocate_string (struct expression *e, struct substring s) { - union any_node *n = pool_alloc (e->expr_pool, sizeof n->string); - n->type = OP_string; - if (length > MAX_STRING) - length = MAX_STRING; - n->string.s = copy_string (e, string, length); + struct expr_node *n = pool_alloc (e->expr_pool, sizeof *n); + *n = (struct expr_node) { .type = OP_string, .string = s }; return n; } -union any_node * -expr_allocate_string (struct expression *e, struct substring s) +struct expr_node * +expr_allocate_variable (struct expression *e, const struct variable *v) { - union any_node *n = pool_alloc (e->expr_pool, sizeof n->string); - n->type = OP_string; - n->string.s = s; + struct expr_node *n = pool_alloc (e->expr_pool, sizeof *n); + *n = (struct expr_node) { + .type = var_is_numeric (v) ? OP_num_var : OP_str_var, + .variable = v + }; return n; } -union any_node * -expr_allocate_variable (struct expression *e, struct variable *v) +struct expr_node * +expr_allocate_format (struct expression *e, const struct fmt_spec *format) { - union any_node *n = pool_alloc (e->expr_pool, sizeof n->variable); - n->type = var_is_numeric (v) ? OP_num_var : OP_str_var; - n->variable.v = v; + struct expr_node *n = pool_alloc (e->expr_pool, sizeof *n); + *n = (struct expr_node) { .type = OP_format, .format = *format }; return n; } -union any_node * -expr_allocate_format (struct expression *e, const struct fmt_spec *format) +struct expr_node * +expr_allocate_expr_node (struct expression *e, + const struct expr_node *expr_node) { - union any_node *n = pool_alloc (e->expr_pool, sizeof n->format); - n->type = OP_format; - n->format.f = *format; + struct expr_node *n = pool_alloc (e->expr_pool, sizeof *n); + *n = (struct expr_node) { .type = OP_expr_node, .expr_node = expr_node }; return n; } /* Allocates a unary composite node that represents the value of variable V in expression E. */ -static union any_node * -allocate_unary_variable (struct expression *e, struct variable *v) +static struct expr_node * +allocate_unary_variable (struct expression *e, const struct variable *v) { assert (v != NULL); return expr_allocate_unary (e, var_is_numeric (v) ? OP_NUM_VAR : OP_STR_VAR, expr_allocate_variable (e, v)); } + +/* Export function details to other modules. */ + +/* Returns the operation structure for the function with the + given IDX. */ +const struct operation * +expr_get_function (size_t idx) +{ + assert (idx < n_OP_function); + return &operations[OP_function_first + idx]; +} + +/* Returns the number of expression functions. */ +size_t +expr_get_n_functions (void) +{ + return n_OP_function; +} + +/* Returns the name of operation OP. */ +const char * +expr_operation_get_name (const struct operation *op) +{ + return op->name; +} + +/* Returns the human-readable prototype for operation OP. */ +const char * +expr_operation_get_prototype (const struct operation *op) +{ + return op->prototype; +} + +/* Returns the number of arguments for operation OP. */ +int +expr_operation_get_n_args (const struct operation *op) +{ + return op->n_args; +}