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