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