Use a casefile, instead of a case sink, for MATCH FILES output.
[pspp] / src / language / control / 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., 51 Franklin Street, Fifth Floor, Boston, MA
18    02110-1301, USA. */
19
20 #include <config.h>
21
22 #include "repeat.h"
23
24 #include <ctype.h>
25 #include <math.h>
26 #include <stdlib.h>
27
28 #include <data/dictionary.h>
29 #include <data/procedure.h>
30 #include <data/settings.h>
31 #include <language/command.h>
32 #include <language/lexer/lexer.h>
33 #include <language/line-buffer.h>
34 #include <libpspp/alloc.h>
35 #include <libpspp/message.h>
36 #include <libpspp/message.h>
37 #include <libpspp/misc.h>
38 #include <libpspp/pool.h>
39 #include <libpspp/str.h>
40 #include <data/variable.h>
41
42 #include "intprops.h"
43
44 #include "gettext.h"
45 #define _(msgid) gettext (msgid)
46
47 /* Defines a list of lines used by DO REPEAT. */
48 struct line_list
49   {
50     struct line_list *next;     /* Next line. */
51     char *file_name;            /* File name. */
52     int line_number;            /* Line number. */
53     char *line;                 /* Contents. */
54   };
55
56 /* The type of substitution made for a DO REPEAT macro. */
57 enum repeat_entry_type 
58   {
59     VAR_NAMES,
60     OTHER
61   };
62
63 /* Describes one DO REPEAT macro. */
64 struct repeat_entry
65   {
66     struct repeat_entry *next;          /* Next entry. */
67     enum repeat_entry_type type;        /* Types of replacements. */
68     char id[LONG_NAME_LEN + 1];         /* Macro identifier. */
69     char **replacement;                 /* Macro replacement. */
70   };
71
72 /* A DO REPEAT...END REPEAT block. */
73 struct repeat_block 
74   {
75     struct pool *pool;                  /* Pool used for storage. */
76     struct line_list *first_line;       /* First line in line buffer. */
77     struct line_list *cur_line;         /* Current line in line buffer. */
78     int loop_cnt;                       /* Number of loops. */
79     int loop_idx;                       /* Number of loops so far. */
80     struct repeat_entry *macros;        /* Pointer to macro table. */
81     bool print;                         /* Print lines as executed? */
82   };
83
84 static bool parse_specification (struct repeat_block *);
85 static bool parse_lines (struct repeat_block *);
86 static void create_vars (struct repeat_block *);
87
88 static int parse_ids (struct repeat_entry *);
89 static int parse_numbers (struct repeat_entry *);
90 static int parse_strings (struct repeat_entry *);
91
92 static void do_repeat_filter (struct string *line, void *block);
93 static bool do_repeat_read (struct string *line, char **file_name,
94                             int *line_number, void *block);
95 static void do_repeat_close (void *block);
96
97 int
98 cmd_do_repeat (void)
99 {
100   struct repeat_block *block;
101
102   block = pool_create_container (struct repeat_block, pool);
103
104   if (!parse_specification (block) || !parse_lines (block))
105     goto error;
106   
107   create_vars (block);
108   
109   block->cur_line = NULL;
110   block->loop_idx = -1;
111   getl_include_filter (do_repeat_filter, do_repeat_close, block);
112   getl_include_function (do_repeat_read, NULL, block);
113
114   return CMD_SUCCESS;
115
116  error:
117   pool_destroy (block->pool);
118   return CMD_CASCADING_FAILURE;
119 }
120
121 /* Parses the whole DO REPEAT command specification.
122    Returns success. */
123 static bool
124 parse_specification (struct repeat_block *block) 
125 {
126   char first_name[LONG_NAME_LEN + 1];
127
128   block->loop_cnt = 0;
129   block->macros = NULL;
130   do
131     {
132       struct repeat_entry *e;
133       struct repeat_entry *iter;
134       int count;
135
136       /* Get a stand-in variable name and make sure it's unique. */
137       if (!lex_force_id ())
138         return false;
139       if (dict_lookup_var (default_dict, tokid))
140         msg (SW, _("Dummy variable name \"%s\" hides dictionary "
141                    "variable \"%s\"."),
142              tokid, tokid);
143       for (iter = block->macros; iter != NULL; iter = iter->next)
144         if (!strcasecmp (iter->id, tokid))
145           {
146             msg (SE, _("Dummy variable name \"%s\" is given twice."), tokid);
147             return false;
148           }
149
150       /* Make a new stand-in variable entry and link it into the
151          list. */
152       e = pool_alloc (block->pool, sizeof *e);
153       e->next = block->macros;
154       strcpy (e->id, tokid);
155       block->macros = e;
156
157       /* Skip equals sign. */
158       lex_get ();
159       if (!lex_force_match ('='))
160         return false;
161
162       /* Get the details of the variable's possible values. */
163       if (token == T_ID)
164         count = parse_ids (e);
165       else if (lex_is_number ())
166         count = parse_numbers (e);
167       else if (token == T_STRING)
168         count = parse_strings (e);
169       else
170         {
171           lex_error (NULL);
172           return false;
173         }
174       if (count == 0)
175         return false;
176
177       /* If this is the first variable then it defines how many
178          replacements there must be; otherwise enforce this number of
179          replacements. */
180       if (block->loop_cnt == 0)
181         {
182           block->loop_cnt = count;
183           strcpy (first_name, e->id);
184         }
185       else if (block->loop_cnt != count)
186         {
187           msg (SE, _("Dummy variable \"%s\" had %d "
188                      "substitutions, so \"%s\" must also, but %d "
189                      "were specified."),
190                first_name, block->loop_cnt, e->id, count);
191           return false;
192         }
193
194       lex_match ('/');
195     }
196   while (token != '.');
197
198   return true;
199 }
200
201 /* If KEYWORD appears beginning at CP, possibly preceded by white
202    space, returns a pointer to the character just after the
203    keyword.  Otherwise, returns a null pointer. */
204 static const char *
205 recognize_keyword (const char *cp, const char *keyword)
206 {
207   const char *end;
208
209   while (isspace ((unsigned char) *cp))
210     cp++;
211
212   end = lex_skip_identifier (cp);
213   if (end != cp
214       && lex_id_match_len (keyword, strlen (keyword), cp, end - cp))
215     return end;
216   else
217     return NULL;
218 }
219
220 /* Returns CP, advanced past a '+' or '-' if present. */
221 static const char *
222 skip_indentor (const char *cp) 
223 {
224   if (*cp == '+' || *cp == '-')
225     cp++;
226   return cp;
227 }
228
229 /* Returns true if LINE contains a DO REPEAT command, false
230    otherwise. */
231 static bool
232 recognize_do_repeat (const char *line) 
233 {
234   const char *cp = recognize_keyword (skip_indentor (line), "do");
235   return cp != NULL && recognize_keyword (cp, "repeat") != NULL;
236 }
237
238 /* Returns true if LINE contains an END REPEAT command, false
239    otherwise.  Sets *PRINT to true for END REPEAT PRINT, false
240    otherwise. */
241 static bool
242 recognize_end_repeat (const char *line, bool *print)
243 {
244   const char *cp = recognize_keyword (skip_indentor (line), "end");
245   if (cp == NULL)
246     return false;
247
248   cp = recognize_keyword (cp, "repeat");
249   if (cp == NULL) 
250     return false; 
251
252   *print = recognize_keyword (cp, "print");
253   return true; 
254 }
255
256 /* Read all the lines we are going to substitute, inside the DO
257    REPEAT...END REPEAT block. */
258 static bool
259 parse_lines (struct repeat_block *block) 
260 {
261   char *previous_file_name;
262   struct line_list **last_line;
263   int nesting_level;
264
265   previous_file_name = NULL;
266   block->first_line = NULL;
267   last_line = &block->first_line;
268   nesting_level = 0;
269
270   for (;;)
271     {
272       const char *cur_file_name;
273       int cur_line_number;
274       struct line_list *line;
275       bool dot;
276
277       if (!getl_read_line (NULL))
278         return false;
279
280       /* If the current file has changed then record the fact. */
281       getl_location (&cur_file_name, &cur_line_number);
282       if (previous_file_name == NULL 
283           || !strcmp (cur_file_name, previous_file_name))
284         previous_file_name = pool_strdup (block->pool, cur_file_name);
285
286       ds_rtrim_spaces (&getl_buf);
287       dot = ds_chomp (&getl_buf, get_endcmd ());
288       if (recognize_do_repeat (ds_c_str (&getl_buf))) 
289         nesting_level++; 
290       else if (recognize_end_repeat (ds_c_str (&getl_buf), &block->print)) 
291         {
292         if (nesting_level-- == 0)
293           {
294             lex_discard_line ();
295             return true;
296           } 
297         }
298       if (dot)
299         ds_putc (&getl_buf, get_endcmd ());
300       
301       line = *last_line = pool_alloc (block->pool, sizeof *line);
302       line->next = NULL;
303       line->file_name = previous_file_name;
304       line->line_number = cur_line_number;
305       line->line = pool_strdup (block->pool, ds_c_str (&getl_buf));
306       last_line = &line->next;
307     }
308
309   lex_discard_line ();
310   return true;
311 }
312
313 /* Creates variables for the given DO REPEAT. */
314 static void
315 create_vars (struct repeat_block *block)
316 {
317   struct repeat_entry *iter;
318  
319   for (iter = block->macros; iter; iter = iter->next)
320     if (iter->type == VAR_NAMES)
321       {
322         int i;
323
324         for (i = 0; i < block->loop_cnt; i++)
325           {
326             /* Ignore return value: if the variable already
327                exists there is no harm done. */
328             dict_create_var (default_dict, iter->replacement[i], 0);
329           }
330       }
331 }
332
333 /* Parses a set of ids for DO REPEAT. */
334 static int
335 parse_ids (struct repeat_entry *e)
336 {
337   size_t i;
338   size_t n = 0;
339
340   e->type = VAR_NAMES;
341   e->replacement = NULL;
342
343   do
344     {
345       char **names;
346       size_t nnames;
347
348       if (!parse_mixed_vars (&names, &nnames, PV_NONE))
349         return 0;
350
351       e->replacement = xnrealloc (e->replacement,
352                                   nnames + n, sizeof *e->replacement);
353       for (i = 0; i < nnames; i++)
354         {
355           e->replacement[n + i] = xstrdup (names[i]);
356           free (names[i]);
357         }
358       free (names);
359       n += nnames;
360     }
361   while (token != '/' && token != '.');
362
363   return n;
364 }
365
366 /* Stores VALUE into *REPL. */
367 static inline void
368 store_numeric (char **repl, long value)
369 {
370   *repl = xmalloc (INT_STRLEN_BOUND (value) + 1);
371   sprintf (*repl, "%ld", value);
372 }
373
374 /* Parses a list of numbers for DO REPEAT. */
375 static int
376 parse_numbers (struct repeat_entry *e)
377 {
378   /* First and last numbers for TO, plus the step factor. */
379   long a, b;
380
381   /* Alias to e->replacement. */
382   char **array;
383
384   /* Number of entries in array; maximum number for this allocation
385      size. */
386   int n, m;
387
388   n = m = 0;
389   e->type = OTHER;
390   e->replacement = array = NULL;
391
392   do
393     {
394       /* Parse A TO B into a, b. */
395       if (!lex_force_int ())
396         return 0;
397       a = lex_integer ();
398
399       lex_get ();
400       if (token == T_TO)
401         {
402           lex_get ();
403           if (!lex_force_int ())
404             return 0;
405           b = lex_integer ();
406
407           lex_get ();
408         }
409       else b = a;
410
411       if (n + (abs (b - a) + 1) > m)
412         {
413           m = n + (abs (b - a) + 1) + 16;
414           e->replacement = array = xnrealloc (array,
415                                               m, sizeof *e->replacement);
416         }
417
418       if (a == b)
419         store_numeric (&array[n++], a);
420       else
421         {
422           long iter;
423
424           if (a < b)
425             for (iter = a; iter <= b; iter++)
426               store_numeric (&array[n++], iter);
427           else
428             for (iter = a; iter >= b; iter--)
429               store_numeric (&array[n++], iter);
430         }
431
432       lex_match (',');
433     }
434   while (token != '/' && token != '.');
435   e->replacement = xrealloc (array, n * sizeof *e->replacement);
436
437   return n;
438 }
439
440 /* Parses a list of strings for DO REPEAT. */
441 int
442 parse_strings (struct repeat_entry *e)
443 {
444   char **string;
445   int n, m;
446
447   e->type = OTHER;
448   string = e->replacement = NULL;
449   n = m = 0;
450
451   do
452     {
453       if (token != T_STRING)
454         {
455           int i;
456           msg (SE, _("String expected."));
457           for (i = 0; i < n; i++)
458             free (string[i]);
459           free (string);
460           return 0;
461         }
462
463       if (n + 1 > m)
464         {
465           m += 16;
466           e->replacement = string = xnrealloc (string,
467                                                m, sizeof *e->replacement);
468         }
469       string[n++] = lex_token_representation ();
470       lex_get ();
471
472       lex_match (',');
473     }
474   while (token != '/' && token != '.');
475   e->replacement = xnrealloc (string, n, sizeof *e->replacement);
476
477   return n;
478 }
479 \f
480 int
481 cmd_end_repeat (void)
482 {
483   msg (SE, _("No matching DO REPEAT."));
484   return CMD_CASCADING_FAILURE;
485 }
486 \f
487 /* Finds a DO REPEAT macro with name MACRO_NAME and returns the
488    appropriate subsitution if found, or NULL if not. */
489 static char *
490 find_substitution (struct repeat_block *block, const char *name, size_t length)
491 {
492   struct repeat_entry *e;
493
494   for (e = block->macros; e; e = e->next)
495     if (!memcasecmp (e->id, name, length) && strlen (e->id) == length)
496       return e->replacement[block->loop_idx];
497   
498   return NULL;
499 }
500
501 /* Makes appropriate DO REPEAT macro substitutions within getl_buf. */
502 static void
503 do_repeat_filter (struct string *line, void *block_)
504 {
505   struct repeat_block *block = block_;
506   bool in_apos, in_quote;
507   char *cp;
508   struct string output;
509   bool dot;
510
511   ds_init (&output, ds_capacity (line));
512
513   /* Strip trailing whitespace, check for & remove terminal dot. */
514   while (isspace (ds_last (line)))
515     ds_truncate (line, ds_length (line) - 1);
516   dot = ds_chomp (line, get_endcmd ());
517
518   in_apos = in_quote = false;
519   for (cp = ds_c_str (line); cp < ds_end (line); )
520     {
521       if (*cp == '\'' && !in_quote)
522         in_apos = !in_apos;
523       else if (*cp == '"' && !in_apos)
524         in_quote = !in_quote;
525       
526       if (in_quote || in_apos || !lex_is_id1 (*cp))
527         ds_putc (&output, *cp++);
528       else 
529         {
530           const char *start = cp;
531           char *end = lex_skip_identifier (start);
532           const char *substitution = find_substitution (block,
533                                                         start, end - start);
534           if (substitution != NULL) 
535             ds_puts (&output, substitution);
536           else
537             ds_concat (&output, start, end - start);
538           cp = end;
539         }
540     }
541   if (dot)
542     ds_putc (&output, get_endcmd ());
543
544   ds_swap (line, &output);
545   ds_destroy (&output);
546 }
547
548 /* Function called by getl to read a line.
549    Puts the line in OUTPUT, sets the file name in *FILE_NAME and
550    line number in *LINE_NUMBER.  Returns true if a line was
551    obtained, false if the source is exhausted. */
552 static bool
553 do_repeat_read (struct string *output, char **file_name, int *line_number,
554                 void *block_) 
555 {
556   struct repeat_block *block = block_;
557   struct line_list *line;
558
559   if (block->cur_line == NULL) 
560     {
561       block->loop_idx++;
562       if (block->loop_idx >= block->loop_cnt)
563         return false;
564       block->cur_line = block->first_line;
565     }
566   line = block->cur_line;
567
568   ds_assign_c_str (output, line->line);
569   *file_name = line->file_name;
570   *line_number = -line->line_number;
571   block->cur_line = line->next;
572   return true;
573 }
574
575 /* Frees a DO REPEAT block.
576    Called by getl to close out the DO REPEAT block. */
577 static void
578 do_repeat_close (void *block_)
579 {
580   struct repeat_block *block = block_;
581   pool_destroy (block->pool);
582 }