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 /* Create and initialize transformations to facilitate
171 two = xmalloc (sizeof *two);
172 two->h.proc = loop_2_trns_proc;
173 two->h.free = loop_2_trns_free;
177 one = xmalloc (sizeof *one);
178 one->h.proc = loop_1_trns_proc;
179 one->h.free = loop_1_trns_free;
180 one->init = one->incr = one->term = NULL;
183 /* Parse indexing clause. */
184 if (token == T_ID && lex_look_ahead () == '=')
186 struct variable *v = dict_lookup_var (default_dict, tokid);
188 two->flags |= LPC_INDEX;
190 if (v && v->type == ALPHA)
192 msg (SE, _("The index variable may not be a string variable."));
195 strcpy (name, tokid);
198 assert (token == '=');
201 one->init = expr_parse (PXP_NUMERIC);
205 if (!lex_force_match (T_TO))
207 expr_free (one->init);
210 one->term = expr_parse (PXP_NUMERIC);
213 expr_free (one->init);
217 if (lex_match (T_BY))
219 one->incr = expr_parse (PXP_NUMERIC);
227 /* Parse IF clause. */
228 if (lex_match_id ("IF"))
230 two->flags |= LPC_COND;
232 two->cond = expr_parse (PXP_BOOLEAN);
239 lex_error (_("expecting end of command"));
243 /* Find variable; create if necessary. */
246 two->index = dict_lookup_var (default_dict, name);
248 two->index = dict_create_var (default_dict, name, 0);
251 /* Push on control stack. */
252 two->ctl.down = ctl_stack;
253 two->ctl.type = CST_LOOP;
254 two->ctl.trns = (struct trns_header *) two;
256 ctl_stack = &two->ctl;
258 /* Dump out the transformations. */
259 add_transformation ((struct trns_header *) one);
260 add_transformation ((struct trns_header *) two);
264 if (two->flags & LPC_INDEX)
266 if (two->flags & LPC_COND)
274 /* Parses the END LOOP command by passing the buck off to
275 cmd_internal_end_loop(). */
279 if (!internal_cmd_end_loop ())
281 loop_3_trns_free ((struct trns_header *) thr);
282 if (ctl_stack && ctl_stack->type == CST_LOOP)
290 /* Parses the END LOOP command. */
292 internal_cmd_end_loop (void)
294 /* Backpatch pointer for BREAK commands. */
295 struct break_trns *brk;
297 /* Allocate, initialize transformation to facilitate
299 thr = xmalloc (sizeof *thr);
300 thr->h.proc = loop_3_trns_proc;
301 thr->h.free = loop_3_trns_free;
304 /* There must be a matching LOOP command. */
305 if (!ctl_stack || ctl_stack->type != CST_LOOP)
307 msg (SE, _("There is no LOOP command that corresponds to this "
311 thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
313 /* Parse the expression if any. */
314 if (lex_match_id ("IF"))
316 thr->cond = expr_parse (PXP_BOOLEAN);
321 add_transformation ((struct trns_header *) thr);
324 ((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns;
325 for (brk = ctl_stack->brk; brk; brk = brk->next)
326 brk->loop_term = n_trns;
328 /* Pop off the top of stack. */
329 ctl_stack = ctl_stack->down;
341 /* Performs transformation 1. */
343 loop_1_trns_proc (struct trns_header * trns, struct ccase * c,
346 struct loop_1_trns *one = (struct loop_1_trns *) trns;
347 struct loop_2_trns *two = one->two;
350 if (two->flags & LPC_INDEX)
352 union value t1, t2, t3;
354 expr_evaluate (one->init, c, case_num, &t1);
356 expr_evaluate (one->incr, c, case_num, &t2);
359 expr_evaluate (one->term, c, case_num, &t3);
361 /* Even if the loop is never entered, force the index variable
362 to assume the initial value. */
363 c->data[two->index->fv].f = t1.f;
365 /* Throw out various pathological cases. */
366 if (!finite (t1.f) || !finite (t2.f) || !finite (t3.f) || t2.f == 0.0)
367 return two->loop_term;
368 debug_printf (("LOOP %s=%g TO %g BY %g.\n", two->index->name,
372 /* Loop counts upward: I=1 TO 5 BY 1. */
373 two->flags &= ~LPC_RINDEX;
375 /* incr>0 but init>term */
377 return two->loop_term;
381 /* Loop counts downward: I=5 TO 1 BY -1. */
382 two->flags |= LPC_RINDEX;
384 /* incr<0 but init<term */
386 return two->loop_term;
397 /* Frees transformation 1. */
399 loop_1_trns_free (struct trns_header * trns)
401 struct loop_1_trns *one = (struct loop_1_trns *) trns;
403 expr_free (one->init);
404 expr_free (one->incr);
405 expr_free (one->term);
408 /* Performs transformation 2. */
410 loop_2_trns_proc (struct trns_header * trns, struct ccase * c,
413 struct loop_2_trns *two = (struct loop_2_trns *) trns;
415 /* MXLOOPS limiter. */
419 if (two->pass > get_mxloops() )
420 return two->loop_term;
423 /* Indexing clause limiter: counting downward. */
424 if (two->flags & LPC_RINDEX)
426 /* Test if we're at the end of the looping. */
427 if (two->curr < two->term)
428 return two->loop_term;
430 /* Set the current value into the case. */
431 c->data[two->index->fv].f = two->curr;
433 /* Decrement the current value. */
434 two->curr += two->incr;
436 /* Indexing clause limiter: counting upward. */
437 else if (two->flags & LPC_INDEX)
439 /* Test if we're at the end of the looping. */
440 if (two->curr > two->term)
441 return two->loop_term;
443 /* Set the current value into the case. */
444 c->data[two->index->fv].f = two->curr;
446 /* Increment the current value. */
447 two->curr += two->incr;
450 /* Conditional clause limiter. */
451 if ((two->flags & LPC_COND)
452 && expr_evaluate (two->cond, c, case_num, NULL) != 1.0)
453 return two->loop_term;
458 /* Frees transformation 2. */
460 loop_2_trns_free (struct trns_header * trns)
462 struct loop_2_trns *two = (struct loop_2_trns *) trns;
464 expr_free (two->cond);
467 /* Performs transformation 3. */
469 loop_3_trns_proc (struct trns_header * trns, struct ccase * c,
472 struct loop_3_trns *thr = (struct loop_3_trns *) trns;
474 /* Note that it breaks out of the loop if the expression is true *or
475 missing*. This is conformant. */
476 if (thr->cond && expr_evaluate (two->cond, c, case_num, NULL) != 0.0)
479 return thr->loop_start;
482 /* Frees transformation 3. */
484 loop_3_trns_free (struct trns_header * trns)
486 struct loop_3_trns *thr = (struct loop_3_trns *) trns;
488 expr_free (thr->cond);
493 /* Parses the BREAK command. */
497 /* Climbs down the stack to find a LOOP. */
498 struct ctl_stmt *loop;
500 /* New transformation. */
501 struct break_trns *t;
503 for (loop = ctl_stack; loop; loop = loop->down)
504 if (loop->type == CST_LOOP)
508 msg (SE, _("This command may only appear enclosed in a LOOP/"
509 "END LOOP control structure."));
513 if (ctl_stack->type != CST_DO_IF)
514 msg (SW, _("BREAK not enclosed in DO IF structure."));
516 t = xmalloc (sizeof *t);
517 t->h.proc = break_trns_proc;
521 add_transformation ((struct trns_header *) t);
523 return lex_end_of_command ();
527 break_trns_proc (struct trns_header * trns, struct ccase * c UNUSED,
530 return ((struct break_trns *) trns)->loop_term;
533 /* Control stack operations. */
535 /* Pops the top of stack element off of ctl_stack. Does not
536 check that ctl_stack is indeed non-NULL. */
540 switch (ctl_stack->type)
544 /* Pointer for chasing down and backpatching BREAKs. */
545 struct break_trns *brk;
547 /* Terminate the loop. */
548 thr = xmalloc (sizeof *thr);
549 thr->h.proc = loop_3_trns_proc;
550 thr->h.free = loop_3_trns_free;
552 thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
553 add_transformation ((struct trns_header *) thr);
556 ((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns;
557 for (brk = ctl_stack->brk; brk; brk = brk->next)
558 brk->loop_term = n_trns;
564 struct do_if_trns *iter;
566 iter = ((struct do_if_trns *) ctl_stack->trns);
570 iter->brk->dest = n_trns;
571 iter->missing_jump = n_trns;
577 iter->false_jump = n_trns;
583 ctl_stack = ctl_stack->down;
586 /* Checks for unclosed LOOPs and DO IFs and closes them out. */
588 discard_ctl_stack (void)
592 msg (SE, _("%s without %s."), ctl_stack->type == CST_LOOP ? "LOOP" : "DO IF",
593 ctl_stack->type == CST_LOOP ? "END LOOP" : "END IF");