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"
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.
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.
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.
52 After the second transformation the body of the loop is executed.
54 The last transformation checks the test clause if present and
55 either jumps back up to the second transformation or terminates the
58 Flow of control: (The characters ^V<> represents arrows.)
60 1. LOOP (sets pass # to -1)
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
69 ^ *. execute loop body V
71 ^ . (any number of transformations) V
74 ^ 3. END LOOP (test optional IF clause) V
75 ^<<<<if we need another trip if we're done with the loop>>V
78 *. transformations after loop body<<<<<<<<<<<<<<<<<<<<<<<<<<<
83 /* Types of limits on loop execution. */
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. */
92 /* LOOP transformation 1. */
97 struct loop_2_trns *two; /* Allows modification of associated
98 second transformation. */
100 struct expression *init; /* Starting index. */
101 struct expression *incr; /* Index increment. */
102 struct expression *term; /* Terminal index. */
105 /* LOOP transformation 2. */
108 struct trns_header h;
110 struct ctl_stmt ctl; /* Nesting control info. */
112 int flags; /* Types of limits on loop execution. */
113 int pass; /* Number of passes thru the loop so far. */
115 struct variable *index; /* Index variable. */
116 double curr; /* Current index. */
117 double incr; /* Increment. */
118 double term; /* Terminal index. */
120 struct expression *cond; /* Optional IF condition when non-NULL. */
122 int loop_term; /* 1+(t_trns[] index of transformation 3);
123 backpatched in by END LOOP. */
126 /* LOOP transformation 3. (Actually output by END LOOP.) */
129 struct trns_header h;
131 struct expression *cond; /* Optional IF condition when non-NULL. */
133 int loop_start; /* t_trns[] index of transformation 2. */
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;
141 static int internal_cmd_loop (void);
142 static int internal_cmd_end_loop (void);
143 static trns_proc_func break_trns_proc;
144 static trns_proc_func loop_1_trns_proc, loop_2_trns_proc, loop_3_trns_proc;
145 static trns_free_func loop_1_trns_free, loop_2_trns_free, loop_3_trns_free;
146 static void pop_ctl_stack (void);
150 /* Parses a LOOP command. Passes the real work off to
151 internal_cmd_loop(). */
155 if (!internal_cmd_loop ())
157 loop_1_trns_free ((struct trns_header *) one);
158 loop_2_trns_free ((struct trns_header *) two);
165 /* Parses a LOOP command, returns success. */
167 internal_cmd_loop (void)
169 /* Name of indexing variable if applicable. */
172 lex_match_id ("LOOP");
174 /* Create and initialize transformations to facilitate
176 two = xmalloc (sizeof *two);
177 two->h.proc = loop_2_trns_proc;
178 two->h.free = loop_2_trns_free;
182 one = xmalloc (sizeof *one);
183 one->h.proc = loop_1_trns_proc;
184 one->h.free = loop_1_trns_free;
185 one->init = one->incr = one->term = NULL;
188 /* Parse indexing clause. */
189 if (token == T_ID && lex_look_ahead () == '=')
191 struct variable *v = dict_lookup_var (default_dict, tokid);
193 two->flags |= LPC_INDEX;
195 if (v && v->type == ALPHA)
197 msg (SE, _("The index variable may not be a string variable."));
200 strcpy (name, tokid);
203 assert (token == '=');
206 one->init = expr_parse (PXP_NUMERIC);
210 if (!lex_force_match (T_TO))
212 expr_free (one->init);
215 one->term = expr_parse (PXP_NUMERIC);
218 expr_free (one->init);
222 if (lex_match (T_BY))
224 one->incr = expr_parse (PXP_NUMERIC);
232 /* Parse IF clause. */
233 if (lex_match_id ("IF"))
235 two->flags |= LPC_COND;
237 two->cond = expr_parse (PXP_BOOLEAN);
244 lex_error (_("expecting end of command"));
248 /* Find variable; create if necessary. */
251 two->index = dict_lookup_var (default_dict, name);
253 two->index = dict_create_var (default_dict, name, 0);
256 /* Push on control stack. */
257 two->ctl.down = ctl_stack;
258 two->ctl.type = CST_LOOP;
259 two->ctl.trns = (struct trns_header *) two;
261 ctl_stack = &two->ctl;
263 /* Dump out the transformations. */
264 add_transformation ((struct trns_header *) one);
265 add_transformation ((struct trns_header *) two);
269 if (two->flags & LPC_INDEX)
271 if (two->flags & LPC_COND)
279 /* Parses the END LOOP command by passing the buck off to
280 cmd_internal_end_loop(). */
284 if (!internal_cmd_end_loop ())
286 loop_3_trns_free ((struct trns_header *) thr);
287 if (ctl_stack && ctl_stack->type == CST_LOOP)
295 /* Parses the END LOOP command. */
297 internal_cmd_end_loop (void)
299 /* Backpatch pointer for BREAK commands. */
300 struct break_trns *brk;
302 /* Allocate, initialize transformation to facilitate
304 thr = xmalloc (sizeof *thr);
305 thr->h.proc = loop_3_trns_proc;
306 thr->h.free = loop_3_trns_free;
309 /* There must be a matching LOOP command. */
310 if (!ctl_stack || ctl_stack->type != CST_LOOP)
312 msg (SE, _("There is no LOOP command that corresponds to this "
316 thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
318 /* Parse the expression if any. */
319 if (lex_match_id ("IF"))
321 thr->cond = expr_parse (PXP_BOOLEAN);
326 add_transformation ((struct trns_header *) thr);
329 ((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns;
330 for (brk = ctl_stack->brk; brk; brk = brk->next)
331 brk->loop_term = n_trns;
333 /* Pop off the top of stack. */
334 ctl_stack = ctl_stack->down;
346 /* Performs transformation 1. */
348 loop_1_trns_proc (struct trns_header * trns, struct ccase * c,
351 struct loop_1_trns *one = (struct loop_1_trns *) trns;
352 struct loop_2_trns *two = one->two;
355 if (two->flags & LPC_INDEX)
357 union value t1, t2, t3;
359 expr_evaluate (one->init, c, case_num, &t1);
361 expr_evaluate (one->incr, c, case_num, &t2);
364 expr_evaluate (one->term, c, case_num, &t3);
366 /* Even if the loop is never entered, force the index variable
367 to assume the initial value. */
368 c->data[two->index->fv].f = t1.f;
370 /* Throw out various pathological cases. */
371 if (!finite (t1.f) || !finite (t2.f) || !finite (t3.f) || t2.f == 0.0)
372 return two->loop_term;
373 debug_printf (("LOOP %s=%g TO %g BY %g.\n", two->index->name,
377 /* Loop counts upward: I=1 TO 5 BY 1. */
378 two->flags &= ~LPC_RINDEX;
380 /* incr>0 but init>term */
382 return two->loop_term;
386 /* Loop counts downward: I=5 TO 1 BY -1. */
387 two->flags |= LPC_RINDEX;
389 /* incr<0 but init<term */
391 return two->loop_term;
402 /* Frees transformation 1. */
404 loop_1_trns_free (struct trns_header * trns)
406 struct loop_1_trns *one = (struct loop_1_trns *) trns;
408 expr_free (one->init);
409 expr_free (one->incr);
410 expr_free (one->term);
413 /* Performs transformation 2. */
415 loop_2_trns_proc (struct trns_header * trns, struct ccase * c,
418 struct loop_2_trns *two = (struct loop_2_trns *) trns;
420 /* MXLOOPS limiter. */
424 if (two->pass > set_mxloops)
425 return two->loop_term;
428 /* Indexing clause limiter: counting downward. */
429 if (two->flags & LPC_RINDEX)
431 /* Test if we're at the end of the looping. */
432 if (two->curr < two->term)
433 return two->loop_term;
435 /* Set the current value into the case. */
436 c->data[two->index->fv].f = two->curr;
438 /* Decrement the current value. */
439 two->curr += two->incr;
441 /* Indexing clause limiter: counting upward. */
442 else if (two->flags & LPC_INDEX)
444 /* Test if we're at the end of the looping. */
445 if (two->curr > two->term)
446 return two->loop_term;
448 /* Set the current value into the case. */
449 c->data[two->index->fv].f = two->curr;
451 /* Increment the current value. */
452 two->curr += two->incr;
455 /* Conditional clause limiter. */
456 if ((two->flags & LPC_COND)
457 && expr_evaluate (two->cond, c, case_num, NULL) != 1.0)
458 return two->loop_term;
463 /* Frees transformation 2. */
465 loop_2_trns_free (struct trns_header * trns)
467 struct loop_2_trns *two = (struct loop_2_trns *) trns;
469 expr_free (two->cond);
472 /* Performs transformation 3. */
474 loop_3_trns_proc (struct trns_header * trns, struct ccase * c,
477 struct loop_3_trns *thr = (struct loop_3_trns *) trns;
479 /* Note that it breaks out of the loop if the expression is true *or
480 missing*. This is conformant. */
481 if (thr->cond && expr_evaluate (two->cond, c, case_num, NULL) != 0.0)
484 return thr->loop_start;
487 /* Frees transformation 3. */
489 loop_3_trns_free (struct trns_header * trns)
491 struct loop_3_trns *thr = (struct loop_3_trns *) trns;
493 expr_free (thr->cond);
498 /* Parses the BREAK command. */
502 /* Climbs down the stack to find a LOOP. */
503 struct ctl_stmt *loop;
505 /* New transformation. */
506 struct break_trns *t;
508 lex_match_id ("BREAK");
510 for (loop = ctl_stack; loop; loop = loop->down)
511 if (loop->type == CST_LOOP)
515 msg (SE, _("This command may only appear enclosed in a LOOP/"
516 "END LOOP control structure."));
520 if (ctl_stack->type != CST_DO_IF)
521 msg (SW, _("BREAK not enclosed in DO IF structure."));
523 t = xmalloc (sizeof *t);
524 t->h.proc = break_trns_proc;
528 add_transformation ((struct trns_header *) t);
530 return lex_end_of_command ();
534 break_trns_proc (struct trns_header * trns, struct ccase * c UNUSED,
537 return ((struct break_trns *) trns)->loop_term;
540 /* Control stack operations. */
542 /* Pops the top of stack element off of ctl_stack. Does not
543 check that ctl_stack is indeed non-NULL. */
547 switch (ctl_stack->type)
551 /* Pointer for chasing down and backpatching BREAKs. */
552 struct break_trns *brk;
554 /* Terminate the loop. */
555 thr = xmalloc (sizeof *thr);
556 thr->h.proc = loop_3_trns_proc;
557 thr->h.free = loop_3_trns_free;
559 thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
560 add_transformation ((struct trns_header *) thr);
563 ((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns;
564 for (brk = ctl_stack->brk; brk; brk = brk->next)
565 brk->loop_term = n_trns;
571 struct do_if_trns *iter;
573 iter = ((struct do_if_trns *) ctl_stack->trns);
577 iter->brk->dest = n_trns;
578 iter->missing_jump = n_trns;
584 iter->false_jump = n_trns;
590 ctl_stack = ctl_stack->down;
593 /* Checks for unclosed LOOPs and DO IFs and closes them out. */
595 discard_ctl_stack (void)
599 msg (SE, _("%s without %s."), ctl_stack->type == CST_LOOP ? "LOOP" : "DO IF",
600 ctl_stack->type == CST_LOOP ? "END LOOP" : "END IF");