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 #include "message.h"
  22 #include "alloc.h"
  23 #include "case.h"
  24 #include "command.h"
  25 #include "dictionary.h"
  26 #include "control-stack.h"
  27 #include "message.h"
  28 #include "expressions/public.h"
  29 #include "lexer.h"
  30 #include "misc.h"
  31 #include "pool.h"
  32 #include "settings.h"
  33 #include "str.h"
  34 #include "variable.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
  59     /* Iteration limit. */
  60     int max_pass_count;         /* Maximum number of passes (-1=unlimited). */
  61     int pass;                   /* Number of passes thru the loop so far. */
  62
  63     /* a=a TO b [BY c]. */
  64     struct variable *index_var; /* Index variable. */
  65     struct expression *first_expr; /* Starting index. */
  66     struct expression *by_expr; /* Index increment (default 1.0 if null). */
  67     struct expression *last_expr; /* Terminal index. */
  68     double cur, by, last;       /* Current value, increment, last value. */
  69
  70     /* IF condition for LOOP or END LOOP. */
  71     struct expression *loop_condition;
  72     struct expression *end_loop_condition;
  73
  74     /* Transformation indexes. */
  75     int past_LOOP_index;        /* Just past LOOP transformation. */
  76     int past_END_LOOP_index;    /* Just past END LOOP transformation. */
  77   };
  78
  79 static struct ctl_class loop_class;
  80
  81 static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
  82 static trns_free_func loop_trns_free;
  83
  84 static struct loop_trns *create_loop_trns (void);
  85 static bool parse_if_clause (struct loop_trns *, struct expression **);
  86 static bool parse_index_clause (struct loop_trns *, char index_var_name[]);
  87 static void close_loop (void *);
  88 \f
  89 /* LOOP. */
  90
  91 /* Parses LOOP. */
  92 int
  93 cmd_loop (void)
  94 {
  95   struct loop_trns *loop;
  96   char index_var_name[LONG_NAME_LEN + 1];
  97   bool ok = true;
  98
  99   loop = create_loop_trns ();
 100   while (token != '.' && ok)
 101     {
 102       if (lex_match_id ("IF"))
 103         ok = parse_if_clause (loop, &loop->loop_condition);
 104       else
 105         ok = parse_index_clause (loop, index_var_name);
 106     }
 107
 108   /* Find index variable and create if necessary. */
 109   if (ok && index_var_name[0] != '\0')
 110     {
 111       loop->index_var = dict_lookup_var (default_dict, index_var_name);
 112       if (loop->index_var == NULL)
 113         loop->index_var = dict_create_var (default_dict, index_var_name, 0);
 114     }
 115
 116   if (!ok)
 117     loop->max_pass_count = 0;
 118   return ok ? CMD_SUCCESS : CMD_PART_SUCCESS;
 119 }
 120
 121 /* Parses END LOOP. */
 122 int
 123 cmd_end_loop (void)
 124 {
 125   struct loop_trns *loop;
 126   bool ok = true;
 127
 128   loop = ctl_stack_top (&loop_class);
 129   if (loop == NULL)
 130     return CMD_CASCADING_FAILURE;
 131
 132   /* Parse syntax. */
 133   if (lex_match_id ("IF"))
 134     ok = parse_if_clause (loop, &loop->end_loop_condition);
 135   if (ok)
 136     ok = lex_end_of_command () == CMD_SUCCESS;
 137
 138   if (!ok)
 139     loop->max_pass_count = 0;
 140
 141   ctl_stack_pop (loop);
 142
 143   return ok ? CMD_SUCCESS : CMD_PART_SUCCESS;
 144 }
 145
 146 /* Parses BREAK. */
 147 int
 148 cmd_break (void)
 149 {
 150   struct ctl_stmt *loop = ctl_stack_search (&loop_class);
 151   if (loop == NULL)
 152     return CMD_CASCADING_FAILURE;
 153
 154   add_transformation (break_trns_proc, NULL, loop);
 155
 156   return lex_end_of_command ();
 157 }
 158
 159 /* Closes a LOOP construct by emitting the END LOOP
 160    transformation and finalizing its members appropriately. */
 161 static void
 162 close_loop (void *loop_)
 163 {
 164   struct loop_trns *loop = loop_;
 165
 166   add_transformation (end_loop_trns_proc, NULL, loop);
 167   loop->past_END_LOOP_index = next_transformation ();
 168
 169   /* If there's nothing else limiting the number of loops, use
 170      MXLOOPS as a limit. */
 171   if (loop->max_pass_count == -1
 172       && loop->index_var == NULL
 173       && loop->loop_condition == NULL
 174       && loop->end_loop_condition == NULL)
 175     loop->max_pass_count = get_mxloops ();
 176 }
 177
 178 /* Parses an IF clause for LOOP or END LOOP and stores the
 179    resulting expression to *CONDITION.
 180    Returns true if successful, false on failure. */
 181 static bool
 182 parse_if_clause (struct loop_trns *loop, struct expression **condition)
 183 {
 184   *condition = expr_parse_pool (loop->pool, default_dict, EXPR_BOOLEAN);
 185   return *condition != NULL;
 186 }
 187
 188 /* Parses an indexing clause into LOOP.
 189    Stores the index variable's name in INDEX_VAR_NAME[].
 190    Returns true if successful, false on failure. */
 191 static bool
 192 parse_index_clause (struct loop_trns *loop, char index_var_name[])
 193 {
 194   if (token != T_ID)
 195     {
 196       lex_error (NULL);
 197       return false;
 198     }
 199   strcpy (index_var_name, tokid);
 200   lex_get ();
 201
 202   if (!lex_force_match ('='))
 203     return false;
 204
 205   loop->first_expr = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER);
 206   if (loop->first_expr == NULL)
 207     return false;
 208
 209   for (;;)
 210     {
 211       struct expression **e;
 212       if (lex_match (T_TO))
 213         e = &loop->last_expr;
 214       else if (lex_match (T_BY))
 215         e = &loop->by_expr;
 216       else
 217         break;
 218
 219       if (*e != NULL)
 220         {
 221           lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
 222           return false;
 223         }
 224       *e = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER);
 225       if (*e == NULL)
 226         return false;
 227     }
 228   if (loop->last_expr == NULL)
 229     {
 230       lex_sbc_missing ("TO");
 231       return false;
 232     }
 233   if (loop->by_expr == NULL)
 234     loop->by = 1.0;
 235
 236   return true;
 237 }
 238
 239 /* Creates, initializes, and returns a new loop_trns. */
 240 static struct loop_trns *
 241 create_loop_trns (void)
 242 {
 243   struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
 244   loop->max_pass_count = -1;
 245   loop->pass = 0;
 246   loop->index_var = NULL;
 247   loop->first_expr = loop->by_expr = loop->last_expr = NULL;
 248   loop->loop_condition = loop->end_loop_condition = NULL;
 249
 250   add_transformation (loop_trns_proc, loop_trns_free, loop);
 251   loop->past_LOOP_index = next_transformation ();
 252
 253   ctl_stack_push (&loop_class, loop);
 254
 255   return loop;
 256 }
 257
 258 /* Sets up LOOP for the first pass. */
 259 static int
 260 loop_trns_proc (void *loop_, struct ccase *c, int case_num)
 261 {
 262   struct loop_trns *loop = loop_;
 263
 264   if (loop->index_var != NULL)
 265     {
 266       /* Evaluate loop index expressions. */
 267       loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
 268       if (loop->by_expr != NULL)
 269         loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
 270       loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
 271
 272       /* Even if the loop is never entered, set the index
 273          variable to the initial value. */
 274       case_data_rw (c, loop->index_var->fv)->f = loop->cur;
 275
 276       /* Throw out pathological cases. */
 277       if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
 278           || loop->by == 0.0
 279           || (loop->by > 0.0 && loop->cur > loop->last)
 280           || (loop->by < 0.0 && loop->cur < loop->last))
 281         goto zero_pass;
 282     }
 283
 284   /* Initialize pass count. */
 285   loop->pass = 0;
 286   if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
 287     goto zero_pass;
 288
 289   /* Check condition. */
 290   if (loop->loop_condition != NULL
 291       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
 292     goto zero_pass;
 293
 294   return loop->past_LOOP_index;
 295
 296  zero_pass:
 297   return loop->past_END_LOOP_index;
 298 }
 299
 300 /* Frees LOOP. */
 301 static bool
 302 loop_trns_free (void *loop_)
 303 {
 304   struct loop_trns *loop = loop_;
 305
 306   pool_destroy (loop->pool);
 307   return true;
 308 }
 309
 310 /* Finishes a pass through the loop and starts the next. */
 311 static int
 312 end_loop_trns_proc (void *loop_, struct ccase *c, int case_num UNUSED)
 313 {
 314   struct loop_trns *loop = loop_;
 315
 316   if (loop->end_loop_condition != NULL
 317       && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 1.0)
 318     goto break_out;
 319
 320   /* MXLOOPS limiter. */
 321   if (loop->max_pass_count >= 0)
 322     {
 323       if (loop->pass >= loop->max_pass_count)
 324         goto break_out;
 325       loop->pass++;
 326     }
 327
 328   /* Indexing clause limiter: counting downward. */
 329   if (loop->index_var != NULL)
 330     {
 331       loop->cur += loop->by;
 332       if ((loop->by > 0.0 && loop->cur > loop->last)
 333           || (loop->by < 0.0 && loop->cur < loop->last))
 334         goto break_out;
 335       case_data_rw (c, loop->index_var->fv)->f = loop->cur;
 336     }
 337
 338   if (loop->loop_condition != NULL
 339       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
 340     goto break_out;
 341
 342   return loop->past_LOOP_index;
 343
 344  break_out:
 345   return loop->past_END_LOOP_index;
 346 }
 347
 348 /* Executes BREAK. */
 349 static int
 350 break_trns_proc (void *loop_, struct ccase *c UNUSED, int case_num UNUSED)
 351 {
 352   struct loop_trns *loop = loop_;
 353
 354   return loop->past_END_LOOP_index;
 355 }
 356
 357 /* LOOP control structure class definition. */
 358 static struct ctl_class loop_class =
 359   {
 360     "LOOP",
 361     "END LOOP",
 362     close_loop,
 363   };