b0c329367403da025ef14cbe82c82f7c2f232020
[pspp-builds.git] / src / language / data-io / placement-parser.c
1 /* PSPP - computes sample statistics.
2    Copyright (C) 2006 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/placement-parser.h>
23
24 #include <assert.h>
25
26 #include <language/lexer/format-parser.h>
27 #include <language/lexer/lexer.h>
28 #include <libpspp/message.h>
29 #include <libpspp/pool.h>
30 #include <libpspp/str.h>
31
32 #include "xalloc.h"
33 #include "xsize.h"
34
35 #include "gettext.h"
36 #define _(msgid) gettext (msgid)
37
38 /* Extensions to the format specifiers used only for
39    placement. */
40 enum 
41   {
42     PRS_TYPE_T = -1,            /* Tab to absolute column. */
43     PRS_TYPE_X = -2,            /* Skip columns. */
44     PRS_TYPE_NEW_REC = -3       /* Next record. */
45   };
46
47 static bool fixed_parse_columns (struct pool *, size_t var_cnt,
48                                  struct fmt_spec **, size_t *);
49 static bool fixed_parse_fortran (struct pool *,
50                                  struct fmt_spec **, size_t *);
51
52 /* Parses Fortran-like or column-based specifications for placing
53    variable data in fixed positions in columns and rows, that is,
54    formats like those parsed by DATA LIST or PRINT.  Returns true
55    only if successful.
56
57    If successful, formats for VAR_CNT variables are stored in
58    *FORMATS, and the number of formats required is stored in
59    *FORMAT_CNT.  *FORMAT_CNT may be greater than VAR_CNT because
60    of T, X, and / "formats", but success guarantees that exactly
61    VAR_CNT variables will be placed by the output formats.  The
62    caller should call execute_placement_format to process those
63    "formats" in interpreting the output.
64
65    Uses POOL for allocation.  When the caller is finished
66    interpreting *FORMATS, POOL may be destroyed. */
67 bool
68 parse_var_placements (struct pool *pool, size_t var_cnt,
69                       struct fmt_spec **formats, size_t *format_cnt) 
70 {
71   assert (var_cnt > 0);
72   if (lex_is_number ())
73     return fixed_parse_columns (pool, var_cnt, formats, format_cnt);
74   else if (lex_match ('(')) 
75     {
76       size_t assignment_cnt;
77       size_t i;
78
79       if (!fixed_parse_fortran (pool, formats, format_cnt))
80         return false; 
81
82       assignment_cnt = 0;
83       for (i = 0; i < *format_cnt; i++)
84         assignment_cnt += (*formats)[i].type >= 0;
85
86       if (assignment_cnt != var_cnt)
87         {
88           msg (SE, _("Number of variables specified (%d) "
89                      "differs from number of variable formats (%d)."),
90                (int) var_cnt, (int) assignment_cnt);
91           return false;
92         }
93
94       return true;
95     }
96   else
97     {
98       msg (SE, _("SPSS-like or Fortran-like format "
99                  "specification expected after variable names."));
100       return false;
101     }
102 }
103
104 /* Implements parse_var_placements for column-based formats. */
105 static bool
106 fixed_parse_columns (struct pool *pool, size_t var_cnt,
107                      struct fmt_spec **formats, size_t *format_cnt)
108 {
109   struct fmt_spec format;
110   int fc, lc;
111   size_t i;
112
113   if (!parse_column_range (&fc, &lc, NULL))
114     return false;
115
116   /* Divide columns evenly. */    
117   format.w = (lc - fc + 1) / var_cnt;
118   if ((lc - fc + 1) % var_cnt)
119     {
120       msg (SE, _("The %d columns %d-%d "
121                  "can't be evenly divided into %d fields."),
122            lc - fc + 1, fc, lc, var_cnt);
123       return false;
124     }
125
126   /* Format specifier. */
127   if (lex_match ('('))
128     {
129       /* Get format type. */
130       if (token == T_ID)
131         {
132           if (!parse_format_specifier_name (&format.type))
133             return false;
134           lex_match (',');
135         }
136       else
137         format.type = FMT_F;
138
139       /* Get decimal places. */
140       if (lex_is_integer ())
141         {
142           format.d = lex_integer ();
143           lex_get ();
144         }
145       else
146         format.d = 0;
147
148       if (!lex_force_match (')'))
149         return false;
150     }
151   else
152     {
153       format.type = FMT_F;
154       format.d = 0;
155     }
156   if (!check_input_specifier (&format, 1))
157     return false;
158
159   *formats = pool_nalloc (pool, var_cnt + 1, sizeof **formats);
160   *format_cnt = var_cnt + 1;
161   (*formats)[0].type = PRS_TYPE_T;
162   (*formats)[0].w = fc;
163   for (i = 1; i <= var_cnt; i++)
164     (*formats)[i] = format;
165   return true;
166 }
167
168 /* Implements parse_var_placements for Fortran-like formats. */
169 static bool
170 fixed_parse_fortran (struct pool *pool,
171                      struct fmt_spec **formats, size_t *format_cnt)
172 {
173   size_t formats_allocated = 0;
174   size_t formats_used = 0;
175
176   *formats = NULL;
177   while (!lex_match (')'))
178     {
179       struct fmt_spec f;
180       struct fmt_spec *new_formats;
181       size_t new_format_cnt;
182       size_t count;
183       size_t formats_needed;
184       
185       /* Parse count. */
186       if (lex_is_integer ())
187         {
188           count = lex_integer ();
189           lex_get ();
190         }
191       else
192         count = 1;
193
194       /* Parse format specifier. */
195       if (lex_match ('('))
196         {
197           /* Call ourselves recursively to handle parentheses. */
198           if (!fixed_parse_fortran (pool, &new_formats, &new_format_cnt))
199             return false;
200         }
201       else
202         {
203           new_formats = &f;
204           new_format_cnt = 1;
205           if (lex_match ('/'))
206             f.type = PRS_TYPE_NEW_REC;
207           else
208             {
209               char type[FMT_TYPE_LEN_MAX + 1];
210               
211               if (!parse_abstract_format_specifier (type, &f.w, &f.d))
212                 return false;
213
214               if (!strcasecmp (type, "T")) 
215                 f.type = PRS_TYPE_T;
216               else if (!strcasecmp (type, "X")) 
217                 {
218                   f.type = PRS_TYPE_X;
219                   f.w = count;
220                   count = 1;
221                 }
222               else 
223                 {
224                   if (!fmt_type_from_string (type, &f.type)) 
225                     {
226                       msg (SE, _("Unknown format type \"%s\"."), type);
227                       return false;
228                     }
229                   if (!check_input_specifier (&f, 1))
230                     return false;
231                 }
232             } 
233         }
234
235       /* Add COUNT copies of the NEW_FORMAT_CNT formats in
236          NEW_FORMATS to FORMATS. */
237       if (new_format_cnt != 0
238           && size_overflow_p (xtimes (xsum (formats_used,
239                                             xtimes (count, new_format_cnt)),
240                                       sizeof *formats)))
241         xalloc_die ();
242       formats_needed = count * new_format_cnt;
243       if (formats_used + formats_needed > formats_allocated) 
244         {
245           formats_allocated = formats_used + formats_needed;
246           *formats = pool_2nrealloc (pool, *formats, &formats_allocated,
247                                      sizeof **formats);
248         }
249       for (; count > 0; count--) 
250         {
251           memcpy (&(*formats)[formats_used], new_formats,
252                   sizeof **formats * new_format_cnt);
253           formats_used += new_format_cnt;
254         }
255
256       lex_match (',');
257     }
258
259   *format_cnt = formats_used;
260   return true;
261 }
262
263 /* Checks whether FORMAT represents one of the special "formats"
264    for T, X, or /.  If so, updates *RECORD or *COLUMN (or both)
265    as appropriate, and returns true.  Otherwise, returns false
266    without any side effects. */
267 bool
268 execute_placement_format (const struct fmt_spec *format,
269                           int *record, int *column) 
270 {
271   switch (format->type) 
272     {
273     case PRS_TYPE_X:
274       *column += format->w;
275       return true;
276       
277     case PRS_TYPE_T:
278       *column = format->w;
279       return true;
280       
281     case PRS_TYPE_NEW_REC:
282       (*record)++;
283       *column = 1;
284       return true;
285
286     default:
287       assert (format->type >= 0 && format->type < FMT_NUMBER_OF_FORMATS);
288       return false;
289     }
290 }
291
292 /* Parse a column or a range of columns, specified as a single
293    integer or two integer delimited by a dash.  Stores the range
294    in *FIRST_COLUMN and *LAST_COLUMN.  (If only a single integer
295    is given, it is stored in both.)  If RANGE_SPECIFIED is
296    non-null, then *RANGE_SPECIFIED is set to true if the syntax
297    contained a dash, false otherwise.  Returns true if
298    successful, false if the syntax was invalid or the values
299    specified did not make sense. */
300 bool
301 parse_column_range (int *first_column, int *last_column,
302                     bool *range_specified) 
303 {
304   /* First column. */
305   if (!lex_force_int ())
306     return false;
307   *first_column = lex_integer ();
308   if (*first_column < 1)
309     {
310       msg (SE, _("Column positions for fields must be positive."));
311       return false;
312     }
313   lex_get ();
314
315   /* Last column. */
316   lex_negative_to_dash ();
317   if (lex_match ('-'))
318     {
319       if (!lex_force_int ())
320         return false;
321       *last_column = lex_integer ();
322       if (*last_column < 1)
323         {
324           msg (SE, _("Column positions for fields must be positive."));
325           return false;
326         }
327       else if (*last_column < *first_column)
328         {
329           msg (SE, _("The ending column for a field must be "
330                      "greater than the starting column."));
331           return false;
332         }
333
334       if (range_specified)
335         *range_specified = true;
336       lex_get ();
337     }
338   else 
339     {
340       *last_column = *first_column;
341       if (range_specified)
342         *range_specified = false;
343     }
344
345   return true;
346 }
347
348 /* Parses a (possibly empty) sequence of slashes, each of which
349    may be followed by an integer.  A slash on its own increases
350    *RECORD by 1 and sets *COLUMN to 1.  A slash followed by an
351    integer sets *RECORD to the integer, as long as that increases
352    *RECORD, and sets *COLUMN to 1.
353
354    Returns true if successful, false on syntax error. */
355 bool
356 parse_record_placement (int *record, int *column) 
357 {
358   while (lex_match ('/'))
359     {
360       if (lex_is_integer ())
361         {
362           if (lex_integer () <= *record)
363             {
364               msg (SE, _("The record number specified, %ld, is at or "
365                          "before the previous record, %d.  Data "
366                          "fields must be listed in order of "
367                          "increasing record number."),
368                    lex_integer (), *record);
369               return false;
370             }
371           *record = lex_integer ();
372           lex_get ();
373         }
374       else
375         (*record)++;
376       *column = 1;
377     }
378   assert (*record >= 1);
379   
380   return true;
381 }