-/* PSPP - computes sample statistics.
- Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
- Written by Ben Pfaff <blp@gnu.org>.
+/* 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 <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <limits.h>
#include <stdlib.h>
-#include "helpers.h"
-#include <data/case.h>
-#include <data/dictionary.h>
-#include <data/settings.h>
-#include <data/variable.h>
-#include <language/lexer/format-parser.h>
-#include <language/lexer/lexer.h>
-#include <language/lexer/variable-parser.h>
-#include <libpspp/alloc.h>
-#include <libpspp/array.h>
-#include <libpspp/assertion.h>
-#include <libpspp/message.h>
-#include <libpspp/misc.h>
-#include <libpspp/pool.h>
-#include <libpspp/str.h>
+#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/xalloc.h"
\f
/* Declarations. */
static const char *atom_type_name (atom_type);
static struct expression *finish_expression (union any_node *,
struct expression *);
-static bool type_check (struct expression *, union any_node **,
- enum expr_type expected_type);
+static bool type_check (const union any_node *, enum val_type expected_type);
static union any_node *allocate_unary_variable (struct expression *,
- struct variable *);
+ const struct variable *);
\f
/* 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. */
+/* 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. If POOL is nonnull,
+ then destroying POOL will free the expression; otherwise, the caller must
+ eventually free it with expr_free(). */
struct expression *
-expr_parse (struct lexer *lexer, struct dataset *ds, enum expr_type type)
+expr_parse (struct lexer *lexer, struct pool *pool, 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);
+ union any_node *n = parse_or (lexer, e);
+ if (!n || !type_check (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
+ e = finish_expression (expr_optimize (n, e), e);
+ if (pool)
+ pool_add_subpool (pool, e->expr_pool);
+ return e;
+}
+
+/* Parses a boolean expression, otherwise similar to expr_parse(). */
+struct expression *
+expr_parse_bool (struct lexer *lexer, struct pool *pool, struct dataset *ds)
+{
+ struct expression *e = expr_create (ds);
+ union any_node *n = parse_or (lexer, e);
+ if (!n)
{
expr_free (e);
- return NULL;
+ return NULL;
}
+
+ atom_type actual_type = expr_node_returns (n);
+ if (actual_type == OP_number)
+ n = expr_allocate_binary (e, OP_NUM_TO_BOOLEAN, n,
+ expr_allocate_string (e, ss_empty ()));
+ else if (actual_type != OP_boolean)
+ {
+ msg (SE, _("Type mismatch: expression has %s type, "
+ "but a boolean value is required here."),
+ atom_type_name (actual_type));
+ expr_free (e);
+ return NULL;
+ }
+
+ e = finish_expression (expr_optimize (n, e), e);
+ if (pool)
+ pool_add_subpool (pool, e->expr_pool);
+ return 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 pool *pool, struct dataset *ds,
+ const char *new_var_name)
{
- struct expression *e = expr_parse (lexer, ds, type);
- if (e != NULL)
+ struct expression *e = expr_create (ds);
+ union any_node *n = parse_or (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;
+ }
+
+ e = finish_expression (expr_optimize (n, e), e);
+ if (pool)
pool_add_subpool (pool, e->expr_pool);
return e;
}
expr_free (e);
return NULL;
}
-
+
if (optimize)
n = expr_optimize (n, e);
return finish_expression (n, e);
/* 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. */
atom_type_stack (atom_type type)
{
assert (is_atom (type));
-
- switch (type)
+
+ switch (type)
{
case OP_number:
case OP_boolean:
case OP_pos_int:
case OP_vector:
return ¬_on_stack;
-
+
default:
NOT_REACHED ();
}
{
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++)
+ for (i = 0; i < n->composite.n_args; i++)
measure_stack (n->composite.args[i], &args, max);
return_height = atom_type_stack (operations[n->type].returns);
/* Allocates stacks within E sufficient for evaluating node N. */
static void
-allocate_stacks (union any_node *n, struct expression *e)
+allocate_stacks (union any_node *n, struct expression *e)
{
struct stack_heights initial = {0, 0};
struct stack_heights max = {0, 0};
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 union any_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, "
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, "
default:
NOT_REACHED ();
}
-
+
return true;
}
\f
atom_type required_type,
union any_node **node,
const char *operator_name,
- bool do_coercion)
+ bool do_coercion)
{
atom_type actual_type;
assert (!!do_coercion == (e != NULL));
- if (*node == NULL)
+ if (*node == NULL)
{
/* Propagate error. Whatever caused the original error
already emitted an error message. */
}
actual_type = expr_node_returns (*node);
- if (actual_type == required_type)
+ 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;
+ return true;
}
break;
{
/* Convert numeric to boolean. */
if (do_coercion)
- *node = expr_allocate_unary (e, OP_NUM_TO_BOOLEAN, *node);
+ {
+ union any_node *op_name;
+
+ op_name = expr_allocate_string (e, ss_cstr (operator_name));
+ *node = expr_allocate_binary (e, OP_NUM_TO_BOOLEAN, *node,
+ op_name);
+ }
return true;
}
break;
msg_disable ();
if ((*node)->type == OP_format
&& fmt_check_input (&(*node)->format.f)
- && fmt_check_type_compat (&(*node)->format.f, VAR_NUMERIC))
+ && fmt_check_type_compat (&(*node)->format.f, VAL_NUMERIC))
{
msg_enable ();
if (do_coercion)
msg_disable ();
if ((*node)->type == OP_format
&& fmt_check_output (&(*node)->format.f)
- && fmt_check_type_compat (&(*node)->format.f, VAR_NUMERIC))
+ && fmt_check_type_compat (&(*node)->format.f, VAL_NUMERIC))
{
msg_enable ();
if (do_coercion)
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)
+ && (*node)->number.n > 0 && (*node)->number.n < INT_MAX)
{
if (do_coercion)
*node = expr_allocate_pos_int (e, (*node)->number.n);
NOT_REACHED ();
}
- if (do_coercion)
+ if (do_coercion)
{
msg (SE, _("Type mismatch while applying %s operator: "
"cannot convert %s to %s."),
/* 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)
+is_compatible (atom_type required_type, atom_type actual_type)
{
return (required_type == actual_type
|| (required_type == OP_var
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)
+match_operator (struct lexer *lexer, const struct operator ops[], size_t n_ops,
+ const struct operator **operator)
{
const struct operator *op;
- 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;
- }
- }
+ for (op = ops; op < ops + n_ops; op++)
+ if (lex_token (lexer) == op->token)
+ {
+ if (op->token != T_NEG_NUM)
+ lex_get (lexer);
+ if (operator != NULL)
+ *operator = op;
+ return true;
+ }
if (operator != NULL)
*operator = NULL;
return false;
}
static bool
-check_operator (const struct operator *op, int arg_cnt, atom_type arg_type)
+check_operator (const struct operator *op, int n_args, atom_type arg_type)
{
const struct operation *o;
size_t i;
assert (op != NULL);
o = &operations[op->type];
- assert (o->arg_cnt == arg_cnt);
+ assert (o->n_args == n_args);
assert ((o->flags & OPF_ARRAY_OPERAND) == 0);
- for (i = 0; i < arg_cnt; i++)
+ for (i = 0; i < n_args; i++)
assert (is_compatible (arg_type, o->args[i]));
return true;
}
static bool
-check_binary_operators (const struct operator ops[], size_t op_cnt,
+check_binary_operators (const struct operator ops[], size_t n_ops,
atom_type arg_type)
{
size_t i;
- for (i = 0; i < op_cnt; i++)
+ for (i = 0; i < n_ops; i++)
check_operator (&ops[i], 2, arg_type);
return true;
}
static atom_type
-get_operand_type (const struct operator *op)
+get_operand_type (const struct operator *op)
{
return operations[op->type].args[0];
}
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,
+ const struct operator ops[], size_t n_ops,
parse_recursively_func *parse_next_level,
const char *chain_warning)
{
int op_count;
const struct operator *operator;
- assert (check_binary_operators (ops, op_cnt, operand_type));
+ assert (check_binary_operators (ops, n_ops, operand_type));
if (node == NULL)
return node;
- for (op_count = 0; match_operator (lexer, ops, op_cnt, &operator); op_count++)
+ for (op_count = 0; match_operator (lexer, ops, n_ops, &operator); op_count++)
{
union any_node *rhs;
}
if (op_count > 1 && chain_warning != NULL)
- msg (SW, chain_warning);
+ msg (SW, "%s", chain_warning);
return node;
}
static union any_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;
static union any_node *
parse_or (struct lexer *lexer, struct expression *e)
{
- static const struct operator op =
- { T_OR, OP_OR, "logical disjunction (\"OR\")" };
-
+ 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 union any_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),
+ 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);
}
parse_not (struct lexer *lexer, struct expression *e)
{
static const struct operator op
- = { T_NOT, OP_NOT, "logical negation (\"NOT\")" };
+ = { T_NOT, OP_NOT, "logical negation (`NOT')" };
return parse_inverting_unary_operator (lexer, e, &op, parse_rel);
}
static union any_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\"). "
+ "(e.g. `a < b AND b < c'). "
"If chaining is really intended, parentheses will disable "
- "this warning (e.g. \"(a < b) < c\".)");
+ "this warning (e.g. `(a < b) < c'.)");
union any_node *node = parse_add (lexer, e);
if (node == NULL)
return NULL;
-
- switch (expr_node_returns (node))
+
+ switch (expr_node_returns (node))
{
case OP_number:
- case OP_boolean:
+ 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 (\"<>\")" },
+ { T_EQUALS, 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,
+ 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 (\"<>\")" },
+ { T_EQUALS, 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,
+ return parse_binary_operators (lexer, e, node, ops,
sizeof ops / sizeof *ops,
parse_add, chain_warning);
}
-
+
default:
return node;
}
static union any_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 (\"-\")" },
+ { T_PLUS, OP_ADD, "addition (`+')" },
+ { T_DASH, OP_SUB, "subtraction (`-')" },
+ { T_NEG_NUM, OP_ADD, "subtraction (`-')" },
};
-
+
return parse_binary_operators (lexer, e, parse_mul (lexer, e),
ops, sizeof ops / sizeof *ops,
parse_mul, NULL);
static union any_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 (\"/\")" },
+ { T_ASTERISK, OP_MUL, "multiplication (`*')" },
+ { T_SLASH, OP_DIV, "division (`/')" },
};
-
+
return parse_binary_operators (lexer, e, parse_neg (lexer, e),
ops, sizeof ops / sizeof *ops,
parse_neg, NULL);
static union any_node *
parse_neg (struct lexer *lexer, struct expression *e)
{
- static const struct operator op = { '-', OP_NEG, "negation (\"-\")" };
+ static const struct operator op = { T_DASH, OP_NEG, "negation (`-')" };
return parse_inverting_unary_operator (lexer, e, &op, parse_exp);
}
static union any_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, "
+ 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)\". "
+ "That is, `a**b**c' equals `(a**b)**c', not as `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);
+ union any_node *lhs, *node;
+ bool negative = false;
+
+ if (lex_token (lexer) == T_NEG_NUM)
+ {
+ lhs = expr_allocate_number (e, -lex_tokval (lexer));
+ negative = true;
+ lex_get (lexer);
+ }
+ else
+ lhs = parse_primary (lexer, e);
+
+ node = parse_binary_operators (lexer, e, lhs, &op, 1,
+ parse_primary, chain_warning);
+ return negative ? expr_allocate_unary (e, OP_NEG, node) : node;
}
/* Parses system variables. */
time_t last_proc_time = time_of_last_procedure (e->ds);
struct tm *time;
char temp_buf[10];
+ struct substring s;
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));
+ ss_alloc_substring (&s, ss_cstr (temp_buf));
+ return expr_allocate_string (e, s);
}
else if (lex_match_id (lexer, "$TRUE"))
return expr_allocate_boolean (e, 1.0);
+ 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;
}
}
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 ();
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) );
+ union any_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;
+ union any_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 `)'"));
+ /* Count number of left parentheses so that we can match them against
+ an equal number of right parentheses. This defeats trivial attempts
+ to exhaust the stack with a lot of left parentheses. (More
+ sophisticated attacks will still succeed.) */
+ size_t n = 0;
+ while (lex_match (lexer, T_LPAREN))
+ n++;
+
+ union any_node *node = parse_or (lexer, e);
+ if (!node)
+ return NULL;
+
+ for (size_t i = 0; i < n; i++)
+ if (!lex_force_match (lexer, T_RPAREN))
return NULL;
- }
+
return node;
}
default:
- lex_error (lexer, _("in expression"));
+ lex_error (lexer, NULL);
return NULL;
}
}
/* 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));
+ 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, ')'))
+ || !lex_match (lexer, T_RPAREN))
return NULL;
- return expr_allocate_binary (e, (vector_get_type (vector) == VAR_NUMERIC
+ return expr_allocate_binary (e, (vector_get_type (vector) == VAL_NUMERIC
? OP_VEC_ELEM_NUM : OP_VEC_ELEM_STR),
element, expr_allocate_vector (e, vector));
}
\f
/* 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;
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)
-{
- if (!abbrev_ok)
- return true;
-
- for (;;)
- {
- if (!word_matches (&test, &name))
- return true;
- if (*name == '\0' && *test == '\0')
- return false;
- }
-}
-
-static int
-compare_strings (const char *test, const char *name, bool abbrev_ok UNUSED)
+compare_function_names (const char *token_, const char *func_)
{
- return strcasecmp (test, name);
+ 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 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)
+lookup_function (const char *token,
+ 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;
+ *first = *last = NULL;
+ const struct operation *best = NULL;
- while (f <= operations + OP_function_last
- && !compare (name, f->name, !(f->flags & OPF_NO_ABBREV)))
- f++;
- *last = 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;
+ }
- return true;
- }
+ if (!best)
+ return false;
- return false;
-}
+ *first = best;
-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));
+ const struct operation *f = best;
+ while (f <= operations + OP_function_last
+ && !c_strcasecmp (f->name, best->name))
+ f++;
+ *last = f;
+
+ return true;
}
static int
-extract_min_valid (char *s)
+extract_min_valid (const char *s)
{
char *p = strrchr (s, '.');
if (p == NULL
}
static atom_type
-function_arg_type (const struct operation *f, size_t arg_idx)
+function_arg_type (const struct operation *f, size_t arg_idx)
{
- assert (arg_idx < f->arg_cnt || (f->flags & OPF_ARRAY_OPERAND));
+ assert (arg_idx < f->n_args || (f->flags & OPF_ARRAY_OPERAND));
- return f->args[arg_idx < f->arg_cnt ? arg_idx : f->arg_cnt - 1];
+ return f->args[arg_idx < f->n_args ? arg_idx : f->n_args - 1];
}
static bool
-match_function (union any_node **args, int arg_cnt, const struct operation *f)
+match_function (union any_node **args, int n_args, 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 (n_args < f->n_args
+ || (n_args > f->n_args && (f->flags & OPF_ARRAY_OPERAND) == 0)
+ || n_args - (f->n_args - 1) < f->array_min_elems)
return false;
- for (i = 0; i < arg_cnt; i++)
+ for (i = 0; i < n_args; i++)
if (!is_coercible (function_arg_type (f, i), &args[i]))
- return false;
+ return false;
return true;
}
static void
coerce_function_args (struct expression *e, const struct operation *f,
- union any_node **args, size_t arg_cnt)
+ union any_node **args, size_t n_args)
{
int i;
-
- for (i = 0; i < arg_cnt; i++)
+
+ for (i = 0; i < n_args; i++)
type_coercion_assert (e, function_arg_type (f, i), &args[i]);
}
static bool
-validate_function_args (const struct operation *f, int arg_cnt, int min_valid)
+validate_function_args (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 (SE, _("%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 (SE, _("%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)
+ if (min_valid > array_n_args)
{
- 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)
- {
- 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 (SE, _("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;
}
}
}
static void
-add_arg (union any_node ***args, int *arg_cnt, int *arg_cap,
+add_arg (union any_node ***args, int *n_args, int *allocated_args,
union any_node *arg)
{
- if (*arg_cnt >= *arg_cap)
+ if (*n_args >= *allocated_args)
{
- *arg_cap += 8;
- *args = xrealloc (*args, sizeof **args * *arg_cap);
+ *allocated_args += 8;
+ *args = xrealloc (*args, sizeof **args * *allocated_args);
}
- (*args)[(*arg_cnt)++] = 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, union any_node **args, size_t n_args)
{
size_t i;
ds_put_format (s, "%s(", func_name);
- for (i = 0; i < arg_cnt; i++)
+ for (i = 0; i < n_args; i++)
{
if (i > 0)
ds_put_cstr (s, ", ");
ds_put_cstr (s, operations[expr_node_returns (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)
+ union any_node **args, size_t n_args,
+ const struct operation *first, const struct operation *last)
{
struct string s;
const struct operation *f;
ds_init_empty (&s);
- if (last - first == 1)
+ if (last - first == 1)
{
ds_put_format (&s, _("Type mismatch invoking %s as "), first->prototype);
- put_invocation (&s, func_name, args, arg_cnt);
+ put_invocation (&s, func_name, args, n_args);
}
- else
+ else
{
ds_put_cstr (&s, _("Function invocation "));
- put_invocation (&s, func_name, args, arg_cnt);
+ put_invocation (&s, func_name, args, n_args);
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);
}
- ds_put_char (&s, '.');
+ ds_put_byte (&s, '.');
msg (SE, "%s", ds_cstr (&s));
-
+
ds_destroy (&s);
}
const struct operation *f, *first, *last;
union any_node **args = NULL;
- int arg_cnt = 0;
- int arg_cap = 0;
+ int n_args = 0;
+ int allocated_args = 0;
struct string func_name;
union any_node *n;
- 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))
+ ds_init_substring (&func_name, lex_tokss (lexer));
+ min_valid = extract_min_valid (lex_tokcstr (lexer));
+ 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;
}
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) != ')')
+ n_args = allocated_args = 0;
+ if (lex_token (lexer) != T_RPAREN)
for (;;)
{
- if (lex_token (lexer) == T_ID && lex_look_ahead (lexer) == 'T')
+ if (lex_token (lexer) == T_ID
+ && lex_next_token (lexer, 1) == T_TO)
{
- struct variable **vars;
- size_t var_cnt;
+ const struct variable **vars;
+ size_t n_vars;
size_t i;
- 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,
+ for (i = 0; i < n_vars; i++)
+ add_arg (&args, &n_args, &allocated_args,
allocate_unary_variable (e, vars[i]));
free (vars);
}
if (arg == NULL)
goto fail;
- add_arg (&args, &arg_cnt, &arg_cap, arg);
+ add_arg (&args, &n_args, &allocated_args, arg);
}
- 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))
+ if (match_function (args, n_args, f))
break;
- if (f >= last)
+ if (f >= last)
{
- no_match (ds_cstr (&func_name), args, arg_cnt, first, last);
+ no_match (ds_cstr (&func_name), args, n_args, first, last);
goto fail;
}
- coerce_function_args (e, f, args, arg_cnt);
- if (!validate_function_args (f, arg_cnt, min_valid))
+ coerce_function_args (e, f, args, n_args);
+ if (!validate_function_args (f, n_args, min_valid))
goto fail;
- if ((f->flags & OPF_EXTENSION) && get_syntax () == COMPATIBLE)
+ if ((f->flags & OPF_EXTENSION) && settings_get_syntax () == COMPATIBLE)
msg (SW, _("%s is a PSPP extension."), f->prototype);
- if (f->flags & OPF_UNIMPLEMENTED)
+ if (f->flags & OPF_UNIMPLEMENTED)
{
- msg (SE, _("%s is not yet implemented."), f->prototype);
+ msg (SE, _("%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 (SE, _("%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);
- }
+ n = expr_allocate_composite (e, f - operations, args, n_args);
+ n->composite.min_valid = min_valid != -1 ? min_valid : f->array_min_elems;
+
+ 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.n_args == 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);
+ dataset_need_lag (e->ds, n_before);
}
-
+
free (args);
ds_destroy (&func_name);
return n;
e->eval_pool = pool_create_subpool (e->expr_pool);
e->ops = NULL;
e->op_types = NULL;
- e->op_cnt = e->op_cap = 0;
+ e->n_ops = e->allocated_ops = 0;
return e;
}
{
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;
}
static bool
-is_valid_node (union any_node *n)
+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 (c->n_args >= op->n_args);
+ for (i = 0; i < op->n_args; i++)
assert (is_compatible (op->args[i], expr_node_returns (c->args[i])));
- if (c->arg_cnt > op->arg_cnt && !is_operator (n->type))
+ if (c->n_args > op->n_args && !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],
+ for (i = 0; i < c->n_args; i++)
+ assert (is_compatible (op->args[op->n_args - 1],
expr_node_returns (c->args[i])));
}
}
- return true;
+ return true;
}
union any_node *
expr_allocate_composite (struct expression *e, operation_type op,
- union any_node **args, size_t arg_cnt)
+ union any_node **args, size_t n_args)
{
union any_node *n;
size_t i;
n = pool_alloc (e->expr_pool, sizeof n->composite);
n->type = op;
- n->composite.arg_cnt = arg_cnt;
+ n->composite.n_args = n_args;
n->composite.args = pool_alloc (e->expr_pool,
- sizeof *n->composite.args * arg_cnt);
- for (i = 0; i < arg_cnt; i++)
+ sizeof *n->composite.args * n_args);
+ for (i = 0; i < n_args; i++)
{
if (args[i] == NULL)
return NULL;
n->composite.args[i] = args[i];
}
- memcpy (n->composite.args, args, sizeof *n->composite.args * arg_cnt);
+ memcpy (n->composite.args, args, sizeof *n->composite.args * n_args);
n->composite.min_valid = 0;
assert (is_valid_node (n));
return n;
return n;
}
-union any_node *
-expr_allocate_string_buffer (struct expression *e,
- const char *string, size_t length)
-{
- 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);
- return n;
-}
-
union any_node *
expr_allocate_string (struct expression *e, struct substring s)
{
}
union any_node *
-expr_allocate_variable (struct expression *e, struct variable *v)
+expr_allocate_variable (struct expression *e, const struct variable *v)
{
union any_node *n = pool_alloc (e->expr_pool, sizeof n->variable);
n->type = var_is_numeric (v) ? OP_num_var : OP_str_var;
/* 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)
+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));
}
+\f
+/* 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;
+}
projects / pspp / blobdiff