expressions: Parse multiple sets of parentheses for grouping together.
[pspp] / src / language / expressions / parse.c
index 3124c100a19e4c8922916fcda501ec2c0db058b1..0493ed878bfd98283451eed17b06a66ea88b3409 100644 (file)
@@ -1,5 +1,5 @@
 /* PSPP - a program for statistical analysis.
-   Copyright (C) 1997-9, 2000, 2006, 2010, 2011 Free Software Foundation, Inc.
+   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
@@ -39,6 +39,7 @@
 #include "libpspp/pool.h"
 #include "libpspp/str.h"
 
+#include "gl/c-strcase.h"
 #include "gl/xalloc.h"
 \f
 /* Declarations. */
@@ -58,49 +59,98 @@ atom_type expr_node_returns (const union any_node *);
 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 *,
                                                 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;
     }
+
+  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;
 }
@@ -246,15 +296,13 @@ 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 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)
     {
-    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, "
@@ -262,11 +310,9 @@ type_check (struct expression *e,
                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, "
@@ -883,7 +929,7 @@ parse_primary (struct lexer *lexer, struct expression *e)
     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;
       }
@@ -907,11 +953,22 @@ parse_primary (struct lexer *lexer, struct expression *e)
 
     case T_LPAREN:
       {
-        union any_node *node;
-       lex_get (lexer);
-       node = parse_or (lexer, e);
-       if (node != NULL && !lex_force_match (lexer, T_RPAREN))
+        /* 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;
       }
 
@@ -1005,7 +1062,7 @@ compare_names (const char *test, const char *name, bool abbrev_ok)
 static int
 compare_strings (const char *test, const char *name, bool abbrev_ok UNUSED)
 {
-  return strcasecmp (test, name);
+  return c_strcasecmp (test, name);
 }
 
 static bool
@@ -1094,23 +1151,21 @@ coerce_function_args (struct expression *e, const struct operation *f,
 static bool
 validate_function_args (const struct operation *f, int arg_cnt, int min_valid)
 {
+  /* 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_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;
-    }
+  assert (array_arg_cnt >= f->array_min_elems);
 
   if ((f->flags & OPF_ARRAY_OPERAND)
       && array_arg_cnt % f->array_granularity != 0)
     {
-      if (f->array_granularity == 2)
-        msg (SE, _("%s must have an 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 (arg_cnt % 2 == 0);
+      msg (SE, _("%s must have an odd number of arguments."), f->prototype);
       return false;
     }
 
@@ -1119,26 +1174,19 @@ validate_function_args (const struct operation *f, int arg_cnt, int min_valid)
       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
         {
           assert (f->flags & OPF_MIN_VALID);
-          if (array_arg_cnt < f->array_min_elems)
-            {
-              msg (SE, _("%s requires at least %d valid arguments in list."),
-                   f->prototype, f->array_min_elems);
-              return false;
-            }
-          else if (min_valid > array_arg_cnt)
+          if (min_valid > array_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, arg_cnt, array_arg_cnt, min_valid);
               return false;
             }
         }
@@ -1268,7 +1316,7 @@ parse_function (struct lexer *lexer, struct expression *e)
           break;
         else if (!lex_match (lexer, T_COMMA))
           {
-            lex_error_expecting (lexer, "`,'", "`)'", NULL_SENTINEL);
+            lex_error_expecting (lexer, "`,'", "`)'");
             goto fail;
           }
       }
@@ -1290,13 +1338,14 @@ parse_function (struct lexer *lexer, struct expression *e)
     msg (SW, _("%s is a PSPP extension."), f->prototype);
   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))
     {
-      msg (SE, _("%s may not appear after TEMPORARY."), f->prototype);
+      msg (SE, _("%s may not appear after %s."), f->prototype, "TEMPORARY");
       goto fail;
     }