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 #include <data/case.h>
  21 #include <data/dictionary.h>
  22 #include <data/procedure.h>
  23 #include <data/settings.h>
  24 #include <data/transformations.h>
  25 #include <data/variable.h>
  26 #include <language/command.h>
  27 #include <language/expressions/public.h>
  28 #include <language/lexer/lexer.h>
  29 #include <libpspp/compiler.h>
  30 #include <libpspp/message.h>
  31 #include <libpspp/misc.h>
  32 #include <libpspp/pool.h>
  33 #include <libpspp/str.h>
  34
  35 #include "xalloc.h"
  36
  37 #include "gettext.h"
  38 #define _(msgid) gettext (msgid)
  39
  40 /* LOOP outputs a transformation that is executed only on the
  41    first pass through the loop.  On this trip, it initializes for
  42    the first pass by resetting the pass number, setting up the
  43    indexing clause, and testing the LOOP IF clause.  If the loop
  44    is not to be entered at all, it jumps forward just past the
  45    END LOOP transformation; otherwise, it continues to the
  46    transformation following LOOP.
  47
  48    END LOOP outputs a transformation that executes at the end of
  49    each trip through the loop.  It checks the END LOOP IF clause,
  50    then updates the pass number, increments the indexing clause,
  51    and tests the LOOP IF clause.  If another pass through the
  52    loop is due, it jumps backward to just after the LOOP
  53    transformation; otherwise, it continues to the transformation
  54    following END LOOP. */
  55
  56 struct loop_trns
  57   {
  58     struct pool *pool;
  59     struct dataset *ds;
  60
  61     /* Iteration limit. */
  62     int max_pass_count;         /* Maximum number of passes (-1=unlimited). */
  63     int pass;                   /* Number of passes thru the loop so far. */
  64
  65     /* a=a TO b [BY c]. */
  66     struct variable *index_var; /* Index variable. */
  67     struct expression *first_expr; /* Starting index. */
  68     struct expression *by_expr; /* Index increment (default 1.0 if null). */
  69     struct expression *last_expr; /* Terminal index. */
  70     double cur, by, last;       /* Current value, increment, last value. */
  71
  72     /* IF condition for LOOP or END LOOP. */
  73     struct expression *loop_condition;
  74     struct expression *end_loop_condition;
  75
  76     /* Transformation indexes. */
  77     int past_LOOP_index;        /* Just past LOOP transformation. */
  78     int past_END_LOOP_index;    /* Just past END LOOP transformation. */
  79   };
  80
  81 static const struct ctl_class loop_class;
  82
  83 static trns_finalize_func loop_trns_finalize;
  84 static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
  85 static trns_free_func loop_trns_free;
  86
  87 static struct loop_trns *create_loop_trns (struct dataset *);
  88 static bool parse_if_clause (struct lexer *,
  89                              struct loop_trns *, struct expression **);
  90 static bool parse_index_clause (struct dataset *, struct lexer *,
  91                                 struct loop_trns *, bool *created_index_var);
  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   bool created_index_var = false;
 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 (ds, lexer, loop, &created_index_var);
 111     }
 112
 113   /* Clean up if necessary. */
 114   if (!ok)
 115     {
 116       loop->max_pass_count = 0;
 117       if (loop->index_var != NULL && created_index_var)
 118         {
 119           dict_delete_var (dataset_dict (ds), loop->index_var);
 120           loop->index_var = NULL;
 121         }
 122     }
 123
 124   return ok ? CMD_SUCCESS : CMD_CASCADING_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   if (*condition != NULL)
 194     {
 195       lex_sbc_only_once ("IF");
 196       return false;
 197     }
 198
 199   *condition = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_BOOLEAN);
 200   return *condition != NULL;
 201 }
 202
 203 /* Parses an indexing clause into LOOP.
 204    Stores true in *CREATED_INDEX_VAR if the index clause created
 205    a new variable, false otherwise.
 206    Returns true if successful, false on failure. */
 207 static bool
 208 parse_index_clause (struct dataset *ds, struct lexer *lexer,
 209                     struct loop_trns *loop, bool *created_index_var)
 210 {
 211   if (loop->index_var != NULL)
 212     {
 213       msg (SE, _("Only one index clause may be specified."));
 214       return false;
 215     }
 216
 217   if (lex_token (lexer) != T_ID)
 218     {
 219       lex_error (lexer, NULL);
 220       return false;
 221     }
 222
 223   loop->index_var = dict_lookup_var (dataset_dict (ds), lex_tokid (lexer));
 224   if (loop->index_var != NULL)
 225     *created_index_var = false;
 226   else
 227     {
 228       loop->index_var = dict_create_var_assert (dataset_dict (ds),
 229                                                 lex_tokid (lexer), 0);
 230       *created_index_var = true;
 231     }
 232   lex_get (lexer);
 233
 234   if (!lex_force_match (lexer, '='))
 235     return false;
 236
 237   loop->first_expr = expr_parse_pool (lexer, loop->pool,
 238                                       loop->ds, EXPR_NUMBER);
 239   if (loop->first_expr == NULL)
 240     return false;
 241
 242   for (;;)
 243     {
 244       struct expression **e;
 245       if (lex_match (lexer, T_TO))
 246         e = &loop->last_expr;
 247       else if (lex_match (lexer, T_BY))
 248         e = &loop->by_expr;
 249       else
 250         break;
 251
 252       if (*e != NULL)
 253         {
 254           lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
 255           return false;
 256         }
 257       *e = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_NUMBER);
 258       if (*e == NULL)
 259         return false;
 260     }
 261   if (loop->last_expr == NULL)
 262     {
 263       lex_sbc_missing (lexer, "TO");
 264       return false;
 265     }
 266   if (loop->by_expr == NULL)
 267     loop->by = 1.0;
 268
 269   return true;
 270 }
 271
 272 /* Creates, initializes, and returns a new loop_trns. */
 273 static struct loop_trns *
 274 create_loop_trns (struct dataset *ds)
 275 {
 276   struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
 277   loop->max_pass_count = -1;
 278   loop->pass = 0;
 279   loop->index_var = NULL;
 280   loop->first_expr = loop->by_expr = loop->last_expr = NULL;
 281   loop->loop_condition = loop->end_loop_condition = NULL;
 282   loop->ds = ds;
 283
 284   add_transformation_with_finalizer (ds, loop_trns_finalize,
 285                                      loop_trns_proc, loop_trns_free, loop);
 286   loop->past_LOOP_index = next_transformation (ds);
 287
 288   ctl_stack_push (&loop_class, loop);
 289
 290   return loop;
 291 }
 292
 293 /* Finalizes LOOP by clearing the control stack, thus ensuring
 294    that all open LOOPs are closed. */
 295 static void
 296 loop_trns_finalize (void *do_if_ UNUSED)
 297 {
 298   /* This will be called multiple times if multiple LOOPs were
 299      executed, which is slightly unclean, but at least it's
 300      idempotent. */
 301   ctl_stack_clear ();
 302 }
 303
 304 /* Sets up LOOP for the first pass. */
 305 static int
 306 loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num)
 307 {
 308   struct loop_trns *loop = loop_;
 309
 310   if (loop->index_var != NULL)
 311     {
 312       /* Evaluate loop index expressions. */
 313       loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
 314       if (loop->by_expr != NULL)
 315         loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
 316       loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
 317
 318       /* Even if the loop is never entered, set the index
 319          variable to the initial value. */
 320       case_data_rw (c, loop->index_var)->f = loop->cur;
 321
 322       /* Throw out pathological cases. */
 323       if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
 324           || loop->by == 0.0
 325           || (loop->by > 0.0 && loop->cur > loop->last)
 326           || (loop->by < 0.0 && loop->cur < loop->last))
 327         goto zero_pass;
 328     }
 329
 330   /* Initialize pass count. */
 331   loop->pass = 0;
 332   if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
 333     goto zero_pass;
 334
 335   /* Check condition. */
 336   if (loop->loop_condition != NULL
 337       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
 338     goto zero_pass;
 339
 340   return loop->past_LOOP_index;
 341
 342  zero_pass:
 343   return loop->past_END_LOOP_index;
 344 }
 345
 346 /* Frees LOOP. */
 347 static bool
 348 loop_trns_free (void *loop_)
 349 {
 350   struct loop_trns *loop = loop_;
 351
 352   pool_destroy (loop->pool);
 353   return true;
 354 }
 355
 356 /* Finishes a pass through the loop and starts the next. */
 357 static int
 358 end_loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num UNUSED)
 359 {
 360   struct loop_trns *loop = loop_;
 361
 362   if (loop->end_loop_condition != NULL
 363       && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 0.0)
 364     goto break_out;
 365
 366   /* MXLOOPS limiter. */
 367   if (loop->max_pass_count >= 0)
 368     {
 369       if (loop->pass >= loop->max_pass_count)
 370         goto break_out;
 371       loop->pass++;
 372     }
 373
 374   /* Indexing clause limiter: counting downward. */
 375   if (loop->index_var != NULL)
 376     {
 377       loop->cur += loop->by;
 378       if ((loop->by > 0.0 && loop->cur > loop->last)
 379           || (loop->by < 0.0 && loop->cur < loop->last))
 380         goto break_out;
 381       case_data_rw (c, loop->index_var)->f = loop->cur;
 382     }
 383
 384   if (loop->loop_condition != NULL
 385       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
 386     goto break_out;
 387
 388   return loop->past_LOOP_index;
 389
 390  break_out:
 391   return loop->past_END_LOOP_index;
 392 }
 393
 394 /* Executes BREAK. */
 395 static int
 396 break_trns_proc (void *loop_, struct ccase *c UNUSED, casenumber case_num UNUSED)
 397 {
 398   struct loop_trns *loop = loop_;
 399
 400   return loop->past_END_LOOP_index;
 401 }
 402
 403 /* LOOP control structure class definition. */
 404 static const struct ctl_class loop_class =
 405   {
 406     "LOOP",
 407     "END LOOP",
 408     close_loop,
 409   };