src/language/control/loop.c

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