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 loop_trns *, struct expression **);
  91 static bool parse_index_clause (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 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 (token != '.' && ok)
 106     {
 107       if (lex_match_id ("IF"))
 108         ok = parse_if_clause (loop, &loop->loop_condition);
 109       else
 110         ok = parse_index_clause (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 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 ("IF"))
 142     ok = parse_if_clause (loop, &loop->end_loop_condition);
 143   if (ok)
 144     ok = lex_end_of_command () == 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 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 ();
 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 loop_trns *loop, struct expression **condition)
 191 {
 192   *condition = expr_parse_pool (loop->pool, loop->ds, EXPR_BOOLEAN);
 193   return *condition != NULL;
 194 }
 195
 196 /* Parses an indexing clause into LOOP.
 197    Stores the index variable's name in INDEX_VAR_NAME[].
 198    Returns true if successful, false on failure. */
 199 static bool
 200 parse_index_clause (struct loop_trns *loop, char index_var_name[])
 201 {
 202   if (token != T_ID)
 203     {
 204       lex_error (NULL);
 205       return false;
 206     }
 207   strcpy (index_var_name, tokid);
 208   lex_get ();
 209
 210   if (!lex_force_match ('='))
 211     return false;
 212
 213   loop->first_expr = expr_parse_pool (loop->pool, loop->ds, EXPR_NUMBER);
 214   if (loop->first_expr == NULL)
 215     return false;
 216
 217   for (;;)
 218     {
 219       struct expression **e;
 220       if (lex_match (T_TO))
 221         e = &loop->last_expr;
 222       else if (lex_match (T_BY))
 223         e = &loop->by_expr;
 224       else
 225         break;
 226
 227       if (*e != NULL)
 228         {
 229           lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
 230           return false;
 231         }
 232       *e = expr_parse_pool (loop->pool, loop->ds, EXPR_NUMBER);
 233       if (*e == NULL)
 234         return false;
 235     }
 236   if (loop->last_expr == NULL)
 237     {
 238       lex_sbc_missing ("TO");
 239       return false;
 240     }
 241   if (loop->by_expr == NULL)
 242     loop->by = 1.0;
 243
 244   return true;
 245 }
 246
 247 /* Creates, initializes, and returns a new loop_trns. */
 248 static struct loop_trns *
 249 create_loop_trns (struct dataset *ds)
 250 {
 251   struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
 252   loop->max_pass_count = -1;
 253   loop->pass = 0;
 254   loop->index_var = NULL;
 255   loop->first_expr = loop->by_expr = loop->last_expr = NULL;
 256   loop->loop_condition = loop->end_loop_condition = NULL;
 257   loop->ds = ds;
 258
 259   add_transformation_with_finalizer (ds, loop_trns_finalize,
 260                                      loop_trns_proc, loop_trns_free, loop);
 261   loop->past_LOOP_index = next_transformation (ds);
 262
 263   ctl_stack_push (&loop_class, loop);
 264
 265   return loop;
 266 }
 267
 268 /* Finalizes LOOP by clearing the control stack, thus ensuring
 269    that all open LOOPs are closed. */
 270 static void
 271 loop_trns_finalize (void *do_if_ UNUSED)
 272 {
 273   /* This will be called multiple times if multiple LOOPs were
 274      executed, which is slightly unclean, but at least it's
 275      idempotent. */
 276   ctl_stack_clear ();
 277 }
 278
 279 /* Sets up LOOP for the first pass. */
 280 static int
 281 loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num)
 282 {
 283   struct loop_trns *loop = loop_;
 284
 285   if (loop->index_var != NULL)
 286     {
 287       /* Evaluate loop index expressions. */
 288       loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
 289       if (loop->by_expr != NULL)
 290         loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
 291       loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
 292
 293       /* Even if the loop is never entered, set the index
 294          variable to the initial value. */
 295       case_data_rw (c, loop->index_var->fv)->f = loop->cur;
 296
 297       /* Throw out pathological cases. */
 298       if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
 299           || loop->by == 0.0
 300           || (loop->by > 0.0 && loop->cur > loop->last)
 301           || (loop->by < 0.0 && loop->cur < loop->last))
 302         goto zero_pass;
 303     }
 304
 305   /* Initialize pass count. */
 306   loop->pass = 0;
 307   if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
 308     goto zero_pass;
 309
 310   /* Check condition. */
 311   if (loop->loop_condition != NULL
 312       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
 313     goto zero_pass;
 314
 315   return loop->past_LOOP_index;
 316
 317  zero_pass:
 318   return loop->past_END_LOOP_index;
 319 }
 320
 321 /* Frees LOOP. */
 322 static bool
 323 loop_trns_free (void *loop_)
 324 {
 325   struct loop_trns *loop = loop_;
 326
 327   pool_destroy (loop->pool);
 328   return true;
 329 }
 330
 331 /* Finishes a pass through the loop and starts the next. */
 332 static int
 333 end_loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num UNUSED)
 334 {
 335   struct loop_trns *loop = loop_;
 336
 337   if (loop->end_loop_condition != NULL
 338       && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 1.0)
 339     goto break_out;
 340
 341   /* MXLOOPS limiter. */
 342   if (loop->max_pass_count >= 0)
 343     {
 344       if (loop->pass >= loop->max_pass_count)
 345         goto break_out;
 346       loop->pass++;
 347     }
 348
 349   /* Indexing clause limiter: counting downward. */
 350   if (loop->index_var != NULL)
 351     {
 352       loop->cur += loop->by;
 353       if ((loop->by > 0.0 && loop->cur > loop->last)
 354           || (loop->by < 0.0 && loop->cur < loop->last))
 355         goto break_out;
 356       case_data_rw (c, loop->index_var->fv)->f = loop->cur;
 357     }
 358
 359   if (loop->loop_condition != NULL
 360       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
 361     goto break_out;
 362
 363   return loop->past_LOOP_index;
 364
 365  break_out:
 366   return loop->past_END_LOOP_index;
 367 }
 368
 369 /* Executes BREAK. */
 370 static int
 371 break_trns_proc (void *loop_, struct ccase *c UNUSED, casenumber case_num UNUSED)
 372 {
 373   struct loop_trns *loop = loop_;
 374
 375   return loop->past_END_LOOP_index;
 376 }
 377
 378 /* LOOP control structure class definition. */
 379 static const struct ctl_class loop_class =
 380   {
 381     "LOOP",
 382     "END LOOP",
 383     close_loop,
 384   };