Completely rewrite src/data/format.[ch], to achieve better
[pspp-builds.git] / src / language / expressions / parse.c
index b6c8076ce4a1fbb3b2fbdf33ce270dd8ec121b07..43aa553d894456227bcb7eb7eb328627a15de455 100644 (file)
@@ -1,5 +1,5 @@
 /* PSPP - computes sample statistics.
-   Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
+   Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
    Written by Ben Pfaff <blp@gnu.org>.
 
    This program is free software; you can redistribute it and/or
    02110-1301, USA. */
 
 #include <config.h>
+
 #include "private.h"
+
 #include <ctype.h>
 #include <float.h>
 #include <limits.h>
 #include <stdlib.h>
-#include <libpspp/array.h>
-#include <libpspp/alloc.h>
+
+#include "helpers.h"
 #include <data/case.h>
 #include <data/dictionary.h>
-#include <libpspp/message.h>
-#include "helpers.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 <data/settings.h>
 #include <libpspp/str.h>
-#include <data/variable.h>
-#include <procedure.h>
 \f
 /* Declarations. */
 
@@ -48,7 +53,7 @@ static parse_recursively_func parse_primary;
 static parse_recursively_func parse_vector_element, parse_function;
 
 /* Utility functions. */
-static struct expression *expr_create (struct dictionary *);
+static struct expression *expr_create (struct dataset *ds);
 atom_type expr_node_returns (const union any_node *);
 
 static const char *atom_type_name (atom_type);
@@ -68,14 +73,14 @@ static union any_node *allocate_unary_variable (struct expression *,
    Returns the new expression if successful or a null pointer
    otherwise. */
 struct expression *
-expr_parse (struct dictionary *dict, enum expr_type type) 
+expr_parse (struct dataset *ds, enum expr_type type) 
 {
   union any_node *n;
   struct expression *e;
 
   assert (type == EXPR_NUMBER || type == EXPR_STRING || type == EXPR_BOOLEAN);
 
-  e = expr_create (dict);
+  e = expr_create (ds);
   n = parse_or (e);
   if (n != NULL && type_check (e, &n, type))
     return finish_expression (expr_optimize (n, e), e);
@@ -91,9 +96,10 @@ expr_parse (struct dictionary *dict, enum expr_type type)
    the expression as well. */
 struct expression *
 expr_parse_pool (struct pool *pool,
-                 struct dictionary *dict, enum expr_type type) 
+                struct dataset *ds, 
+                 enum expr_type type) 
 {
-  struct expression *e = expr_parse (dict, type);
+  struct expression *e = expr_parse (ds, type);
   if (e != NULL)
     pool_add_subpool (pool, e->expr_pool);
   return e;
@@ -108,12 +114,12 @@ expr_free (struct expression *e)
 }
 
 struct expression *
-expr_parse_any (struct dictionary *dict, bool optimize)
+expr_parse_any (struct dataset *ds, bool optimize)
 {
   union any_node *n;
   struct expression *e;
 
-  e = expr_create (dict);
+  e = expr_create (ds);
   n = parse_or (e);
   if (n == NULL)
     {
@@ -167,7 +173,7 @@ atom_type_stack (atom_type type)
       return &not_on_stack;
           
     default:
-      abort ();
+      NOT_REACHED ();
     }
 }
 
@@ -271,7 +277,7 @@ type_check (struct expression *e,
       break;
 
     default:
-      abort ();
+      NOT_REACHED ();
     }
   
   return true;
@@ -345,28 +351,34 @@ type_coercion_core (struct expression *e,
       break;
 
     case OP_format:
-      abort ();
+      NOT_REACHED ();
 
     case OP_ni_format:
+      msg_disable ();
       if ((*node)->type == OP_format
-          && check_input_specifier (&(*node)->format.f, false)
-          && check_specifier_type (&(*node)->format.f, NUMERIC, false))
+          && fmt_check_input (&(*node)->format.f)
+          && fmt_check_type_compat (&(*node)->format.f, NUMERIC))
         {
+          msg_enable ();
           if (do_coercion)
             (*node)->type = OP_ni_format;
           return true;
         }
+      msg_enable ();
       break;
 
     case OP_no_format:
+      msg_disable ();
       if ((*node)->type == OP_format
-          && check_output_specifier (&(*node)->format.f, false)
-          && check_specifier_type (&(*node)->format.f, NUMERIC, false))
+          && fmt_check_output (&(*node)->format.f)
+          && fmt_check_type_compat (&(*node)->format.f, NUMERIC))
         {
+          msg_enable ();
           if (do_coercion)
             (*node)->type = OP_no_format;
           return true;
         }
+      msg_enable ();
       break;
 
     case OP_num_var:
@@ -399,7 +411,7 @@ type_coercion_core (struct expression *e,
       break;
 
     default:
-      abort ();
+      NOT_REACHED ();
     }
 
   if (do_coercion) 
@@ -731,7 +743,7 @@ parse_sysvar (struct expression *e)
           "JUL", "AUG", "SEP", "OCT", "NOV", "DEC",
         };
 
-      time_t last_proc_time = time_of_last_procedure ();
+      time_t last_proc_time = time_of_last_procedure (e->ds);
       struct tm *time;
       char temp_buf[10];
 
@@ -749,7 +761,7 @@ parse_sysvar (struct expression *e)
     return expr_allocate_number (e, SYSMIS);
   else if (lex_match_id ("$JDATE"))
     {
-      time_t time = time_of_last_procedure ();
+      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,
@@ -757,7 +769,7 @@ parse_sysvar (struct expression *e)
     }
   else if (lex_match_id ("$TIME"))
     {
-      time_t time = time_of_last_procedure ();
+      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,
@@ -790,7 +802,7 @@ parse_primary (struct expression *e)
           /* An identifier followed by a left parenthesis may be
              a vector element reference.  If not, it's a function
              call. */
-          if (e->dict != NULL && dict_lookup_vector (e->dict, tokid) != NULL) 
+          if (e->ds != NULL && dict_lookup_vector (dataset_dict (e->ds), tokid) != NULL) 
             return parse_vector_element (e);
           else
             return parse_function (e);
@@ -800,18 +812,24 @@ parse_primary (struct expression *e)
           /* $ at the beginning indicates a system variable. */
           return parse_sysvar (e);
         }
-      else if (e->dict != NULL && dict_lookup_var (e->dict, tokid))
+      else if (e->ds != NULL && dict_lookup_var (dataset_dict (e->ds), tokid))
         {
           /* 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_dict_variable (e->dict));
+          return allocate_unary_variable (e, parse_variable (dataset_dict (e->ds)));
         }
       else 
         {
           /* Try to parse it as a format specifier. */
           struct fmt_spec fmt;
-          if (parse_format_specifier (&fmt, FMTP_SUPPRESS_ERRORS))
+          bool ok;
+          
+          msg_disable ();
+          ok = parse_format_specifier (&fmt);
+          msg_enable ();
+
+          if (ok)
             return expr_allocate_format (e, &fmt);
 
           /* All attempts failed. */
@@ -830,8 +848,8 @@ parse_primary (struct expression *e)
 
     case T_STRING:
       {
-        union any_node *node = expr_allocate_string_buffer (e, ds_c_str (&tokstr),
-                                                       ds_length (&tokstr));
+        union any_node *node = expr_allocate_string_buffer (
+          e, ds_cstr (&tokstr), ds_length (&tokstr));
        lex_get ();
        return node;
       }
@@ -864,7 +882,7 @@ parse_vector_element (struct expression *e)
   /* Find vector, skip token.
      The caller must already have verified that the current token
      is the name of a vector. */
-  vector = dict_lookup_vector (default_dict, tokid);
+  vector = dict_lookup_vector (dataset_dict (e->ds), tokid);
   assert (vector != NULL);
   lex_get ();
 
@@ -886,7 +904,7 @@ parse_vector_element (struct expression *e)
 \f
 /* Individual function parsing. */
 
-struct operation operations[OP_first + OP_cnt] = {
+const struct operation operations[OP_first + OP_cnt] = {
 #include "parse.inc"
 };
     
@@ -945,7 +963,7 @@ lookup_function_helper (const char *name,
                         const struct operation **first,
                         const struct operation **last)
 {
-  struct operation *f;
+  const struct operation *f;
   
   for (f = operations + OP_function_first;
        f <= operations + OP_function_last; f++) 
@@ -1095,14 +1113,14 @@ put_invocation (struct string *s,
 {
   size_t i;
 
-  ds_printf (s, "%s(", func_name);
+  ds_put_format (s, "%s(", func_name);
   for (i = 0; i < arg_cnt; i++)
     {
       if (i > 0)
-        ds_puts (s, ", ");
-      ds_puts (s, operations[expr_node_returns (args[i])].prototype);
+        ds_put_cstr (s, ", ");
+      ds_put_cstr (s, operations[expr_node_returns (args[i])].prototype);
     }
-  ds_putc (s, ')');
+  ds_put_char (s, ')');
 }
 
 static void
@@ -1113,25 +1131,25 @@ no_match (const char *func_name,
   struct string s;
   const struct operation *f;
 
-  ds_init (&s, 128);
+  ds_init_empty (&s);
 
   if (last - first == 1) 
     {
-      ds_printf (&s, _("Type mismatch invoking %s as "), first->prototype);
+      ds_put_format (&s, _("Type mismatch invoking %s as "), first->prototype);
       put_invocation (&s, func_name, args, arg_cnt);
     }
   else 
     {
-      ds_puts (&s, _("Function invocation "));
+      ds_put_cstr (&s, _("Function invocation "));
       put_invocation (&s, func_name, args, arg_cnt);
-      ds_puts (&s, _(" does not match any known function.  Candidates are:"));
+      ds_put_cstr (&s, _(" does not match any known function.  Candidates are:"));
 
       for (f = first; f < last; f++)
-        ds_printf (&s, "\n%s", f->prototype);
+        ds_put_format (&s, "\n%s", f->prototype);
     }
-  ds_putc (&s, '.');
+  ds_put_char (&s, '.');
 
-  msg (SE, "%s", ds_c_str (&s));
+  msg (SE, "%s", ds_cstr (&s));
     
   ds_destroy (&s);
 }
@@ -1146,23 +1164,23 @@ parse_function (struct expression *e)
   int arg_cnt = 0;
   int arg_cap = 0;
 
-  struct fixed_string func_name;
+  struct string func_name;
 
   union any_node *n;
 
-  ls_create (&func_name, ds_c_str (&tokstr));
-  min_valid = extract_min_valid (ds_c_str (&tokstr));
-  if (!lookup_function (ds_c_str (&tokstr), &first, &last)) 
+  ds_init_string (&func_name, &tokstr);
+  min_valid = extract_min_valid (ds_cstr (&tokstr));
+  if (!lookup_function (ds_cstr (&tokstr), &first, &last)) 
     {
-      msg (SE, _("No function or vector named %s."), ds_c_str (&tokstr));
-      ls_destroy (&func_name);
+      msg (SE, _("No function or vector named %s."), ds_cstr (&tokstr));
+      ds_destroy (&func_name);
       return NULL;
     }
 
   lex_get ();
   if (!lex_force_match ('(')) 
     {
-      ls_destroy (&func_name);
+      ds_destroy (&func_name);
       return NULL; 
     }
   
@@ -1177,7 +1195,7 @@ parse_function (struct expression *e)
             size_t var_cnt;
             size_t i;
 
-            if (!parse_variables (default_dict, &vars, &var_cnt, PV_SINGLE))
+            if (!parse_variables (dataset_dict (e->ds), &vars, &var_cnt, PV_SINGLE))
               goto fail;
             for (i = 0; i < var_cnt; i++)
               add_arg (&args, &arg_cnt, &arg_cap,
@@ -1207,7 +1225,7 @@ parse_function (struct expression *e)
       break;
   if (f >= last) 
     {
-      no_match (ls_c_str (&func_name), args, arg_cnt, first, last);
+      no_match (ds_cstr (&func_name), args, arg_cnt, first, last);
       goto fail;
     }
 
@@ -1222,7 +1240,8 @@ parse_function (struct expression *e)
       msg (SE, _("%s is not yet implemented."), f->prototype);
       goto fail;
     }
-  if ((f->flags & OPF_PERM_ONLY) && proc_in_temporary_transformations ()) 
+  if ((f->flags & OPF_PERM_ONLY) && 
+      proc_in_temporary_transformations (e->ds)) 
     {
       msg (SE, _("%s may not appear after TEMPORARY."), f->prototype);
       goto fail;
@@ -1233,8 +1252,8 @@ parse_function (struct expression *e)
 
   if (n->type == OP_LAG_Vn || n->type == OP_LAG_Vs) 
     {
-      if (n_lag < 1)
-        n_lag = 1; 
+      if (dataset_n_lag (e->ds) < 1)
+        dataset_set_n_lag (e->ds, 1);
     }
   else if (n->type == OP_LAG_Vnn || n->type == OP_LAG_Vsn)
     {
@@ -1242,29 +1261,29 @@ parse_function (struct expression *e)
       assert (n->composite.arg_cnt == 2);
       assert (n->composite.args[1]->type == OP_pos_int);
       n_before = n->composite.args[1]->integer.i;
-      if (n_lag < n_before)
-        n_lag = n_before;
+      if ( dataset_n_lag (e->ds) < n_before)
+        dataset_set_n_lag (e->ds, n_before);
     }
   
   free (args);
-  ls_destroy (&func_name);
+  ds_destroy (&func_name);
   return n;
 
 fail:
   free (args);
-  ls_destroy (&func_name);
+  ds_destroy (&func_name);
   return NULL;
 }
 \f
 /* Utility functions. */
 
 static struct expression *
-expr_create (struct dictionary *dict)
+expr_create (struct dataset *ds)
 {
   struct pool *pool = pool_create ();
   struct expression *e = pool_alloc (pool, sizeof *e);
   e->expr_pool = pool;
-  e->dict = dict;
+  e->ds = ds;
   e->eval_pool = pool_create_subpool (e->expr_pool);
   e->ops = NULL;
   e->op_types = NULL;
@@ -1282,7 +1301,7 @@ expr_node_returns (const union any_node *n)
   else if (is_composite (n->type))
     return operations[n->type].returns;
   else
-    abort ();
+    NOT_REACHED ();
 }
 
 static const char *
@@ -1318,7 +1337,7 @@ expr_allocate_binary (struct expression *e, operation_type op,
 static bool
 is_valid_node (union any_node *n) 
 {
-  struct operation *op;
+  const struct operation *op;
   size_t i;
   
   assert (n != NULL);
@@ -1429,7 +1448,7 @@ expr_allocate_string_buffer (struct expression *e,
 }
 
 union any_node *
-expr_allocate_string (struct expression *e, struct fixed_string s)
+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;