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