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., 51 Franklin Street, Fifth Floor, Boston, MA
25 #include "dictionary.h"
26 #include "control-stack.h"
28 #include "expressions/public.h"
37 #define _(msgid) gettext (msgid)
39 /* LOOP outputs a transformation that is executed only on the
40 first pass through the loop. On this trip, it initializes for
41 the first pass by resetting the pass number, setting up the
42 indexing clause, and testing the LOOP IF clause. If the loop
43 is not to be entered at all, it jumps forward just past the
44 END LOOP transformation; otherwise, it continues to the
45 transformation following LOOP.
47 END LOOP outputs a transformation that executes at the end of
48 each trip through the loop. It checks the END LOOP IF clause,
49 then updates the pass number, increments the indexing clause,
50 and tests the LOOP IF clause. If another pass through the
51 loop is due, it jumps backward to just after the LOOP
52 transformation; otherwise, it continues to the transformation
53 following END LOOP. */
59 /* Iteration limit. */
60 int max_pass_count; /* Maximum number of passes (-1=unlimited). */
61 int pass; /* Number of passes thru the loop so far. */
63 /* a=a TO b [BY c]. */
64 struct variable *index_var; /* Index variable. */
65 struct expression *first_expr; /* Starting index. */
66 struct expression *by_expr; /* Index increment (default 1.0 if null). */
67 struct expression *last_expr; /* Terminal index. */
68 double cur, by, last; /* Current value, increment, last value. */
70 /* IF condition for LOOP or END LOOP. */
71 struct expression *loop_condition;
72 struct expression *end_loop_condition;
74 /* Transformation indexes. */
75 int past_LOOP_index; /* Just past LOOP transformation. */
76 int past_END_LOOP_index; /* Just past END LOOP transformation. */
79 static struct ctl_class loop_class;
81 static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
82 static trns_free_func loop_trns_free;
84 static struct loop_trns *create_loop_trns (void);
85 static bool parse_if_clause (struct loop_trns *, struct expression **);
86 static bool parse_index_clause (struct loop_trns *, char index_var_name[]);
87 static void close_loop (void *);
95 struct loop_trns *loop;
96 char index_var_name[LONG_NAME_LEN + 1];
99 loop = create_loop_trns ();
100 while (token != '.' && ok)
102 if (lex_match_id ("IF"))
103 ok = parse_if_clause (loop, &loop->loop_condition);
105 ok = parse_index_clause (loop, index_var_name);
108 /* Find index variable and create if necessary. */
109 if (ok && index_var_name[0] != '\0')
111 loop->index_var = dict_lookup_var (default_dict, index_var_name);
112 if (loop->index_var == NULL)
113 loop->index_var = dict_create_var (default_dict, index_var_name, 0);
117 loop->max_pass_count = 0;
118 return ok ? CMD_SUCCESS : CMD_PART_SUCCESS;
121 /* Parses END LOOP. */
125 struct loop_trns *loop;
128 loop = ctl_stack_top (&loop_class);
130 return CMD_CASCADING_FAILURE;
133 if (lex_match_id ("IF"))
134 ok = parse_if_clause (loop, &loop->end_loop_condition);
136 ok = lex_end_of_command () == CMD_SUCCESS;
139 loop->max_pass_count = 0;
141 ctl_stack_pop (loop);
143 return ok ? CMD_SUCCESS : CMD_PART_SUCCESS;
150 struct ctl_stmt *loop = ctl_stack_search (&loop_class);
152 return CMD_CASCADING_FAILURE;
154 add_transformation (break_trns_proc, NULL, loop);
156 return lex_end_of_command ();
159 /* Closes a LOOP construct by emitting the END LOOP
160 transformation and finalizing its members appropriately. */
162 close_loop (void *loop_)
164 struct loop_trns *loop = loop_;
166 add_transformation (end_loop_trns_proc, NULL, loop);
167 loop->past_END_LOOP_index = next_transformation ();
169 /* If there's nothing else limiting the number of loops, use
170 MXLOOPS as a limit. */
171 if (loop->max_pass_count == -1
172 && loop->index_var == NULL
173 && loop->loop_condition == NULL
174 && loop->end_loop_condition == NULL)
175 loop->max_pass_count = get_mxloops ();
178 /* Parses an IF clause for LOOP or END LOOP and stores the
179 resulting expression to *CONDITION.
180 Returns true if successful, false on failure. */
182 parse_if_clause (struct loop_trns *loop, struct expression **condition)
184 *condition = expr_parse_pool (loop->pool, default_dict, EXPR_BOOLEAN);
185 return *condition != NULL;
188 /* Parses an indexing clause into LOOP.
189 Stores the index variable's name in INDEX_VAR_NAME[].
190 Returns true if successful, false on failure. */
192 parse_index_clause (struct loop_trns *loop, char index_var_name[])
199 strcpy (index_var_name, tokid);
202 if (!lex_force_match ('='))
205 loop->first_expr = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER);
206 if (loop->first_expr == NULL)
211 struct expression **e;
212 if (lex_match (T_TO))
213 e = &loop->last_expr;
214 else if (lex_match (T_BY))
221 lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
224 *e = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER);
228 if (loop->last_expr == NULL)
230 lex_sbc_missing ("TO");
233 if (loop->by_expr == NULL)
239 /* Creates, initializes, and returns a new loop_trns. */
240 static struct loop_trns *
241 create_loop_trns (void)
243 struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
244 loop->max_pass_count = -1;
246 loop->index_var = NULL;
247 loop->first_expr = loop->by_expr = loop->last_expr = NULL;
248 loop->loop_condition = loop->end_loop_condition = NULL;
250 add_transformation (loop_trns_proc, loop_trns_free, loop);
251 loop->past_LOOP_index = next_transformation ();
253 ctl_stack_push (&loop_class, loop);
258 /* Sets up LOOP for the first pass. */
260 loop_trns_proc (void *loop_, struct ccase *c, int case_num)
262 struct loop_trns *loop = loop_;
264 if (loop->index_var != NULL)
266 /* Evaluate loop index expressions. */
267 loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
268 if (loop->by_expr != NULL)
269 loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
270 loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
272 /* Even if the loop is never entered, set the index
273 variable to the initial value. */
274 case_data_rw (c, loop->index_var->fv)->f = loop->cur;
276 /* Throw out pathological cases. */
277 if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
279 || (loop->by > 0.0 && loop->cur > loop->last)
280 || (loop->by < 0.0 && loop->cur < loop->last))
284 /* Initialize pass count. */
286 if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
289 /* Check condition. */
290 if (loop->loop_condition != NULL
291 && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
294 return loop->past_LOOP_index;
297 return loop->past_END_LOOP_index;
302 loop_trns_free (void *loop_)
304 struct loop_trns *loop = loop_;
306 pool_destroy (loop->pool);
310 /* Finishes a pass through the loop and starts the next. */
312 end_loop_trns_proc (void *loop_, struct ccase *c, int case_num UNUSED)
314 struct loop_trns *loop = loop_;
316 if (loop->end_loop_condition != NULL
317 && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 1.0)
320 /* MXLOOPS limiter. */
321 if (loop->max_pass_count >= 0)
323 if (loop->pass >= loop->max_pass_count)
328 /* Indexing clause limiter: counting downward. */
329 if (loop->index_var != NULL)
331 loop->cur += loop->by;
332 if ((loop->by > 0.0 && loop->cur > loop->last)
333 || (loop->by < 0.0 && loop->cur < loop->last))
335 case_data_rw (c, loop->index_var->fv)->f = loop->cur;
338 if (loop->loop_condition != NULL
339 && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
342 return loop->past_LOOP_index;
345 return loop->past_END_LOOP_index;
348 /* Executes BREAK. */
350 break_trns_proc (void *loop_, struct ccase *c UNUSED, int case_num UNUSED)
352 struct loop_trns *loop = loop_;
354 return loop->past_END_LOOP_index;
357 /* LOOP control structure class definition. */
358 static struct ctl_class loop_class =