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