src/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 "error.h"
  22 #include "alloc.h"
  23 #include "case.h"
  24 #include "command.h"
  25 #include "dictionary.h"
  26 #include "do-ifP.h"
  27 #include "error.h"
  28 #include "expressions/public.h"
  29 #include "lexer.h"
  30 #include "misc.h"
  31 #include "settings.h"
  32 #include "str.h"
  33 #include "var.h"
  34
  35 #include "gettext.h"
  36 #define _(msgid) gettext (msgid)
  37
  38 #include "debug-print.h"
  39
  40 /* LOOP strategy:
  41
  42    Each loop causes 3 different transformations to be output.  The
  43    first two are output when the LOOP command is encountered; the last
  44    is output when the END LOOP command is encountered.
  45
  46    The first to be output resets the pass number in the second
  47    transformation to -1.  This ensures that the pass number is set to
  48    -1 every time the loop is encountered, before the first iteration.
  49
  50    The second transformation increments the pass number.  If
  51    there is no indexing or test clause on either LOOP or END
  52    LOOP, then the pass number is checked against MXLOOPS and
  53    control may pass out of the loop.  Otherwise the indexing or
  54    test clause(s) on LOOP are checked, and again control may pass
  55    out of the loop.
  56
  57    After the second transformation the body of the loop is
  58    executed.
  59
  60    The last transformation checks the test clause if present and
  61    either jumps back up to the second transformation or
  62    terminates the loop.
  63
  64    Flow of control:
  65
  66    1. LOOP.  Sets pass number to -1 and continues to next
  67       transformation.
  68
  69    2. LOOP.  Increments pass number.  Tests optional indexing
  70       clause and optional IF clause.  If we're done with the
  71       loop, we jump to the transformation just after LOOP
  72       transformation 3.
  73
  74       Otherwise, we continue through the transformations in the
  75       loop body.
  76
  77    3. END LOOP.  We test the optional IF clause.  If we need to
  78       make another pass through the loop, we jump to LOOP
  79       transformation 2.
  80
  81       Otherwise, we continue with the transformation jump after
  82       the loop.
  83  */
  84
  85 /* Types of limits on loop execution. */
  86 enum
  87   {
  88     LPC_INDEX = 001,            /* Limited by indexing clause. */
  89     LPC_COND = 002,             /* Limited by IF clause. */
  90     LPC_RINDEX = 004            /* Indexing clause counts downward, at least
  91                                    for this pass thru the loop. */
  92   };
  93
  94 /* LOOP transformation 1. */
  95 struct loop_1_trns
  96   {
  97     struct trns_header h;
  98
  99     struct loop_2_trns *two;    /* Allows modification of associated
 100                                    second transformation. */
 101
 102     struct expression *init;    /* Starting index. */
 103     struct expression *incr;    /* Index increment. */
 104     struct expression *term;    /* Terminal index. */
 105   };
 106
 107 /* LOOP transformation 2. */
 108 struct loop_2_trns
 109   {
 110     struct trns_header h;
 111
 112     struct ctl_stmt ctl;        /* Nesting control info. */
 113
 114     int flags;                  /* Types of limits on loop execution. */
 115     int pass;                   /* Number of passes thru the loop so far. */
 116
 117     struct variable *index;     /* Index variable. */
 118     double curr;                /* Current index. */
 119     double incr;                /* Increment. */
 120     double term;                /* Terminal index. */
 121
 122     struct expression *cond;    /* Optional IF condition when non-NULL. */
 123
 124     int loop_term;              /* 1+(t_trns[] index of transformation 3);
 125                                    backpatched in by END LOOP. */
 126   };
 127
 128 /* LOOP transformation 3.  (Actually output by END LOOP.)  */
 129 struct loop_3_trns
 130   {
 131     struct trns_header h;
 132
 133     struct expression *cond;    /* Optional IF condition when non-NULL. */
 134
 135     int loop_start;             /* t_trns[] index of transformation 2. */
 136   };
 137
 138 /* LOOP transformations being created. */
 139 static struct loop_1_trns *one;
 140 static struct loop_2_trns *two;
 141 static struct loop_3_trns *thr;
 142
 143 static int internal_cmd_loop (void);
 144 static int internal_cmd_end_loop (void);
 145 static trns_proc_func break_trns_proc;
 146 static trns_proc_func loop_1_trns_proc, loop_2_trns_proc, loop_3_trns_proc;
 147 static trns_free_func loop_1_trns_free, loop_2_trns_free, loop_3_trns_free;
 148 static void pop_ctl_stack (void);
 149 \f
 150 /* LOOP. */
 151
 152 /* Parses a LOOP command.  Passes the real work off to
 153    internal_cmd_loop(). */
 154 int
 155 cmd_loop (void)
 156 {
 157   if (!internal_cmd_loop ())
 158     {
 159       loop_1_trns_free ((struct trns_header *) one);
 160       loop_2_trns_free ((struct trns_header *) two);
 161       return CMD_FAILURE;
 162     }
 163
 164   return CMD_SUCCESS;
 165 }
 166
 167 /* Parses a LOOP command, returns success. */
 168 static int
 169 internal_cmd_loop (void)
 170 {
 171   /* Name of indexing variable if applicable. */
 172   char name[LONG_NAME_LEN + 1];
 173
 174   /* Create and initialize transformations to facilitate
 175      error-handling. */
 176   two = xmalloc (sizeof *two);
 177   two->h.proc = loop_2_trns_proc;
 178   two->h.free = loop_2_trns_free;
 179   two->cond = NULL;
 180   two->flags = 0;
 181
 182   one = xmalloc (sizeof *one);
 183   one->h.proc = loop_1_trns_proc;
 184   one->h.free = loop_1_trns_free;
 185   one->init = one->incr = one->term = NULL;
 186   one->two = two;
 187
 188   /* Parse indexing clause. */
 189   if (token == T_ID && lex_look_ahead () == '=')
 190     {
 191       struct variable *v = dict_lookup_var (default_dict, tokid);
 192
 193       two->flags |= LPC_INDEX;
 194
 195       if (v && v->type == ALPHA)
 196         {
 197           msg (SE, _("The index variable may not be a string variable."));
 198           return 0;
 199         }
 200       strcpy (name, tokid);
 201
 202       lex_get ();
 203       assert (token == '=');
 204       lex_get ();
 205
 206       one->init = expr_parse (default_dict, EXPR_NUMBER);
 207       if (!one->init)
 208         return 0;
 209
 210       if (!lex_force_match (T_TO))
 211         {
 212           expr_free (one->init);
 213           return 0;
 214         }
 215       one->term = expr_parse (default_dict, EXPR_NUMBER);
 216       if (!one->term)
 217         {
 218           expr_free (one->init);
 219           return 0;
 220         }
 221
 222       if (lex_match (T_BY))
 223         {
 224           one->incr = expr_parse (default_dict, EXPR_NUMBER);
 225           if (!one->incr)
 226             return 0;
 227         }
 228     }
 229   else
 230     name[0] = '\0';
 231
 232   /* Parse IF clause. */
 233   if (lex_match_id ("IF"))
 234     {
 235       two->flags |= LPC_COND;
 236
 237       two->cond = expr_parse (default_dict, EXPR_BOOLEAN);
 238       if (!two->cond)
 239         return 0;
 240     }
 241
 242   if (token != '.')
 243     {
 244       lex_error (_("expecting end of command"));
 245       return 0;
 246     }
 247
 248   /* Find variable; create if necessary. */
 249   if (name[0] != '\0')
 250     {
 251       two->index = dict_lookup_var (default_dict, name);
 252       if (!two->index)
 253         two->index = dict_create_var (default_dict, name, 0);
 254     }
 255
 256   /* Push on control stack. */
 257   two->ctl.down = ctl_stack;
 258   two->ctl.type = CST_LOOP;
 259   two->ctl.trns = (struct trns_header *) two;
 260   two->ctl.brk = NULL;
 261   ctl_stack = &two->ctl;
 262
 263   /* Dump out the transformations. */
 264   add_transformation ((struct trns_header *) one);
 265   add_transformation ((struct trns_header *) two);
 266
 267   return 1;
 268 }
 269
 270 /* Parses the END LOOP command by passing the buck off to
 271    cmd_internal_end_loop(). */
 272 int
 273 cmd_end_loop (void)
 274 {
 275   if (!internal_cmd_end_loop ())
 276     {
 277       loop_3_trns_free ((struct trns_header *) thr);
 278       if (ctl_stack && ctl_stack->type == CST_LOOP)
 279         pop_ctl_stack ();
 280       return CMD_FAILURE;
 281     }
 282
 283   return CMD_SUCCESS;
 284 }
 285
 286 /* Parses the END LOOP command. */
 287 int
 288 internal_cmd_end_loop (void)
 289 {
 290   /* Backpatch pointer for BREAK commands. */
 291   struct break_trns *brk;
 292
 293   /* Allocate, initialize transformation to facilitate
 294      error-handling. */
 295   thr = xmalloc (sizeof *thr);
 296   thr->h.proc = loop_3_trns_proc;
 297   thr->h.free = loop_3_trns_free;
 298   thr->cond = NULL;
 299
 300   /* There must be a matching LOOP command. */
 301   if (!ctl_stack || ctl_stack->type != CST_LOOP)
 302     {
 303       msg (SE, _("There is no LOOP command that corresponds to this "
 304                  "END LOOP."));
 305       return 0;
 306     }
 307   thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
 308
 309   /* Parse the expression if any. */
 310   if (lex_match_id ("IF"))
 311     {
 312       thr->cond = expr_parse (default_dict, EXPR_BOOLEAN);
 313       if (!thr->cond)
 314         return 0;
 315     }
 316
 317   add_transformation ((struct trns_header *) thr);
 318
 319   /* Backpatch. */
 320   ((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns;
 321   for (brk = ctl_stack->brk; brk; brk = brk->next)
 322     brk->loop_term = n_trns;
 323
 324   /* Pop off the top of stack. */
 325   ctl_stack = ctl_stack->down;
 326
 327   return 1;
 328 }
 329
 330 /* Performs transformation 1. */
 331 static int
 332 loop_1_trns_proc (struct trns_header * trns, struct ccase * c,
 333                   int case_num)
 334 {
 335   struct loop_1_trns *one = (struct loop_1_trns *) trns;
 336   struct loop_2_trns *two = one->two;
 337
 338   two->pass = -1;
 339   if (two->flags & LPC_INDEX)
 340     {
 341       double t1, t2, t3;
 342
 343       t1 = expr_evaluate_num (one->init, c, case_num);
 344       if (one->incr)
 345         t2 = expr_evaluate_num (one->incr, c, case_num);
 346       else
 347         t2 = 1.0;
 348       t3 = expr_evaluate_num (one->term, c, case_num);
 349
 350       /* Even if the loop is never entered, force the index variable
 351          to assume the initial value. */
 352       case_data_rw (c, two->index->fv)->f = t1;
 353
 354       /* Throw out various pathological cases. */
 355       if (!finite (t1) || !finite (t2) || !finite (t3) || t2 == 0.0)
 356         return two->loop_term;
 357       debug_printf (("LOOP %s=%g TO %g BY %g.\n", two->index->name,
 358                      t1, t3, t2));
 359       if (t2 > 0.0)
 360         {
 361           /* Loop counts upward: I=1 TO 5 BY 1. */
 362           two->flags &= ~LPC_RINDEX;
 363
 364           /* incr>0 but init>term */
 365           if (t1 > t3)
 366             return two->loop_term;
 367         }
 368       else
 369         {
 370           /* Loop counts downward: I=5 TO 1 BY -1. */
 371           two->flags |= LPC_RINDEX;
 372
 373           /* incr<0 but init<term */
 374           if (t1 < t3)
 375             return two->loop_term;
 376         }
 377
 378       two->curr = t1;
 379       two->incr = t2;
 380       two->term = t3;
 381     }
 382
 383   return -1;
 384 }
 385
 386 /* Frees transformation 1. */
 387 static void
 388 loop_1_trns_free (struct trns_header * trns)
 389 {
 390   struct loop_1_trns *one = (struct loop_1_trns *) trns;
 391
 392   expr_free (one->init);
 393   expr_free (one->incr);
 394   expr_free (one->term);
 395 }
 396
 397 /* Performs transformation 2. */
 398 static int
 399 loop_2_trns_proc (struct trns_header * trns, struct ccase * c,
 400                   int case_num UNUSED)
 401 {
 402   struct loop_2_trns *two = (struct loop_2_trns *) trns;
 403
 404   /* MXLOOPS limiter. */
 405   if (two->flags == 0)
 406     {
 407       two->pass++;
 408       if (two->pass > get_mxloops() )
 409          return two->loop_term;
 410     }
 411
 412   /* Indexing clause limiter: counting downward. */
 413   if (two->flags & LPC_RINDEX)
 414     {
 415       /* Test if we're at the end of the looping. */
 416       if (two->curr < two->term)
 417         return two->loop_term;
 418
 419       /* Set the current value into the case. */
 420       case_data_rw (c, two->index->fv)->f = two->curr;
 421
 422       /* Decrement the current value. */
 423       two->curr += two->incr;
 424     }
 425   /* Indexing clause limiter: counting upward. */
 426   else if (two->flags & LPC_INDEX)
 427     {
 428       /* Test if we're at the end of the looping. */
 429       if (two->curr > two->term)
 430         return two->loop_term;
 431
 432       /* Set the current value into the case. */
 433       case_data_rw (c, two->index->fv)->f = two->curr;
 434
 435       /* Increment the current value. */
 436       two->curr += two->incr;
 437     }
 438
 439   /* Conditional clause limiter. */
 440   if ((two->flags & LPC_COND)
 441       && expr_evaluate_num (two->cond, c, case_num) != 1.0)
 442     return two->loop_term;
 443
 444   return -1;
 445 }
 446
 447 /* Frees transformation 2. */
 448 static void
 449 loop_2_trns_free (struct trns_header * trns)
 450 {
 451   struct loop_2_trns *two = (struct loop_2_trns *) trns;
 452
 453   expr_free (two->cond);
 454 }
 455
 456 /* Performs transformation 3. */
 457 static int
 458 loop_3_trns_proc (struct trns_header * trns, struct ccase * c,
 459                   int case_num)
 460 {
 461   struct loop_3_trns *thr = (struct loop_3_trns *) trns;
 462
 463   /* Note that it breaks out of the loop if the expression is true *or
 464      missing*.  This is conformant. */
 465   if (thr->cond && expr_evaluate_num (two->cond, c, case_num) != 0.0)
 466     return -1;
 467
 468   return thr->loop_start;
 469 }
 470
 471 /* Frees transformation 3. */
 472 static void
 473 loop_3_trns_free (struct trns_header * trns)
 474 {
 475   struct loop_3_trns *thr = (struct loop_3_trns *) trns;
 476
 477   expr_free (thr->cond);
 478 }
 479 \f
 480 /* BREAK. */
 481
 482 /* Parses the BREAK command. */
 483 int
 484 cmd_break (void)
 485 {
 486   /* Climbs down the stack to find a LOOP. */
 487   struct ctl_stmt *loop;
 488
 489   /* New transformation. */
 490   struct break_trns *t;
 491
 492   for (loop = ctl_stack; loop; loop = loop->down)
 493     if (loop->type == CST_LOOP)
 494       break;
 495   if (!loop)
 496     {
 497       msg (SE, _("This command may only appear enclosed in a LOOP/"
 498                  "END LOOP control structure."));
 499       return CMD_FAILURE;
 500     }
 501
 502   if (ctl_stack->type != CST_DO_IF)
 503     msg (SW, _("BREAK not enclosed in DO IF structure."));
 504
 505   t = xmalloc (sizeof *t);
 506   t->h.proc = break_trns_proc;
 507   t->h.free = NULL;
 508   t->next = loop->brk;
 509   loop->brk = t;
 510   add_transformation ((struct trns_header *) t);
 511
 512   return lex_end_of_command ();
 513 }
 514
 515 static int
 516 break_trns_proc (struct trns_header * trns, struct ccase * c UNUSED,
 517                  int case_num UNUSED)
 518 {
 519   return ((struct break_trns *) trns)->loop_term;
 520 }
 521 \f
 522 /* Control stack operations. */
 523
 524 /* Pops the top of stack element off of ctl_stack.  Does not
 525    check that ctl_stack is indeed non-NULL. */
 526 static void
 527 pop_ctl_stack (void)
 528 {
 529   switch (ctl_stack->type)
 530     {
 531     case CST_LOOP:
 532       {
 533         /* Pointer for chasing down and backpatching BREAKs. */
 534         struct break_trns *brk;
 535
 536         /* Terminate the loop. */
 537         thr = xmalloc (sizeof *thr);
 538         thr->h.proc = loop_3_trns_proc;
 539         thr->h.free = loop_3_trns_free;
 540         thr->cond = NULL;
 541         thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
 542         add_transformation ((struct trns_header *) thr);
 543
 544         /* Backpatch. */
 545         ((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns;
 546         for (brk = ctl_stack->brk; brk; brk = brk->next)
 547           brk->loop_term = n_trns;
 548       }
 549       break;
 550     case CST_DO_IF:
 551       {
 552         /* List iterator. */
 553         struct do_if_trns *iter;
 554
 555         iter = ((struct do_if_trns *) ctl_stack->trns);
 556         for (;;)
 557           {
 558             if (iter->brk)
 559               iter->brk->dest = n_trns;
 560             iter->missing_jump = n_trns;
 561             if (iter->next)
 562               iter = iter->next;
 563             else
 564               break;
 565           }
 566         iter->false_jump = n_trns;
 567       }
 568       break;
 569     default:
 570       assert (0);
 571     }
 572   ctl_stack = ctl_stack->down;
 573 }
 574
 575 /* Checks for unclosed LOOPs and DO IFs and closes them out. */
 576 void
 577 discard_ctl_stack (void)
 578 {
 579   if (!ctl_stack)
 580     return;
 581   msg (SE, _("%s without %s."), ctl_stack->type == CST_LOOP ? "LOOP" : "DO IF",
 582        ctl_stack->type == CST_LOOP ? "END LOOP" : "END IF");
 583   while (ctl_stack)
 584     pop_ctl_stack ();
 585   ctl_stack = NULL;
 586 }