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 <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 }