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 *, struct loop_trns *, struct expression **);
  90 static bool parse_index_clause (struct lexer *, struct loop_trns *, char index_var_name[]);
  91 static void close_loop (void *);
  92 \f
  93 /* LOOP. */
  94
  95 /* Parses LOOP. */
  96 int
  97 cmd_loop (struct lexer *lexer, struct dataset *ds)
  98 {
  99   struct loop_trns *loop;
 100   char index_var_name[LONG_NAME_LEN + 1];
 101   bool ok = true;
 102
 103   loop = create_loop_trns (ds);
 104   while (lex_token (lexer) != '.' && ok)
 105     {
 106       if (lex_match_id (lexer, "IF"))
 107         ok = parse_if_clause (lexer, loop, &loop->loop_condition);
 108       else
 109         ok = parse_index_clause (lexer, loop, index_var_name);
 110     }
 111
 112   /* Find index variable and create if necessary. */
 113   if (ok && index_var_name[0] != '\0')
 114     {
 115       loop->index_var = dict_lookup_var (dataset_dict (ds), index_var_name);
 116       if (loop->index_var == NULL)
 117         loop->index_var = dict_create_var (dataset_dict (ds),
 118                                            index_var_name, 0);
 119     }
 120
 121   if (!ok)
 122     loop->max_pass_count = 0;
 123   return ok ? CMD_SUCCESS : CMD_FAILURE;
 124 }
 125
 126 /* Parses END LOOP. */
 127 int
 128 cmd_end_loop (struct lexer *lexer, struct dataset *ds)
 129 {
 130   struct loop_trns *loop;
 131   bool ok = true;
 132
 133   loop = ctl_stack_top (&loop_class);
 134   if (loop == NULL)
 135     return CMD_CASCADING_FAILURE;
 136
 137   assert (loop->ds == ds);
 138
 139   /* Parse syntax. */
 140   if (lex_match_id (lexer, "IF"))
 141     ok = parse_if_clause (lexer, loop, &loop->end_loop_condition);
 142   if (ok)
 143     ok = lex_end_of_command (lexer) == CMD_SUCCESS;
 144
 145   if (!ok)
 146     loop->max_pass_count = 0;
 147
 148   ctl_stack_pop (loop);
 149
 150   return ok ? CMD_SUCCESS : CMD_FAILURE;
 151 }
 152
 153 /* Parses BREAK. */
 154 int
 155 cmd_break (struct lexer *lexer, struct dataset *ds)
 156 {
 157   struct ctl_stmt *loop = ctl_stack_search (&loop_class);
 158   if (loop == NULL)
 159     return CMD_CASCADING_FAILURE;
 160
 161   add_transformation (ds, break_trns_proc, NULL, loop);
 162
 163   return lex_end_of_command (lexer);
 164 }
 165
 166 /* Closes a LOOP construct by emitting the END LOOP
 167    transformation and finalizing its members appropriately. */
 168 static void
 169 close_loop (void *loop_)
 170 {
 171   struct loop_trns *loop = loop_;
 172
 173   add_transformation (loop->ds, end_loop_trns_proc, NULL, loop);
 174   loop->past_END_LOOP_index = next_transformation (loop->ds);
 175
 176   /* If there's nothing else limiting the number of loops, use
 177      MXLOOPS as a limit. */
 178   if (loop->max_pass_count == -1
 179       && loop->index_var == NULL
 180       && loop->loop_condition == NULL
 181       && loop->end_loop_condition == NULL)
 182     loop->max_pass_count = get_mxloops ();
 183 }
 184
 185 /* Parses an IF clause for LOOP or END LOOP and stores the
 186    resulting expression to *CONDITION.
 187    Returns true if successful, false on failure. */
 188 static bool
 189 parse_if_clause (struct lexer *lexer,
 190                  struct loop_trns *loop, struct expression **condition)
 191 {
 192   *condition = expr_parse_pool (lexer, 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 lexer *lexer, struct loop_trns *loop, char index_var_name[])
 201 {
 202   if (lex_token (lexer) != T_ID)
 203     {
 204       lex_error (lexer, NULL);
 205       return false;
 206     }
 207   strcpy (index_var_name, lex_tokid (lexer));
 208   lex_get (lexer);
 209
 210   if (!lex_force_match (lexer, '='))
 211     return false;
 212
 213   loop->first_expr = expr_parse_pool (lexer, loop->pool,
 214                                       loop->ds, EXPR_NUMBER);
 215   if (loop->first_expr == NULL)
 216     return false;
 217
 218   for (;;)
 219     {
 220       struct expression **e;
 221       if (lex_match (lexer, T_TO))
 222         e = &loop->last_expr;
 223       else if (lex_match (lexer, T_BY))
 224         e = &loop->by_expr;
 225       else
 226         break;
 227
 228       if (*e != NULL)
 229         {
 230           lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
 231           return false;
 232         }
 233       *e = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_NUMBER);
 234       if (*e == NULL)
 235         return false;
 236     }
 237   if (loop->last_expr == NULL)
 238     {
 239       lex_sbc_missing (lexer, "TO");
 240       return false;
 241     }
 242   if (loop->by_expr == NULL)
 243     loop->by = 1.0;
 244
 245   return true;
 246 }
 247
 248 /* Creates, initializes, and returns a new loop_trns. */
 249 static struct loop_trns *
 250 create_loop_trns (struct dataset *ds)
 251 {
 252   struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
 253   loop->max_pass_count = -1;
 254   loop->pass = 0;
 255   loop->index_var = NULL;
 256   loop->first_expr = loop->by_expr = loop->last_expr = NULL;
 257   loop->loop_condition = loop->end_loop_condition = NULL;
 258   loop->ds = ds;
 259
 260   add_transformation_with_finalizer (ds, loop_trns_finalize,
 261                                      loop_trns_proc, loop_trns_free, loop);
 262   loop->past_LOOP_index = next_transformation (ds);
 263
 264   ctl_stack_push (&loop_class, loop);
 265
 266   return loop;
 267 }
 268
 269 /* Finalizes LOOP by clearing the control stack, thus ensuring
 270    that all open LOOPs are closed. */
 271 static void
 272 loop_trns_finalize (void *do_if_ UNUSED)
 273 {
 274   /* This will be called multiple times if multiple LOOPs were
 275      executed, which is slightly unclean, but at least it's
 276      idempotent. */
 277   ctl_stack_clear ();
 278 }
 279
 280 /* Sets up LOOP for the first pass. */
 281 static int
 282 loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num)
 283 {
 284   struct loop_trns *loop = loop_;
 285
 286   if (loop->index_var != NULL)
 287     {
 288       /* Evaluate loop index expressions. */
 289       loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
 290       if (loop->by_expr != NULL)
 291         loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
 292       loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
 293
 294       /* Even if the loop is never entered, set the index
 295          variable to the initial value. */
 296       case_data_rw (c, loop->index_var)->f = loop->cur;
 297
 298       /* Throw out pathological cases. */
 299       if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
 300           || loop->by == 0.0
 301           || (loop->by > 0.0 && loop->cur > loop->last)
 302           || (loop->by < 0.0 && loop->cur < loop->last))
 303         goto zero_pass;
 304     }
 305
 306   /* Initialize pass count. */
 307   loop->pass = 0;
 308   if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
 309     goto zero_pass;
 310
 311   /* Check condition. */
 312   if (loop->loop_condition != NULL
 313       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
 314     goto zero_pass;
 315
 316   return loop->past_LOOP_index;
 317
 318  zero_pass:
 319   return loop->past_END_LOOP_index;
 320 }
 321
 322 /* Frees LOOP. */
 323 static bool
 324 loop_trns_free (void *loop_)
 325 {
 326   struct loop_trns *loop = loop_;
 327
 328   pool_destroy (loop->pool);
 329   return true;
 330 }
 331
 332 /* Finishes a pass through the loop and starts the next. */
 333 static int
 334 end_loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num UNUSED)
 335 {
 336   struct loop_trns *loop = loop_;
 337
 338   if (loop->end_loop_condition != NULL
 339       && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 1.0)
 340     goto break_out;
 341
 342   /* MXLOOPS limiter. */
 343   if (loop->max_pass_count >= 0)
 344     {
 345       if (loop->pass >= loop->max_pass_count)
 346         goto break_out;
 347       loop->pass++;
 348     }
 349
 350   /* Indexing clause limiter: counting downward. */
 351   if (loop->index_var != NULL)
 352     {
 353       loop->cur += loop->by;
 354       if ((loop->by > 0.0 && loop->cur > loop->last)
 355           || (loop->by < 0.0 && loop->cur < loop->last))
 356         goto break_out;
 357       case_data_rw (c, loop->index_var)->f = loop->cur;
 358     }
 359
 360   if (loop->loop_condition != NULL
 361       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
 362     goto break_out;
 363
 364   return loop->past_LOOP_index;
 365
 366  break_out:
 367   return loop->past_END_LOOP_index;
 368 }
 369
 370 /* Executes BREAK. */
 371 static int
 372 break_trns_proc (void *loop_, struct ccase *c UNUSED, casenumber case_num UNUSED)
 373 {
 374   struct loop_trns *loop = loop_;
 375
 376   return loop->past_END_LOOP_index;
 377 }
 378
 379 /* LOOP control structure class definition. */
 380 static const struct ctl_class loop_class =
 381   {
 382     "LOOP",
 383     "END LOOP",
 384     close_loop,
 385   };