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
34 #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
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
53 After the second transformation the body of the loop is
56 The last transformation checks the test clause if present and
57 either jumps back up to the second transformation or
62 1. LOOP. Sets pass number to -1 and continues to next
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
70 Otherwise, we continue through the transformations in the
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
77 Otherwise, we continue with the transformation jump after
81 /* Types of limits on loop execution. */
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. */
90 /* LOOP transformation 1. */
95 struct loop_2_trns *two; /* Allows modification of associated
96 second transformation. */
98 struct expression *init; /* Starting index. */
99 struct expression *incr; /* Index increment. */
100 struct expression *term; /* Terminal index. */
103 /* LOOP transformation 2. */
106 struct trns_header h;
108 struct ctl_stmt ctl; /* Nesting control info. */
110 int flags; /* Types of limits on loop execution. */
111 int pass; /* Number of passes thru the loop so far. */
113 struct variable *index; /* Index variable. */
114 double curr; /* Current index. */
115 double incr; /* Increment. */
116 double term; /* Terminal index. */
118 struct expression *cond; /* Optional IF condition when non-NULL. */
120 int loop_term; /* 1+(t_trns[] index of transformation 3);
121 backpatched in by END LOOP. */
124 /* LOOP transformation 3. (Actually output by END LOOP.) */
127 struct trns_header h;
129 struct expression *cond; /* Optional IF condition when non-NULL. */
131 int loop_start; /* t_trns[] index of transformation 2. */
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;
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);
148 /* Parses a LOOP command. Passes the real work off to
149 internal_cmd_loop(). */
153 if (!internal_cmd_loop ())
155 loop_1_trns_free ((struct trns_header *) one);
156 loop_2_trns_free ((struct trns_header *) two);
163 /* Parses a LOOP command, returns success. */
165 internal_cmd_loop (void)
167 /* Name of indexing variable if applicable. */
170 /* Create and initialize transformations to facilitate
172 two = xmalloc (sizeof *two);
173 two->h.proc = loop_2_trns_proc;
174 two->h.free = loop_2_trns_free;
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;
184 /* Parse indexing clause. */
185 if (token == T_ID && lex_look_ahead () == '=')
187 struct variable *v = dict_lookup_var (default_dict, tokid);
189 two->flags |= LPC_INDEX;
191 if (v && v->type == ALPHA)
193 msg (SE, _("The index variable may not be a string variable."));
196 strcpy (name, tokid);
199 assert (token == '=');
202 one->init = expr_parse (EXPR_NUMERIC);
206 if (!lex_force_match (T_TO))
208 expr_free (one->init);
211 one->term = expr_parse (EXPR_NUMERIC);
214 expr_free (one->init);
218 if (lex_match (T_BY))
220 one->incr = expr_parse (EXPR_NUMERIC);
228 /* Parse IF clause. */
229 if (lex_match_id ("IF"))
231 two->flags |= LPC_COND;
233 two->cond = expr_parse (EXPR_BOOLEAN);
240 lex_error (_("expecting end of command"));
244 /* Find variable; create if necessary. */
247 two->index = dict_lookup_var (default_dict, name);
249 two->index = dict_create_var (default_dict, name, 0);
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;
257 ctl_stack = &two->ctl;
259 /* Dump out the transformations. */
260 add_transformation ((struct trns_header *) one);
261 add_transformation ((struct trns_header *) two);
266 /* Parses the END LOOP command by passing the buck off to
267 cmd_internal_end_loop(). */
271 if (!internal_cmd_end_loop ())
273 loop_3_trns_free ((struct trns_header *) thr);
274 if (ctl_stack && ctl_stack->type == CST_LOOP)
282 /* Parses the END LOOP command. */
284 internal_cmd_end_loop (void)
286 /* Backpatch pointer for BREAK commands. */
287 struct break_trns *brk;
289 /* Allocate, initialize transformation to facilitate
291 thr = xmalloc (sizeof *thr);
292 thr->h.proc = loop_3_trns_proc;
293 thr->h.free = loop_3_trns_free;
296 /* There must be a matching LOOP command. */
297 if (!ctl_stack || ctl_stack->type != CST_LOOP)
299 msg (SE, _("There is no LOOP command that corresponds to this "
303 thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
305 /* Parse the expression if any. */
306 if (lex_match_id ("IF"))
308 thr->cond = expr_parse (EXPR_BOOLEAN);
313 add_transformation ((struct trns_header *) thr);
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;
320 /* Pop off the top of stack. */
321 ctl_stack = ctl_stack->down;
326 /* Performs transformation 1. */
328 loop_1_trns_proc (struct trns_header * trns, struct ccase * c,
331 struct loop_1_trns *one = (struct loop_1_trns *) trns;
332 struct loop_2_trns *two = one->two;
335 if (two->flags & LPC_INDEX)
337 union value t1, t2, t3;
339 expr_evaluate (one->init, c, case_num, &t1);
341 expr_evaluate (one->incr, c, case_num, &t2);
344 expr_evaluate (one->term, c, case_num, &t3);
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;
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,
357 /* Loop counts upward: I=1 TO 5 BY 1. */
358 two->flags &= ~LPC_RINDEX;
360 /* incr>0 but init>term */
362 return two->loop_term;
366 /* Loop counts downward: I=5 TO 1 BY -1. */
367 two->flags |= LPC_RINDEX;
369 /* incr<0 but init<term */
371 return two->loop_term;
382 /* Frees transformation 1. */
384 loop_1_trns_free (struct trns_header * trns)
386 struct loop_1_trns *one = (struct loop_1_trns *) trns;
388 expr_free (one->init);
389 expr_free (one->incr);
390 expr_free (one->term);
393 /* Performs transformation 2. */
395 loop_2_trns_proc (struct trns_header * trns, struct ccase * c,
398 struct loop_2_trns *two = (struct loop_2_trns *) trns;
400 /* MXLOOPS limiter. */
404 if (two->pass > get_mxloops() )
405 return two->loop_term;
408 /* Indexing clause limiter: counting downward. */
409 if (two->flags & LPC_RINDEX)
411 /* Test if we're at the end of the looping. */
412 if (two->curr < two->term)
413 return two->loop_term;
415 /* Set the current value into the case. */
416 case_data_rw (c, two->index->fv)->f = two->curr;
418 /* Decrement the current value. */
419 two->curr += two->incr;
421 /* Indexing clause limiter: counting upward. */
422 else if (two->flags & LPC_INDEX)
424 /* Test if we're at the end of the looping. */
425 if (two->curr > two->term)
426 return two->loop_term;
428 /* Set the current value into the case. */
429 case_data_rw (c, two->index->fv)->f = two->curr;
431 /* Increment the current value. */
432 two->curr += two->incr;
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;
443 /* Frees transformation 2. */
445 loop_2_trns_free (struct trns_header * trns)
447 struct loop_2_trns *two = (struct loop_2_trns *) trns;
449 expr_free (two->cond);
452 /* Performs transformation 3. */
454 loop_3_trns_proc (struct trns_header * trns, struct ccase * c,
457 struct loop_3_trns *thr = (struct loop_3_trns *) trns;
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)
464 return thr->loop_start;
467 /* Frees transformation 3. */
469 loop_3_trns_free (struct trns_header * trns)
471 struct loop_3_trns *thr = (struct loop_3_trns *) trns;
473 expr_free (thr->cond);
478 /* Parses the BREAK command. */
482 /* Climbs down the stack to find a LOOP. */
483 struct ctl_stmt *loop;
485 /* New transformation. */
486 struct break_trns *t;
488 for (loop = ctl_stack; loop; loop = loop->down)
489 if (loop->type == CST_LOOP)
493 msg (SE, _("This command may only appear enclosed in a LOOP/"
494 "END LOOP control structure."));
498 if (ctl_stack->type != CST_DO_IF)
499 msg (SW, _("BREAK not enclosed in DO IF structure."));
501 t = xmalloc (sizeof *t);
502 t->h.proc = break_trns_proc;
506 add_transformation ((struct trns_header *) t);
508 return lex_end_of_command ();
512 break_trns_proc (struct trns_header * trns, struct ccase * c UNUSED,
515 return ((struct break_trns *) trns)->loop_term;
518 /* Control stack operations. */
520 /* Pops the top of stack element off of ctl_stack. Does not
521 check that ctl_stack is indeed non-NULL. */
525 switch (ctl_stack->type)
529 /* Pointer for chasing down and backpatching BREAKs. */
530 struct break_trns *brk;
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;
537 thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
538 add_transformation ((struct trns_header *) thr);
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;
549 struct do_if_trns *iter;
551 iter = ((struct do_if_trns *) ctl_stack->trns);
555 iter->brk->dest = n_trns;
556 iter->missing_jump = n_trns;
562 iter->false_jump = n_trns;
568 ctl_stack = ctl_stack->down;
571 /* Checks for unclosed LOOPs and DO IFs and closes them out. */
573 discard_ctl_stack (void)
577 msg (SE, _("%s without %s."), ctl_stack->type == CST_LOOP ? "LOOP" : "DO IF",
578 ctl_stack->type == CST_LOOP ? "END LOOP" : "END IF");