1 /* PSPP - a program for statistical analysis.
2 Copyright (C) 1997-9, 2000, 2009-2011 Free Software Foundation, Inc.
4 This program is free software: you can redistribute it and/or modify
5 it under the terms of the GNU General Public License as published by
6 the Free Software Foundation, either version 3 of the License, or
7 (at your option) any later version.
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 GNU General Public License for more details.
14 You should have received a copy of the GNU General Public License
15 along with this program. If not, see <http://www.gnu.org/licenses/>. */
19 #include "language/control/control-stack.h"
21 #include "data/case.h"
22 #include "data/dataset.h"
23 #include "data/dictionary.h"
24 #include "data/settings.h"
25 #include "data/transformations.h"
26 #include "data/variable.h"
27 #include "language/command.h"
28 #include "language/expressions/public.h"
29 #include "language/lexer/lexer.h"
30 #include "libpspp/compiler.h"
31 #include "libpspp/message.h"
32 #include "libpspp/misc.h"
33 #include "libpspp/pool.h"
34 #include "libpspp/str.h"
36 #include "gl/xalloc.h"
39 #define _(msgid) gettext (msgid)
41 /* LOOP outputs a transformation that is executed only on the
42 first pass through the loop. On this trip, it initializes for
43 the first pass by resetting the pass number, setting up the
44 indexing clause, and testing the LOOP IF clause. If the loop
45 is not to be entered at all, it jumps forward just past the
46 END LOOP transformation; otherwise, it continues to the
47 transformation following LOOP.
49 END LOOP outputs a transformation that executes at the end of
50 each trip through the loop. It checks the END LOOP IF clause,
51 then updates the pass number, increments the indexing clause,
52 and tests the LOOP IF clause. If another pass through the
53 loop is due, it jumps backward to just after the LOOP
54 transformation; otherwise, it continues to the transformation
55 following END LOOP. */
62 /* Iteration limit. */
63 int max_pass_count; /* Maximum number of passes (-1=unlimited). */
64 int pass; /* Number of passes through the loop so far. */
66 /* a=a TO b [BY c]. */
67 struct variable *index_var; /* Index variable. */
68 struct expression *first_expr; /* Starting index. */
69 struct expression *by_expr; /* Index increment (default 1.0 if null). */
70 struct expression *last_expr; /* Terminal index. */
71 double cur, by, last; /* Current value, increment, last value. */
73 /* IF condition for LOOP or END LOOP. */
74 struct expression *loop_condition;
75 struct expression *end_loop_condition;
77 /* Transformation indexes. */
78 int past_LOOP_index; /* Just past LOOP transformation. */
79 int past_END_LOOP_index; /* Just past END LOOP transformation. */
82 static const struct ctl_class loop_class;
84 static trns_finalize_func loop_trns_finalize;
85 static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
86 static trns_free_func loop_trns_free;
88 static struct loop_trns *create_loop_trns (struct dataset *);
89 static bool parse_if_clause (struct lexer *,
90 struct loop_trns *, struct expression **);
91 static bool parse_index_clause (struct dataset *, struct lexer *,
92 struct loop_trns *, bool *created_index_var);
93 static void close_loop (void *);
99 cmd_loop (struct lexer *lexer, struct dataset *ds)
101 struct loop_trns *loop;
102 bool created_index_var = false;
105 loop = create_loop_trns (ds);
106 while (lex_token (lexer) != T_ENDCMD && ok)
108 if (lex_match_id (lexer, "IF"))
109 ok = parse_if_clause (lexer, loop, &loop->loop_condition);
111 ok = parse_index_clause (ds, lexer, loop, &created_index_var);
114 /* Clean up if necessary. */
117 loop->max_pass_count = 0;
118 if (loop->index_var != NULL && created_index_var)
120 dict_delete_var (dataset_dict (ds), loop->index_var);
121 loop->index_var = NULL;
125 return ok ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
128 /* Parses END LOOP. */
130 cmd_end_loop (struct lexer *lexer, struct dataset *ds)
132 struct loop_trns *loop;
135 loop = ctl_stack_top (&loop_class);
137 return CMD_CASCADING_FAILURE;
139 assert (loop->ds == ds);
142 if (lex_match_id (lexer, "IF"))
143 ok = parse_if_clause (lexer, loop, &loop->end_loop_condition);
145 ok = lex_end_of_command (lexer) == CMD_SUCCESS;
148 loop->max_pass_count = 0;
150 ctl_stack_pop (loop);
152 return ok ? CMD_SUCCESS : CMD_FAILURE;
157 cmd_break (struct lexer *lexer UNUSED, struct dataset *ds)
159 struct ctl_stmt *loop = ctl_stack_search (&loop_class);
161 return CMD_CASCADING_FAILURE;
163 add_transformation (ds, break_trns_proc, NULL, loop);
168 /* Closes a LOOP construct by emitting the END LOOP
169 transformation and finalizing its members appropriately. */
171 close_loop (void *loop_)
173 struct loop_trns *loop = loop_;
175 add_transformation (loop->ds, end_loop_trns_proc, NULL, loop);
176 loop->past_END_LOOP_index = next_transformation (loop->ds);
178 /* If there's nothing else limiting the number of loops, use
179 MXLOOPS as a limit. */
180 if (loop->max_pass_count == -1 && loop->index_var == NULL)
181 loop->max_pass_count = settings_get_mxloops ();
184 /* Parses an IF clause for LOOP or END LOOP and stores the
185 resulting expression to *CONDITION.
186 Returns true if successful, false on failure. */
188 parse_if_clause (struct lexer *lexer,
189 struct loop_trns *loop, struct expression **condition)
191 if (*condition != NULL)
193 lex_sbc_only_once ("IF");
197 *condition = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_BOOLEAN);
198 return *condition != NULL;
201 /* Parses an indexing clause into LOOP.
202 Stores true in *CREATED_INDEX_VAR if the index clause created
203 a new variable, false otherwise.
204 Returns true if successful, false on failure. */
206 parse_index_clause (struct dataset *ds, struct lexer *lexer,
207 struct loop_trns *loop, bool *created_index_var)
209 if (loop->index_var != NULL)
211 msg (SE, _("Only one index clause may be specified."));
215 if (lex_token (lexer) != T_ID)
217 lex_error (lexer, NULL);
221 loop->index_var = dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer));
222 if (loop->index_var != NULL)
223 *created_index_var = false;
226 loop->index_var = dict_create_var_assert (dataset_dict (ds),
227 lex_tokcstr (lexer), 0);
228 *created_index_var = true;
232 if (!lex_force_match (lexer, T_EQUALS))
235 loop->first_expr = expr_parse_pool (lexer, loop->pool,
236 loop->ds, EXPR_NUMBER);
237 if (loop->first_expr == NULL)
242 struct expression **e;
243 if (lex_match (lexer, T_TO))
244 e = &loop->last_expr;
245 else if (lex_match (lexer, T_BY))
252 lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
255 *e = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_NUMBER);
259 if (loop->last_expr == NULL)
261 lex_sbc_missing ("TO");
264 if (loop->by_expr == NULL)
270 /* Creates, initializes, and returns a new loop_trns. */
271 static struct loop_trns *
272 create_loop_trns (struct dataset *ds)
274 struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
275 loop->max_pass_count = -1;
277 loop->index_var = NULL;
278 loop->first_expr = loop->by_expr = loop->last_expr = NULL;
279 loop->loop_condition = loop->end_loop_condition = NULL;
282 add_transformation_with_finalizer (ds, loop_trns_finalize,
283 loop_trns_proc, loop_trns_free, loop);
284 loop->past_LOOP_index = next_transformation (ds);
286 ctl_stack_push (&loop_class, loop);
291 /* Finalizes LOOP by clearing the control stack, thus ensuring
292 that all open LOOPs are closed. */
294 loop_trns_finalize (void *do_if_ UNUSED)
296 /* This will be called multiple times if multiple LOOPs were
297 executed, which is slightly unclean, but at least it's
302 /* Sets up LOOP for the first pass. */
304 loop_trns_proc (void *loop_, struct ccase **c, casenumber case_num)
306 struct loop_trns *loop = loop_;
308 if (loop->index_var != NULL)
310 /* Evaluate loop index expressions. */
311 loop->cur = expr_evaluate_num (loop->first_expr, *c, case_num);
312 if (loop->by_expr != NULL)
313 loop->by = expr_evaluate_num (loop->by_expr, *c, case_num);
314 loop->last = expr_evaluate_num (loop->last_expr, *c, case_num);
316 /* Even if the loop is never entered, set the index
317 variable to the initial value. */
318 *c = case_unshare (*c);
319 case_data_rw (*c, loop->index_var)->f = loop->cur;
321 /* Throw out pathological cases. */
322 if (!isfinite (loop->cur) || !isfinite (loop->by)
323 || !isfinite (loop->last)
325 || (loop->by > 0.0 && loop->cur > loop->last)
326 || (loop->by < 0.0 && loop->cur < loop->last))
330 /* Initialize pass count. */
332 if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
335 /* Check condition. */
336 if (loop->loop_condition != NULL
337 && expr_evaluate_num (loop->loop_condition, *c, case_num) != 1.0)
340 return loop->past_LOOP_index;
343 return loop->past_END_LOOP_index;
348 loop_trns_free (void *loop_)
350 struct loop_trns *loop = loop_;
352 pool_destroy (loop->pool);
356 /* Finishes a pass through the loop and starts the next. */
358 end_loop_trns_proc (void *loop_, struct ccase **c, casenumber case_num UNUSED)
360 struct loop_trns *loop = loop_;
362 if (loop->end_loop_condition != NULL
363 && expr_evaluate_num (loop->end_loop_condition, *c, case_num) != 0.0)
366 /* MXLOOPS limiter. */
367 if (loop->max_pass_count >= 0 && ++loop->pass >= loop->max_pass_count)
370 /* Indexing clause limiter: counting downward. */
371 if (loop->index_var != NULL)
373 loop->cur += loop->by;
374 if ((loop->by > 0.0 && loop->cur > loop->last)
375 || (loop->by < 0.0 && loop->cur < loop->last))
377 *c = case_unshare (*c);
378 case_data_rw (*c, loop->index_var)->f = loop->cur;
381 if (loop->loop_condition != NULL
382 && expr_evaluate_num (loop->loop_condition, *c, case_num) != 1.0)
385 return loop->past_LOOP_index;
388 return loop->past_END_LOOP_index;
391 /* Executes BREAK. */
393 break_trns_proc (void *loop_, struct ccase **c UNUSED,
394 casenumber case_num UNUSED)
396 struct loop_trns *loop = loop_;
398 return loop->past_END_LOOP_index;
401 /* LOOP control structure class definition. */
402 static const struct ctl_class loop_class =