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