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 int break_trns_proc (struct trns_header *, struct ccase *);
 144 static int loop_1_trns_proc (struct trns_header *, struct ccase *);
 145 static void loop_1_trns_free (struct trns_header *);
 146 static int loop_2_trns_proc (struct trns_header *, struct ccase *);
 147 static void loop_2_trns_free (struct trns_header *);
 148 static int loop_3_trns_proc (struct trns_header *, struct ccase *);
 149 static void loop_3_trns_free (struct trns_header *);
 150 static void pop_ctl_stack (void);
 151 \f
 152 /* LOOP. */
 153
 154 /* Parses a LOOP command.  Passes the real work off to
 155    internal_cmd_loop(). */
 156 int
 157 cmd_loop (void)
 158 {
 159   if (!internal_cmd_loop ())
 160     {
 161       loop_1_trns_free ((struct trns_header *) one);
 162       loop_2_trns_free ((struct trns_header *) two);
 163       return CMD_FAILURE;
 164     }
 165
 166   return CMD_SUCCESS;
 167 }
 168
 169 /* Parses a LOOP command, returns success. */
 170 static int
 171 internal_cmd_loop (void)
 172 {
 173   /* Name of indexing variable if applicable. */
 174   char name[9];
 175
 176   lex_match_id ("LOOP");
 177
 178   /* Create and initialize transformations to facilitate
 179      error-handling. */
 180   two = xmalloc (sizeof *two);
 181   two->h.proc = loop_2_trns_proc;
 182   two->h.free = loop_2_trns_free;
 183   two->cond = NULL;
 184   two->flags = 0;
 185
 186   one = xmalloc (sizeof *one);
 187   one->h.proc = loop_1_trns_proc;
 188   one->h.free = loop_1_trns_free;
 189   one->init = one->incr = one->term = NULL;
 190   one->two = two;
 191
 192   /* Parse indexing clause. */
 193   if (token == T_ID && lex_look_ahead () == '=')
 194     {
 195       struct variable *v = dict_lookup_var (default_dict, tokid);
 196
 197       two->flags |= LPC_INDEX;
 198
 199       if (v && v->type == ALPHA)
 200         {
 201           msg (SE, _("The index variable may not be a string variable."));
 202           return 0;
 203         }
 204       strcpy (name, tokid);
 205
 206       lex_get ();
 207       assert (token == '=');
 208       lex_get ();
 209
 210       one->init = expr_parse (PXP_NUMERIC);
 211       if (!one->init)
 212         return 0;
 213
 214       if (!lex_force_match (T_TO))
 215         {
 216           expr_free (one->init);
 217           return 0;
 218         }
 219       one->term = expr_parse (PXP_NUMERIC);
 220       if (!one->term)
 221         {
 222           expr_free (one->init);
 223           return 0;
 224         }
 225
 226       if (lex_match (T_BY))
 227         {
 228           one->incr = expr_parse (PXP_NUMERIC);
 229           if (!one->incr)
 230             return 0;
 231         }
 232     }
 233   else
 234     name[0] = 0;
 235
 236   /* Parse IF clause. */
 237   if (lex_match_id ("IF"))
 238     {
 239       two->flags |= LPC_COND;
 240
 241       two->cond = expr_parse (PXP_BOOLEAN);
 242       if (!two->cond)
 243         return 0;
 244     }
 245
 246   if (token != '.')
 247     {
 248       lex_error (_("expecting end of command"));
 249       return 0;
 250     }
 251
 252   /* Find variable; create if necessary. */
 253   if (name[0])
 254     {
 255       two->index = dict_lookup_var (default_dict, name);
 256       if (!two->index)
 257         two->index = dict_create_var (default_dict, name, 0);
 258     }
 259
 260   /* Push on control stack. */
 261   two->ctl.down = ctl_stack;
 262   two->ctl.type = CST_LOOP;
 263   two->ctl.trns = (struct trns_header *) two;
 264   two->ctl.brk = NULL;
 265   ctl_stack = &two->ctl;
 266
 267   /* Dump out the transformations. */
 268   add_transformation ((struct trns_header *) one);
 269   add_transformation ((struct trns_header *) two);
 270
 271 #if DEBUGGING
 272   printf ("LOOP");
 273   if (two->flags & LPC_INDEX)
 274     printf ("(INDEX)");
 275   if (two->flags & LPC_COND)
 276     printf ("(IF)");
 277   printf ("\n");
 278 #endif
 279
 280   return 1;
 281 }
 282
 283 /* Parses the END LOOP command by passing the buck off to
 284    cmd_internal_end_loop(). */
 285 int
 286 cmd_end_loop (void)
 287 {
 288   if (!internal_cmd_end_loop ())
 289     {
 290       loop_3_trns_free ((struct trns_header *) thr);
 291       if (ctl_stack && ctl_stack->type == CST_LOOP)
 292         pop_ctl_stack ();
 293       return CMD_FAILURE;
 294     }
 295
 296   return CMD_SUCCESS;
 297 }
 298
 299 /* Parses the END LOOP command. */
 300 int
 301 internal_cmd_end_loop (void)
 302 {
 303   /* Backpatch pointer for BREAK commands. */
 304   struct break_trns *brk;
 305
 306   /* Allocate, initialize transformation to facilitate
 307      error-handling. */
 308   thr = xmalloc (sizeof *thr);
 309   thr->h.proc = loop_3_trns_proc;
 310   thr->h.free = loop_3_trns_free;
 311   thr->cond = NULL;
 312
 313   /* There must be a matching LOOP command. */
 314   if (!ctl_stack || ctl_stack->type != CST_LOOP)
 315     {
 316       msg (SE, _("There is no LOOP command that corresponds to this "
 317                  "END LOOP."));
 318       return 0;
 319     }
 320   thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
 321
 322   /* Parse the expression if any. */
 323   if (lex_match_id ("IF"))
 324     {
 325       thr->cond = expr_parse (PXP_BOOLEAN);
 326       if (!thr->cond)
 327         return 0;
 328     }
 329
 330   add_transformation ((struct trns_header *) thr);
 331
 332   /* Backpatch. */
 333   ((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns;
 334   for (brk = ctl_stack->brk; brk; brk = brk->next)
 335     brk->loop_term = n_trns;
 336
 337   /* Pop off the top of stack. */
 338   ctl_stack = ctl_stack->down;
 339
 340 #if DEBUGGING
 341   printf ("END LOOP");
 342   if (thr->cond)
 343     printf ("(IF)");
 344   printf ("\n");
 345 #endif
 346
 347   return 1;
 348 }
 349
 350 /* Performs transformation 1. */
 351 static int
 352 loop_1_trns_proc (struct trns_header * trns, struct ccase * c)
 353 {
 354   struct loop_1_trns *one = (struct loop_1_trns *) trns;
 355   struct loop_2_trns *two = one->two;
 356
 357   two->pass = -1;
 358   if (two->flags & LPC_INDEX)
 359     {
 360       union value t1, t2, t3;
 361
 362       expr_evaluate (one->init, c, &t1);
 363       if (one->incr)
 364         expr_evaluate (one->incr, c, &t2);
 365       else
 366         t2.f = 1.0;
 367       expr_evaluate (one->term, c, &t3);
 368
 369       /* Even if the loop is never entered, force the index variable
 370          to assume the initial value. */
 371       c->data[two->index->fv].f = t1.f;
 372
 373       /* Throw out various pathological cases. */
 374       if (!finite (t1.f) || !finite (t2.f) || !finite (t3.f) || t2.f == 0.0)
 375         return two->loop_term;
 376       debug_printf (("LOOP %s=%g TO %g BY %g.\n", two->index->name,
 377                      t1.f, t3.f, t2.f));
 378       if (t2.f > 0.0)
 379         {
 380           /* Loop counts upward: I=1 TO 5 BY 1. */
 381           two->flags &= ~LPC_RINDEX;
 382
 383           /* incr>0 but init>term */
 384           if (t1.f > t3.f)
 385             return two->loop_term;
 386         }
 387       else
 388         {
 389           /* Loop counts downward: I=5 TO 1 BY -1. */
 390           two->flags |= LPC_RINDEX;
 391
 392           /* incr<0 but init<term */
 393           if (t1.f < t3.f)
 394             return two->loop_term;
 395         }
 396
 397       two->curr = t1.f;
 398       two->incr = t2.f;
 399       two->term = t3.f;
 400     }
 401
 402   return -1;
 403 }
 404
 405 /* Frees transformation 1. */
 406 static void
 407 loop_1_trns_free (struct trns_header * trns)
 408 {
 409   struct loop_1_trns *one = (struct loop_1_trns *) trns;
 410
 411   expr_free (one->init);
 412   expr_free (one->incr);
 413   expr_free (one->term);
 414 }
 415
 416 /* Performs transformation 2. */
 417 static int
 418 loop_2_trns_proc (struct trns_header * trns, struct ccase * c)
 419 {
 420   struct loop_2_trns *two = (struct loop_2_trns *) trns;
 421
 422   /* MXLOOPS limiter. */
 423   if (two->flags == 0)
 424     {
 425       two->pass++;
 426       if (two->pass > set_mxloops)
 427          return two->loop_term;
 428     }
 429
 430   /* Indexing clause limiter: counting downward. */
 431   if (two->flags & LPC_RINDEX)
 432     {
 433       /* Test if we're at the end of the looping. */
 434       if (two->curr < two->term)
 435         return two->loop_term;
 436
 437       /* Set the current value into the case. */
 438       c->data[two->index->fv].f = two->curr;
 439
 440       /* Decrement the current value. */
 441       two->curr += two->incr;
 442     }
 443   /* Indexing clause limiter: counting upward. */
 444   else if (two->flags & LPC_INDEX)
 445     {
 446       /* Test if we're at the end of the looping. */
 447       if (two->curr > two->term)
 448         return two->loop_term;
 449
 450       /* Set the current value into the case. */
 451       c->data[two->index->fv].f = two->curr;
 452
 453       /* Increment the current value. */
 454       two->curr += two->incr;
 455     }
 456
 457   /* Conditional clause limiter. */
 458   if ((two->flags & LPC_COND)
 459       && expr_evaluate (two->cond, c, NULL) != 1.0)
 460     return two->loop_term;
 461
 462   return -1;
 463 }
 464
 465 /* Frees transformation 2. */
 466 static void
 467 loop_2_trns_free (struct trns_header * trns)
 468 {
 469   struct loop_2_trns *two = (struct loop_2_trns *) trns;
 470
 471   expr_free (two->cond);
 472 }
 473
 474 /* Performs transformation 3. */
 475 static int
 476 loop_3_trns_proc (struct trns_header * trns, struct ccase * c)
 477 {
 478   struct loop_3_trns *thr = (struct loop_3_trns *) trns;
 479
 480   /* Note that it breaks out of the loop if the expression is true *or
 481      missing*.  This is conformant. */
 482   if (thr->cond && expr_evaluate (two->cond, c, NULL) != 0.0)
 483     return -1;
 484
 485   return thr->loop_start;
 486 }
 487
 488 /* Frees transformation 3. */
 489 static void
 490 loop_3_trns_free (struct trns_header * trns)
 491 {
 492   struct loop_3_trns *thr = (struct loop_3_trns *) trns;
 493
 494   expr_free (thr->cond);
 495 }
 496 \f
 497 /* BREAK. */
 498
 499 /* Parses the BREAK command. */
 500 int
 501 cmd_break (void)
 502 {
 503   /* Climbs down the stack to find a LOOP. */
 504   struct ctl_stmt *loop;
 505
 506   /* New transformation. */
 507   struct break_trns *t;
 508
 509   lex_match_id ("BREAK");
 510
 511   for (loop = ctl_stack; loop; loop = loop->down)
 512     if (loop->type == CST_LOOP)
 513       break;
 514   if (!loop)
 515     {
 516       msg (SE, _("This command may only appear enclosed in a LOOP/"
 517                  "END LOOP control structure."));
 518       return CMD_FAILURE;
 519     }
 520
 521   if (ctl_stack->type != CST_DO_IF)
 522     msg (SW, _("BREAK not enclosed in DO IF structure."));
 523
 524   t = xmalloc (sizeof *t);
 525   t->h.proc = break_trns_proc;
 526   t->h.free = NULL;
 527   t->next = loop->brk;
 528   loop->brk = t;
 529   add_transformation ((struct trns_header *) t);
 530
 531   return lex_end_of_command ();
 532 }
 533
 534 static int
 535 break_trns_proc (struct trns_header * trns, struct ccase * c 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 }