4a5bf2f9dc1a983c8edd235b547082441a2b6012
[pspp-builds.git] / src / repeat.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 "repeat.h"
22 #include "error.h"
23 #include <ctype.h>
24 #include <math.h>
25 #include <stdlib.h>
26 #include "alloc.h"
27 #include "command.h"
28 #include "dictionary.h"
29 #include "error.h"
30 #include "getline.h"
31 #include "lexer.h"
32 #include "misc.h"
33 #include "settings.h"
34 #include "str.h"
35 #include "var.h"
36
37 #include "debug-print.h"
38
39 /* Describes one DO REPEAT macro. */
40 struct repeat_entry
41   {
42     int type;                   /* 1=variable names, 0=any other. */
43     char id[9];                 /* Macro identifier. */
44     char **replacement;         /* Macro replacement. */
45     struct repeat_entry *next;
46   };
47
48 /* List of macro identifiers. */
49 static struct repeat_entry *repeat_tab;
50
51 /* Number of substitutions for each macro. */
52 static int count;
53
54 /* List of lines before it's actually assigned to a file. */
55 static struct getl_line_list *line_buf_head;
56 static struct getl_line_list *line_buf_tail;
57
58 static int parse_ids (struct repeat_entry *);
59 static int parse_numbers (struct repeat_entry *);
60 static int parse_strings (struct repeat_entry *);
61 static void clean_up (void);
62 static int internal_cmd_do_repeat (void);
63
64 int
65 cmd_do_repeat (void)
66 {
67   if (internal_cmd_do_repeat ())
68     return CMD_SUCCESS;
69
70   clean_up ();
71   return CMD_FAILURE;
72 }
73
74 /* Garbage collects all the allocated memory that's no longer
75    needed. */
76 static void
77 clean_up (void)
78 {
79   struct repeat_entry *iter, *next;
80   int i;
81
82   iter = repeat_tab;
83   repeat_tab = NULL;
84
85   while (iter)
86     {
87       if (iter->replacement)
88         {
89           for (i = 0; i < count; i++)
90             free (iter->replacement[i]);
91           free (iter->replacement);
92         }
93       next = iter->next;
94       free (iter);
95       iter = next;
96     }
97 }
98
99 /* Allocates & appends another record at the end of the line_buf_tail
100    chain. */
101 static inline void
102 append_record (void)
103 {
104   struct getl_line_list *new = xmalloc (sizeof *new);
105   
106   if (line_buf_head == NULL)
107     line_buf_head = line_buf_tail = new;
108   else
109     line_buf_tail = line_buf_tail->next = new;
110 }
111
112 /* Returns nonzero if KEYWORD appears beginning at CONTEXT. */
113 static int
114 recognize_keyword (const char *context, const char *keyword)
115 {
116   const char *end = context;
117   while (isalpha ((unsigned char) *end))
118     end++;
119   return lex_id_match_len (keyword, strlen (keyword), context, end - context);
120 }
121
122 /* Does the real work of parsing the DO REPEAT command and its nested
123    commands. */
124 static int
125 internal_cmd_do_repeat (void)
126 {
127   /* Name of first DO REPEAT macro. */
128   char first_name[9];
129
130   /* Current filename. */
131   const char *current_filename = NULL;
132
133   /* 1=Print lines after preprocessing. */
134   int print;
135
136   /* The first step is parsing the DO REPEAT command itself. */
137   count = 0;
138   line_buf_head = NULL;
139   do
140     {
141       struct repeat_entry *e;
142       struct repeat_entry *iter;
143       int result;
144
145       /* Get a stand-in variable name and make sure it's unique. */
146       if (!lex_force_id ())
147         return 0;
148       for (iter = repeat_tab; iter; iter = iter->next)
149         if (!strcmp (iter->id, tokid))
150           {
151             msg (SE, _("Identifier %s is given twice."), tokid);
152             return 0;
153           }
154
155       /* Make a new stand-in variable entry and link it into the
156          list. */
157       e = xmalloc (sizeof *e);
158       e->type = 0;
159       e->next = repeat_tab;
160       strcpy (e->id, tokid);
161       repeat_tab = e;
162
163       /* Skip equals sign. */
164       lex_get ();
165       if (!lex_force_match ('='))
166         return 0;
167
168       /* Get the details of the variable's possible values. */
169       
170       if (token == T_ID)
171         result = parse_ids (e);
172       else if (lex_is_number ())
173         result = parse_numbers (e);
174       else if (token == T_STRING)
175         result = parse_strings (e);
176       else
177         {
178           lex_error (NULL);
179           return 0;
180         }
181       if (!result)
182         return 0;
183
184       /* If this is the first variable then it defines how many
185          replacements there must be; otherwise enforce this number of
186          replacements. */
187       if (!count)
188         {
189           count = result;
190           strcpy (first_name, e->id);
191         }
192       else if (count != result)
193         {
194           msg (SE, _("There must be the same number of substitutions "
195                      "for each dummy variable specified.  Since there "
196                      "were %d substitutions for %s, there must be %d "
197                      "for %s as well, but %d were specified."),
198                count, first_name, count, e->id, result);
199           return 0;
200         }
201
202       /* Next! */
203       lex_match ('/');
204     }
205   while (token != '.');
206
207   /* Read all the lines inside the DO REPEAT ... END REPEAT. */
208   {
209     int nest = 1;
210
211     for (;;)
212       {
213         if (!getl_read_line ())
214           msg (FE, _("Unexpected end of file."));
215
216         /* If the current file has changed then record the fact. */
217         {
218           const char *curfn;
219           int curln;
220
221           getl_location (&curfn, &curln);
222           if (current_filename != curfn)
223             {
224               assert (curln > 0 && curfn != NULL);
225             
226               append_record ();
227               line_buf_tail->len = -curln;
228               line_buf_tail->line = xstrdup (curfn);
229               current_filename = curfn;
230             }
231         }
232         
233         /* FIXME?  This code is not strictly correct, however if you
234            have begun a line with DO REPEAT or END REPEAT and it's
235            *not* a command name, then you are obviously *trying* to
236            break this mechanism.  And you will.  Also, the entire
237            command names must appear on a single line--they can't be
238            spread out. */
239         {
240           char *cp = ds_c_str (&getl_buf);
241
242           /* Skip leading indentors and any whitespace. */
243           if (*cp == '+' || *cp == '-' || *cp == '.')
244             cp++;
245           while (isspace ((unsigned char) *cp))
246             cp++;
247
248           /* Find END REPEAT. */
249           if (recognize_keyword (cp, "end"))
250             {
251               while (isalpha ((unsigned char) *cp))
252                 cp++;
253               while (isspace ((unsigned char) *cp))
254                 cp++;
255               if (recognize_keyword (cp, "repeat"))
256                 {
257                   nest--;
258
259                   if (!nest)
260                   {
261                     while (isalpha ((unsigned char) *cp))
262                       cp++;
263                     while (isspace ((unsigned char) *cp))
264                       cp++;
265
266                     print = recognize_keyword (cp, "print");
267                     break;
268                   }
269                 }
270             }
271           else /* Find DO REPEAT. */
272             if (!strncasecmp (cp, "do", 2))
273               {
274                 cp += 2;
275                 while (isspace ((unsigned char) *cp))
276                   cp++;
277                 if (!strncasecmp (cp, "rep", 3))
278                   nest++;
279               }
280         }
281
282         append_record ();
283         line_buf_tail->len = ds_length (&getl_buf);
284         line_buf_tail->line = xmalloc (ds_length (&getl_buf) + 1);
285         memcpy (line_buf_tail->line,
286                 ds_c_str (&getl_buf), ds_length (&getl_buf) + 1);
287       }
288   }
289
290   /* FIXME: For the moment we simply discard the contents of the END
291      REPEAT line.  We should actually check for the PRINT specifier.
292      This can be done easier when we buffer entire commands instead of
293      doing it token by token; see TODO. */
294   lex_discard_line ();  
295   
296   /* Tie up the loose end of the chain. */
297   if (line_buf_head == NULL)
298     {
299       msg (SW, _("No commands in scope."));
300       return 1;
301     }
302   line_buf_tail->next = NULL;
303
304   /* Make new variables. */
305   {
306     struct repeat_entry *iter;
307     for (iter = repeat_tab; iter; iter = iter->next)
308       if (iter->type == 1)
309         {
310           int i;
311           for (i = 0; i < count; i++)
312             {
313               /* Note that if the variable already exists there is no
314                  harm done. */
315               dict_create_var (default_dict, iter->replacement[i], 0);
316             }
317         }
318   }
319
320   /* Create the DO REPEAT virtual input file. */
321   {
322     struct getl_script *script = xmalloc (sizeof *script);
323
324     script->first_line = line_buf_head;
325     script->cur_line = NULL;
326     script->remaining_loops = count;
327     script->loop_index = -1;
328     script->macros = repeat_tab;
329     script->print = print;
330
331     getl_add_DO_REPEAT_file (script);
332   }
333
334   return 1;
335 }
336
337 /* Parses a set of ids for DO REPEAT. */
338 static int
339 parse_ids (struct repeat_entry * e)
340 {
341   int i;
342   int n = 0;
343
344   e->type = 1;
345   e->replacement = NULL;
346
347   do
348     {
349       char **names;
350       int nnames;
351
352       if (!parse_mixed_vars (&names, &nnames, PV_NONE))
353         return 0;
354
355       e->replacement = xrealloc (e->replacement,
356                                  (nnames + n) * sizeof *e->replacement);
357       for (i = 0; i < nnames; i++)
358         {
359           e->replacement[n + i] = xstrdup (names[i]);
360           free (names[i]);
361         }
362       free (names);
363       n += nnames;
364     }
365   while (token != '/' && token != '.');
366
367   return n;
368 }
369
370 /* Stores VALUE into *REPL. */
371 static inline void
372 store_numeric (char **repl, long value)
373 {
374   *repl = xmalloc (INT_DIGITS + 1);
375   sprintf (*repl, "%ld", value);
376 }
377
378 /* Parses a list of numbers for DO REPEAT. */
379 static int
380 parse_numbers (struct repeat_entry *e)
381 {
382   /* First and last numbers for TO, plus the step factor. */
383   long a, b;
384
385   /* Alias to e->replacement. */
386   char **array;
387
388   /* Number of entries in array; maximum number for this allocation
389      size. */
390   int n, m;
391
392   n = m = 0;
393   e->type = 0;
394   e->replacement = array = NULL;
395
396   do
397     {
398       /* Parse A TO B into a, b. */
399       if (!lex_force_int ())
400         return 0;
401       a = lex_integer ();
402
403       lex_get ();
404       if (token == T_TO)
405         {
406           lex_get ();
407           if (!lex_force_int ())
408             return 0;
409           b = lex_integer ();
410
411           lex_get ();
412         }
413       else b = a;
414
415       if (n + (abs (b - a) + 1) > m)
416         {
417           m = n + (abs (b - a) + 1) + 16;
418           e->replacement = array = xrealloc (array,
419                                              m * sizeof *e->replacement);
420         }
421
422       if (a == b)
423         store_numeric (&array[n++], a);
424       else
425         {
426           long iter;
427
428           if (a < b)
429             for (iter = a; iter <= b; iter++)
430               store_numeric (&array[n++], iter);
431           else
432             for (iter = a; iter >= b; iter--)
433               store_numeric (&array[n++], iter);
434         }
435
436       lex_match (',');
437     }
438   while (token != '/' && token != '.');
439   e->replacement = xrealloc (array, n * sizeof *e->replacement);
440
441   return n;
442 }
443
444 /* Parses a list of strings for DO REPEAT. */
445 int
446 parse_strings (struct repeat_entry * e)
447 {
448   char **string;
449   int n, m;
450
451   e->type = 0;
452   string = e->replacement = NULL;
453   n = m = 0;
454
455   do
456     {
457       if (token != T_STRING)
458         {
459           int i;
460           msg (SE, _("String expected."));
461           for (i = 0; i < n; i++)
462             free (string[i]);
463           free (string);
464           return 0;
465         }
466
467       if (n + 1 > m)
468         {
469           m += 16;
470           e->replacement = string = xrealloc (string,
471                                               m * sizeof *e->replacement);
472         }
473       string[n++] = lex_token_representation ();
474       lex_get ();
475
476       lex_match (',');
477     }
478   while (token != '/' && token != '.');
479   e->replacement = xrealloc (string, n * sizeof *e->replacement);
480
481   return n;
482 }
483 \f
484 int
485 cmd_end_repeat (void)
486 {
487   msg (SE, _("No matching DO REPEAT."));
488   return CMD_FAILURE;
489 }
490 \f
491 /* Finds a DO REPEAT macro with name MACRO_NAME and returns the
492    appropriate subsitution if found, or NULL if not. */
493 static char *
494 find_DO_REPEAT_substitution (char *macro_name)
495 {
496   struct getl_script *s;
497             
498   for (s = getl_head; s; s = s->included_from)
499     {
500       struct repeat_entry *e;
501       
502       if (s->first_line == NULL)
503         continue;
504
505       for (e = s->macros; e; e = e->next)
506         if (!strcasecmp (e->id, macro_name))
507           return e->replacement[s->loop_index];
508     }
509   
510   return NULL;
511 }
512
513 /* Makes appropriate DO REPEAT macro substitutions within getl_buf. */
514 void
515 perform_DO_REPEAT_substitutions (void)
516 {
517   /* Are we in an apostrophized string or a quoted string? */
518   int in_apos = 0, in_quote = 0;
519
520   /* Source pointer. */
521   char *cp;
522
523   /* Output buffer, size, pointer. */
524   struct string output;
525
526   /* Terminal dot. */
527   int dot = 0;
528
529   ds_init (&output, ds_capacity (&getl_buf));
530
531   /* Strip trailing whitespace, check for & remove terminal dot. */
532   while (ds_length (&getl_buf) > 0
533          && isspace ((unsigned char) ds_end (&getl_buf)[-1]))
534     ds_truncate (&getl_buf, ds_length (&getl_buf) - 1);
535   if (ds_length (&getl_buf) > 0 && ds_end (&getl_buf)[-1] == get_endcmd() )
536     {
537       dot = 1;
538       ds_truncate (&getl_buf, ds_length (&getl_buf) - 1);
539     }
540   
541   for (cp = ds_c_str (&getl_buf); cp < ds_end (&getl_buf); )
542     {
543       if (*cp == '\'' && !in_quote)
544         in_apos ^= 1;
545       else if (*cp == '"' && !in_apos)
546         in_quote ^= 1;
547       
548       if (in_quote || in_apos || !CHAR_IS_ID1 (*cp))
549         {
550           ds_putc (&output, *cp++);
551           continue;
552         }
553
554       /* Collect an identifier. */
555       {
556         char name[9];
557         char *start = cp;
558         char *np = name;
559         char *substitution;
560
561         while (CHAR_IS_IDN (*cp) && np < &name[8])
562           *np++ = *cp++;
563         while (CHAR_IS_IDN (*cp))
564           cp++;
565         *np = 0;
566
567         substitution = find_DO_REPEAT_substitution (name);
568         if (!substitution)
569           {
570             ds_concat (&output, start, cp - start);
571             continue;
572           }
573
574         /* Force output buffer size, copy substitution. */
575         ds_puts (&output, substitution);
576       }
577     }
578   if (dot)
579     ds_putc (&output, get_endcmd() );
580
581   ds_destroy (&getl_buf);
582   getl_buf = output;
583 }