1 /* PSPP - a program for statistical analysis.
2 Copyright (C) 1997-9, 2000, 2009-2011, 2013 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 thru 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_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
85 static trns_free_func loop_trns_free;
87 static struct loop_trns *create_loop_trns (struct dataset *);
88 static bool parse_if_clause (struct lexer *,
89 struct loop_trns *, struct expression **);
90 static bool parse_index_clause (struct dataset *, struct lexer *,
91 struct loop_trns *, bool *created_index_var);
92 static void close_loop (void *);
98 cmd_loop (struct lexer *lexer, struct dataset *ds)
100 struct loop_trns *loop;
101 bool created_index_var = false;
104 loop = create_loop_trns (ds);
105 while (lex_token (lexer) != T_ENDCMD && ok)
107 if (lex_match_id (lexer, "IF"))
108 ok = parse_if_clause (lexer, loop, &loop->loop_condition);
110 ok = parse_index_clause (ds, lexer, loop, &created_index_var);
113 /* Clean up if necessary. */
116 loop->max_pass_count = 0;
117 if (loop->index_var != NULL && created_index_var)
119 dict_delete_var (dataset_dict (ds), loop->index_var);
120 loop->index_var = NULL;
124 return ok ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
127 /* Parses END LOOP. */
129 cmd_end_loop (struct lexer *lexer, struct dataset *ds)
131 struct loop_trns *loop;
134 loop = ctl_stack_top (&loop_class);
136 return CMD_CASCADING_FAILURE;
138 assert (loop->ds == ds);
141 if (lex_match_id (lexer, "IF"))
142 ok = parse_if_clause (lexer, loop, &loop->end_loop_condition);
144 ok = lex_end_of_command (lexer) == CMD_SUCCESS;
147 loop->max_pass_count = 0;
149 ctl_stack_pop (loop);
151 return ok ? CMD_SUCCESS : CMD_FAILURE;
156 cmd_break (struct lexer *lexer UNUSED, struct dataset *ds)
158 struct ctl_stmt *loop = ctl_stack_search (&loop_class);
160 return CMD_CASCADING_FAILURE;
162 add_transformation (ds, break_trns_proc, NULL, loop);
167 /* Closes a LOOP construct by emitting the END LOOP
168 transformation and finalizing its members appropriately. */
170 close_loop (void *loop_)
172 struct loop_trns *loop = loop_;
174 add_transformation (loop->ds, end_loop_trns_proc, NULL, loop);
175 loop->past_END_LOOP_index = next_transformation (loop->ds);
177 /* If there's nothing else limiting the number of loops, use
178 MXLOOPS as a limit. */
179 if (loop->max_pass_count == -1
180 && loop->index_var == NULL
181 && loop->loop_condition == NULL
182 && loop->end_loop_condition == NULL)
183 loop->max_pass_count = settings_get_mxloops ();
186 /* Parses an IF clause for LOOP or END LOOP and stores the
187 resulting expression to *CONDITION.
188 Returns true if successful, false on failure. */
190 parse_if_clause (struct lexer *lexer,
191 struct loop_trns *loop, struct expression **condition)
193 if (*condition != NULL)
195 lex_sbc_only_once ("IF");
199 *condition = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_BOOLEAN);
200 return *condition != NULL;
203 /* Parses an indexing clause into LOOP.
204 Stores true in *CREATED_INDEX_VAR if the index clause created
205 a new variable, false otherwise.
206 Returns true if successful, false on failure. */
208 parse_index_clause (struct dataset *ds, struct lexer *lexer,
209 struct loop_trns *loop, bool *created_index_var)
211 if (loop->index_var != NULL)
213 msg (SE, _("Only one index clause may be specified."));
217 if (lex_token (lexer) != T_ID)
219 lex_error (lexer, NULL);
223 loop->index_var = dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer));
224 if (loop->index_var != NULL)
225 *created_index_var = false;
228 loop->index_var = dict_create_var_assert (dataset_dict (ds),
229 lex_tokcstr (lexer), 0);
230 *created_index_var = true;
234 if (!lex_force_match (lexer, T_EQUALS))
237 loop->first_expr = expr_parse_pool (lexer, loop->pool,
238 loop->ds, EXPR_NUMBER);
239 if (loop->first_expr == NULL)
244 struct expression **e;
245 if (lex_match (lexer, T_TO))
246 e = &loop->last_expr;
247 else if (lex_match (lexer, T_BY))
254 lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
257 *e = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_NUMBER);
261 if (loop->last_expr == NULL)
263 lex_sbc_missing ("TO");
266 if (loop->by_expr == NULL)
272 /* Creates, initializes, and returns a new loop_trns. */
273 static struct loop_trns *
274 create_loop_trns (struct dataset *ds)
276 struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
277 loop->max_pass_count = -1;
279 loop->index_var = NULL;
280 loop->first_expr = loop->by_expr = loop->last_expr = NULL;
281 loop->loop_condition = loop->end_loop_condition = NULL;
284 add_transformation (ds, loop_trns_proc, loop_trns_free, loop);
285 loop->past_LOOP_index = next_transformation (ds);
287 ctl_stack_push (&loop_class, loop);
292 /* Sets up LOOP for the first pass. */
294 loop_trns_proc (void *loop_, struct ccase **c, casenumber case_num)
296 struct loop_trns *loop = loop_;
298 if (loop->index_var != NULL)
300 /* Evaluate loop index expressions. */
301 loop->cur = expr_evaluate_num (loop->first_expr, *c, case_num);
302 if (loop->by_expr != NULL)
303 loop->by = expr_evaluate_num (loop->by_expr, *c, case_num);
304 loop->last = expr_evaluate_num (loop->last_expr, *c, case_num);
306 /* Even if the loop is never entered, set the index
307 variable to the initial value. */
308 *c = case_unshare (*c);
309 case_data_rw (*c, loop->index_var)->f = loop->cur;
311 /* Throw out pathological cases. */
312 if (!isfinite (loop->cur) || !isfinite (loop->by)
313 || !isfinite (loop->last)
315 || (loop->by > 0.0 && loop->cur > loop->last)
316 || (loop->by < 0.0 && loop->cur < loop->last))
320 /* Initialize pass count. */
322 if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
325 /* Check condition. */
326 if (loop->loop_condition != NULL
327 && expr_evaluate_num (loop->loop_condition, *c, case_num) != 1.0)
330 return loop->past_LOOP_index;
333 return loop->past_END_LOOP_index;
338 loop_trns_free (void *loop_)
340 struct loop_trns *loop = loop_;
342 pool_destroy (loop->pool);
346 /* Finishes a pass through the loop and starts the next. */
348 end_loop_trns_proc (void *loop_, struct ccase **c, casenumber case_num UNUSED)
350 struct loop_trns *loop = loop_;
352 if (loop->end_loop_condition != NULL
353 && expr_evaluate_num (loop->end_loop_condition, *c, case_num) != 0.0)
356 /* MXLOOPS limiter. */
357 if (loop->max_pass_count >= 0 && ++loop->pass >= loop->max_pass_count)
360 /* Indexing clause limiter: counting downward. */
361 if (loop->index_var != NULL)
363 loop->cur += loop->by;
364 if ((loop->by > 0.0 && loop->cur > loop->last)
365 || (loop->by < 0.0 && loop->cur < loop->last))
367 *c = case_unshare (*c);
368 case_data_rw (*c, loop->index_var)->f = loop->cur;
371 if (loop->loop_condition != NULL
372 && expr_evaluate_num (loop->loop_condition, *c, case_num) != 1.0)
375 return loop->past_LOOP_index;
378 return loop->past_END_LOOP_index;
381 /* Executes BREAK. */
383 break_trns_proc (void *loop_, struct ccase **c UNUSED,
384 casenumber case_num UNUSED)
386 struct loop_trns *loop = loop_;
388 return loop->past_END_LOOP_index;
391 /* LOOP control structure class definition. */
392 static const struct ctl_class loop_class =