pintos-os.org Git - pspp/blob - src/language/control/loop.c

   1 /* PSPP - a program for statistical analysis.
   2    Copyright (C) 1997-9, 2000, 2009-2011, 2013 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 "language/control/control-stack.h"
  20
  21 #include "data/case.h"
  22 #include "data/dataset.h"
  23 #include "data/dictionary.h"
  24 #include "data/settings.h"
  25 #include "data/transformations.h"
  26 #include "data/variable.h"
  27 #include "language/command.h"
  28 #include "language/expressions/public.h"
  29 #include "language/lexer/lexer.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 "gl/xalloc.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_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
  85 static trns_free_func loop_trns_free;
  86
  87 static struct loop_trns *create_loop_trns (struct dataset *);
  88 static bool parse_if_clause (struct lexer *,
  89                              struct loop_trns *, struct expression **);
  90 static bool parse_index_clause (struct dataset *, struct lexer *,
  91                                 struct loop_trns *, bool *created_index_var);
  92 static void close_loop (void *);
  93 \f
  94 /* LOOP. */
  95
  96 /* Parses LOOP. */
  97 int
  98 cmd_loop (struct lexer *lexer, struct dataset *ds)
  99 {
 100   struct loop_trns *loop;
 101   bool created_index_var = false;
 102   bool ok = true;
 103
 104   loop = create_loop_trns (ds);
 105   while (lex_token (lexer) != T_ENDCMD && ok)
 106     {
 107       if (lex_match_id (lexer, "IF"))
 108         ok = parse_if_clause (lexer, loop, &loop->loop_condition);
 109       else
 110         ok = parse_index_clause (ds, lexer, loop, &created_index_var);
 111     }
 112
 113   /* Clean up if necessary. */
 114   if (!ok)
 115     {
 116       loop->max_pass_count = 0;
 117       if (loop->index_var != NULL && created_index_var)
 118         {
 119           dict_delete_var (dataset_dict (ds), loop->index_var);
 120           loop->index_var = NULL;
 121         }
 122     }
 123
 124   return ok ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
 125 }
 126
 127 /* Parses END LOOP. */
 128 int
 129 cmd_end_loop (struct lexer *lexer, struct dataset *ds)
 130 {
 131   struct loop_trns *loop;
 132   bool ok = true;
 133
 134   loop = ctl_stack_top (&loop_class);
 135   if (loop == NULL)
 136     return CMD_CASCADING_FAILURE;
 137
 138   assert (loop->ds == ds);
 139
 140   /* Parse syntax. */
 141   if (lex_match_id (lexer, "IF"))
 142     ok = parse_if_clause (lexer, loop, &loop->end_loop_condition);
 143   if (ok)
 144     ok = lex_end_of_command (lexer) == CMD_SUCCESS;
 145
 146   if (!ok)
 147     loop->max_pass_count = 0;
 148
 149   ctl_stack_pop (loop);
 150
 151   return ok ? CMD_SUCCESS : CMD_FAILURE;
 152 }
 153
 154 /* Parses BREAK. */
 155 int
 156 cmd_break (struct lexer *lexer UNUSED, struct dataset *ds)
 157 {
 158   struct ctl_stmt *loop = ctl_stack_search (&loop_class);
 159   if (loop == NULL)
 160     return CMD_CASCADING_FAILURE;
 161
 162   add_transformation (ds, break_trns_proc, NULL, loop);
 163
 164   return CMD_SUCCESS;
 165 }
 166
 167 /* Closes a LOOP construct by emitting the END LOOP
 168    transformation and finalizing its members appropriately. */
 169 static void
 170 close_loop (void *loop_)
 171 {
 172   struct loop_trns *loop = loop_;
 173
 174   add_transformation (loop->ds, end_loop_trns_proc, NULL, loop);
 175   loop->past_END_LOOP_index = next_transformation (loop->ds);
 176
 177   /* If there's nothing else limiting the number of loops, use
 178      MXLOOPS as a limit. */
 179   if (loop->max_pass_count == -1
 180       && loop->index_var == NULL
 181       && loop->loop_condition == NULL
 182       && loop->end_loop_condition == NULL)
 183     loop->max_pass_count = settings_get_mxloops ();
 184 }
 185
 186 /* Parses an IF clause for LOOP or END LOOP and stores the
 187    resulting expression to *CONDITION.
 188    Returns true if successful, false on failure. */
 189 static bool
 190 parse_if_clause (struct lexer *lexer,
 191                  struct loop_trns *loop, struct expression **condition)
 192 {
 193   if (*condition != NULL)
 194     {
 195       lex_sbc_only_once ("IF");
 196       return false;
 197     }
 198
 199   *condition = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_BOOLEAN);
 200   return *condition != NULL;
 201 }
 202
 203 /* Parses an indexing clause into LOOP.
 204    Stores true in *CREATED_INDEX_VAR if the index clause created
 205    a new variable, false otherwise.
 206    Returns true if successful, false on failure. */
 207 static bool
 208 parse_index_clause (struct dataset *ds, struct lexer *lexer,
 209                     struct loop_trns *loop, bool *created_index_var)
 210 {
 211   if (loop->index_var != NULL)
 212     {
 213       msg (SE, _("Only one index clause may be specified."));
 214       return false;
 215     }
 216
 217   if (lex_token (lexer) != T_ID)
 218     {
 219       lex_error (lexer, NULL);
 220       return false;
 221     }
 222
 223   loop->index_var = dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer));
 224   if (loop->index_var != NULL)
 225     *created_index_var = false;
 226   else
 227     {
 228       loop->index_var = dict_create_var_assert (dataset_dict (ds),
 229                                                 lex_tokcstr (lexer), 0);
 230       *created_index_var = true;
 231     }
 232   lex_get (lexer);
 233
 234   if (!lex_force_match (lexer, T_EQUALS))
 235     return false;
 236
 237   loop->first_expr = expr_parse_pool (lexer, loop->pool,
 238                                       loop->ds, EXPR_NUMBER);
 239   if (loop->first_expr == NULL)
 240     return false;
 241
 242   for (;;)
 243     {
 244       struct expression **e;
 245       if (lex_match (lexer, T_TO))
 246         e = &loop->last_expr;
 247       else if (lex_match (lexer, T_BY))
 248         e = &loop->by_expr;
 249       else
 250         break;
 251
 252       if (*e != NULL)
 253         {
 254           lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
 255           return false;
 256         }
 257       *e = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_NUMBER);
 258       if (*e == NULL)
 259         return false;
 260     }
 261   if (loop->last_expr == NULL)
 262     {
 263       lex_sbc_missing ("TO");
 264       return false;
 265     }
 266   if (loop->by_expr == NULL)
 267     loop->by = 1.0;
 268
 269   return true;
 270 }
 271
 272 /* Creates, initializes, and returns a new loop_trns. */
 273 static struct loop_trns *
 274 create_loop_trns (struct dataset *ds)
 275 {
 276   struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
 277   loop->max_pass_count = -1;
 278   loop->pass = 0;
 279   loop->index_var = NULL;
 280   loop->first_expr = loop->by_expr = loop->last_expr = NULL;
 281   loop->loop_condition = loop->end_loop_condition = NULL;
 282   loop->ds = ds;
 283
 284   add_transformation (ds, 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 /* Sets up LOOP for the first pass. */
 293 static int
 294 loop_trns_proc (void *loop_, struct ccase **c, casenumber case_num)
 295 {
 296   struct loop_trns *loop = loop_;
 297
 298   if (loop->index_var != NULL)
 299     {
 300       /* Evaluate loop index expressions. */
 301       loop->cur = expr_evaluate_num (loop->first_expr, *c, case_num);
 302       if (loop->by_expr != NULL)
 303         loop->by = expr_evaluate_num (loop->by_expr, *c, case_num);
 304       loop->last = expr_evaluate_num (loop->last_expr, *c, case_num);
 305
 306       /* Even if the loop is never entered, set the index
 307          variable to the initial value. */
 308       *c = case_unshare (*c);
 309       case_data_rw (*c, loop->index_var)->f = loop->cur;
 310
 311       /* Throw out pathological cases. */
 312       if (!isfinite (loop->cur) || !isfinite (loop->by)
 313           || !isfinite (loop->last)
 314           || loop->by == 0.0
 315           || (loop->by > 0.0 && loop->cur > loop->last)
 316           || (loop->by < 0.0 && loop->cur < loop->last))
 317         goto zero_pass;
 318     }
 319
 320   /* Initialize pass count. */
 321   loop->pass = 0;
 322   if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
 323     goto zero_pass;
 324
 325   /* Check condition. */
 326   if (loop->loop_condition != NULL
 327       && expr_evaluate_num (loop->loop_condition, *c, case_num) != 1.0)
 328     goto zero_pass;
 329
 330   return loop->past_LOOP_index;
 331
 332  zero_pass:
 333   return loop->past_END_LOOP_index;
 334 }
 335
 336 /* Frees LOOP. */
 337 static bool
 338 loop_trns_free (void *loop_)
 339 {
 340   struct loop_trns *loop = loop_;
 341
 342   pool_destroy (loop->pool);
 343   return true;
 344 }
 345
 346 /* Finishes a pass through the loop and starts the next. */
 347 static int
 348 end_loop_trns_proc (void *loop_, struct ccase **c, casenumber case_num UNUSED)
 349 {
 350   struct loop_trns *loop = loop_;
 351
 352   if (loop->end_loop_condition != NULL
 353       && expr_evaluate_num (loop->end_loop_condition, *c, case_num) != 0.0)
 354     goto break_out;
 355
 356   /* MXLOOPS limiter. */
 357   if (loop->max_pass_count >= 0 && ++loop->pass >= loop->max_pass_count)
 358     goto break_out;
 359
 360   /* Indexing clause limiter: counting downward. */
 361   if (loop->index_var != NULL)
 362     {
 363       loop->cur += loop->by;
 364       if ((loop->by > 0.0 && loop->cur > loop->last)
 365           || (loop->by < 0.0 && loop->cur < loop->last))
 366         goto break_out;
 367       *c = case_unshare (*c);
 368       case_data_rw (*c, loop->index_var)->f = loop->cur;
 369     }
 370
 371   if (loop->loop_condition != NULL
 372       && expr_evaluate_num (loop->loop_condition, *c, case_num) != 1.0)
 373     goto break_out;
 374
 375   return loop->past_LOOP_index;
 376
 377  break_out:
 378   return loop->past_END_LOOP_index;
 379 }
 380
 381 /* Executes BREAK. */
 382 static int
 383 break_trns_proc (void *loop_, struct ccase **c UNUSED,
 384                  casenumber case_num UNUSED)
 385 {
 386   struct loop_trns *loop = loop_;
 387
 388   return loop->past_END_LOOP_index;
 389 }
 390
 391 /* LOOP control structure class definition. */
 392 static const struct ctl_class loop_class =
 393   {
 394     "LOOP",
 395     "END LOOP",
 396     close_loop,
 397   };