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