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