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