1 /* PSPP - computes sample statistics.
2 Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3 Written by Ben Pfaff <blp@gnu.org>.
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.
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.
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
33 #include "debug-print.h"
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.
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.
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
52 After the second transformation the body of the loop is
55 The last transformation checks the test clause if present and
56 either jumps back up to the second transformation or
61 1. LOOP. Sets pass number to -1 and continues to next
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
69 Otherwise, we continue through the transformations in the
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
76 Otherwise, we continue with the transformation jump after
80 /* Types of limits on loop execution. */
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. */
89 /* LOOP transformation 1. */
94 struct loop_2_trns *two; /* Allows modification of associated
95 second transformation. */
97 struct expression *init; /* Starting index. */
98 struct expression *incr; /* Index increment. */
99 struct expression *term; /* Terminal index. */
102 /* LOOP transformation 2. */
105 struct trns_header h;
107 struct ctl_stmt ctl; /* Nesting control info. */
109 int flags; /* Types of limits on loop execution. */
110 int pass; /* Number of passes thru the loop so far. */
112 struct variable *index; /* Index variable. */
113 double curr; /* Current index. */
114 double incr; /* Increment. */
115 double term; /* Terminal index. */
117 struct expression *cond; /* Optional IF condition when non-NULL. */
119 int loop_term; /* 1+(t_trns[] index of transformation 3);
120 backpatched in by END LOOP. */
123 /* LOOP transformation 3. (Actually output by END LOOP.) */
126 struct trns_header h;
128 struct expression *cond; /* Optional IF condition when non-NULL. */
130 int loop_start; /* t_trns[] index of transformation 2. */
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;
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);
147 /* Parses a LOOP command. Passes the real work off to
148 internal_cmd_loop(). */
152 if (!internal_cmd_loop ())
154 loop_1_trns_free ((struct trns_header *) one);
155 loop_2_trns_free ((struct trns_header *) two);
162 /* Parses a LOOP command, returns success. */
164 internal_cmd_loop (void)
166 /* Name of indexing variable if applicable. */
169 lex_match_id ("LOOP");
171 /* Create and initialize transformations to facilitate
173 two = xmalloc (sizeof *two);
174 two->h.proc = loop_2_trns_proc;
175 two->h.free = loop_2_trns_free;
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;
185 /* Parse indexing clause. */
186 if (token == T_ID && lex_look_ahead () == '=')
188 struct variable *v = dict_lookup_var (default_dict, tokid);
190 two->flags |= LPC_INDEX;
192 if (v && v->type == ALPHA)
194 msg (SE, _("The index variable may not be a string variable."));
197 strcpy (name, tokid);
200 assert (token == '=');
203 one->init = expr_parse (PXP_NUMERIC);
207 if (!lex_force_match (T_TO))
209 expr_free (one->init);
212 one->term = expr_parse (PXP_NUMERIC);
215 expr_free (one->init);
219 if (lex_match (T_BY))
221 one->incr = expr_parse (PXP_NUMERIC);
229 /* Parse IF clause. */
230 if (lex_match_id ("IF"))
232 two->flags |= LPC_COND;
234 two->cond = expr_parse (PXP_BOOLEAN);
241 lex_error (_("expecting end of command"));
245 /* Find variable; create if necessary. */
248 two->index = dict_lookup_var (default_dict, name);
250 two->index = dict_create_var (default_dict, name, 0);
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;
258 ctl_stack = &two->ctl;
260 /* Dump out the transformations. */
261 add_transformation ((struct trns_header *) one);
262 add_transformation ((struct trns_header *) two);
266 if (two->flags & LPC_INDEX)
268 if (two->flags & LPC_COND)
276 /* Parses the END LOOP command by passing the buck off to
277 cmd_internal_end_loop(). */
281 if (!internal_cmd_end_loop ())
283 loop_3_trns_free ((struct trns_header *) thr);
284 if (ctl_stack && ctl_stack->type == CST_LOOP)
292 /* Parses the END LOOP command. */
294 internal_cmd_end_loop (void)
296 /* Backpatch pointer for BREAK commands. */
297 struct break_trns *brk;
299 /* Allocate, initialize transformation to facilitate
301 thr = xmalloc (sizeof *thr);
302 thr->h.proc = loop_3_trns_proc;
303 thr->h.free = loop_3_trns_free;
306 /* There must be a matching LOOP command. */
307 if (!ctl_stack || ctl_stack->type != CST_LOOP)
309 msg (SE, _("There is no LOOP command that corresponds to this "
313 thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
315 /* Parse the expression if any. */
316 if (lex_match_id ("IF"))
318 thr->cond = expr_parse (PXP_BOOLEAN);
323 add_transformation ((struct trns_header *) thr);
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;
330 /* Pop off the top of stack. */
331 ctl_stack = ctl_stack->down;
343 /* Performs transformation 1. */
345 loop_1_trns_proc (struct trns_header * trns, struct ccase * c,
348 struct loop_1_trns *one = (struct loop_1_trns *) trns;
349 struct loop_2_trns *two = one->two;
352 if (two->flags & LPC_INDEX)
354 union value t1, t2, t3;
356 expr_evaluate (one->init, c, case_num, &t1);
358 expr_evaluate (one->incr, c, case_num, &t2);
361 expr_evaluate (one->term, c, case_num, &t3);
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;
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,
374 /* Loop counts upward: I=1 TO 5 BY 1. */
375 two->flags &= ~LPC_RINDEX;
377 /* incr>0 but init>term */
379 return two->loop_term;
383 /* Loop counts downward: I=5 TO 1 BY -1. */
384 two->flags |= LPC_RINDEX;
386 /* incr<0 but init<term */
388 return two->loop_term;
399 /* Frees transformation 1. */
401 loop_1_trns_free (struct trns_header * trns)
403 struct loop_1_trns *one = (struct loop_1_trns *) trns;
405 expr_free (one->init);
406 expr_free (one->incr);
407 expr_free (one->term);
410 /* Performs transformation 2. */
412 loop_2_trns_proc (struct trns_header * trns, struct ccase * c,
415 struct loop_2_trns *two = (struct loop_2_trns *) trns;
417 /* MXLOOPS limiter. */
421 if (two->pass > set_mxloops)
422 return two->loop_term;
425 /* Indexing clause limiter: counting downward. */
426 if (two->flags & LPC_RINDEX)
428 /* Test if we're at the end of the looping. */
429 if (two->curr < two->term)
430 return two->loop_term;
432 /* Set the current value into the case. */
433 c->data[two->index->fv].f = two->curr;
435 /* Decrement the current value. */
436 two->curr += two->incr;
438 /* Indexing clause limiter: counting upward. */
439 else if (two->flags & LPC_INDEX)
441 /* Test if we're at the end of the looping. */
442 if (two->curr > two->term)
443 return two->loop_term;
445 /* Set the current value into the case. */
446 c->data[two->index->fv].f = two->curr;
448 /* Increment the current value. */
449 two->curr += two->incr;
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;
460 /* Frees transformation 2. */
462 loop_2_trns_free (struct trns_header * trns)
464 struct loop_2_trns *two = (struct loop_2_trns *) trns;
466 expr_free (two->cond);
469 /* Performs transformation 3. */
471 loop_3_trns_proc (struct trns_header * trns, struct ccase * c,
474 struct loop_3_trns *thr = (struct loop_3_trns *) trns;
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)
481 return thr->loop_start;
484 /* Frees transformation 3. */
486 loop_3_trns_free (struct trns_header * trns)
488 struct loop_3_trns *thr = (struct loop_3_trns *) trns;
490 expr_free (thr->cond);
495 /* Parses the BREAK command. */
499 /* Climbs down the stack to find a LOOP. */
500 struct ctl_stmt *loop;
502 /* New transformation. */
503 struct break_trns *t;
505 lex_match_id ("BREAK");
507 for (loop = ctl_stack; loop; loop = loop->down)
508 if (loop->type == CST_LOOP)
512 msg (SE, _("This command may only appear enclosed in a LOOP/"
513 "END LOOP control structure."));
517 if (ctl_stack->type != CST_DO_IF)
518 msg (SW, _("BREAK not enclosed in DO IF structure."));
520 t = xmalloc (sizeof *t);
521 t->h.proc = break_trns_proc;
525 add_transformation ((struct trns_header *) t);
527 return lex_end_of_command ();
531 break_trns_proc (struct trns_header * trns, struct ccase * c UNUSED,
534 return ((struct break_trns *) trns)->loop_term;
537 /* Control stack operations. */
539 /* Pops the top of stack element off of ctl_stack. Does not
540 check that ctl_stack is indeed non-NULL. */
544 switch (ctl_stack->type)
548 /* Pointer for chasing down and backpatching BREAKs. */
549 struct break_trns *brk;
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;
556 thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
557 add_transformation ((struct trns_header *) thr);
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;
568 struct do_if_trns *iter;
570 iter = ((struct do_if_trns *) ctl_stack->trns);
574 iter->brk->dest = n_trns;
575 iter->missing_jump = n_trns;
581 iter->false_jump = n_trns;
587 ctl_stack = ctl_stack->down;
590 /* Checks for unclosed LOOPs and DO IFs and closes them out. */
592 discard_ctl_stack (void)
596 msg (SE, _("%s without %s."), ctl_stack->type == CST_LOOP ? "LOOP" : "DO IF",
597 ctl_stack->type == CST_LOOP ? "END LOOP" : "END IF");