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"
20 #include <data/case.h>
21 #include <data/dictionary.h>
22 #include <data/procedure.h>
23 #include <data/settings.h>
24 #include <data/transformations.h>
25 #include <data/variable.h>
26 #include <language/command.h>
27 #include <language/expressions/public.h>
28 #include <language/lexer/lexer.h>
29 #include <libpspp/alloc.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>
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. */
60 /* Iteration limit. */
61 int max_pass_count; /* Maximum number of passes (-1=unlimited). */
62 int pass; /* Number of passes thru the loop so far. */
64 /* a=a TO b [BY c]. */
65 struct variable *index_var; /* Index variable. */
66 struct expression *first_expr; /* Starting index. */
67 struct expression *by_expr; /* Index increment (default 1.0 if null). */
68 struct expression *last_expr; /* Terminal index. */
69 double cur, by, last; /* Current value, increment, last value. */
71 /* IF condition for LOOP or END LOOP. */
72 struct expression *loop_condition;
73 struct expression *end_loop_condition;
75 /* Transformation indexes. */
76 int past_LOOP_index; /* Just past LOOP transformation. */
77 int past_END_LOOP_index; /* Just past END LOOP transformation. */
80 static const struct ctl_class loop_class;
82 static trns_finalize_func loop_trns_finalize;
83 static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
84 static trns_free_func loop_trns_free;
86 static struct loop_trns *create_loop_trns (struct dataset *);
87 static bool parse_if_clause (struct lexer *,
88 struct loop_trns *, struct expression **);
89 static bool parse_index_clause (struct dataset *, struct lexer *,
90 struct loop_trns *, bool *created_index_var);
91 static void close_loop (void *);
97 cmd_loop (struct lexer *lexer, struct dataset *ds)
99 struct loop_trns *loop;
100 bool created_index_var = false;
103 loop = create_loop_trns (ds);
104 while (lex_token (lexer) != '.' && ok)
106 if (lex_match_id (lexer, "IF"))
107 ok = parse_if_clause (lexer, loop, &loop->loop_condition);
109 ok = parse_index_clause (ds, lexer, loop, &created_index_var);
112 /* Clean up if necessary. */
115 loop->max_pass_count = 0;
116 if (loop->index_var != NULL && created_index_var)
118 dict_delete_var (dataset_dict (ds), loop->index_var);
119 loop->index_var = NULL;
123 return ok ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
126 /* Parses END LOOP. */
128 cmd_end_loop (struct lexer *lexer, struct dataset *ds)
130 struct loop_trns *loop;
133 loop = ctl_stack_top (&loop_class);
135 return CMD_CASCADING_FAILURE;
137 assert (loop->ds == ds);
140 if (lex_match_id (lexer, "IF"))
141 ok = parse_if_clause (lexer, loop, &loop->end_loop_condition);
143 ok = lex_end_of_command (lexer) == CMD_SUCCESS;
146 loop->max_pass_count = 0;
148 ctl_stack_pop (loop);
150 return ok ? CMD_SUCCESS : CMD_FAILURE;
155 cmd_break (struct lexer *lexer, struct dataset *ds)
157 struct ctl_stmt *loop = ctl_stack_search (&loop_class);
159 return CMD_CASCADING_FAILURE;
161 add_transformation (ds, break_trns_proc, NULL, loop);
163 return lex_end_of_command (lexer);
166 /* Closes a LOOP construct by emitting the END LOOP
167 transformation and finalizing its members appropriately. */
169 close_loop (void *loop_)
171 struct loop_trns *loop = loop_;
173 add_transformation (loop->ds, end_loop_trns_proc, NULL, loop);
174 loop->past_END_LOOP_index = next_transformation (loop->ds);
176 /* If there's nothing else limiting the number of loops, use
177 MXLOOPS as a limit. */
178 if (loop->max_pass_count == -1
179 && loop->index_var == NULL
180 && loop->loop_condition == NULL
181 && loop->end_loop_condition == NULL)
182 loop->max_pass_count = get_mxloops ();
185 /* Parses an IF clause for LOOP or END LOOP and stores the
186 resulting expression to *CONDITION.
187 Returns true if successful, false on failure. */
189 parse_if_clause (struct lexer *lexer,
190 struct loop_trns *loop, struct expression **condition)
192 if (*condition != NULL)
194 lex_sbc_only_once ("IF");
198 *condition = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_BOOLEAN);
199 return *condition != NULL;
202 /* Parses an indexing clause into LOOP.
203 Stores true in *CREATED_INDEX_VAR if the index clause created
204 a new variable, false otherwise.
205 Returns true if successful, false on failure. */
207 parse_index_clause (struct dataset *ds, struct lexer *lexer,
208 struct loop_trns *loop, bool *created_index_var)
210 if (loop->index_var != NULL)
212 msg (SE, _("Only one index clause may be specified."));
216 if (lex_token (lexer) != T_ID)
218 lex_error (lexer, NULL);
222 loop->index_var = dict_lookup_var (dataset_dict (ds), lex_tokid (lexer));
223 if (loop->index_var != NULL)
224 *created_index_var = false;
227 loop->index_var = dict_create_var_assert (dataset_dict (ds),
228 lex_tokid (lexer), 0);
229 *created_index_var = true;
233 if (!lex_force_match (lexer, '='))
236 loop->first_expr = expr_parse_pool (lexer, loop->pool,
237 loop->ds, EXPR_NUMBER);
238 if (loop->first_expr == NULL)
243 struct expression **e;
244 if (lex_match (lexer, T_TO))
245 e = &loop->last_expr;
246 else if (lex_match (lexer, T_BY))
253 lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
256 *e = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_NUMBER);
260 if (loop->last_expr == NULL)
262 lex_sbc_missing (lexer, "TO");
265 if (loop->by_expr == NULL)
271 /* Creates, initializes, and returns a new loop_trns. */
272 static struct loop_trns *
273 create_loop_trns (struct dataset *ds)
275 struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
276 loop->max_pass_count = -1;
278 loop->index_var = NULL;
279 loop->first_expr = loop->by_expr = loop->last_expr = NULL;
280 loop->loop_condition = loop->end_loop_condition = NULL;
283 add_transformation_with_finalizer (ds, loop_trns_finalize,
284 loop_trns_proc, loop_trns_free, loop);
285 loop->past_LOOP_index = next_transformation (ds);
287 ctl_stack_push (&loop_class, loop);
292 /* Finalizes LOOP by clearing the control stack, thus ensuring
293 that all open LOOPs are closed. */
295 loop_trns_finalize (void *do_if_ UNUSED)
297 /* This will be called multiple times if multiple LOOPs were
298 executed, which is slightly unclean, but at least it's
303 /* Sets up LOOP for the first pass. */
305 loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num)
307 struct loop_trns *loop = loop_;
309 if (loop->index_var != NULL)
311 /* Evaluate loop index expressions. */
312 loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
313 if (loop->by_expr != NULL)
314 loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
315 loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
317 /* Even if the loop is never entered, set the index
318 variable to the initial value. */
319 case_data_rw (c, loop->index_var)->f = loop->cur;
321 /* Throw out pathological cases. */
322 if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
324 || (loop->by > 0.0 && loop->cur > loop->last)
325 || (loop->by < 0.0 && loop->cur < loop->last))
329 /* Initialize pass count. */
331 if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
334 /* Check condition. */
335 if (loop->loop_condition != NULL
336 && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
339 return loop->past_LOOP_index;
342 return loop->past_END_LOOP_index;
347 loop_trns_free (void *loop_)
349 struct loop_trns *loop = loop_;
351 pool_destroy (loop->pool);
355 /* Finishes a pass through the loop and starts the next. */
357 end_loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num UNUSED)
359 struct loop_trns *loop = loop_;
361 if (loop->end_loop_condition != NULL
362 && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 0.0)
365 /* MXLOOPS limiter. */
366 if (loop->max_pass_count >= 0)
368 if (loop->pass >= loop->max_pass_count)
373 /* Indexing clause limiter: counting downward. */
374 if (loop->index_var != NULL)
376 loop->cur += loop->by;
377 if ((loop->by > 0.0 && loop->cur > loop->last)
378 || (loop->by < 0.0 && loop->cur < loop->last))
380 case_data_rw (c, loop->index_var)->f = loop->cur;
383 if (loop->loop_condition != NULL
384 && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
387 return loop->past_LOOP_index;
390 return loop->past_END_LOOP_index;
393 /* Executes BREAK. */
395 break_trns_proc (void *loop_, struct ccase *c UNUSED, casenumber case_num UNUSED)
397 struct loop_trns *loop = loop_;
399 return loop->past_END_LOOP_index;
402 /* LOOP control structure class definition. */
403 static const struct ctl_class loop_class =