Continue reforming procedure execution. In this phase, get rid of
[pspp-builds.git] / src / language / data-io / 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., 51 Franklin Street, Fifth Floor, Boston, MA
18    02110-1301, USA. */
19
20 #include <config.h>
21
22 #include <language/data-io/inpt-pgm.h>
23
24 #include <float.h>
25 #include <stdlib.h>
26
27 #include <data/case-source.h>
28 #include <data/case.h>
29 #include <data/case-source.h>
30 #include <data/dictionary.h>
31 #include <data/transformations.h>
32 #include <data/variable.h>
33 #include <language/command.h>
34 #include <language/data-io/data-reader.h>
35 #include <language/data-io/file-handle.h>
36 #include <language/expressions/public.h>
37 #include <language/lexer/lexer.h>
38 #include <libpspp/alloc.h>
39 #include <libpspp/compiler.h>
40 #include <libpspp/message.h>
41 #include <libpspp/message.h>
42 #include <libpspp/misc.h>
43 #include <libpspp/str.h>
44 #include <procedure.h>
45
46 #include "gettext.h"
47 #define _(msgid) gettext (msgid)
48
49 /* Private result codes for use within INPUT PROGRAM. */
50 enum cmd_result_extensions 
51   {
52     CMD_END_INPUT_PROGRAM = CMD_PRIVATE_FIRST,
53     CMD_END_CASE
54   };
55
56 /* Indicates how a `union value' should be initialized. */
57 enum value_init_type
58   {
59     INP_NUMERIC = 01,           /* Numeric. */
60     INP_STRING = 0,             /* String. */
61     
62     INP_INIT_ONCE = 02,         /* Initialize only once. */
63     INP_REINIT = 0,             /* Reinitialize for each iteration. */
64   };
65
66 struct input_program_pgm 
67   {
68     struct trns_chain *trns_chain;
69
70     size_t case_nr;             /* Incremented by END CASE transformation. */
71     write_case_func *write_case;/* Called by END CASE. */
72     write_case_data wc_data;    /* Aux data used by END CASE. */
73
74     enum value_init_type *init; /* How to initialize each `union value'. */
75     size_t init_cnt;            /* Number of elements in inp_init. */
76     size_t case_size;           /* Size of case in bytes. */
77   };
78
79 static void destroy_input_program (struct input_program_pgm *);
80 static trns_proc_func end_case_trns_proc;
81 static trns_proc_func reread_trns_proc;
82 static trns_proc_func end_file_trns_proc;
83 static trns_free_func reread_trns_free;
84
85 static const struct case_source_class input_program_source_class;
86
87 static bool inside_input_program;
88
89 /* Returns true if we're parsing the inside of a INPUT
90    PROGRAM...END INPUT PROGRAM construct, false otherwise. */
91 bool
92 in_input_program (void) 
93 {
94   return inside_input_program;
95 }
96
97 /* Emits an END CASE transformation for INP. */
98 static void
99 emit_END_CASE (struct input_program_pgm *inp) 
100 {
101   add_transformation (end_case_trns_proc, NULL, inp);
102 }
103
104 int
105 cmd_input_program (void)
106 {
107   struct input_program_pgm *inp;
108   size_t i;
109   bool saw_END_CASE = false;
110
111   discard_variables ();
112   if (token != '.')
113     return lex_end_of_command ();
114
115   inp = xmalloc (sizeof *inp);
116   inp->trns_chain = NULL;
117   inp->init = NULL;
118   
119   inside_input_program = true;
120   for (;;) 
121     {
122       enum cmd_result result;
123       lex_get ();
124       result = cmd_parse (CMD_STATE_INPUT_PROGRAM);
125       if (result == CMD_END_INPUT_PROGRAM)
126         break;
127       else if (result == CMD_END_CASE) 
128         {
129           emit_END_CASE (inp);
130           saw_END_CASE = true; 
131         }
132       else if (cmd_result_is_failure (result) && result != CMD_FAILURE)
133         {
134           if (result == CMD_EOF)
135             msg (SE, _("Unexpected end-of-file within INPUT PROGRAM."));
136           inside_input_program = false;
137           discard_variables ();
138           destroy_input_program (inp);
139           return result;
140         }
141     }
142   if (!saw_END_CASE)
143     emit_END_CASE (inp);
144   inside_input_program = false;
145
146   if (dict_get_next_value_idx (default_dict) == 0) 
147     {
148       msg (SE, _("Input program did not create any variables."));
149       discard_variables ();
150       destroy_input_program (inp);
151       return CMD_FAILURE;
152     }
153   
154   inp->trns_chain = proc_capture_transformations ();
155   trns_chain_finalize (inp->trns_chain);
156
157   /* Figure out how to initialize each input case. */
158   inp->init_cnt = dict_get_next_value_idx (default_dict);
159   inp->init = xnmalloc (inp->init_cnt, sizeof *inp->init);
160   for (i = 0; i < inp->init_cnt; i++)
161     inp->init[i] = -1;
162   for (i = 0; i < dict_get_var_cnt (default_dict); i++)
163     {
164       struct variable *var = dict_get_var (default_dict, i);
165       enum value_init_type value_init;
166       size_t j;
167       
168       value_init = var->type == NUMERIC ? INP_NUMERIC : INP_STRING;
169       value_init |= var->leave ? INP_INIT_ONCE : INP_REINIT;
170
171       for (j = 0; j < var->nv; j++)
172         inp->init[j + var->fv] = value_init;
173     }
174   for (i = 0; i < inp->init_cnt; i++)
175     assert (inp->init[i] != -1);
176   inp->case_size = dict_get_case_size (default_dict);
177
178   proc_set_source (create_case_source (&input_program_source_class, inp));
179
180   return CMD_SUCCESS;
181 }
182
183 int
184 cmd_end_input_program (void)
185 {
186   assert (in_input_program ());
187   return CMD_END_INPUT_PROGRAM; 
188 }
189
190 /* Initializes case C.  Called before the first case is read. */
191 static void
192 init_case (const struct input_program_pgm *inp, struct ccase *c)
193 {
194   size_t i;
195
196   for (i = 0; i < inp->init_cnt; i++)
197     switch (inp->init[i]) 
198       {
199       case INP_NUMERIC | INP_INIT_ONCE:
200         case_data_rw (c, i)->f = 0.0;
201         break;
202       case INP_NUMERIC | INP_REINIT:
203         case_data_rw (c, i)->f = SYSMIS;
204         break;
205       case INP_STRING | INP_INIT_ONCE:
206       case INP_STRING | INP_REINIT:
207         memset (case_data_rw (c, i)->s, ' ', sizeof case_data_rw (c, i)->s);
208         break;
209       default:
210         assert (0);
211       }
212 }
213
214 /* Clears case C.  Called between reading successive records. */
215 static void
216 clear_case (const struct input_program_pgm *inp, struct ccase *c)
217 {
218   size_t i;
219
220   for (i = 0; i < inp->init_cnt; i++)
221     switch (inp->init[i]) 
222       {
223       case INP_NUMERIC | INP_INIT_ONCE:
224         break;
225       case INP_NUMERIC | INP_REINIT:
226         case_data_rw (c, i)->f = SYSMIS;
227         break;
228       case INP_STRING | INP_INIT_ONCE:
229         break;
230       case INP_STRING | INP_REINIT:
231         memset (case_data_rw (c, i)->s, ' ', sizeof case_data_rw (c, i)->s);
232         break;
233       default:
234         assert (0);
235       }
236 }
237
238 /* Executes each transformation in turn on a `blank' case.
239    Returns true if successful, false if an I/O error occurred. */
240 static bool
241 input_program_source_read (struct case_source *source,
242                            struct ccase *c,
243                            write_case_func *write_case,
244                            write_case_data wc_data)
245 {
246   struct input_program_pgm *inp = source->aux;
247
248   inp->case_nr = 1;
249   inp->write_case = write_case;
250   inp->wc_data = wc_data;
251   for (init_case (inp, c); ; clear_case (inp, c))
252     {
253       enum trns_result result = trns_chain_execute (inp->trns_chain, c,
254                                                     &inp->case_nr);
255       if (result == TRNS_ERROR)
256         return false;
257       else if (result == TRNS_END_FILE)
258         return true;
259     }
260 }
261
262 static void
263 destroy_input_program (struct input_program_pgm *pgm) 
264 {
265   if (pgm != NULL) 
266     {
267       trns_chain_destroy (pgm->trns_chain);
268       free (pgm->init);
269       free (pgm);
270     }
271 }
272
273 /* Destroys an INPUT PROGRAM source. */
274 static void
275 input_program_source_destroy (struct case_source *source)
276 {
277   struct input_program_pgm *inp = source->aux;
278
279   destroy_input_program (inp);
280 }
281
282 static const struct case_source_class input_program_source_class =
283   {
284     "INPUT PROGRAM",
285     NULL,
286     input_program_source_read,
287     input_program_source_destroy,
288   };
289 \f
290 int
291 cmd_end_case (void)
292 {
293   assert (in_input_program ());
294   if (token == '.')
295     return CMD_END_CASE;
296   return lex_end_of_command ();
297 }
298
299 /* Sends the current case as the source's output. */
300 int
301 end_case_trns_proc (void *inp_, struct ccase *c, int case_nr UNUSED)
302 {
303   struct input_program_pgm *inp = inp_;
304
305   if (!inp->write_case (inp->wc_data))
306     return TRNS_ERROR;
307
308   inp->case_nr++;
309   clear_case (inp, c);
310   return TRNS_CONTINUE;
311 }
312
313 /* REREAD transformation. */
314 struct reread_trns
315   {
316     struct dfm_reader *reader;  /* File to move file pointer back on. */
317     struct expression *column;  /* Column to reset file pointer to. */
318   };
319
320 /* Parses REREAD command. */
321 int
322 cmd_reread (void)
323 {
324   struct file_handle *fh;       /* File to be re-read. */
325   struct expression *e;         /* Expression for column to set. */
326   struct reread_trns *t;        /* Created transformation. */
327
328   fh = fh_get_default_handle ();
329   e = NULL;
330   while (token != '.')
331     {
332       if (lex_match_id ("COLUMN"))
333         {
334           lex_match ('=');
335           
336           if (e)
337             {
338               msg (SE, _("COLUMN subcommand multiply specified."));
339               expr_free (e);
340               return CMD_CASCADING_FAILURE;
341             }
342           
343           e = expr_parse (default_dict, EXPR_NUMBER);
344           if (!e)
345             return CMD_CASCADING_FAILURE;
346         }
347       else if (lex_match_id ("FILE"))
348         {
349           lex_match ('=');
350           fh = fh_parse (FH_REF_FILE | FH_REF_INLINE);
351           if (fh == NULL)
352             {
353               expr_free (e);
354               return CMD_CASCADING_FAILURE;
355             }
356           lex_get ();
357         }
358       else
359         {
360           lex_error (NULL);
361           expr_free (e);
362         }
363     }
364
365   t = xmalloc (sizeof *t);
366   t->reader = dfm_open_reader (fh);
367   t->column = e;
368   add_transformation (reread_trns_proc, reread_trns_free, t);
369
370   return CMD_SUCCESS;
371 }
372
373 /* Executes a REREAD transformation. */
374 static int
375 reread_trns_proc (void *t_, struct ccase *c, int case_num)
376 {
377   struct reread_trns *t = t_;
378
379   if (t->column == NULL)
380     dfm_reread_record (t->reader, 1);
381   else
382     {
383       double column = expr_evaluate_num (t->column, c, case_num);
384       if (!finite (column) || column < 1)
385         {
386           msg (SE, _("REREAD: Column numbers must be positive finite "
387                "numbers.  Column set to 1."));
388           dfm_reread_record (t->reader, 1);
389         }
390       else
391         dfm_reread_record (t->reader, column);
392     }
393   return TRNS_CONTINUE;
394 }
395
396 /* Frees a REREAD transformation.
397    Returns true if successful, false if an I/O error occurred. */
398 static bool
399 reread_trns_free (void *t_)
400 {
401   struct reread_trns *t = t_;
402   expr_free (t->column);
403   dfm_close_reader (t->reader);
404   return true;
405 }
406
407 /* Parses END FILE command. */
408 int
409 cmd_end_file (void)
410 {
411   assert (in_input_program ());
412
413   add_transformation (end_file_trns_proc, NULL, NULL);
414
415   return lex_end_of_command ();
416 }
417
418 /* Executes an END FILE transformation. */
419 static int
420 end_file_trns_proc (void *trns_ UNUSED, struct ccase *c UNUSED,
421                     int case_num UNUSED)
422 {
423   return TRNS_END_FILE;
424 }