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 int break_trns_proc (struct trns_header *, struct ccase *);
144 static int loop_1_trns_proc (struct trns_header *, struct ccase *);
145 static void loop_1_trns_free (struct trns_header *);
146 static int loop_2_trns_proc (struct trns_header *, struct ccase *);
147 static void loop_2_trns_free (struct trns_header *);
148 static int loop_3_trns_proc (struct trns_header *, struct ccase *);
149 static void loop_3_trns_free (struct trns_header *);
150 static void pop_ctl_stack (void);
154 /* Parses a LOOP command. Passes the real work off to
155 internal_cmd_loop(). */
159 if (!internal_cmd_loop ())
161 loop_1_trns_free ((struct trns_header *) one);
162 loop_2_trns_free ((struct trns_header *) two);
169 /* Parses a LOOP command, returns success. */
171 internal_cmd_loop (void)
173 /* Name of indexing variable if applicable. */
176 lex_match_id ("LOOP");
178 /* Create and initialize transformations to facilitate
180 two = xmalloc (sizeof *two);
181 two->h.proc = loop_2_trns_proc;
182 two->h.free = loop_2_trns_free;
186 one = xmalloc (sizeof *one);
187 one->h.proc = loop_1_trns_proc;
188 one->h.free = loop_1_trns_free;
189 one->init = one->incr = one->term = NULL;
192 /* Parse indexing clause. */
193 if (token == T_ID && lex_look_ahead () == '=')
195 struct variable *v = dict_lookup_var (default_dict, tokid);
197 two->flags |= LPC_INDEX;
199 if (v && v->type == ALPHA)
201 msg (SE, _("The index variable may not be a string variable."));
204 strcpy (name, tokid);
207 assert (token == '=');
210 one->init = expr_parse (PXP_NUMERIC);
214 if (!lex_force_match (T_TO))
216 expr_free (one->init);
219 one->term = expr_parse (PXP_NUMERIC);
222 expr_free (one->init);
226 if (lex_match (T_BY))
228 one->incr = expr_parse (PXP_NUMERIC);
236 /* Parse IF clause. */
237 if (lex_match_id ("IF"))
239 two->flags |= LPC_COND;
241 two->cond = expr_parse (PXP_BOOLEAN);
248 lex_error (_("expecting end of command"));
252 /* Find variable; create if necessary. */
255 two->index = dict_lookup_var (default_dict, name);
257 two->index = dict_create_var (default_dict, name, 0);
260 /* Push on control stack. */
261 two->ctl.down = ctl_stack;
262 two->ctl.type = CST_LOOP;
263 two->ctl.trns = (struct trns_header *) two;
265 ctl_stack = &two->ctl;
267 /* Dump out the transformations. */
268 add_transformation ((struct trns_header *) one);
269 add_transformation ((struct trns_header *) two);
273 if (two->flags & LPC_INDEX)
275 if (two->flags & LPC_COND)
283 /* Parses the END LOOP command by passing the buck off to
284 cmd_internal_end_loop(). */
288 if (!internal_cmd_end_loop ())
290 loop_3_trns_free ((struct trns_header *) thr);
291 if (ctl_stack && ctl_stack->type == CST_LOOP)
299 /* Parses the END LOOP command. */
301 internal_cmd_end_loop (void)
303 /* Backpatch pointer for BREAK commands. */
304 struct break_trns *brk;
306 /* Allocate, initialize transformation to facilitate
308 thr = xmalloc (sizeof *thr);
309 thr->h.proc = loop_3_trns_proc;
310 thr->h.free = loop_3_trns_free;
313 /* There must be a matching LOOP command. */
314 if (!ctl_stack || ctl_stack->type != CST_LOOP)
316 msg (SE, _("There is no LOOP command that corresponds to this "
320 thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
322 /* Parse the expression if any. */
323 if (lex_match_id ("IF"))
325 thr->cond = expr_parse (PXP_BOOLEAN);
330 add_transformation ((struct trns_header *) thr);
333 ((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns;
334 for (brk = ctl_stack->brk; brk; brk = brk->next)
335 brk->loop_term = n_trns;
337 /* Pop off the top of stack. */
338 ctl_stack = ctl_stack->down;
350 /* Performs transformation 1. */
352 loop_1_trns_proc (struct trns_header * trns, struct ccase * c)
354 struct loop_1_trns *one = (struct loop_1_trns *) trns;
355 struct loop_2_trns *two = one->two;
358 if (two->flags & LPC_INDEX)
360 union value t1, t2, t3;
362 expr_evaluate (one->init, c, &t1);
364 expr_evaluate (one->incr, c, &t2);
367 expr_evaluate (one->term, c, &t3);
369 /* Even if the loop is never entered, force the index variable
370 to assume the initial value. */
371 c->data[two->index->fv].f = t1.f;
373 /* Throw out various pathological cases. */
374 if (!finite (t1.f) || !finite (t2.f) || !finite (t3.f) || t2.f == 0.0)
375 return two->loop_term;
376 debug_printf (("LOOP %s=%g TO %g BY %g.\n", two->index->name,
380 /* Loop counts upward: I=1 TO 5 BY 1. */
381 two->flags &= ~LPC_RINDEX;
383 /* incr>0 but init>term */
385 return two->loop_term;
389 /* Loop counts downward: I=5 TO 1 BY -1. */
390 two->flags |= LPC_RINDEX;
392 /* incr<0 but init<term */
394 return two->loop_term;
405 /* Frees transformation 1. */
407 loop_1_trns_free (struct trns_header * trns)
409 struct loop_1_trns *one = (struct loop_1_trns *) trns;
411 expr_free (one->init);
412 expr_free (one->incr);
413 expr_free (one->term);
416 /* Performs transformation 2. */
418 loop_2_trns_proc (struct trns_header * trns, struct ccase * c)
420 struct loop_2_trns *two = (struct loop_2_trns *) trns;
422 /* MXLOOPS limiter. */
426 if (two->pass > set_mxloops)
427 return two->loop_term;
430 /* Indexing clause limiter: counting downward. */
431 if (two->flags & LPC_RINDEX)
433 /* Test if we're at the end of the looping. */
434 if (two->curr < two->term)
435 return two->loop_term;
437 /* Set the current value into the case. */
438 c->data[two->index->fv].f = two->curr;
440 /* Decrement the current value. */
441 two->curr += two->incr;
443 /* Indexing clause limiter: counting upward. */
444 else if (two->flags & LPC_INDEX)
446 /* Test if we're at the end of the looping. */
447 if (two->curr > two->term)
448 return two->loop_term;
450 /* Set the current value into the case. */
451 c->data[two->index->fv].f = two->curr;
453 /* Increment the current value. */
454 two->curr += two->incr;
457 /* Conditional clause limiter. */
458 if ((two->flags & LPC_COND)
459 && expr_evaluate (two->cond, c, NULL) != 1.0)
460 return two->loop_term;
465 /* Frees transformation 2. */
467 loop_2_trns_free (struct trns_header * trns)
469 struct loop_2_trns *two = (struct loop_2_trns *) trns;
471 expr_free (two->cond);
474 /* Performs transformation 3. */
476 loop_3_trns_proc (struct trns_header * trns, struct ccase * c)
478 struct loop_3_trns *thr = (struct loop_3_trns *) trns;
480 /* Note that it breaks out of the loop if the expression is true *or
481 missing*. This is conformant. */
482 if (thr->cond && expr_evaluate (two->cond, c, NULL) != 0.0)
485 return thr->loop_start;
488 /* Frees transformation 3. */
490 loop_3_trns_free (struct trns_header * trns)
492 struct loop_3_trns *thr = (struct loop_3_trns *) trns;
494 expr_free (thr->cond);
499 /* Parses the BREAK command. */
503 /* Climbs down the stack to find a LOOP. */
504 struct ctl_stmt *loop;
506 /* New transformation. */
507 struct break_trns *t;
509 lex_match_id ("BREAK");
511 for (loop = ctl_stack; loop; loop = loop->down)
512 if (loop->type == CST_LOOP)
516 msg (SE, _("This command may only appear enclosed in a LOOP/"
517 "END LOOP control structure."));
521 if (ctl_stack->type != CST_DO_IF)
522 msg (SW, _("BREAK not enclosed in DO IF structure."));
524 t = xmalloc (sizeof *t);
525 t->h.proc = break_trns_proc;
529 add_transformation ((struct trns_header *) t);
531 return lex_end_of_command ();
535 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");