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
21 #include <libpspp/message.h>
22 #include <libpspp/alloc.h>
23 #include <data/case.h>
24 #include <language/command.h>
25 #include <libpspp/compiler.h>
26 #include <data/dictionary.h>
27 #include "control-stack.h"
28 #include <libpspp/message.h>
29 #include <language/expressions/public.h>
30 #include <language/lexer/lexer.h>
31 #include <libpspp/misc.h>
32 #include <libpspp/pool.h>
33 #include <data/settings.h>
34 #include <libpspp/str.h>
35 #include <data/variable.h>
38 #define _(msgid) gettext (msgid)
40 /* LOOP outputs a transformation that is executed only on the
41 first pass through the loop. On this trip, it initializes for
42 the first pass by resetting the pass number, setting up the
43 indexing clause, and testing the LOOP IF clause. If the loop
44 is not to be entered at all, it jumps forward just past the
45 END LOOP transformation; otherwise, it continues to the
46 transformation following LOOP.
48 END LOOP outputs a transformation that executes at the end of
49 each trip through the loop. It checks the END LOOP IF clause,
50 then updates the pass number, increments the indexing clause,
51 and tests the LOOP IF clause. If another pass through the
52 loop is due, it jumps backward to just after the LOOP
53 transformation; otherwise, it continues to the transformation
54 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 struct ctl_class loop_class;
82 static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
83 static trns_free_func loop_trns_free;
85 static struct loop_trns *create_loop_trns (void);
86 static bool parse_if_clause (struct loop_trns *, struct expression **);
87 static bool parse_index_clause (struct loop_trns *, char index_var_name[]);
88 static void close_loop (void *);
96 struct loop_trns *loop;
97 char index_var_name[LONG_NAME_LEN + 1];
100 loop = create_loop_trns ();
101 while (token != '.' && ok)
103 if (lex_match_id ("IF"))
104 ok = parse_if_clause (loop, &loop->loop_condition);
106 ok = parse_index_clause (loop, index_var_name);
109 /* Find index variable and create if necessary. */
110 if (ok && index_var_name[0] != '\0')
112 loop->index_var = dict_lookup_var (default_dict, index_var_name);
113 if (loop->index_var == NULL)
114 loop->index_var = dict_create_var (default_dict, index_var_name, 0);
118 loop->max_pass_count = 0;
119 return ok ? CMD_SUCCESS : CMD_PART_SUCCESS;
122 /* Parses END LOOP. */
126 struct loop_trns *loop;
129 loop = ctl_stack_top (&loop_class);
131 return CMD_CASCADING_FAILURE;
134 if (lex_match_id ("IF"))
135 ok = parse_if_clause (loop, &loop->end_loop_condition);
137 ok = lex_end_of_command () == CMD_SUCCESS;
140 loop->max_pass_count = 0;
142 ctl_stack_pop (loop);
144 return ok ? CMD_SUCCESS : CMD_PART_SUCCESS;
151 struct ctl_stmt *loop = ctl_stack_search (&loop_class);
153 return CMD_CASCADING_FAILURE;
155 add_transformation (break_trns_proc, NULL, loop);
157 return lex_end_of_command ();
160 /* Closes a LOOP construct by emitting the END LOOP
161 transformation and finalizing its members appropriately. */
163 close_loop (void *loop_)
165 struct loop_trns *loop = loop_;
167 add_transformation (end_loop_trns_proc, NULL, loop);
168 loop->past_END_LOOP_index = next_transformation ();
170 /* If there's nothing else limiting the number of loops, use
171 MXLOOPS as a limit. */
172 if (loop->max_pass_count == -1
173 && loop->index_var == NULL
174 && loop->loop_condition == NULL
175 && loop->end_loop_condition == NULL)
176 loop->max_pass_count = get_mxloops ();
179 /* Parses an IF clause for LOOP or END LOOP and stores the
180 resulting expression to *CONDITION.
181 Returns true if successful, false on failure. */
183 parse_if_clause (struct loop_trns *loop, struct expression **condition)
185 *condition = expr_parse_pool (loop->pool, default_dict, EXPR_BOOLEAN);
186 return *condition != NULL;
189 /* Parses an indexing clause into LOOP.
190 Stores the index variable's name in INDEX_VAR_NAME[].
191 Returns true if successful, false on failure. */
193 parse_index_clause (struct loop_trns *loop, char index_var_name[])
200 strcpy (index_var_name, tokid);
203 if (!lex_force_match ('='))
206 loop->first_expr = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER);
207 if (loop->first_expr == NULL)
212 struct expression **e;
213 if (lex_match (T_TO))
214 e = &loop->last_expr;
215 else if (lex_match (T_BY))
222 lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
225 *e = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER);
229 if (loop->last_expr == NULL)
231 lex_sbc_missing ("TO");
234 if (loop->by_expr == NULL)
240 /* Creates, initializes, and returns a new loop_trns. */
241 static struct loop_trns *
242 create_loop_trns (void)
244 struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
245 loop->max_pass_count = -1;
247 loop->index_var = NULL;
248 loop->first_expr = loop->by_expr = loop->last_expr = NULL;
249 loop->loop_condition = loop->end_loop_condition = NULL;
251 add_transformation (loop_trns_proc, loop_trns_free, loop);
252 loop->past_LOOP_index = next_transformation ();
254 ctl_stack_push (&loop_class, loop);
259 /* Sets up LOOP for the first pass. */
261 loop_trns_proc (void *loop_, struct ccase *c, int case_num)
263 struct loop_trns *loop = loop_;
265 if (loop->index_var != NULL)
267 /* Evaluate loop index expressions. */
268 loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
269 if (loop->by_expr != NULL)
270 loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
271 loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
273 /* Even if the loop is never entered, set the index
274 variable to the initial value. */
275 case_data_rw (c, loop->index_var->fv)->f = loop->cur;
277 /* Throw out pathological cases. */
278 if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
280 || (loop->by > 0.0 && loop->cur > loop->last)
281 || (loop->by < 0.0 && loop->cur < loop->last))
285 /* Initialize pass count. */
287 if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
290 /* Check condition. */
291 if (loop->loop_condition != NULL
292 && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
295 return loop->past_LOOP_index;
298 return loop->past_END_LOOP_index;
303 loop_trns_free (void *loop_)
305 struct loop_trns *loop = loop_;
307 pool_destroy (loop->pool);
311 /* Finishes a pass through the loop and starts the next. */
313 end_loop_trns_proc (void *loop_, struct ccase *c, int case_num UNUSED)
315 struct loop_trns *loop = loop_;
317 if (loop->end_loop_condition != NULL
318 && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 1.0)
321 /* MXLOOPS limiter. */
322 if (loop->max_pass_count >= 0)
324 if (loop->pass >= loop->max_pass_count)
329 /* Indexing clause limiter: counting downward. */
330 if (loop->index_var != NULL)
332 loop->cur += loop->by;
333 if ((loop->by > 0.0 && loop->cur > loop->last)
334 || (loop->by < 0.0 && loop->cur < loop->last))
336 case_data_rw (c, loop->index_var->fv)->f = loop->cur;
339 if (loop->loop_condition != NULL
340 && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
343 return loop->past_LOOP_index;
346 return loop->past_END_LOOP_index;
349 /* Executes BREAK. */
351 break_trns_proc (void *loop_, struct ccase *c UNUSED, int case_num UNUSED)
353 struct loop_trns *loop = loop_;
355 return loop->past_END_LOOP_index;
358 /* LOOP control structure class definition. */
359 static struct ctl_class loop_class =