expressions: Fix value of $TIME variable and add a test.
[pspp] / src / language / expressions / parse.c
index 695d3caf6d5b7a13880aa8c9d05447d1586a4ab7..d06d633d5b02fa4eb40273a02e2d7bbb64e90714 100644 (file)
@@ -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 <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/minmax.h"
+#include "gl/xalloc.h"
 \f
 /* 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 *);
 \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. */
+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 &not_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;
 }
 \f
 /* 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,68 +891,67 @@ 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_mday) * DAY_S
                                    + tm->tm_hour * 60 * 60.
                                    + tm->tm_min * 60.
                                    + 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;
+
+  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."));
 
-  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));
+      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;
 }
 \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;
@@ -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)
+          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_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,173 +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 (;;)
       {
+        int arg_start_ofs = lex_ofs (lexer);
         if (lex_token (lexer) == T_ID
-            && toupper (lex_look_ahead (lexer)) == 'T')
+            && 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 (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;
-      dataset_need_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;
@@ -1306,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;
@@ -1332,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));
 }
+\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;
+}