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 "approx.h"
  24 #include "command.h"
  25 #include "do-ifP.h"
  26 #include "error.h"
  27 #include "expr.h"
  28 #include "lexer.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 = find_variable (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 = find_variable (name);
 256       if (!two->index)
 257         {
 258           two->index = force_create_variable (&default_dict, name, NUMERIC, 0);
 259 #if DEBUGGING
 260           envector (two->index);
 261 #endif
 262         }
 263     }
 264
 265   /* Push on control stack. */
 266   two->ctl.down = ctl_stack;
 267   two->ctl.type = CST_LOOP;
 268   two->ctl.trns = (struct trns_header *) two;
 269   two->ctl.brk = NULL;
 270   ctl_stack = &two->ctl;
 271
 272   /* Dump out the transformations. */
 273   add_transformation ((struct trns_header *) one);
 274   add_transformation ((struct trns_header *) two);
 275
 276 #if DEBUGGING
 277   printf ("LOOP");
 278   if (two->flags & LPC_INDEX)
 279     printf ("(INDEX)");
 280   if (two->flags & LPC_COND)
 281     printf ("(IF)");
 282   printf ("\n");
 283 #endif
 284
 285   return 1;
 286 }
 287
 288 /* Parses the END LOOP command by passing the buck off to
 289    cmd_internal_end_loop(). */
 290 int
 291 cmd_end_loop (void)
 292 {
 293   if (!internal_cmd_end_loop ())
 294     {
 295       loop_3_trns_free ((struct trns_header *) thr);
 296       if (ctl_stack && ctl_stack->type == CST_LOOP)
 297         pop_ctl_stack ();
 298       return CMD_FAILURE;
 299     }
 300
 301   return CMD_SUCCESS;
 302 }
 303
 304 /* Parses the END LOOP command. */
 305 int
 306 internal_cmd_end_loop (void)
 307 {
 308   /* Backpatch pointer for BREAK commands. */
 309   struct break_trns *brk;
 310
 311   /* Allocate, initialize transformation to facilitate
 312      error-handling. */
 313   thr = xmalloc (sizeof *thr);
 314   thr->h.proc = loop_3_trns_proc;
 315   thr->h.free = loop_3_trns_free;
 316   thr->cond = NULL;
 317
 318   /* There must be a matching LOOP command. */
 319   if (!ctl_stack || ctl_stack->type != CST_LOOP)
 320     {
 321       msg (SE, _("There is no LOOP command that corresponds to this "
 322                  "END LOOP."));
 323       return 0;
 324     }
 325   thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
 326
 327   /* Parse the expression if any. */
 328   if (lex_match_id ("IF"))
 329     {
 330       thr->cond = expr_parse (PXP_BOOLEAN);
 331       if (!thr->cond)
 332         return 0;
 333     }
 334
 335   add_transformation ((struct trns_header *) thr);
 336
 337   /* Backpatch. */
 338   ((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns;
 339   for (brk = ctl_stack->brk; brk; brk = brk->next)
 340     brk->loop_term = n_trns;
 341
 342   /* Pop off the top of stack. */
 343   ctl_stack = ctl_stack->down;
 344
 345 #if DEBUGGING
 346   printf ("END LOOP");
 347   if (thr->cond)
 348     printf ("(IF)");
 349   printf ("\n");
 350 #endif
 351
 352   return 1;
 353 }
 354
 355 /* Performs transformation 1. */
 356 static int
 357 loop_1_trns_proc (struct trns_header * trns, struct ccase * c)
 358 {
 359   struct loop_1_trns *one = (struct loop_1_trns *) trns;
 360   struct loop_2_trns *two = one->two;
 361
 362   two->pass = -1;
 363   if (two->flags & LPC_INDEX)
 364     {
 365       union value t1, t2, t3;
 366
 367       expr_evaluate (one->init, c, &t1);
 368       if (one->incr)
 369         expr_evaluate (one->incr, c, &t2);
 370       else
 371         t2.f = 1.0;
 372       expr_evaluate (one->term, c, &t3);
 373
 374       /* Even if the loop is never entered, force the index variable
 375          to assume the initial value. */
 376       c->data[two->index->fv].f = t1.f;
 377
 378       /* Throw out various pathological cases. */
 379       if (!finite (t1.f) || !finite (t2.f) || !finite (t3.f)
 380           || approx_eq (t2.f, 0.0))
 381         return two->loop_term;
 382       debug_printf (("LOOP %s=%g TO %g BY %g.\n", two->index->name,
 383                      t1.f, t3.f, t2.f));
 384       if (t2.f > 0.0)
 385         {
 386           /* Loop counts upward: I=1 TO 5 BY 1. */
 387           two->flags &= ~LPC_RINDEX;
 388
 389           /* incr>0 but init>term */
 390           if (approx_gt (t1.f, t3.f))
 391             return two->loop_term;
 392         }
 393       else
 394         {
 395           /* Loop counts downward: I=5 TO 1 BY -1. */
 396           two->flags |= LPC_RINDEX;
 397
 398           /* incr<0 but init<term */
 399           if (approx_lt (t1.f, t3.f))
 400             return two->loop_term;
 401         }
 402
 403       two->curr = t1.f;
 404       two->incr = t2.f;
 405       two->term = t3.f;
 406     }
 407
 408   return -1;
 409 }
 410
 411 /* Frees transformation 1. */
 412 static void
 413 loop_1_trns_free (struct trns_header * trns)
 414 {
 415   struct loop_1_trns *one = (struct loop_1_trns *) trns;
 416
 417   expr_free (one->init);
 418   expr_free (one->incr);
 419   expr_free (one->term);
 420 }
 421
 422 /* Performs transformation 2. */
 423 static int
 424 loop_2_trns_proc (struct trns_header * trns, struct ccase * c)
 425 {
 426   struct loop_2_trns *two = (struct loop_2_trns *) trns;
 427
 428   /* MXLOOPS limiter. */
 429   if (two->flags == 0)
 430     {
 431       two->pass++;
 432       if (two->pass > set_mxloops)
 433          return two->loop_term;
 434     }
 435
 436   /* Indexing clause limiter: counting downward. */
 437   if (two->flags & LPC_RINDEX)
 438     {
 439       /* Test if we're at the end of the looping. */
 440       if (approx_lt (two->curr, two->term))
 441         return two->loop_term;
 442
 443       /* Set the current value into the case. */
 444       c->data[two->index->fv].f = two->curr;
 445
 446       /* Decrement the current value. */
 447       two->curr += two->incr;
 448     }
 449   /* Indexing clause limiter: counting upward. */
 450   else if (two->flags & LPC_INDEX)
 451     {
 452       /* Test if we're at the end of the looping. */
 453       if (approx_gt (two->curr, two->term))
 454         return two->loop_term;
 455
 456       /* Set the current value into the case. */
 457       c->data[two->index->fv].f = two->curr;
 458
 459       /* Increment the current value. */
 460       two->curr += two->incr;
 461     }
 462
 463   /* Conditional clause limiter. */
 464   if ((two->flags & LPC_COND)
 465       && expr_evaluate (two->cond, c, NULL) != 1.0)
 466     return two->loop_term;
 467
 468   return -1;
 469 }
 470
 471 /* Frees transformation 2. */
 472 static void
 473 loop_2_trns_free (struct trns_header * trns)
 474 {
 475   struct loop_2_trns *two = (struct loop_2_trns *) trns;
 476
 477   expr_free (two->cond);
 478 }
 479
 480 /* Performs transformation 3. */
 481 static int
 482 loop_3_trns_proc (struct trns_header * trns, struct ccase * c)
 483 {
 484   struct loop_3_trns *thr = (struct loop_3_trns *) trns;
 485
 486   /* Note that it breaks out of the loop if the expression is true *or
 487      missing*.  This is conformant. */
 488   if (thr->cond && expr_evaluate (two->cond, c, NULL) != 0.0)
 489     return -1;
 490
 491   return thr->loop_start;
 492 }
 493
 494 /* Frees transformation 3. */
 495 static void
 496 loop_3_trns_free (struct trns_header * trns)
 497 {
 498   struct loop_3_trns *thr = (struct loop_3_trns *) trns;
 499
 500   expr_free (thr->cond);
 501 }
 502 \f
 503 /* BREAK. */
 504
 505 /* Parses the BREAK command. */
 506 int
 507 cmd_break (void)
 508 {
 509   /* Climbs down the stack to find a LOOP. */
 510   struct ctl_stmt *loop;
 511
 512   /* New transformation. */
 513   struct break_trns *t;
 514
 515   lex_match_id ("BREAK");
 516
 517   for (loop = ctl_stack; loop; loop = loop->down)
 518     if (loop->type == CST_LOOP)
 519       break;
 520   if (!loop)
 521     {
 522       msg (SE, _("This command may only appear enclosed in a LOOP/"
 523                  "END LOOP control structure."));
 524       return CMD_FAILURE;
 525     }
 526
 527   if (ctl_stack->type != CST_DO_IF)
 528     msg (SW, _("BREAK not enclosed in DO IF structure."));
 529
 530   t = xmalloc (sizeof *t);
 531   t->h.proc = break_trns_proc;
 532   t->h.free = NULL;
 533   t->next = loop->brk;
 534   loop->brk = t;
 535   add_transformation ((struct trns_header *) t);
 536
 537   return lex_end_of_command ();
 538 }
 539
 540 static int
 541 break_trns_proc (struct trns_header * trns, struct ccase * c unused)
 542 {
 543   return ((struct break_trns *) trns)->loop_term;
 544 }
 545 \f
 546 /* Control stack operations. */
 547
 548 /* Pops the top of stack element off of ctl_stack.  Does not
 549    check that ctl_stack is indeed non-NULL. */
 550 static void
 551 pop_ctl_stack (void)
 552 {
 553   switch (ctl_stack->type)
 554     {
 555     case CST_LOOP:
 556       {
 557         /* Pointer for chasing down and backpatching BREAKs. */
 558         struct break_trns *brk;
 559
 560         /* Terminate the loop. */
 561         thr = xmalloc (sizeof *thr);
 562         thr->h.proc = loop_3_trns_proc;
 563         thr->h.free = loop_3_trns_free;
 564         thr->cond = NULL;
 565         thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
 566         add_transformation ((struct trns_header *) thr);
 567
 568         /* Backpatch. */
 569         ((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns;
 570         for (brk = ctl_stack->brk; brk; brk = brk->next)
 571           brk->loop_term = n_trns;
 572       }
 573       break;
 574     case CST_DO_IF:
 575       {
 576         /* List iterator. */
 577         struct do_if_trns *iter;
 578
 579         iter = ((struct do_if_trns *) ctl_stack->trns);
 580         for (;;)
 581           {
 582             if (iter->brk)
 583               iter->brk->dest = n_trns;
 584             iter->missing_jump = n_trns;
 585             if (iter->next)
 586               iter = iter->next;
 587             else
 588               break;
 589           }
 590         iter->false_jump = n_trns;
 591       }
 592       break;
 593     default:
 594       assert (0);
 595     }
 596   ctl_stack = ctl_stack->down;
 597 }
 598
 599 /* Checks for unclosed LOOPs and DO IFs and closes them out. */
 600 void
 601 discard_ctl_stack (void)
 602 {
 603   if (!ctl_stack)
 604     return;
 605   msg (SE, _("%s without %s."), ctl_stack->type == CST_LOOP ? "LOOP" : "DO IF",
 606        ctl_stack->type == CST_LOOP ? "END LOOP" : "END IF");
 607   while (ctl_stack)
 608     pop_ctl_stack ();
 609   ctl_stack = NULL;
 610 }