src/language/control/loop.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 "control-stack.h"
  23 #include <data/case.h>
  24 #include <data/dictionary.h>
  25 #include <data/procedure.h>
  26 #include <data/settings.h>
  27 #include <data/transformations.h>
  28 #include <data/variable.h>
  29 #include <language/command.h>
  30 #include <language/expressions/public.h>
  31 #include <language/lexer/lexer.h>
  32 #include <libpspp/alloc.h>
  33 #include <libpspp/compiler.h>
  34 #include <libpspp/message.h>
  35 #include <libpspp/misc.h>
  36 #include <libpspp/pool.h>
  37 #include <libpspp/str.h>
  38
  39 #include "gettext.h"
  40 #define _(msgid) gettext (msgid)
  41
  42 /* LOOP outputs a transformation that is executed only on the
  43    first pass through the loop.  On this trip, it initializes for
  44    the first pass by resetting the pass number, setting up the
  45    indexing clause, and testing the LOOP IF clause.  If the loop
  46    is not to be entered at all, it jumps forward just past the
  47    END LOOP transformation; otherwise, it continues to the
  48    transformation following LOOP.
  49
  50    END LOOP outputs a transformation that executes at the end of
  51    each trip through the loop.  It checks the END LOOP IF clause,
  52    then updates the pass number, increments the indexing clause,
  53    and tests the LOOP IF clause.  If another pass through the
  54    loop is due, it jumps backward to just after the LOOP
  55    transformation; otherwise, it continues to the transformation
  56    following END LOOP. */
  57
  58 struct loop_trns
  59   {
  60     struct pool *pool;
  61     struct dataset *ds;
  62
  63     /* Iteration limit. */
  64     int max_pass_count;         /* Maximum number of passes (-1=unlimited). */
  65     int pass;                   /* Number of passes thru the loop so far. */
  66
  67     /* a=a TO b [BY c]. */
  68     struct variable *index_var; /* Index variable. */
  69     struct expression *first_expr; /* Starting index. */
  70     struct expression *by_expr; /* Index increment (default 1.0 if null). */
  71     struct expression *last_expr; /* Terminal index. */
  72     double cur, by, last;       /* Current value, increment, last value. */
  73
  74     /* IF condition for LOOP or END LOOP. */
  75     struct expression *loop_condition;
  76     struct expression *end_loop_condition;
  77
  78     /* Transformation indexes. */
  79     int past_LOOP_index;        /* Just past LOOP transformation. */
  80     int past_END_LOOP_index;    /* Just past END LOOP transformation. */
  81   };
  82
  83 static const struct ctl_class loop_class;
  84
  85 static trns_finalize_func loop_trns_finalize;
  86 static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
  87 static trns_free_func loop_trns_free;
  88
  89 static struct loop_trns *create_loop_trns (struct dataset *);
  90 static bool parse_if_clause (struct lexer *, struct loop_trns *, struct expression **);
  91 static bool parse_index_clause (struct lexer *, struct loop_trns *, char index_var_name[]);
  92 static void close_loop (void *);
  93 \f
  94 /* LOOP. */
  95
  96 /* Parses LOOP. */
  97 int
  98 cmd_loop (struct lexer *lexer, struct dataset *ds)
  99 {
 100   struct loop_trns *loop;
 101   char index_var_name[LONG_NAME_LEN + 1];
 102   bool ok = true;
 103
 104   loop = create_loop_trns (ds);
 105   while (lex_token (lexer) != '.' && ok)
 106     {
 107       if (lex_match_id (lexer, "IF"))
 108         ok = parse_if_clause (lexer, loop, &loop->loop_condition);
 109       else
 110         ok = parse_index_clause (lexer, loop, index_var_name);
 111     }
 112
 113   /* Find index variable and create if necessary. */
 114   if (ok && index_var_name[0] != '\0')
 115     {
 116       loop->index_var = dict_lookup_var (dataset_dict (ds), index_var_name);
 117       if (loop->index_var == NULL)
 118         loop->index_var = dict_create_var (dataset_dict (ds),
 119                                            index_var_name, 0);
 120     }
 121
 122   if (!ok)
 123     loop->max_pass_count = 0;
 124   return ok ? CMD_SUCCESS : CMD_FAILURE;
 125 }
 126
 127 /* Parses END LOOP. */
 128 int
 129 cmd_end_loop (struct lexer *lexer, struct dataset *ds)
 130 {
 131   struct loop_trns *loop;
 132   bool ok = true;
 133
 134   loop = ctl_stack_top (&loop_class);
 135   if (loop == NULL)
 136     return CMD_CASCADING_FAILURE;
 137
 138   assert (loop->ds == ds);
 139
 140   /* Parse syntax. */
 141   if (lex_match_id (lexer, "IF"))
 142     ok = parse_if_clause (lexer, loop, &loop->end_loop_condition);
 143   if (ok)
 144     ok = lex_end_of_command (lexer) == CMD_SUCCESS;
 145
 146   if (!ok)
 147     loop->max_pass_count = 0;
 148
 149   ctl_stack_pop (loop);
 150
 151   return ok ? CMD_SUCCESS : CMD_FAILURE;
 152 }
 153
 154 /* Parses BREAK. */
 155 int
 156 cmd_break (struct lexer *lexer, struct dataset *ds)
 157 {
 158   struct ctl_stmt *loop = ctl_stack_search (&loop_class);
 159   if (loop == NULL)
 160     return CMD_CASCADING_FAILURE;
 161
 162   add_transformation (ds, break_trns_proc, NULL, loop);
 163
 164   return lex_end_of_command (lexer);
 165 }
 166
 167 /* Closes a LOOP construct by emitting the END LOOP
 168    transformation and finalizing its members appropriately. */
 169 static void
 170 close_loop (void *loop_)
 171 {
 172   struct loop_trns *loop = loop_;
 173
 174   add_transformation (loop->ds, end_loop_trns_proc, NULL, loop);
 175   loop->past_END_LOOP_index = next_transformation (loop->ds);
 176
 177   /* If there's nothing else limiting the number of loops, use
 178      MXLOOPS as a limit. */
 179   if (loop->max_pass_count == -1
 180       && loop->index_var == NULL
 181       && loop->loop_condition == NULL
 182       && loop->end_loop_condition == NULL)
 183     loop->max_pass_count = get_mxloops ();
 184 }
 185
 186 /* Parses an IF clause for LOOP or END LOOP and stores the
 187    resulting expression to *CONDITION.
 188    Returns true if successful, false on failure. */
 189 static bool
 190 parse_if_clause (struct lexer *lexer,
 191                  struct loop_trns *loop, struct expression **condition)
 192 {
 193   *condition = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_BOOLEAN);
 194   return *condition != NULL;
 195 }
 196
 197 /* Parses an indexing clause into LOOP.
 198    Stores the index variable's name in INDEX_VAR_NAME[].
 199    Returns true if successful, false on failure. */
 200 static bool
 201 parse_index_clause (struct lexer *lexer, struct loop_trns *loop, char index_var_name[])
 202 {
 203   if (lex_token (lexer) != T_ID)
 204     {
 205       lex_error (lexer, NULL);
 206       return false;
 207     }
 208   strcpy (index_var_name, lex_tokid (lexer));
 209   lex_get (lexer);
 210
 211   if (!lex_force_match (lexer, '='))
 212     return false;
 213
 214   loop->first_expr = expr_parse_pool (lexer, loop->pool,
 215                                       loop->ds, EXPR_NUMBER);
 216   if (loop->first_expr == NULL)
 217     return false;
 218
 219   for (;;)
 220     {
 221       struct expression **e;
 222       if (lex_match (lexer, T_TO))
 223         e = &loop->last_expr;
 224       else if (lex_match (lexer, T_BY))
 225         e = &loop->by_expr;
 226       else
 227         break;
 228
 229       if (*e != NULL)
 230         {
 231           lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
 232           return false;
 233         }
 234       *e = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_NUMBER);
 235       if (*e == NULL)
 236         return false;
 237     }
 238   if (loop->last_expr == NULL)
 239     {
 240       lex_sbc_missing (lexer, "TO");
 241       return false;
 242     }
 243   if (loop->by_expr == NULL)
 244     loop->by = 1.0;
 245
 246   return true;
 247 }
 248
 249 /* Creates, initializes, and returns a new loop_trns. */
 250 static struct loop_trns *
 251 create_loop_trns (struct dataset *ds)
 252 {
 253   struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
 254   loop->max_pass_count = -1;
 255   loop->pass = 0;
 256   loop->index_var = NULL;
 257   loop->first_expr = loop->by_expr = loop->last_expr = NULL;
 258   loop->loop_condition = loop->end_loop_condition = NULL;
 259   loop->ds = ds;
 260
 261   add_transformation_with_finalizer (ds, loop_trns_finalize,
 262                                      loop_trns_proc, loop_trns_free, loop);
 263   loop->past_LOOP_index = next_transformation (ds);
 264
 265   ctl_stack_push (&loop_class, loop);
 266
 267   return loop;
 268 }
 269
 270 /* Finalizes LOOP by clearing the control stack, thus ensuring
 271    that all open LOOPs are closed. */
 272 static void
 273 loop_trns_finalize (void *do_if_ UNUSED)
 274 {
 275   /* This will be called multiple times if multiple LOOPs were
 276      executed, which is slightly unclean, but at least it's
 277      idempotent. */
 278   ctl_stack_clear ();
 279 }
 280
 281 /* Sets up LOOP for the first pass. */
 282 static int
 283 loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num)
 284 {
 285   struct loop_trns *loop = loop_;
 286
 287   if (loop->index_var != NULL)
 288     {
 289       /* Evaluate loop index expressions. */
 290       loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
 291       if (loop->by_expr != NULL)
 292         loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
 293       loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
 294
 295       /* Even if the loop is never entered, set the index
 296          variable to the initial value. */
 297       case_data_rw (c, loop->index_var)->f = loop->cur;
 298
 299       /* Throw out pathological cases. */
 300       if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
 301           || loop->by == 0.0
 302           || (loop->by > 0.0 && loop->cur > loop->last)
 303           || (loop->by < 0.0 && loop->cur < loop->last))
 304         goto zero_pass;
 305     }
 306
 307   /* Initialize pass count. */
 308   loop->pass = 0;
 309   if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
 310     goto zero_pass;
 311
 312   /* Check condition. */
 313   if (loop->loop_condition != NULL
 314       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
 315     goto zero_pass;
 316
 317   return loop->past_LOOP_index;
 318
 319  zero_pass:
 320   return loop->past_END_LOOP_index;
 321 }
 322
 323 /* Frees LOOP. */
 324 static bool
 325 loop_trns_free (void *loop_)
 326 {
 327   struct loop_trns *loop = loop_;
 328
 329   pool_destroy (loop->pool);
 330   return true;
 331 }
 332
 333 /* Finishes a pass through the loop and starts the next. */
 334 static int
 335 end_loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num UNUSED)
 336 {
 337   struct loop_trns *loop = loop_;
 338
 339   if (loop->end_loop_condition != NULL
 340       && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 1.0)
 341     goto break_out;
 342
 343   /* MXLOOPS limiter. */
 344   if (loop->max_pass_count >= 0)
 345     {
 346       if (loop->pass >= loop->max_pass_count)
 347         goto break_out;
 348       loop->pass++;
 349     }
 350
 351   /* Indexing clause limiter: counting downward. */
 352   if (loop->index_var != NULL)
 353     {
 354       loop->cur += loop->by;
 355       if ((loop->by > 0.0 && loop->cur > loop->last)
 356           || (loop->by < 0.0 && loop->cur < loop->last))
 357         goto break_out;
 358       case_data_rw (c, loop->index_var)->f = loop->cur;
 359     }
 360
 361   if (loop->loop_condition != NULL
 362       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
 363     goto break_out;
 364
 365   return loop->past_LOOP_index;
 366
 367  break_out:
 368   return loop->past_END_LOOP_index;
 369 }
 370
 371 /* Executes BREAK. */
 372 static int
 373 break_trns_proc (void *loop_, struct ccase *c UNUSED, casenumber case_num UNUSED)
 374 {
 375   struct loop_trns *loop = loop_;
 376
 377   return loop->past_END_LOOP_index;
 378 }
 379
 380 /* LOOP control structure class definition. */
 381 static const struct ctl_class loop_class =
 382   {
 383     "LOOP",
 384     "END LOOP",
 385     close_loop,
 386   };