src/inpt-pgm.c

   1 /* PSPP - computes sample statistics.
   2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
   3    Written by Ben Pfaff <blp@gnu.org>.
   4
   5    This program is free software; you can redistribute it and/or
   6    modify it under the terms of the GNU General Public License as
   7    published by the Free Software Foundation; either version 2 of the
   8    License, or (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful, but
  11    WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13    General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  18    02111-1307, USA. */
  19
  20 #include <config.h>
  21 #include <assert.h>
  22 #include <float.h>
  23 #include <stdlib.h>
  24 #include "alloc.h"
  25 #include "command.h"
  26 #include "data-list.h"
  27 #include "dfm.h"
  28 #include "error.h"
  29 #include "expr.h"
  30 #include "file-handle.h"
  31 #include "lexer.h"
  32 #include "misc.h"
  33 #include "str.h"
  34 #include "var.h"
  35 #include "vfm.h"
  36
  37 #include "debug-print.h"
  38
  39 /* Indicates how a `union value' should be initialized. */
  40 enum value_init_type
  41   {
  42     INP_NUMERIC = 01,           /* Numeric. */
  43     INP_STRING = 0,             /* String. */
  44
  45     INP_INIT_ONCE = 02,         /* Initialize only once. */
  46     INP_REINIT = 0,             /* Reinitialize for each iteration. */
  47   };
  48
  49 struct input_program_pgm
  50   {
  51     enum value_init_type *init; /* How to initialize each `union value'. */
  52     size_t init_cnt;            /* Number of elements in inp_init. */
  53     size_t case_size;           /* Size of case in bytes. */
  54   };
  55
  56 static trns_proc_func end_case_trns_proc, reread_trns_proc, end_file_trns_proc;
  57 static trns_free_func reread_trns_free;
  58
  59 int
  60 cmd_input_program (void)
  61 {
  62   lex_match_id ("INPUT");
  63   lex_match_id ("PROGRAM");
  64   discard_variables ();
  65
  66   /* FIXME: we shouldn't do this here, but I'm afraid that other
  67      code will check the class of vfm_source. */
  68   vfm_source = create_case_source (&input_program_source_class,
  69                                    default_dict, NULL);
  70
  71   return lex_end_of_command ();
  72 }
  73
  74 int
  75 cmd_end_input_program (void)
  76 {
  77   struct input_program_pgm *inp;
  78   size_t i;
  79
  80   lex_match_id ("END");
  81   lex_match_id ("INPUT");
  82   lex_match_id ("PROGRAM");
  83
  84   if (!case_source_is_class (vfm_source, &input_program_source_class))
  85     {
  86       msg (SE, _("No matching INPUT PROGRAM command."));
  87       return CMD_FAILURE;
  88     }
  89
  90   if (dict_get_next_value_idx (default_dict) == 0)
  91     msg (SW, _("No data-input or transformation commands specified "
  92          "between INPUT PROGRAM and END INPUT PROGRAM."));
  93
  94   /* Mark the boundary between INPUT PROGRAM transformations and
  95      ordinary transformations. */
  96   f_trns = n_trns;
  97
  98   /* Figure out how to initialize each input case. */
  99   inp = xmalloc (sizeof *inp);
 100   inp->init_cnt = dict_get_next_value_idx (default_dict);
 101   inp->init = xmalloc (inp->init_cnt * sizeof *inp->init);
 102   for (i = 0; i < inp->init_cnt; i++)
 103     inp->init[i] = -1;
 104   for (i = 0; i < dict_get_var_cnt (default_dict); i++)
 105     {
 106       struct variable *var = dict_get_var (default_dict, i);
 107       enum value_init_type value_init;
 108       size_t j;
 109
 110       value_init = var->type == NUMERIC ? INP_NUMERIC : INP_STRING;
 111       value_init |= var->reinit ? INP_REINIT : INP_INIT_ONCE;
 112
 113       for (j = 0; j < var->nv; j++)
 114         inp->init[j + var->fv] = value_init;
 115     }
 116   for (i = 0; i < inp->init_cnt; i++)
 117     assert (inp->init[i] != -1);
 118   inp->case_size = dict_get_case_size (default_dict);
 119
 120   /* Put inp into vfm_source for later use. */
 121   vfm_source->aux = inp;
 122
 123   /* FIXME: we should use create_case_source() here. */
 124   vfm_source->value_cnt = dict_get_next_value_idx (default_dict);
 125
 126   return lex_end_of_command ();
 127 }
 128
 129 /* Initializes case C.  Called before the first case is read. */
 130 static void
 131 init_case (const struct input_program_pgm *inp, struct ccase *c)
 132 {
 133   size_t i;
 134
 135   for (i = 0; i < inp->init_cnt; i++)
 136     switch (inp->init[i])
 137       {
 138       case INP_NUMERIC | INP_INIT_ONCE:
 139         c->data[i].f = 0.0;
 140         break;
 141       case INP_NUMERIC | INP_REINIT:
 142         c->data[i].f = SYSMIS;
 143         break;
 144       case INP_STRING | INP_INIT_ONCE:
 145       case INP_STRING | INP_REINIT:
 146         memset (c->data[i].s, ' ', sizeof c->data[i].s);
 147         break;
 148       default:
 149         assert (0);
 150       }
 151 }
 152
 153 /* Clears case C.  Called between reading successive records. */
 154 static void
 155 clear_case (const struct input_program_pgm *inp, struct ccase *c)
 156 {
 157   size_t i;
 158
 159   for (i = 0; i < inp->init_cnt; i++)
 160     switch (inp->init[i])
 161       {
 162       case INP_NUMERIC | INP_INIT_ONCE:
 163         break;
 164       case INP_NUMERIC | INP_REINIT:
 165         c->data[i].f = SYSMIS;
 166         break;
 167       case INP_STRING | INP_INIT_ONCE:
 168         break;
 169       case INP_STRING | INP_REINIT:
 170         memset (c->data[i].s, ' ', sizeof c->data[i].s);
 171         break;
 172       default:
 173         assert (0);
 174       }
 175 }
 176
 177 /* Executes each transformation in turn on a `blank' case.  When a
 178    transformation fails, returning -2, then that's the end of the
 179    file.  -1 means go on to the next transformation.  Otherwise the
 180    return value is the index of the transformation to go to next. */
 181 static void
 182 input_program_source_read (struct case_source *source,
 183                            struct ccase *c,
 184                            write_case_func *write_case,
 185                            write_case_data wc_data)
 186 {
 187   struct input_program_pgm *inp = source->aux;
 188   int i;
 189
 190   /* Nonzero if there were any END CASE commands in the set of
 191      transformations.  If so, we don't automatically write out
 192      cases. */
 193   int end_case = 0;
 194
 195   /* FIXME?  This is the number of cases sent out of the input
 196      program, not the number of cases written to the procedure.
 197      The difference should only show up in $CASENUM in COMPUTE.
 198      We should check behavior against SPSS. */
 199   int cases_written = 0;
 200
 201   assert (inp != NULL);
 202
 203   /* Figure end_case. */
 204   for (i = 0; i < f_trns; i++)
 205     if (t_trns[i]->proc == end_case_trns_proc)
 206       end_case = 1;
 207
 208   /* FIXME: This is an ugly kluge. */
 209   for (i = 0; i < f_trns; i++)
 210     if (t_trns[i]->proc == repeating_data_trns_proc)
 211       repeating_data_set_write_case (t_trns[i], write_case, wc_data);
 212
 213   init_case (inp, c);
 214   for (;;)
 215     {
 216       /* Perform transformations on `blank' case. */
 217       for (i = 0; i < f_trns; )
 218         {
 219           int code;     /* Return value of last-called transformation. */
 220
 221           if (t_trns[i]->proc == end_case_trns_proc)
 222             {
 223               cases_written++;
 224               if (!write_case (wc_data))
 225                 goto done;
 226               clear_case (inp, c);
 227               i++;
 228               continue;
 229             }
 230
 231           code = t_trns[i]->proc (t_trns[i], c, cases_written + 1);
 232           switch (code)
 233             {
 234             case -1:
 235               i++;
 236               break;
 237             case -2:
 238               goto done;
 239             case -3:
 240               goto next_case;
 241             default:
 242               i = code;
 243               break;
 244             }
 245         }
 246
 247       /* Write the case if appropriate. */
 248       if (!end_case)
 249         {
 250           cases_written++;
 251           if (!write_case (wc_data))
 252             break;
 253         }
 254
 255       /* Blank out the case for the next iteration. */
 256     next_case:
 257       clear_case (inp, c);
 258     }
 259  done: ;
 260 }
 261
 262 /* Destroys an INPUT PROGRAM source. */
 263 static void
 264 input_program_source_destroy (struct case_source *source)
 265 {
 266   struct input_program_pgm *inp = source->aux;
 267
 268   cancel_transformations ();
 269
 270   if (inp != NULL)
 271     {
 272       free (inp->init);
 273       free (inp);
 274     }
 275 }
 276
 277 const struct case_source_class input_program_source_class =
 278   {
 279     "INPUT PROGRAM",
 280     NULL,
 281     input_program_source_read,
 282     input_program_source_destroy,
 283   };
 284 \f
 285 int
 286 cmd_end_case (void)
 287 {
 288   struct trns_header *t;
 289
 290   lex_match_id ("END");
 291   lex_match_id ("CASE");
 292
 293   if (!case_source_is_class (vfm_source, &input_program_source_class))
 294     {
 295       msg (SE, _("This command may only be executed between INPUT PROGRAM "
 296                  "and END INPUT PROGRAM."));
 297       return CMD_FAILURE;
 298     }
 299
 300   t = xmalloc (sizeof *t);
 301   t->proc = end_case_trns_proc;
 302   t->free = NULL;
 303   add_transformation ((struct trns_header *) t);
 304
 305   return lex_end_of_command ();
 306 }
 307
 308 /* Should never be called, because this is handled in
 309    input_program_source_read(). */
 310 int
 311 end_case_trns_proc (struct trns_header *t UNUSED, struct ccase * c UNUSED,
 312                     int case_num UNUSED)
 313 {
 314   assert (0);
 315 }
 316
 317 /* REREAD transformation. */
 318 struct reread_trns
 319   {
 320     struct trns_header h;
 321
 322     struct file_handle *handle; /* File to move file pointer back on. */
 323     struct expression *column;  /* Column to reset file pointer to. */
 324   };
 325
 326 /* Parses REREAD command. */
 327 int
 328 cmd_reread (void)
 329 {
 330   /* File to be re-read. */
 331   struct file_handle *h;
 332
 333   /* Expression for column to set file pointer to. */
 334   struct expression *e;
 335
 336   /* Created transformation. */
 337   struct reread_trns *t;
 338
 339   lex_match_id ("REREAD");
 340
 341   h = default_handle;
 342   e = NULL;
 343   while (token != '.')
 344     {
 345       if (lex_match_id ("COLUMN"))
 346         {
 347           lex_match ('=');
 348
 349           if (e)
 350             {
 351               msg (SE, _("COLUMN subcommand multiply specified."));
 352               expr_free (e);
 353               return CMD_FAILURE;
 354             }
 355
 356           e = expr_parse (PXP_NUMERIC);
 357           if (!e)
 358             return CMD_FAILURE;
 359         }
 360       else if (lex_match_id ("FILE"))
 361         {
 362           lex_match ('=');
 363           if (token != T_ID)
 364             {
 365               lex_error (_("expecting file handle name"));
 366               expr_free (e);
 367               return CMD_FAILURE;
 368             }
 369           h = fh_get_handle_by_name (tokid);
 370           if (!h)
 371             {
 372               expr_free (e);
 373               return CMD_FAILURE;
 374             }
 375           lex_get ();
 376         }
 377       else
 378         {
 379           lex_error (NULL);
 380           expr_free (e);
 381         }
 382     }
 383
 384   t = xmalloc (sizeof *t);
 385   t->h.proc = reread_trns_proc;
 386   t->h.free = reread_trns_free;
 387   t->handle = h;
 388   t->column = e;
 389   add_transformation ((struct trns_header *) t);
 390
 391   return CMD_SUCCESS;
 392 }
 393
 394 /* Executes a REREAD transformation. */
 395 static int
 396 reread_trns_proc (struct trns_header * pt, struct ccase * c,
 397                   int case_num)
 398 {
 399   struct reread_trns *t = (struct reread_trns *) pt;
 400
 401   if (t->column == NULL)
 402     dfm_bkwd_record (t->handle, 1);
 403   else
 404     {
 405       union value column;
 406
 407       expr_evaluate (t->column, c, case_num, &column);
 408       if (!finite (column.f) || column.f < 1)
 409         {
 410           msg (SE, _("REREAD: Column numbers must be positive finite "
 411                "numbers.  Column set to 1."));
 412           dfm_bkwd_record (t->handle, 1);
 413         }
 414       else
 415         dfm_bkwd_record (t->handle, column.f);
 416     }
 417   return -1;
 418 }
 419
 420 /* Frees a REREAD transformation. */
 421 static void
 422 reread_trns_free (struct trns_header * t)
 423 {
 424   expr_free (((struct reread_trns *) t)->column);
 425 }
 426
 427 /* Parses END FILE command. */
 428 int
 429 cmd_end_file (void)
 430 {
 431   struct trns_header *t;
 432
 433   lex_match_id ("END");
 434   lex_match_id ("FILE");
 435
 436   if (!case_source_is_class (vfm_source, &input_program_source_class))
 437     {
 438       msg (SE, _("This command may only be executed between INPUT PROGRAM "
 439                  "and END INPUT PROGRAM."));
 440       return CMD_FAILURE;
 441     }
 442
 443   t = xmalloc (sizeof *t);
 444   t->proc = end_file_trns_proc;
 445   t->free = NULL;
 446   add_transformation ((struct trns_header *) t);
 447
 448   return lex_end_of_command ();
 449 }
 450
 451 /* Executes an END FILE transformation. */
 452 static int
 453 end_file_trns_proc (struct trns_header * t UNUSED, struct ccase * c UNUSED,
 454                     int case_num UNUSED)
 455 {
 456   return -2;
 457 }