Added a dict parameter to data_in and dealt with the consequences.

[pspp-builds.git] / src / language / data-io / data-list.c

diff --git a/src/language/data-io/data-list.c b/src/language/data-io/data-list.c
index 641740fc6c29c66f97e583d21df58de39b298aea..d43af347a701693224980ea18281eaf72d6c0e60 100644 (file)
--- a/src/language/data-io/data-list.c
+++ b/src/language/data-io/data-list.c
@@ -1,33 +1,30 @@
-/* PSPP - computes sample statistics.
-   Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
-   Written by Ben Pfaff <blp@gnu.org>.
+/* PSPP - a program for statistical analysis.
+   Copyright (C) 1997-9, 2000, 2006, 2007, 2009 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
 
    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 <ctype.h>
 #include <float.h>
 
 #include <config.h>
 
 #include <ctype.h>
 #include <float.h>

+#include <stdint.h>

 #include <stdio.h>
 #include <stdlib.h>
 
 #include <stdio.h>
 #include <stdlib.h>
 

-#include <data/case-source.h>

 #include <data/case.h>
 #include <data/case.h>

-#include <data/case-source.h>

 #include <data/data-in.h>
 #include <data/data-in.h>

+#include <data/casereader.h>

 #include <data/dictionary.h>
 #include <data/format.h>
 #include <data/procedure.h>
 #include <data/dictionary.h>
 #include <data/format.h>
 #include <data/procedure.h>


@@ -35,6 +32,7 @@
 #include <data/transformations.h>
 #include <data/variable.h>
 #include <language/command.h>
 #include <data/transformations.h>
 #include <data/variable.h>
 #include <language/command.h>

+#include <language/data-io/data-parser.h>

 #include <language/data-io/data-reader.h>
 #include <language/data-io/file-handle.h>
 #include <language/data-io/inpt-pgm.h>
 #include <language/data-io/data-reader.h>
 #include <language/data-io/file-handle.h>
 #include <language/data-io/inpt-pgm.h>


@@ -42,76 +40,31 @@
 #include <language/lexer/format-parser.h>
 #include <language/lexer/lexer.h>
 #include <language/lexer/variable-parser.h>
 #include <language/lexer/format-parser.h>
 #include <language/lexer/lexer.h>
 #include <language/lexer/variable-parser.h>

-#include <libpspp/alloc.h>

 #include <libpspp/assertion.h>
 #include <libpspp/compiler.h>
 #include <libpspp/assertion.h>
 #include <libpspp/compiler.h>

-#include <libpspp/ll.h>

 #include <libpspp/message.h>
 #include <libpspp/misc.h>
 #include <libpspp/pool.h>
 #include <libpspp/str.h>
 #include <libpspp/message.h>
 #include <libpspp/misc.h>
 #include <libpspp/pool.h>
 #include <libpspp/str.h>

-#include <output/table.h>

 
 

-#include "size_max.h"

 #include "xsize.h"
 #include "xsize.h"

+#include "xalloc.h"

 
 #include "gettext.h"
 #define _(msgid) gettext (msgid)
 \f
 
 #include "gettext.h"
 #define _(msgid) gettext (msgid)
 \f

-/* Utility function. */
-
-/* Describes how to parse one variable. */
-struct dls_var_spec
-  {
-    struct ll ll;               /* List element. */
-
-    /* All parsers. */
-    struct fmt_spec input;     /* Input format of this field. */
-    int fv;                    /* First value in case. */
-    char name[LONG_NAME_LEN + 1]; /* Var name for error messages and tables. */
-
-    /* Fixed format only. */
-    int record;                        /* Record number (1-based). */
-    int first_column;           /* Column numbers in record. */
-  };
-
-static struct dls_var_spec *
-ll_to_dls_var_spec (struct ll *ll) 
-{
-  return ll_data (ll, struct dls_var_spec, ll);
-}
-
-/* Constants for DATA LIST type. */
-enum dls_type
-  {
-    DLS_FIXED,
-    DLS_FREE,
-    DLS_LIST
-  };
-
-/* DATA LIST private data structure. */
-struct data_list_pgm
+/* DATA LIST transformation data. */
+struct data_list_trns

   {
   {

-    struct pool *pool;          /* Used for all DATA LIST storage. */
-    struct ll_list specs;       /* List of dls_var_specs. */
+    struct data_parser *parser; /* Parser. */

     struct dfm_reader *reader;  /* Data file reader. */
     struct dfm_reader *reader;  /* Data file reader. */

-    enum dls_type type;                /* Type of DATA LIST construct. */

     struct variable *end;      /* Variable specified on END subcommand. */
     struct variable *end;      /* Variable specified on END subcommand. */

-    int record_cnt;             /* Number of records. */
-    struct string delims;       /* Field delimiters. */
-    int skip_records;           /* Records to skip before first case. */

   };
 
   };
 

-static const struct case_source_class data_list_source_class;
-
-static bool parse_fixed (struct lexer *, struct dictionary *dict, 
-                        struct pool *tmp_pool, struct data_list_pgm *);
-static bool parse_free (struct lexer *, struct dictionary *dict, 
-                       struct pool *tmp_pool, struct data_list_pgm *);
-static void dump_fixed_table (const struct ll_list *,
-                              const struct file_handle *, int record_cnt);
-static void dump_free_table (const struct data_list_pgm *,
-                             const struct file_handle *);
+static bool parse_fixed (struct lexer *, struct dictionary *,
+                         struct pool *, struct data_parser *);
+static bool parse_free (struct lexer *, struct dictionary *,
+                        struct pool *, struct data_parser *);

 
 static trns_free_func data_list_trns_free;
 static trns_proc_func data_list_trns_proc;
 
 static trns_free_func data_list_trns_free;
 static trns_proc_func data_list_trns_proc;


@@ -119,44 +72,53 @@ static trns_proc_func data_list_trns_proc;
 int
 cmd_data_list (struct lexer *lexer, struct dataset *ds)
 {
 int
 cmd_data_list (struct lexer *lexer, struct dataset *ds)
 {

-  struct dictionary *dict = dataset_dict (ds);
-  struct data_list_pgm *dls;
-  int table = -1;                /* Print table if nonzero, -1=undecided. */
-  struct file_handle *fh = fh_inline_file ();
+  struct dictionary *dict;
+  struct data_parser *parser;
+  struct dfm_reader *reader;
+  struct variable *end = NULL;
+  struct file_handle *fh = NULL;
+  struct string encoding = DS_EMPTY_INITIALIZER;
+
+  int table;
+  enum data_parser_type type;
+  bool has_type;

   struct pool *tmp_pool;
   bool ok;
 
   struct pool *tmp_pool;
   bool ok;
 

-  if (!in_input_program ())
-    discard_variables (ds);
-
-  dls = pool_create_container (struct data_list_pgm, pool);
-  ll_init (&dls->specs);
-  dls->reader = NULL;
-  dls->type = -1;
-  dls->end = NULL;
-  dls->record_cnt = 0;
-  dls->skip_records = 0;
-  ds_init_empty (&dls->delims);
-  ds_register_pool (&dls->delims, dls->pool);
+  dict = in_input_program () ? dataset_dict (ds) : dict_create ();
+  parser = data_parser_create (dict);
+  reader = NULL;

 
 

-  tmp_pool = pool_create_subpool (dls->pool);
+  table = -1;                /* Print table if nonzero, -1=undecided. */
+  has_type = false;

 
   while (lex_token (lexer) != '/')
     {
       if (lex_match_id (lexer, "FILE"))
        {
          lex_match (lexer, '=');
 
   while (lex_token (lexer) != '/')
     {
       if (lex_match_id (lexer, "FILE"))
        {
          lex_match (lexer, '=');

+          fh_unref (fh);

          fh = fh_parse (lexer, FH_REF_FILE | FH_REF_INLINE);
          if (fh == NULL)
            goto error;
        }
          fh = fh_parse (lexer, FH_REF_FILE | FH_REF_INLINE);
          if (fh == NULL)
            goto error;
        }

+      else if (lex_match_id (lexer, "ENCODING"))
+       {
+         lex_match (lexer, '=');
+         if (!lex_force_string (lexer))
+           goto error;
+
+         ds_init_string (&encoding, lex_tokstr (lexer));
+
+         lex_get (lexer);
+       }

       else if (lex_match_id (lexer, "RECORDS"))
        {
          lex_match (lexer, '=');
          lex_match (lexer, '(');
          if (!lex_force_int (lexer))
            goto error;
       else if (lex_match_id (lexer, "RECORDS"))
        {
          lex_match (lexer, '=');
          lex_match (lexer, '(');
          if (!lex_force_int (lexer))
            goto error;

-         dls->record_cnt = lex_integer (lexer);
+          data_parser_set_records (parser, lex_integer (lexer));

          lex_get (lexer);
          lex_match (lexer, ')');
        }
          lex_get (lexer);
          lex_match (lexer, ')');
        }


@@ -165,78 +127,105 @@ cmd_data_list (struct lexer *lexer, struct dataset *ds)
          lex_match (lexer, '=');
          if (!lex_force_int (lexer))
            goto error;
          lex_match (lexer, '=');
          if (!lex_force_int (lexer))
            goto error;

-         dls->skip_records = lex_integer (lexer);
+          data_parser_set_skip (parser, lex_integer (lexer));

          lex_get (lexer);
        }
       else if (lex_match_id (lexer, "END"))
        {
          lex_get (lexer);
        }
       else if (lex_match_id (lexer, "END"))
        {

-         if (dls->end)
+          if (!in_input_program ())
+            {
+              msg (SE, _("The END subcommand may only be used within "
+                         "INPUT PROGRAM."));
+              goto error;
+            }
+         if (end)

            {
              msg (SE, _("The END subcommand may only be specified once."));
              goto error;
            }
            {
              msg (SE, _("The END subcommand may only be specified once."));
              goto error;
            }

-         
+

          lex_match (lexer, '=');
          if (!lex_force_id (lexer))
            goto error;
          lex_match (lexer, '=');
          if (!lex_force_id (lexer))
            goto error;

-         dls->end = dict_lookup_var (dataset_dict (ds), lex_tokid (lexer));
-         if (!dls->end) 
-            dls->end = dict_create_var_assert (dataset_dict (ds), lex_tokid (lexer), 0);
+         end = dict_lookup_var (dict, lex_tokid (lexer));
+         if (!end)
+            end = dict_create_var_assert (dict, lex_tokid (lexer), 0);

          lex_get (lexer);
        }
          lex_get (lexer);
        }

+      else if (lex_match_id (lexer, "NOTABLE"))
+        table = 0;
+      else if (lex_match_id (lexer, "TABLE"))
+        table = 1;

       else if (lex_token (lexer) == T_ID)
        {
       else if (lex_token (lexer) == T_ID)
        {

-          if (lex_match_id (lexer, "NOTABLE"))
-            table = 0;
-          else if (lex_match_id (lexer, "TABLE"))
-            table = 1;
-          else 
+          if (lex_match_id (lexer, "FIXED"))
+            data_parser_set_type (parser, DP_FIXED);
+          else if (lex_match_id (lexer, "FREE"))

             {
             {

-              int type;
-              if (lex_match_id (lexer, "FIXED"))
-                type = DLS_FIXED;
-              else if (lex_match_id (lexer, "FREE"))
-                type = DLS_FREE;
-              else if (lex_match_id (lexer, "LIST"))
-                type = DLS_LIST;
-              else 
-                {
-                  lex_error (lexer, NULL);
-                  goto error;
-                }
+              data_parser_set_type (parser, DP_DELIMITED);
+              data_parser_set_span (parser, true);
+            }
+          else if (lex_match_id (lexer, "LIST"))
+            {
+              data_parser_set_type (parser, DP_DELIMITED);
+              data_parser_set_span (parser, false);
+            }
+          else
+            {
+              lex_error (lexer, NULL);
+              goto error;
+            }

 
 

-             if (dls->type != -1)
-               {
-                 msg (SE, _("Only one of FIXED, FREE, or LIST may "
-                             "be specified."));
-                 goto error;
-               }
-             dls->type = type;
+          if (has_type)
+            {
+              msg (SE, _("Only one of FIXED, FREE, or LIST may "
+                         "be specified."));
+              goto error;
+            }
+          has_type = true;

 
 

-              if ((dls->type == DLS_FREE || dls->type == DLS_LIST)
-                  && lex_match (lexer, '(')) 
+          if (data_parser_get_type (parser) == DP_DELIMITED)
+            {
+              if (lex_match (lexer, '('))

                 {
                 {

+                  struct string delims = DS_EMPTY_INITIALIZER;
+

                   while (!lex_match (lexer, ')'))
                     {
                       int delim;
 
                       if (lex_match_id (lexer, "TAB"))
                         delim = '\t';
                   while (!lex_match (lexer, ')'))
                     {
                       int delim;
 
                       if (lex_match_id (lexer, "TAB"))
                         delim = '\t';

-                      else if (lex_token (lexer) == T_STRING && ds_length (lex_tokstr (lexer)) == 1)
-                       {
-                         delim = ds_first (lex_tokstr (lexer));
-                         lex_get (lexer);
-                       }
-                      else 
+                      else if (lex_token (lexer) == T_STRING
+                               && ds_length (lex_tokstr (lexer)) == 1)
+                        {
+                          delim = ds_first (lex_tokstr (lexer));
+                          lex_get (lexer);
+                        }
+                      else

                         {
                           lex_error (lexer, NULL);
                         {
                           lex_error (lexer, NULL);

+                          ds_destroy (&delims);

                           goto error;
                         }
                           goto error;
                         }

-
-                      ds_put_char (&dls->delims, delim);
+                      ds_put_char (&delims, delim);

 
                       lex_match (lexer, ',');
                     }
 
                       lex_match (lexer, ',');
                     }

+
+                  data_parser_set_empty_line_has_field (parser, true);
+                  data_parser_set_quotes (parser, ss_empty ());
+                  data_parser_set_soft_delimiters (parser, ss_empty ());
+                  data_parser_set_hard_delimiters (parser, ds_ss (&delims));
+                  ds_destroy (&delims);
+                }
+              else
+                {
+                  data_parser_set_empty_line_has_field (parser, false);
+                  data_parser_set_quotes (parser, ss_cstr ("'\""));
+                  data_parser_set_soft_delimiters (parser,
+                                                   ss_cstr (CC_SPACES));
+                  data_parser_set_hard_delimiters (parser, ss_cstr (","));

                 }
             }
         }
                 }
             }
         }


@@ -246,59 +235,89 @@ cmd_data_list (struct lexer *lexer, struct dataset *ds)
          goto error;
        }
     }
          goto error;
        }
     }

+  type = data_parser_get_type (parser);

 
 

-  fh_set_default_handle (fh);
+  if (! ds_is_empty (&encoding))
+    {
+      if ( NULL == fh)
+       msg (MW, _("Encoding should not be specified for inline data. It will be ignored."));
+      else
+       dict_set_encoding (dict, ds_cstr (&encoding));
+    }

 
 

-  if (dls->type == -1)
-    dls->type = DLS_FIXED;
+  if (fh == NULL)
+    fh = fh_inline_file ();
+  fh_set_default_handle (fh);

 
 

-  if (table == -1)
-    table = dls->type != DLS_FREE;
+  if (type != DP_FIXED && end != NULL)
+    {
+      msg (SE, _("The END subcommand may be used only with DATA LIST FIXED."));
+      goto error;
+    }

 
 

-  ok = (dls->type == DLS_FIXED ? parse_fixed : parse_free) (lexer, dict, tmp_pool, dls);
+  tmp_pool = pool_create ();
+  if (type == DP_FIXED)
+    ok = parse_fixed (lexer, dict, tmp_pool, parser);
+  else
+    ok = parse_free (lexer, dict, tmp_pool, parser);
+  pool_destroy (tmp_pool);

   if (!ok)
     goto error;
 
   if (!ok)
     goto error;
 

+  if (!data_parser_any_fields (parser))
+    {
+      msg (SE, _("At least one variable must be specified."));
+      goto error;
+    }
+

   if (lex_end_of_command (lexer) != CMD_SUCCESS)
     goto error;
 
   if (lex_end_of_command (lexer) != CMD_SUCCESS)
     goto error;
 

+  if (table == -1)
+    table = type == DP_FIXED || !data_parser_get_span (parser);

   if (table)
   if (table)

-    {
-      if (dls->type == DLS_FIXED)
-       dump_fixed_table (&dls->specs, fh, dls->record_cnt);
-      else
-       dump_free_table (dls, fh);
-    }
+    data_parser_output_description (parser, fh);

 
 

-  dls->reader = dfm_open_reader (fh, lexer);
-  if (dls->reader == NULL)
+  reader = dfm_open_reader (fh, lexer);
+  if (reader == NULL)

     goto error;
 
   if (in_input_program ())
     goto error;
 
   if (in_input_program ())

-    add_transformation (ds, data_list_trns_proc, data_list_trns_free, dls);
-  else 
-    proc_set_source (ds, create_case_source (&data_list_source_class, dls));
+    {
+      struct data_list_trns *trns = xmalloc (sizeof *trns);
+      trns->parser = parser;
+      trns->reader = reader;
+      trns->end = end;
+      add_transformation (ds, data_list_trns_proc, data_list_trns_free, trns);
+    }
+  else
+    data_parser_make_active_file (parser, ds, reader, dict);

 
 

-  pool_destroy (tmp_pool);
+  fh_unref (fh);
+  ds_destroy (&encoding);

 
   return CMD_SUCCESS;
 
  error:
 
   return CMD_SUCCESS;
 
  error:

-  data_list_trns_free (dls);
+  data_parser_destroy (parser);
+  if (!in_input_program ())
+    dict_destroy (dict);
+  fh_unref (fh);
+  ds_destroy (&encoding);

   return CMD_CASCADING_FAILURE;
 }
 \f
 /* Fixed-format parsing. */
 
 /* Parses all the variable specifications for DATA LIST FIXED,
   return CMD_CASCADING_FAILURE;
 }
 \f
 /* Fixed-format parsing. */
 
 /* Parses all the variable specifications for DATA LIST FIXED,

-   storing them into DLS.  Uses TMP_POOL for data that is not
-   needed once parsing is complete.  Returns true only if
+   storing them into DLS.  Uses TMP_POOL for temporary storage;
+   the caller may destroy it.  Returns true only if

    successful. */
 static bool
    successful. */
 static bool

-parse_fixed (struct lexer *lexer, struct dictionary *dict, 
-            struct pool *tmp_pool, struct data_list_pgm *dls)
+parse_fixed (struct lexer *lexer, struct dictionary *dict,
+            struct pool *tmp_pool, struct data_parser *parser)

 {
 {

-  int last_nonempty_record;
+  int max_records = data_parser_get_records (parser);

   int record = 0;
   int column = 1;
 
   int record = 0;
   int column = 1;
 


@@ -311,7 +330,7 @@ parse_fixed (struct lexer *lexer, struct dictionary *dict,
 
       /* Parse everything. */
       if (!parse_record_placement (lexer, &record, &column)
 
       /* Parse everything. */
       if (!parse_record_placement (lexer, &record, &column)

-          || !parse_DATA_LIST_vars_pool (lexer, tmp_pool, 
+          || !parse_DATA_LIST_vars_pool (lexer, tmp_pool,

                                         &names, &name_cnt, PV_NONE)
           || !parse_var_placements (lexer, tmp_pool, name_cnt, true,
                                     &formats, &format_cnt))
                                         &names, &name_cnt, PV_NONE)
           || !parse_var_placements (lexer, tmp_pool, name_cnt, true,
                                     &formats, &format_cnt))


@@ -325,8 +344,7 @@ parse_fixed (struct lexer *lexer, struct dictionary *dict,
             char *name;
             int width;
             struct variable *v;
             char *name;
             int width;
             struct variable *v;

-            struct dls_var_spec *spec;
-              
+

             name = names[name_idx++];
 
             /* Create variable. */
             name = names[name_idx++];
 
             /* Create variable. */


@@ -344,7 +362,7 @@ parse_fixed (struct lexer *lexer, struct dictionary *dict,
                    This can be acceptable if we're in INPUT
                    PROGRAM, but only if the existing variable has
                    the same width as the one we would have
                    This can be acceptable if we're in INPUT
                    PROGRAM, but only if the existing variable has
                    the same width as the one we would have

-                   created. */ 
+                   created. */

                 if (!in_input_program ())
                   {
                     msg (SE, _("%s is a duplicate variable name."), name);
                 if (!in_input_program ())
                   {
                     msg (SE, _("%s is a duplicate variable name."), name);


@@ -367,88 +385,34 @@ parse_fixed (struct lexer *lexer, struct dictionary *dict,
                   }
               }
 
                   }
               }
 

-            /* Create specifier for parsing the variable. */
-            spec = pool_alloc (dls->pool, sizeof *spec);
-            spec->input = *f;
-            spec->fv = v->fv;
-            spec->record = record;
-            spec->first_column = column;
-            strcpy (spec->name, var_get_name (v));
-            ll_push_tail (&dls->specs, &spec->ll);
+            if (max_records && record > max_records)
+              {
+                msg (SE, _("Cannot place variable %s on record %d when "
+                           "RECORDS=%d is specified."),
+                     var_get_name (v), record,
+                     data_parser_get_records (parser));
+              }
+
+            data_parser_add_fixed_field (parser, f,
+                                         var_get_case_index (v),
+                                         var_get_name (v), record, column);

 
             column += f->w;
           }
       assert (name_idx == name_cnt);
     }
 
             column += f->w;
           }
       assert (name_idx == name_cnt);
     }

-  if (ll_is_empty (&dls->specs)) 
-    {
-      msg (SE, _("At least one variable must be specified."));
-      return false;
-    }
-
-  last_nonempty_record = ll_to_dls_var_spec (ll_tail (&dls->specs))->record;
-  if (dls->record_cnt && last_nonempty_record > dls->record_cnt)
-    {
-      msg (SE, _("Variables are specified on records that "
-                "should not exist according to RECORDS subcommand."));
-      return false;
-    }
-  else if (!dls->record_cnt) 
-    dls->record_cnt = last_nonempty_record;

 
   return true;
 }
 
   return true;
 }

-
-/* Displays a table giving information on fixed-format variable
-   parsing on DATA LIST. */
-static void
-dump_fixed_table (const struct ll_list *specs,
-                  const struct file_handle *fh, int record_cnt)
-{
-  size_t spec_cnt;
-  struct tab_table *t;
-  struct dls_var_spec *spec;
-  int row;
-
-  spec_cnt = ll_count (specs);
-  t = tab_create (4, spec_cnt + 1, 0);
-  tab_columns (t, TAB_COL_DOWN, 1);
-  tab_headers (t, 0, 0, 1, 0);
-  tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
-  tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
-  tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
-  tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
-  tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, spec_cnt);
-  tab_hline (t, TAL_2, 0, 3, 1);
-  tab_dim (t, tab_natural_dimensions);
-
-  row = 1;
-  ll_for_each (spec, struct dls_var_spec, ll, specs)
-    {
-      char fmt_string[FMT_STRING_LEN_MAX + 1];
-      tab_text (t, 0, row, TAB_LEFT, spec->name);
-      tab_text (t, 1, row, TAT_PRINTF, "%d", spec->record);
-      tab_text (t, 2, row, TAT_PRINTF, "%3d-%3d",
-                spec->first_column, spec->first_column + spec->input.w - 1);
-      tab_text (t, 3, row, TAB_LEFT | TAB_FIX,
-                fmt_to_string (&spec->input, fmt_string));
-      row++;
-    }
-
-  tab_title (t, ngettext ("Reading %d record from %s.",
-                          "Reading %d records from %s.", record_cnt),
-             record_cnt, fh_get_name (fh));
-  tab_submit (t);
-}

 \f
 /* Free-format parsing. */
 
 /* Parses variable specifications for DATA LIST FREE and adds
 \f
 /* Free-format parsing. */
 
 /* Parses variable specifications for DATA LIST FREE and adds

-   them to DLS.  Uses TMP_POOL for data that is not needed once
-   parsing is complete.  Returns true only if successful. */
+   them to DLS.  Uses TMP_POOL for temporary storage; the caller
+   may destroy it.  Returns true only if successful. */

 static bool
 static bool

-parse_free (struct lexer *lexer, struct dictionary *dict, struct pool *tmp_pool, 
-               struct data_list_pgm *dls)
+parse_free (struct lexer *lexer, struct dictionary *dict,
+            struct pool *tmp_pool, struct data_parser *parser)

 {
   lex_get (lexer);
   while (lex_token (lexer) != '.')
 {
   lex_get (lexer);
   while (lex_token (lexer) != '.')


@@ -458,331 +422,77 @@ parse_free (struct lexer *lexer, struct dictionary *dict, struct pool *tmp_pool,
       size_t name_cnt;
       size_t i;
 
       size_t name_cnt;
       size_t i;
 

-      if (!parse_DATA_LIST_vars_pool (lexer, tmp_pool, 
+      if (!parse_DATA_LIST_vars_pool (lexer, tmp_pool,

                                      &name, &name_cnt, PV_NONE))
                                      &name, &name_cnt, PV_NONE))

-       return 0;
+       return false;

 
       if (lex_match (lexer, '('))
        {
          if (!parse_format_specifier (lexer, &input)
               || !fmt_check_input (&input)
 
       if (lex_match (lexer, '('))
        {
          if (!parse_format_specifier (lexer, &input)
               || !fmt_check_input (&input)

-              || !lex_force_match (lexer, ')')) 
+              || !lex_force_match (lexer, ')'))

             return NULL;
 
           /* As a special case, N format is treated as F format
              for free-field input. */
           if (input.type == FMT_N)
             input.type = FMT_F;
             return NULL;
 
           /* As a special case, N format is treated as F format
              for free-field input. */
           if (input.type == FMT_N)
             input.type = FMT_F;

-          
+

          output = fmt_for_output_from_input (&input);
        }
       else
        {
          lex_match (lexer, '*');
           input = fmt_for_input (FMT_F, 8, 0);
          output = fmt_for_output_from_input (&input);
        }
       else
        {
          lex_match (lexer, '*');
           input = fmt_for_input (FMT_F, 8, 0);

-         output = *get_format ();
+         output = *settings_get_format ();

        }
 
       for (i = 0; i < name_cnt; i++)
        {
        }
 
       for (i = 0; i < name_cnt; i++)
        {

-          struct dls_var_spec *spec;

          struct variable *v;
 
          v = dict_create_var (dict, name[i], fmt_var_width (&input));
          if (v == NULL)
            {
              msg (SE, _("%s is a duplicate variable name."), name[i]);
          struct variable *v;
 
          v = dict_create_var (dict, name[i], fmt_var_width (&input));
          if (v == NULL)
            {
              msg (SE, _("%s is a duplicate variable name."), name[i]);

-             return 0;
+             return false;

            }
           var_set_both_formats (v, &output);
 
            }
           var_set_both_formats (v, &output);
 

-          spec = pool_alloc (dls->pool, sizeof *spec);
-          spec->input = input;
-         spec->fv = v->fv;
-         strcpy (spec->name, var_get_name (v));
-          ll_push_tail (&dls->specs, &spec->ll);
+          data_parser_add_delimited_field (parser,
+                                           &input, var_get_case_index (v),
+                                           var_get_name (v));

        }
     }
 
   return true;
 }
        }
     }
 
   return true;
 }

-
-/* Displays a table giving information on free-format variable parsing
-   on DATA LIST. */
-static void
-dump_free_table (const struct data_list_pgm *dls,
-                 const struct file_handle *fh)
-{
-  struct tab_table *t;
-  struct dls_var_spec *spec;
-  size_t spec_cnt;
-  int row;
-
-  spec_cnt = ll_count (&dls->specs);
-  
-  t = tab_create (2, spec_cnt + 1, 0);
-  tab_columns (t, TAB_COL_DOWN, 1);
-  tab_headers (t, 0, 0, 1, 0);
-  tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
-  tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Format"));
-  tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, spec_cnt);
-  tab_hline (t, TAL_2, 0, 1, 1);
-  tab_dim (t, tab_natural_dimensions);
-  row = 1;
-  ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
-    {
-      char str[FMT_STRING_LEN_MAX + 1];
-      tab_text (t, 0, row, TAB_LEFT, spec->name);
-      tab_text (t, 1, row, TAB_LEFT | TAB_FIX,
-                fmt_to_string (&spec->input, str));
-      row++;
-    }
-
-  tab_title (t, _("Reading free-form data from %s."), fh_get_name (fh));
-  
-  tab_submit (t);
-}

 \f
 \f

-/* Input procedure. */ 
-
-/* Extracts a field from the current position in the current
-   record.  Fields can be unquoted or quoted with single- or
-   double-quote characters.
-
-   *FIELD is set to the field content.  The caller must not
-   or destroy this constant string.
-   
-   After parsing the field, sets the current position in the
-   record to just past the field and any trailing delimiter.
-   Returns 0 on failure or a 1-based column number indicating the
-   beginning of the field on success. */
-static bool
-cut_field (const struct data_list_pgm *dls, struct substring *field)
-{
-  struct substring line, p;
-
-  if (dfm_eof (dls->reader))
-    return false;
-  if (ds_is_empty (&dls->delims))
-    dfm_expand_tabs (dls->reader);
-  line = p = dfm_get_record (dls->reader);
-
-  if (ds_is_empty (&dls->delims)) 
-    {
-      bool missing_quote = false;
-      
-      /* Skip leading whitespace. */
-      ss_ltrim (&p, ss_cstr (CC_SPACES));
-      if (ss_is_empty (p))
-        return false;
-      
-      /* Handle actual data, whether quoted or unquoted. */
-      if (ss_match_char (&p, '\''))
-        missing_quote = !ss_get_until (&p, '\'', field);
-      else if (ss_match_char (&p, '"'))
-        missing_quote = !ss_get_until (&p, '"', field);
-      else
-        ss_get_chars (&p, ss_cspan (p, ss_cstr ("," CC_SPACES)), field);
-      if (missing_quote)
-        msg (SW, _("Quoted string extends beyond end of line."));
-
-      /* Skip trailing whitespace and a single comma if present. */
-      ss_ltrim (&p, ss_cstr (CC_SPACES));
-      ss_match_char (&p, ',');
+/* Input procedure. */

 
 

-      dfm_forward_columns (dls->reader, ss_length (line) - ss_length (p));
-    }
-  else 
-    {
-      if (!ss_is_empty (p))
-        ss_get_chars (&p, ss_cspan (p, ds_ss (&dls->delims)), field);
-      else if (dfm_columns_past_end (dls->reader) == 0)
-        {
-          /* A blank line or a line that ends in a delimiter has a
-             trailing blank field. */
-          *field = p;
-        }
-      else 
-        return false;
-
-      /* Advance past the field.
-         
-         Also advance past a trailing delimiter, regardless of
-         whether one actually existed.  If we "skip" a delimiter
-         that was not actually there, then we will return
-         end-of-line on our next call, which is what we want. */
-      dfm_forward_columns (dls->reader, ss_length (line) - ss_length (p) + 1);
-    }
-  return true;
-}
-
-static bool read_from_data_list_fixed (const struct data_list_pgm *,
-                                       struct ccase *);
-static bool read_from_data_list_free (const struct data_list_pgm *,
-                                      struct ccase *);
-static bool read_from_data_list_list (const struct data_list_pgm *,
-                                      struct ccase *);
-
-/* Reads a case from DLS into C.
-   Returns true if successful, false at end of file or on I/O error. */
-static bool
-read_from_data_list (const struct data_list_pgm *dls, struct ccase *c) 
-{
-  bool retval;
-
-  dfm_push (dls->reader);
-  switch (dls->type)
-    {
-    case DLS_FIXED:
-      retval = read_from_data_list_fixed (dls, c);
-      break;
-    case DLS_FREE:
-      retval = read_from_data_list_free (dls, c);
-      break;
-    case DLS_LIST:
-      retval = read_from_data_list_list (dls, c);
-      break;
-    default:
-      NOT_REACHED ();
-    }
-  dfm_pop (dls->reader);
-
-  return retval;
-}
-
-/* Reads a case from the data file into C, parsing it according
-   to fixed-format syntax rules in DLS.  
-   Returns true if successful, false at end of file or on I/O error. */
-static bool
-read_from_data_list_fixed (const struct data_list_pgm *dls, struct ccase *c)
-{
-  struct dls_var_spec *spec;
-  int row;
-
-  if (dfm_eof (dls->reader)) 
-    return false; 
-
-  spec = ll_to_dls_var_spec (ll_head (&dls->specs));
-  for (row = 1; row <= dls->record_cnt; row++)
-    {
-      struct substring line;
-
-      if (dfm_eof (dls->reader))
-        {
-          msg (SW, _("Partial case of %d of %d records discarded."),
-               row - 1, dls->record_cnt);
-          return false;
-        } 
-      dfm_expand_tabs (dls->reader);
-      line = dfm_get_record (dls->reader);
-
-      ll_for_each_continue (spec, struct dls_var_spec, ll, &dls->specs) 
-        data_in (ss_substr (line, spec->first_column - 1, spec->input.w),
-                 spec->input.type, spec->input.d, spec->first_column,
-                 case_data_rw (c, spec->fv), fmt_var_width (&spec->input));
-
-      dfm_forward_record (dls->reader);
-    }
-
-  return true;
-}
-
-/* Reads a case from the data file into C, parsing it according
-   to free-format syntax rules in DLS.  
-   Returns true if successful, false at end of file or on I/O error. */
-static bool
-read_from_data_list_free (const struct data_list_pgm *dls, struct ccase *c)
-{
-  struct dls_var_spec *spec;
-
-  ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
-    {
-      struct substring field;
-      
-      /* Cut out a field and read in a new record if necessary. */
-      while (!cut_field (dls, &field))
-       {
-         if (!dfm_eof (dls->reader)) 
-            dfm_forward_record (dls->reader);
-         if (dfm_eof (dls->reader))
-           {
-             if (&spec->ll != ll_head (&dls->specs))
-               msg (SW, _("Partial case discarded.  The first variable "
-                           "missing was %s."), spec->name);
-             return false;
-           }
-       }
-      
-      data_in (field, spec->input.type, 0,
-               dfm_get_column (dls->reader, ss_data (field)),
-               case_data_rw (c, spec->fv), fmt_var_width (&spec->input));
-    }
-  return true;
-}
-
-/* Reads a case from the data file and parses it according to
-   list-format syntax rules.  
-   Returns true if successful, false at end of file or on I/O error. */
-static bool
-read_from_data_list_list (const struct data_list_pgm *dls, struct ccase *c)
-{
-  struct dls_var_spec *spec;
-
-  if (dfm_eof (dls->reader))
-    return false;
-
-  ll_for_each (spec, struct dls_var_spec, ll, &dls->specs)
-    {
-      struct substring field;
-
-      if (!cut_field (dls, &field))
-       {
-         if (get_undefined ())
-           msg (SW, _("Missing value(s) for all variables from %s onward.  "
-                       "These will be filled with the system-missing value "
-                       "or blanks, as appropriate."),
-                spec->name);
-          ll_for_each_continue (spec, struct dls_var_spec, ll, &dls->specs)
-            {
-              int width = fmt_var_width (&spec->input);
-              if (width == 0)
-                case_data_rw (c, spec->fv)->f = SYSMIS;
-              else
-                memset (case_data_rw (c, spec->fv)->s, ' ', width); 
-            }
-         break;
-       }
-      
-      data_in (field, spec->input.type, 0,
-               dfm_get_column (dls->reader, ss_data (field)),
-               case_data_rw (c, spec->fv), fmt_var_width (&spec->input));
-    }
-
-  dfm_forward_record (dls->reader);
-  return true;
-}
-
-/* Destroys DATA LIST transformation DLS.
+/* Destroys DATA LIST transformation TRNS.

    Returns true if successful, false if an I/O error occurred. */
 static bool
    Returns true if successful, false if an I/O error occurred. */
 static bool

-data_list_trns_free (void *dls_)
+data_list_trns_free (void *trns_)

 {
 {

-  struct data_list_pgm *dls = dls_;
-  dfm_close_reader (dls->reader);
-  pool_destroy (dls->pool);
+  struct data_list_trns *trns = trns_;
+  data_parser_destroy (trns->parser);
+  dfm_close_reader (trns->reader);
+  free (trns);

   return true;
 }
 
   return true;
 }
 

-/* Handle DATA LIST transformation DLS, parsing data into C. */
+/* Handle DATA LIST transformation TRNS, parsing data into *C. */

 static int
 static int

-data_list_trns_proc (void *dls_, struct ccase *c, casenumber case_num UNUSED)
+data_list_trns_proc (void *trns_, struct ccase **c, casenumber case_num UNUSED)

 {
 {

-  struct data_list_pgm *dls = dls_;
+  struct data_list_trns *trns = trns_;

   int retval;
 
   int retval;
 

-  if (read_from_data_list (dls, c))
+  *c = case_unshare (*c);
+  if (data_parser_parse (trns->parser, trns->reader, *c))

     retval = TRNS_CONTINUE;
     retval = TRNS_CONTINUE;

-  else if (dfm_reader_error (dls->reader) || dfm_eof (dls->reader) > 1) 
+  else if (dfm_reader_error (trns->reader) || dfm_eof (trns->reader) > 1)

     {
       /* An I/O error, or encountering end of file for a second
          time, should be escalated into a more serious error. */
     {
       /* An I/O error, or encountering end of file for a second
          time, should be escalated into a more serious error. */


@@ -790,15 +500,15 @@ data_list_trns_proc (void *dls_, struct ccase *c, casenumber case_num UNUSED)
     }
   else
     retval = TRNS_END_FILE;
     }
   else
     retval = TRNS_END_FILE;

-  
+

   /* If there was an END subcommand handle it. */
   /* If there was an END subcommand handle it. */

-  if (dls->end != NULL) 
+  if (trns->end != NULL)

     {
     {

-      double *end = &case_data_rw (c, dls->end->fv)->f;
-      if (retval == TRNS_DROP_CASE)
+      double *end = &case_data_rw (*c, trns->end)->f;
+      if (retval == TRNS_END_FILE)

         {
           *end = 1.0;
         {
           *end = 1.0;

-          retval = TRNS_END_FILE;
+          retval = TRNS_CONTINUE;

         }
       else
         *end = 0.0;
         }
       else
         *end = 0.0;


@@ -807,52 +517,3 @@ data_list_trns_proc (void *dls_, struct ccase *c, casenumber case_num UNUSED)
   return retval;
 }
 \f
   return retval;
 }
 \f

-/* Reads all the records from the data file and passes them to
-   write_case().
-   Returns true if successful, false if an I/O error occurred. */
-static bool
-data_list_source_read (struct case_source *source,
-                       struct ccase *c,
-                       write_case_func *write_case, write_case_data wc_data)
-{
-  struct data_list_pgm *dls = source->aux;
-
-  /* Skip the requested number of records before reading the
-     first case. */
-  while (dls->skip_records > 0) 
-    {
-      if (dfm_eof (dls->reader))
-        return false;
-      dfm_forward_record (dls->reader);
-      dls->skip_records--;
-    }
-  
-  for (;;) 
-    {
-      bool ok;
-
-      if (!read_from_data_list (dls, c)) 
-        return !dfm_reader_error (dls->reader);
-
-      dfm_push (dls->reader);
-      ok = write_case (wc_data);
-      dfm_pop (dls->reader);
-      if (!ok)
-        return false;
-    }
-}
-
-/* Destroys the source's internal data. */
-static void
-data_list_source_destroy (struct case_source *source)
-{
-  data_list_trns_free (source->aux);
-}
-
-static const struct case_source_class data_list_source_class = 
-  {
-    "DATA LIST",
-    NULL,
-    data_list_source_read,
-    data_list_source_destroy,
-  };