1 /* PSPP - a program for statistical analysis.
2 Copyright (C) 1997-9, 2000 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 "control-stack.h"
21 #include <gsl/gsl_math.h>
23 #include <data/case.h>
24 #include <data/dictionary.h>
25 #include <data/procedure.h>
26 #include <data/settings.h>
27 #include <data/transformations.h>
28 #include <data/variable.h>
29 #include <language/command.h>
30 #include <language/expressions/public.h>
31 #include <language/lexer/lexer.h>
32 #include <libpspp/compiler.h>
33 #include <libpspp/message.h>
34 #include <libpspp/misc.h>
35 #include <libpspp/pool.h>
36 #include <libpspp/str.h>
41 #define _(msgid) gettext (msgid)
43 /* LOOP outputs a transformation that is executed only on the
44 first pass through the loop. On this trip, it initializes for
45 the first pass by resetting the pass number, setting up the
46 indexing clause, and testing the LOOP IF clause. If the loop
47 is not to be entered at all, it jumps forward just past the
48 END LOOP transformation; otherwise, it continues to the
49 transformation following LOOP.
51 END LOOP outputs a transformation that executes at the end of
52 each trip through the loop. It checks the END LOOP IF clause,
53 then updates the pass number, increments the indexing clause,
54 and tests the LOOP IF clause. If another pass through the
55 loop is due, it jumps backward to just after the LOOP
56 transformation; otherwise, it continues to the transformation
57 following END LOOP. */
64 /* Iteration limit. */
65 int max_pass_count; /* Maximum number of passes (-1=unlimited). */
66 int pass; /* Number of passes thru the loop so far. */
68 /* a=a TO b [BY c]. */
69 struct variable *index_var; /* Index variable. */
70 struct expression *first_expr; /* Starting index. */
71 struct expression *by_expr; /* Index increment (default 1.0 if null). */
72 struct expression *last_expr; /* Terminal index. */
73 double cur, by, last; /* Current value, increment, last value. */
75 /* IF condition for LOOP or END LOOP. */
76 struct expression *loop_condition;
77 struct expression *end_loop_condition;
79 /* Transformation indexes. */
80 int past_LOOP_index; /* Just past LOOP transformation. */
81 int past_END_LOOP_index; /* Just past END LOOP transformation. */
84 static const struct ctl_class loop_class;
86 static trns_finalize_func loop_trns_finalize;
87 static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
88 static trns_free_func loop_trns_free;
90 static struct loop_trns *create_loop_trns (struct dataset *);
91 static bool parse_if_clause (struct lexer *,
92 struct loop_trns *, struct expression **);
93 static bool parse_index_clause (struct dataset *, struct lexer *,
94 struct loop_trns *, bool *created_index_var);
95 static void close_loop (void *);
101 cmd_loop (struct lexer *lexer, struct dataset *ds)
103 struct loop_trns *loop;
104 bool created_index_var = false;
107 loop = create_loop_trns (ds);
108 while (lex_token (lexer) != '.' && ok)
110 if (lex_match_id (lexer, "IF"))
111 ok = parse_if_clause (lexer, loop, &loop->loop_condition);
113 ok = parse_index_clause (ds, lexer, loop, &created_index_var);
116 /* Clean up if necessary. */
119 loop->max_pass_count = 0;
120 if (loop->index_var != NULL && created_index_var)
122 dict_delete_var (dataset_dict (ds), loop->index_var);
123 loop->index_var = NULL;
127 return ok ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
130 /* Parses END LOOP. */
132 cmd_end_loop (struct lexer *lexer, struct dataset *ds)
134 struct loop_trns *loop;
137 loop = ctl_stack_top (&loop_class);
139 return CMD_CASCADING_FAILURE;
141 assert (loop->ds == ds);
144 if (lex_match_id (lexer, "IF"))
145 ok = parse_if_clause (lexer, loop, &loop->end_loop_condition);
147 ok = lex_end_of_command (lexer) == CMD_SUCCESS;
150 loop->max_pass_count = 0;
152 ctl_stack_pop (loop);
154 return ok ? CMD_SUCCESS : CMD_FAILURE;
159 cmd_break (struct lexer *lexer, struct dataset *ds)
161 struct ctl_stmt *loop = ctl_stack_search (&loop_class);
163 return CMD_CASCADING_FAILURE;
165 add_transformation (ds, break_trns_proc, NULL, loop);
167 return lex_end_of_command (lexer);
170 /* Closes a LOOP construct by emitting the END LOOP
171 transformation and finalizing its members appropriately. */
173 close_loop (void *loop_)
175 struct loop_trns *loop = loop_;
177 add_transformation (loop->ds, end_loop_trns_proc, NULL, loop);
178 loop->past_END_LOOP_index = next_transformation (loop->ds);
180 /* If there's nothing else limiting the number of loops, use
181 MXLOOPS as a limit. */
182 if (loop->max_pass_count == -1
183 && loop->index_var == NULL
184 && loop->loop_condition == NULL
185 && loop->end_loop_condition == NULL)
186 loop->max_pass_count = settings_get_mxloops ();
189 /* Parses an IF clause for LOOP or END LOOP and stores the
190 resulting expression to *CONDITION.
191 Returns true if successful, false on failure. */
193 parse_if_clause (struct lexer *lexer,
194 struct loop_trns *loop, struct expression **condition)
196 if (*condition != NULL)
198 lex_sbc_only_once ("IF");
202 *condition = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_BOOLEAN);
203 return *condition != NULL;
206 /* Parses an indexing clause into LOOP.
207 Stores true in *CREATED_INDEX_VAR if the index clause created
208 a new variable, false otherwise.
209 Returns true if successful, false on failure. */
211 parse_index_clause (struct dataset *ds, struct lexer *lexer,
212 struct loop_trns *loop, bool *created_index_var)
214 if (loop->index_var != NULL)
216 msg (SE, _("Only one index clause may be specified."));
220 if (lex_token (lexer) != T_ID)
222 lex_error (lexer, NULL);
226 loop->index_var = dict_lookup_var (dataset_dict (ds), lex_tokid (lexer));
227 if (loop->index_var != NULL)
228 *created_index_var = false;
231 loop->index_var = dict_create_var_assert (dataset_dict (ds),
232 lex_tokid (lexer), 0);
233 *created_index_var = true;
237 if (!lex_force_match (lexer, '='))
240 loop->first_expr = expr_parse_pool (lexer, loop->pool,
241 loop->ds, EXPR_NUMBER);
242 if (loop->first_expr == NULL)
247 struct expression **e;
248 if (lex_match (lexer, T_TO))
249 e = &loop->last_expr;
250 else if (lex_match (lexer, T_BY))
257 lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
260 *e = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_NUMBER);
264 if (loop->last_expr == NULL)
266 lex_sbc_missing (lexer, "TO");
269 if (loop->by_expr == NULL)
275 /* Creates, initializes, and returns a new loop_trns. */
276 static struct loop_trns *
277 create_loop_trns (struct dataset *ds)
279 struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
280 loop->max_pass_count = -1;
282 loop->index_var = NULL;
283 loop->first_expr = loop->by_expr = loop->last_expr = NULL;
284 loop->loop_condition = loop->end_loop_condition = NULL;
287 add_transformation_with_finalizer (ds, loop_trns_finalize,
288 loop_trns_proc, loop_trns_free, loop);
289 loop->past_LOOP_index = next_transformation (ds);
291 ctl_stack_push (&loop_class, loop);
296 /* Finalizes LOOP by clearing the control stack, thus ensuring
297 that all open LOOPs are closed. */
299 loop_trns_finalize (void *do_if_ UNUSED)
301 /* This will be called multiple times if multiple LOOPs were
302 executed, which is slightly unclean, but at least it's
307 /* Sets up LOOP for the first pass. */
309 loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num)
311 struct loop_trns *loop = loop_;
313 if (loop->index_var != NULL)
315 /* Evaluate loop index expressions. */
316 loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
317 if (loop->by_expr != NULL)
318 loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
319 loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
321 /* Even if the loop is never entered, set the index
322 variable to the initial value. */
323 case_data_rw (c, loop->index_var)->f = loop->cur;
325 /* Throw out pathological cases. */
326 if (!gsl_finite (loop->cur) || !gsl_finite (loop->by)
327 || !gsl_finite (loop->last)
329 || (loop->by > 0.0 && loop->cur > loop->last)
330 || (loop->by < 0.0 && loop->cur < loop->last))
334 /* Initialize pass count. */
336 if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
339 /* Check condition. */
340 if (loop->loop_condition != NULL
341 && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
344 return loop->past_LOOP_index;
347 return loop->past_END_LOOP_index;
352 loop_trns_free (void *loop_)
354 struct loop_trns *loop = loop_;
356 pool_destroy (loop->pool);
360 /* Finishes a pass through the loop and starts the next. */
362 end_loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num UNUSED)
364 struct loop_trns *loop = loop_;
366 if (loop->end_loop_condition != NULL
367 && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 0.0)
370 /* MXLOOPS limiter. */
371 if (loop->max_pass_count >= 0)
373 if (loop->pass >= loop->max_pass_count)
378 /* Indexing clause limiter: counting downward. */
379 if (loop->index_var != NULL)
381 loop->cur += loop->by;
382 if ((loop->by > 0.0 && loop->cur > loop->last)
383 || (loop->by < 0.0 && loop->cur < loop->last))
385 case_data_rw (c, loop->index_var)->f = loop->cur;
388 if (loop->loop_condition != NULL
389 && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
392 return loop->past_LOOP_index;
395 return loop->past_END_LOOP_index;
398 /* Executes BREAK. */
400 break_trns_proc (void *loop_, struct ccase *c UNUSED, casenumber case_num UNUSED)
402 struct loop_trns *loop = loop_;
404 return loop->past_END_LOOP_index;
407 /* LOOP control structure class definition. */
408 static const struct ctl_class loop_class =