src/language/control/loop.c

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