3ed20e195dc1870f142b3345d99db247253601c7
[pspp] / 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 "error.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   discard_variables ();
63
64   /* FIXME: we shouldn't do this here, but I'm afraid that other
65      code will check the class of vfm_source. */
66   vfm_source = create_case_source (&input_program_source_class,
67                                    default_dict, NULL);
68
69   return lex_end_of_command ();
70 }
71
72 int
73 cmd_end_input_program (void)
74 {
75   struct input_program_pgm *inp;
76   size_t i;
77
78   if (!case_source_is_class (vfm_source, &input_program_source_class))
79     {
80       msg (SE, _("No matching INPUT PROGRAM command."));
81       return CMD_FAILURE;
82     }
83   
84   if (dict_get_next_value_idx (default_dict) == 0)
85     msg (SW, _("No data-input or transformation commands specified "
86          "between INPUT PROGRAM and END INPUT PROGRAM."));
87
88   /* Mark the boundary between INPUT PROGRAM transformations and
89      ordinary transformations. */
90   f_trns = n_trns;
91
92   /* Figure out how to initialize each input case. */
93   inp = xmalloc (sizeof *inp);
94   inp->init_cnt = dict_get_next_value_idx (default_dict);
95   inp->init = xmalloc (inp->init_cnt * sizeof *inp->init);
96   for (i = 0; i < inp->init_cnt; i++)
97     inp->init[i] = -1;
98   for (i = 0; i < dict_get_var_cnt (default_dict); i++)
99     {
100       struct variable *var = dict_get_var (default_dict, i);
101       enum value_init_type value_init;
102       size_t j;
103       
104       value_init = var->type == NUMERIC ? INP_NUMERIC : INP_STRING;
105       value_init |= var->reinit ? INP_REINIT : INP_INIT_ONCE;
106
107       for (j = 0; j < var->nv; j++)
108         inp->init[j + var->fv] = value_init;
109     }
110   for (i = 0; i < inp->init_cnt; i++)
111     assert (inp->init[i] != -1);
112   inp->case_size = dict_get_case_size (default_dict);
113
114   /* Put inp into vfm_source for later use. */
115   vfm_source->aux = inp;
116
117   /* FIXME: we should use create_case_source() here. */
118   vfm_source->value_cnt = dict_get_next_value_idx (default_dict);
119
120   return lex_end_of_command ();
121 }
122
123 /* Initializes case C.  Called before the first case is read. */
124 static void
125 init_case (const struct input_program_pgm *inp, struct ccase *c)
126 {
127   size_t i;
128
129   for (i = 0; i < inp->init_cnt; i++)
130     switch (inp->init[i]) 
131       {
132       case INP_NUMERIC | INP_INIT_ONCE:
133         c->data[i].f = 0.0;
134         break;
135       case INP_NUMERIC | INP_REINIT:
136         c->data[i].f = SYSMIS;
137         break;
138       case INP_STRING | INP_INIT_ONCE:
139       case INP_STRING | INP_REINIT:
140         memset (c->data[i].s, ' ', sizeof c->data[i].s);
141         break;
142       default:
143         assert (0);
144       }
145 }
146
147 /* Clears case C.  Called between reading successive records. */
148 static void
149 clear_case (const struct input_program_pgm *inp, struct ccase *c)
150 {
151   size_t i;
152
153   for (i = 0; i < inp->init_cnt; i++)
154     switch (inp->init[i]) 
155       {
156       case INP_NUMERIC | INP_INIT_ONCE:
157         break;
158       case INP_NUMERIC | INP_REINIT:
159         c->data[i].f = SYSMIS;
160         break;
161       case INP_STRING | INP_INIT_ONCE:
162         break;
163       case INP_STRING | INP_REINIT:
164         memset (c->data[i].s, ' ', sizeof c->data[i].s);
165         break;
166       default:
167         assert (0);
168       }
169 }
170
171 /* Executes each transformation in turn on a `blank' case.  When a
172    transformation fails, returning -2, then that's the end of the
173    file.  -1 means go on to the next transformation.  Otherwise the
174    return value is the index of the transformation to go to next. */
175 static void
176 input_program_source_read (struct case_source *source,
177                            struct ccase *c,
178                            write_case_func *write_case,
179                            write_case_data wc_data)
180 {
181   struct input_program_pgm *inp = source->aux;
182   int i;
183
184   /* Nonzero if there were any END CASE commands in the set of
185      transformations.  If so, we don't automatically write out
186      cases. */
187   int end_case = 0;
188
189   /* FIXME?  This is the number of cases sent out of the input
190      program, not the number of cases written to the procedure.
191      The difference should only show up in $CASENUM in COMPUTE.
192      We should check behavior against SPSS. */
193   int cases_written = 0;
194
195   assert (inp != NULL);
196
197   /* Figure end_case. */
198   for (i = 0; i < f_trns; i++)
199     if (t_trns[i]->proc == end_case_trns_proc)
200       end_case = 1;
201
202   /* FIXME: This is an ugly kluge. */
203   for (i = 0; i < f_trns; i++)
204     if (t_trns[i]->proc == repeating_data_trns_proc)
205       repeating_data_set_write_case (t_trns[i], write_case, wc_data);
206
207   init_case (inp, c);
208   for (;;)
209     {
210       /* Perform transformations on `blank' case. */
211       for (i = 0; i < f_trns; )
212         {
213           int code;     /* Return value of last-called transformation. */
214
215           if (t_trns[i]->proc == end_case_trns_proc) 
216             {
217               cases_written++;
218               if (!write_case (wc_data))
219                 goto done;
220               clear_case (inp, c);
221               i++;
222               continue;
223             }
224
225           code = t_trns[i]->proc (t_trns[i], c, cases_written + 1);
226           switch (code)
227             {
228             case -1:
229               i++;
230               break;
231             case -2:
232               goto done;
233             case -3:
234               goto next_case;
235             default:
236               i = code;
237               break;
238             }
239         }
240
241       /* Write the case if appropriate. */
242       if (!end_case) 
243         {
244           cases_written++;
245           if (!write_case (wc_data))
246             break;
247         }
248
249       /* Blank out the case for the next iteration. */
250     next_case:
251       clear_case (inp, c);
252     }
253  done: ;
254 }
255
256 /* Destroys an INPUT PROGRAM source. */
257 static void
258 input_program_source_destroy (struct case_source *source)
259 {
260   struct input_program_pgm *inp = source->aux;
261
262   cancel_transformations ();
263
264   if (inp != NULL) 
265     {
266       free (inp->init);
267       free (inp);
268     }
269 }
270
271 const struct case_source_class input_program_source_class =
272   {
273     "INPUT PROGRAM",
274     NULL,
275     input_program_source_read,
276     input_program_source_destroy,
277   };
278 \f
279 int
280 cmd_end_case (void)
281 {
282   struct trns_header *t;
283
284   if (!case_source_is_class (vfm_source, &input_program_source_class))
285     {
286       msg (SE, _("This command may only be executed between INPUT PROGRAM "
287                  "and END INPUT PROGRAM."));
288       return CMD_FAILURE;
289     }
290
291   t = xmalloc (sizeof *t);
292   t->proc = end_case_trns_proc;
293   t->free = NULL;
294   add_transformation ((struct trns_header *) t);
295
296   return lex_end_of_command ();
297 }
298
299 /* Should never be called, because this is handled in
300    input_program_source_read(). */
301 int
302 end_case_trns_proc (struct trns_header *t UNUSED, struct ccase * c UNUSED,
303                     int case_num UNUSED)
304 {
305   assert (0);
306 }
307
308 /* REREAD transformation. */
309 struct reread_trns
310   {
311     struct trns_header h;
312
313     struct file_handle *handle; /* File to move file pointer back on. */
314     struct expression *column;  /* Column to reset file pointer to. */
315   };
316
317 /* Parses REREAD command. */
318 int
319 cmd_reread (void)
320 {
321   /* File to be re-read. */
322   struct file_handle *h;
323   
324   /* Expression for column to set file pointer to. */
325   struct expression *e;
326
327   /* Created transformation. */
328   struct reread_trns *t;
329
330   h = default_handle;
331   e = NULL;
332   while (token != '.')
333     {
334       if (lex_match_id ("COLUMN"))
335         {
336           lex_match ('=');
337           
338           if (e)
339             {
340               msg (SE, _("COLUMN subcommand multiply specified."));
341               expr_free (e);
342               return CMD_FAILURE;
343             }
344           
345           e = expr_parse (PXP_NUMERIC);
346           if (!e)
347             return CMD_FAILURE;
348         }
349       else if (lex_match_id ("FILE"))
350         {
351           lex_match ('=');
352           h = fh_parse_file_handle ();
353           if (h == NULL)
354             {
355               expr_free (e);
356               return CMD_FAILURE;
357             }
358           lex_get ();
359         }
360       else
361         {
362           lex_error (NULL);
363           expr_free (e);
364         }
365     }
366
367   t = xmalloc (sizeof *t);
368   t->h.proc = reread_trns_proc;
369   t->h.free = reread_trns_free;
370   t->handle = h;
371   t->column = e;
372   add_transformation ((struct trns_header *) t);
373
374   return CMD_SUCCESS;
375 }
376
377 /* Executes a REREAD transformation. */
378 static int
379 reread_trns_proc (struct trns_header * pt, struct ccase * c,
380                   int case_num)
381 {
382   struct reread_trns *t = (struct reread_trns *) pt;
383
384   if (t->column == NULL)
385     dfm_bkwd_record (t->handle, 1);
386   else
387     {
388       union value column;
389
390       expr_evaluate (t->column, c, case_num, &column);
391       if (!finite (column.f) || column.f < 1)
392         {
393           msg (SE, _("REREAD: Column numbers must be positive finite "
394                "numbers.  Column set to 1."));
395           dfm_bkwd_record (t->handle, 1);
396         }
397       else
398         dfm_bkwd_record (t->handle, column.f);
399     }
400   return -1;
401 }
402
403 /* Frees a REREAD transformation. */
404 static void
405 reread_trns_free (struct trns_header * t)
406 {
407   expr_free (((struct reread_trns *) t)->column);
408 }
409
410 /* Parses END FILE command. */
411 int
412 cmd_end_file (void)
413 {
414   struct trns_header *t;
415
416   if (!case_source_is_class (vfm_source, &input_program_source_class))
417     {
418       msg (SE, _("This command may only be executed between INPUT PROGRAM "
419                  "and END INPUT PROGRAM."));
420       return CMD_FAILURE;
421     }
422
423   t = xmalloc (sizeof *t);
424   t->proc = end_file_trns_proc;
425   t->free = NULL;
426   add_transformation ((struct trns_header *) t);
427
428   return lex_end_of_command ();
429 }
430
431 /* Executes an END FILE transformation. */
432 static int
433 end_file_trns_proc (struct trns_header * t UNUSED, struct ccase * c UNUSED,
434                     int case_num UNUSED)
435 {
436   return -2;
437 }