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
22 #include "control-stack.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/alloc.h>
33 #include <libpspp/compiler.h>
34 #include <libpspp/message.h>
35 #include <libpspp/misc.h>
36 #include <libpspp/pool.h>
37 #include <libpspp/str.h>
40 #define _(msgid) gettext (msgid)
42 /* LOOP outputs a transformation that is executed only on the
43 first pass through the loop. On this trip, it initializes for
44 the first pass by resetting the pass number, setting up the
45 indexing clause, and testing the LOOP IF clause. If the loop
46 is not to be entered at all, it jumps forward just past the
47 END LOOP transformation; otherwise, it continues to the
48 transformation following LOOP.
50 END LOOP outputs a transformation that executes at the end of
51 each trip through the loop. It checks the END LOOP IF clause,
52 then updates the pass number, increments the indexing clause,
53 and tests the LOOP IF clause. If another pass through the
54 loop is due, it jumps backward to just after the LOOP
55 transformation; otherwise, it continues to the transformation
56 following END LOOP. */
63 /* Iteration limit. */
64 int max_pass_count; /* Maximum number of passes (-1=unlimited). */
65 int pass; /* Number of passes thru the loop so far. */
67 /* a=a TO b [BY c]. */
68 struct variable *index_var; /* Index variable. */
69 struct expression *first_expr; /* Starting index. */
70 struct expression *by_expr; /* Index increment (default 1.0 if null). */
71 struct expression *last_expr; /* Terminal index. */
72 double cur, by, last; /* Current value, increment, last value. */
74 /* IF condition for LOOP or END LOOP. */
75 struct expression *loop_condition;
76 struct expression *end_loop_condition;
78 /* Transformation indexes. */
79 int past_LOOP_index; /* Just past LOOP transformation. */
80 int past_END_LOOP_index; /* Just past END LOOP transformation. */
83 static const struct ctl_class loop_class;
85 static trns_finalize_func loop_trns_finalize;
86 static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
87 static trns_free_func loop_trns_free;
89 static struct loop_trns *create_loop_trns (struct dataset *);
90 static bool parse_if_clause (struct loop_trns *, struct expression **);
91 static bool parse_index_clause (struct loop_trns *, char index_var_name[]);
92 static void close_loop (void *);
98 cmd_loop (struct dataset *ds)
100 struct loop_trns *loop;
101 char index_var_name[LONG_NAME_LEN + 1];
104 loop = create_loop_trns (ds);
105 while (token != '.' && ok)
107 if (lex_match_id ("IF"))
108 ok = parse_if_clause (loop, &loop->loop_condition);
110 ok = parse_index_clause (loop, index_var_name);
113 /* Find index variable and create if necessary. */
114 if (ok && index_var_name[0] != '\0')
116 loop->index_var = dict_lookup_var (dataset_dict (ds), index_var_name);
117 if (loop->index_var == NULL)
118 loop->index_var = dict_create_var (dataset_dict (ds),
123 loop->max_pass_count = 0;
124 return ok ? CMD_SUCCESS : CMD_FAILURE;
127 /* Parses END LOOP. */
129 cmd_end_loop (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 ("IF"))
142 ok = parse_if_clause (loop, &loop->end_loop_condition);
144 ok = lex_end_of_command () == CMD_SUCCESS;
147 loop->max_pass_count = 0;
149 ctl_stack_pop (loop);
151 return ok ? CMD_SUCCESS : CMD_FAILURE;
156 cmd_break (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);
164 return lex_end_of_command ();
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 = 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 loop_trns *loop, struct expression **condition)
192 *condition = expr_parse_pool (loop->pool, loop->ds, EXPR_BOOLEAN);
193 return *condition != NULL;
196 /* Parses an indexing clause into LOOP.
197 Stores the index variable's name in INDEX_VAR_NAME[].
198 Returns true if successful, false on failure. */
200 parse_index_clause (struct loop_trns *loop, char index_var_name[])
207 strcpy (index_var_name, tokid);
210 if (!lex_force_match ('='))
213 loop->first_expr = expr_parse_pool (loop->pool, loop->ds, EXPR_NUMBER);
214 if (loop->first_expr == NULL)
219 struct expression **e;
220 if (lex_match (T_TO))
221 e = &loop->last_expr;
222 else if (lex_match (T_BY))
229 lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
232 *e = expr_parse_pool (loop->pool, loop->ds, EXPR_NUMBER);
236 if (loop->last_expr == NULL)
238 lex_sbc_missing ("TO");
241 if (loop->by_expr == NULL)
247 /* Creates, initializes, and returns a new loop_trns. */
248 static struct loop_trns *
249 create_loop_trns (struct dataset *ds)
251 struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
252 loop->max_pass_count = -1;
254 loop->index_var = NULL;
255 loop->first_expr = loop->by_expr = loop->last_expr = NULL;
256 loop->loop_condition = loop->end_loop_condition = NULL;
259 add_transformation_with_finalizer (ds, loop_trns_finalize,
260 loop_trns_proc, loop_trns_free, loop);
261 loop->past_LOOP_index = next_transformation (ds);
263 ctl_stack_push (&loop_class, loop);
268 /* Finalizes LOOP by clearing the control stack, thus ensuring
269 that all open LOOPs are closed. */
271 loop_trns_finalize (void *do_if_ UNUSED)
273 /* This will be called multiple times if multiple LOOPs were
274 executed, which is slightly unclean, but at least it's
279 /* Sets up LOOP for the first pass. */
281 loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num)
283 struct loop_trns *loop = loop_;
285 if (loop->index_var != NULL)
287 /* Evaluate loop index expressions. */
288 loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
289 if (loop->by_expr != NULL)
290 loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
291 loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
293 /* Even if the loop is never entered, set the index
294 variable to the initial value. */
295 case_data_rw (c, loop->index_var->fv)->f = loop->cur;
297 /* Throw out pathological cases. */
298 if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
300 || (loop->by > 0.0 && loop->cur > loop->last)
301 || (loop->by < 0.0 && loop->cur < loop->last))
305 /* Initialize pass count. */
307 if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
310 /* Check condition. */
311 if (loop->loop_condition != NULL
312 && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
315 return loop->past_LOOP_index;
318 return loop->past_END_LOOP_index;
323 loop_trns_free (void *loop_)
325 struct loop_trns *loop = loop_;
327 pool_destroy (loop->pool);
331 /* Finishes a pass through the loop and starts the next. */
333 end_loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num UNUSED)
335 struct loop_trns *loop = loop_;
337 if (loop->end_loop_condition != NULL
338 && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 1.0)
341 /* MXLOOPS limiter. */
342 if (loop->max_pass_count >= 0)
344 if (loop->pass >= loop->max_pass_count)
349 /* Indexing clause limiter: counting downward. */
350 if (loop->index_var != NULL)
352 loop->cur += loop->by;
353 if ((loop->by > 0.0 && loop->cur > loop->last)
354 || (loop->by < 0.0 && loop->cur < loop->last))
356 case_data_rw (c, loop->index_var->fv)->f = loop->cur;
359 if (loop->loop_condition != NULL
360 && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
363 return loop->past_LOOP_index;
366 return loop->past_END_LOOP_index;
369 /* Executes BREAK. */
371 break_trns_proc (void *loop_, struct ccase *c UNUSED, casenumber case_num UNUSED)
373 struct loop_trns *loop = loop_;
375 return loop->past_END_LOOP_index;
378 /* LOOP control structure class definition. */
379 static const struct ctl_class loop_class =