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 = 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)
 375           || approx_eq (t2.f, 0.0))
 376         return two->loop_term;
 377       debug_printf (("LOOP %s=%g TO %g BY %g.\n", two->index->name,
 378                      t1.f, t3.f, t2.f));
 379       if (t2.f > 0.0)
 380         {
 381           /* Loop counts upward: I=1 TO 5 BY 1. */
 382           two->flags &= ~LPC_RINDEX;
 383
 384           /* incr>0 but init>term */
 385           if (approx_gt (t1.f, t3.f))
 386             return two->loop_term;
 387         }
 388       else
 389         {
 390           /* Loop counts downward: I=5 TO 1 BY -1. */
 391           two->flags |= LPC_RINDEX;
 392
 393           /* incr<0 but init<term */
 394           if (approx_lt (t1.f, t3.f))
 395             return two->loop_term;
 396         }
 397
 398       two->curr = t1.f;
 399       two->incr = t2.f;
 400       two->term = t3.f;
 401     }
 402
 403   return -1;
 404 }
 405
 406 /* Frees transformation 1. */
 407 static void
 408 loop_1_trns_free (struct trns_header * trns)
 409 {
 410   struct loop_1_trns *one = (struct loop_1_trns *) trns;
 411
 412   expr_free (one->init);
 413   expr_free (one->incr);
 414   expr_free (one->term);
 415 }
 416
 417 /* Performs transformation 2. */
 418 static int
 419 loop_2_trns_proc (struct trns_header * trns, struct ccase * c)
 420 {
 421   struct loop_2_trns *two = (struct loop_2_trns *) trns;
 422
 423   /* MXLOOPS limiter. */
 424   if (two->flags == 0)
 425     {
 426       two->pass++;
 427       if (two->pass > set_mxloops)
 428          return two->loop_term;
 429     }
 430
 431   /* Indexing clause limiter: counting downward. */
 432   if (two->flags & LPC_RINDEX)
 433     {
 434       /* Test if we're at the end of the looping. */
 435       if (approx_lt (two->curr, two->term))
 436         return two->loop_term;
 437
 438       /* Set the current value into the case. */
 439       c->data[two->index->fv].f = two->curr;
 440
 441       /* Decrement the current value. */
 442       two->curr += two->incr;
 443     }
 444   /* Indexing clause limiter: counting upward. */
 445   else if (two->flags & LPC_INDEX)
 446     {
 447       /* Test if we're at the end of the looping. */
 448       if (approx_gt (two->curr, two->term))
 449         return two->loop_term;
 450
 451       /* Set the current value into the case. */
 452       c->data[two->index->fv].f = two->curr;
 453
 454       /* Increment the current value. */
 455       two->curr += two->incr;
 456     }
 457
 458   /* Conditional clause limiter. */
 459   if ((two->flags & LPC_COND)
 460       && expr_evaluate (two->cond, c, NULL) != 1.0)
 461     return two->loop_term;
 462
 463   return -1;
 464 }
 465
 466 /* Frees transformation 2. */
 467 static void
 468 loop_2_trns_free (struct trns_header * trns)
 469 {
 470   struct loop_2_trns *two = (struct loop_2_trns *) trns;
 471
 472   expr_free (two->cond);
 473 }
 474
 475 /* Performs transformation 3. */
 476 static int
 477 loop_3_trns_proc (struct trns_header * trns, struct ccase * c)
 478 {
 479   struct loop_3_trns *thr = (struct loop_3_trns *) trns;
 480
 481   /* Note that it breaks out of the loop if the expression is true *or
 482      missing*.  This is conformant. */
 483   if (thr->cond && expr_evaluate (two->cond, c, NULL) != 0.0)
 484     return -1;
 485
 486   return thr->loop_start;
 487 }
 488
 489 /* Frees transformation 3. */
 490 static void
 491 loop_3_trns_free (struct trns_header * trns)
 492 {
 493   struct loop_3_trns *thr = (struct loop_3_trns *) trns;
 494
 495   expr_free (thr->cond);
 496 }
 497 \f
 498 /* BREAK. */
 499
 500 /* Parses the BREAK command. */
 501 int
 502 cmd_break (void)
 503 {
 504   /* Climbs down the stack to find a LOOP. */
 505   struct ctl_stmt *loop;
 506
 507   /* New transformation. */
 508   struct break_trns *t;
 509
 510   lex_match_id ("BREAK");
 511
 512   for (loop = ctl_stack; loop; loop = loop->down)
 513     if (loop->type == CST_LOOP)
 514       break;
 515   if (!loop)
 516     {
 517       msg (SE, _("This command may only appear enclosed in a LOOP/"
 518                  "END LOOP control structure."));
 519       return CMD_FAILURE;
 520     }
 521
 522   if (ctl_stack->type != CST_DO_IF)
 523     msg (SW, _("BREAK not enclosed in DO IF structure."));
 524
 525   t = xmalloc (sizeof *t);
 526   t->h.proc = break_trns_proc;
 527   t->h.free = NULL;
 528   t->next = loop->brk;
 529   loop->brk = t;
 530   add_transformation ((struct trns_header *) t);
 531
 532   return lex_end_of_command ();
 533 }
 534
 535 static int
 536 break_trns_proc (struct trns_header * trns, struct ccase * c UNUSED)
 537 {
 538   return ((struct break_trns *) trns)->loop_term;
 539 }
 540 \f
 541 /* Control stack operations. */
 542
 543 /* Pops the top of stack element off of ctl_stack.  Does not
 544    check that ctl_stack is indeed non-NULL. */
 545 static void
 546 pop_ctl_stack (void)
 547 {
 548   switch (ctl_stack->type)
 549     {
 550     case CST_LOOP:
 551       {
 552         /* Pointer for chasing down and backpatching BREAKs. */
 553         struct break_trns *brk;
 554
 555         /* Terminate the loop. */
 556         thr = xmalloc (sizeof *thr);
 557         thr->h.proc = loop_3_trns_proc;
 558         thr->h.free = loop_3_trns_free;
 559         thr->cond = NULL;
 560         thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
 561         add_transformation ((struct trns_header *) thr);
 562
 563         /* Backpatch. */
 564         ((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns;
 565         for (brk = ctl_stack->brk; brk; brk = brk->next)
 566           brk->loop_term = n_trns;
 567       }
 568       break;
 569     case CST_DO_IF:
 570       {
 571         /* List iterator. */
 572         struct do_if_trns *iter;
 573
 574         iter = ((struct do_if_trns *) ctl_stack->trns);
 575         for (;;)
 576           {
 577             if (iter->brk)
 578               iter->brk->dest = n_trns;
 579             iter->missing_jump = n_trns;
 580             if (iter->next)
 581               iter = iter->next;
 582             else
 583               break;
 584           }
 585         iter->false_jump = n_trns;
 586       }
 587       break;
 588     default:
 589       assert (0);
 590     }
 591   ctl_stack = ctl_stack->down;
 592 }
 593
 594 /* Checks for unclosed LOOPs and DO IFs and closes them out. */
 595 void
 596 discard_ctl_stack (void)
 597 {
 598   if (!ctl_stack)
 599     return;
 600   msg (SE, _("%s without %s."), ctl_stack->type == CST_LOOP ? "LOOP" : "DO IF",
 601        ctl_stack->type == CST_LOOP ? "END LOOP" : "END IF");
 602   while (ctl_stack)
 603     pop_ctl_stack ();
 604   ctl_stack = NULL;
 605 }