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