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 lexer *, struct loop_trns *, struct expression **);
91 static bool parse_index_clause (struct lexer *, struct loop_trns *, char index_var_name[]);
92 static void close_loop (void *);
98 cmd_loop (struct lexer *lexer, 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 (lex_token (lexer) != '.' && ok)
107 if (lex_match_id (lexer, "IF"))
108 ok = parse_if_clause (lexer, loop, &loop->loop_condition);
110 ok = parse_index_clause (lexer, 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 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, 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 (lexer);
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 lexer *lexer,
191 struct loop_trns *loop, struct expression **condition)
193 *condition = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_BOOLEAN);
194 return *condition != NULL;
197 /* Parses an indexing clause into LOOP.
198 Stores the index variable's name in INDEX_VAR_NAME[].
199 Returns true if successful, false on failure. */
201 parse_index_clause (struct lexer *lexer, struct loop_trns *loop, char index_var_name[])
203 if (lex_token (lexer) != T_ID)
205 lex_error (lexer, NULL);
208 strcpy (index_var_name, lex_tokid (lexer));
211 if (!lex_force_match (lexer, '='))
214 loop->first_expr = expr_parse_pool (lexer, loop->pool,
215 loop->ds, EXPR_NUMBER);
216 if (loop->first_expr == NULL)
221 struct expression **e;
222 if (lex_match (lexer, T_TO))
223 e = &loop->last_expr;
224 else if (lex_match (lexer, T_BY))
231 lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
234 *e = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_NUMBER);
238 if (loop->last_expr == NULL)
240 lex_sbc_missing (lexer, "TO");
243 if (loop->by_expr == NULL)
249 /* Creates, initializes, and returns a new loop_trns. */
250 static struct loop_trns *
251 create_loop_trns (struct dataset *ds)
253 struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
254 loop->max_pass_count = -1;
256 loop->index_var = NULL;
257 loop->first_expr = loop->by_expr = loop->last_expr = NULL;
258 loop->loop_condition = loop->end_loop_condition = NULL;
261 add_transformation_with_finalizer (ds, loop_trns_finalize,
262 loop_trns_proc, loop_trns_free, loop);
263 loop->past_LOOP_index = next_transformation (ds);
265 ctl_stack_push (&loop_class, loop);
270 /* Finalizes LOOP by clearing the control stack, thus ensuring
271 that all open LOOPs are closed. */
273 loop_trns_finalize (void *do_if_ UNUSED)
275 /* This will be called multiple times if multiple LOOPs were
276 executed, which is slightly unclean, but at least it's
281 /* Sets up LOOP for the first pass. */
283 loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num)
285 struct loop_trns *loop = loop_;
287 if (loop->index_var != NULL)
289 /* Evaluate loop index expressions. */
290 loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
291 if (loop->by_expr != NULL)
292 loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
293 loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
295 /* Even if the loop is never entered, set the index
296 variable to the initial value. */
297 case_data_rw (c, loop->index_var->fv)->f = loop->cur;
299 /* Throw out pathological cases. */
300 if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
302 || (loop->by > 0.0 && loop->cur > loop->last)
303 || (loop->by < 0.0 && loop->cur < loop->last))
307 /* Initialize pass count. */
309 if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
312 /* Check condition. */
313 if (loop->loop_condition != NULL
314 && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
317 return loop->past_LOOP_index;
320 return loop->past_END_LOOP_index;
325 loop_trns_free (void *loop_)
327 struct loop_trns *loop = loop_;
329 pool_destroy (loop->pool);
333 /* Finishes a pass through the loop and starts the next. */
335 end_loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num UNUSED)
337 struct loop_trns *loop = loop_;
339 if (loop->end_loop_condition != NULL
340 && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 1.0)
343 /* MXLOOPS limiter. */
344 if (loop->max_pass_count >= 0)
346 if (loop->pass >= loop->max_pass_count)
351 /* Indexing clause limiter: counting downward. */
352 if (loop->index_var != NULL)
354 loop->cur += loop->by;
355 if ((loop->by > 0.0 && loop->cur > loop->last)
356 || (loop->by < 0.0 && loop->cur < loop->last))
358 case_data_rw (c, loop->index_var->fv)->f = loop->cur;
361 if (loop->loop_condition != NULL
362 && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
365 return loop->past_LOOP_index;
368 return loop->past_END_LOOP_index;
371 /* Executes BREAK. */
373 break_trns_proc (void *loop_, struct ccase *c UNUSED, casenumber case_num UNUSED)
375 struct loop_trns *loop = loop_;
377 return loop->past_END_LOOP_index;
380 /* LOOP control structure class definition. */
381 static const struct ctl_class loop_class =