Fix missing @clicksequence problem with older Texinfo versions.
[pspp-builds.git] / control / loop.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3
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.
8
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.
13
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/>. */
16
17 #include <config.h>
18
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/compiler.h>
30 #include <libpspp/message.h>
31 #include <libpspp/misc.h>
32 #include <libpspp/pool.h>
33 #include <libpspp/str.h>
34
35 #include "xalloc.h"
36
37 #include "gettext.h"
38 #define _(msgid) gettext (msgid)
39
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.
47
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. */
55
56 struct loop_trns
57   {
58     struct pool *pool;
59     struct dataset *ds;
60
61     /* Iteration limit. */
62     int max_pass_count;         /* Maximum number of passes (-1=unlimited). */
63     int pass;                   /* Number of passes thru the loop so far. */
64
65     /* a=a TO b [BY c]. */
66     struct variable *index_var; /* Index variable. */
67     struct expression *first_expr; /* Starting index. */
68     struct expression *by_expr; /* Index increment (default 1.0 if null). */
69     struct expression *last_expr; /* Terminal index. */
70     double cur, by, last;       /* Current value, increment, last value. */
71
72     /* IF condition for LOOP or END LOOP. */
73     struct expression *loop_condition;
74     struct expression *end_loop_condition;
75
76     /* Transformation indexes. */
77     int past_LOOP_index;        /* Just past LOOP transformation. */
78     int past_END_LOOP_index;    /* Just past END LOOP transformation. */
79   };
80
81 static const struct ctl_class loop_class;
82
83 static trns_finalize_func loop_trns_finalize;
84 static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
85 static trns_free_func loop_trns_free;
86
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 *);
93 \f
94 /* LOOP. */
95
96 /* Parses LOOP. */
97 int
98 cmd_loop (struct lexer *lexer, struct dataset *ds)
99 {
100   struct loop_trns *loop;
101   bool created_index_var = false;
102   bool ok = true;
103
104   loop = create_loop_trns (ds);
105   while (lex_token (lexer) != '.' && ok)
106     {
107       if (lex_match_id (lexer, "IF"))
108         ok = parse_if_clause (lexer, loop, &loop->loop_condition);
109       else
110         ok = parse_index_clause (ds, lexer, loop, &created_index_var);
111     }
112
113   /* Clean up if necessary. */
114   if (!ok)
115     {
116       loop->max_pass_count = 0;
117       if (loop->index_var != NULL && created_index_var)
118         {
119           dict_delete_var (dataset_dict (ds), loop->index_var);
120           loop->index_var = NULL;
121         }
122     }
123
124   return ok ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
125 }
126
127 /* Parses END LOOP. */
128 int
129 cmd_end_loop (struct lexer *lexer, struct dataset *ds)
130 {
131   struct loop_trns *loop;
132   bool ok = true;
133
134   loop = ctl_stack_top (&loop_class);
135   if (loop == NULL)
136     return CMD_CASCADING_FAILURE;
137
138   assert (loop->ds == ds);
139
140   /* Parse syntax. */
141   if (lex_match_id (lexer, "IF"))
142     ok = parse_if_clause (lexer, loop, &loop->end_loop_condition);
143   if (ok)
144     ok = lex_end_of_command (lexer) == CMD_SUCCESS;
145
146   if (!ok)
147     loop->max_pass_count = 0;
148
149   ctl_stack_pop (loop);
150
151   return ok ? CMD_SUCCESS : CMD_FAILURE;
152 }
153
154 /* Parses BREAK. */
155 int
156 cmd_break (struct lexer *lexer, struct dataset *ds)
157 {
158   struct ctl_stmt *loop = ctl_stack_search (&loop_class);
159   if (loop == NULL)
160     return CMD_CASCADING_FAILURE;
161
162   add_transformation (ds, break_trns_proc, NULL, loop);
163
164   return lex_end_of_command (lexer);
165 }
166
167 /* Closes a LOOP construct by emitting the END LOOP
168    transformation and finalizing its members appropriately. */
169 static void
170 close_loop (void *loop_)
171 {
172   struct loop_trns *loop = loop_;
173
174   add_transformation (loop->ds, end_loop_trns_proc, NULL, loop);
175   loop->past_END_LOOP_index = next_transformation (loop->ds);
176
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 ();
184 }
185
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. */
189 static bool
190 parse_if_clause (struct lexer *lexer,
191                  struct loop_trns *loop, struct expression **condition)
192 {
193   if (*condition != NULL)
194     {
195       lex_sbc_only_once ("IF");
196       return false;
197     }
198
199   *condition = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_BOOLEAN);
200   return *condition != NULL;
201 }
202
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. */
207 static bool
208 parse_index_clause (struct dataset *ds, struct lexer *lexer,
209                     struct loop_trns *loop, bool *created_index_var)
210 {
211   if (loop->index_var != NULL)
212     {
213       msg (SE, _("Only one index clause may be specified."));
214       return false;
215     }
216
217   if (lex_token (lexer) != T_ID)
218     {
219       lex_error (lexer, NULL);
220       return false;
221     }
222
223   loop->index_var = dict_lookup_var (dataset_dict (ds), lex_tokid (lexer));
224   if (loop->index_var != NULL)
225     *created_index_var = false;
226   else
227     {
228       loop->index_var = dict_create_var_assert (dataset_dict (ds),
229                                                 lex_tokid (lexer), 0);
230       *created_index_var = true;
231     }
232   lex_get (lexer);
233
234   if (!lex_force_match (lexer, '='))
235     return false;
236
237   loop->first_expr = expr_parse_pool (lexer, loop->pool,
238                                       loop->ds, EXPR_NUMBER);
239   if (loop->first_expr == NULL)
240     return false;
241
242   for (;;)
243     {
244       struct expression **e;
245       if (lex_match (lexer, T_TO))
246         e = &loop->last_expr;
247       else if (lex_match (lexer, T_BY))
248         e = &loop->by_expr;
249       else
250         break;
251
252       if (*e != NULL)
253         {
254           lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
255           return false;
256         }
257       *e = expr_parse_pool (lexer, loop->pool, loop->ds, EXPR_NUMBER);
258       if (*e == NULL)
259         return false;
260     }
261   if (loop->last_expr == NULL)
262     {
263       lex_sbc_missing (lexer, "TO");
264       return false;
265     }
266   if (loop->by_expr == NULL)
267     loop->by = 1.0;
268
269   return true;
270 }
271
272 /* Creates, initializes, and returns a new loop_trns. */
273 static struct loop_trns *
274 create_loop_trns (struct dataset *ds)
275 {
276   struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
277   loop->max_pass_count = -1;
278   loop->pass = 0;
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;
282   loop->ds = ds;
283
284   add_transformation_with_finalizer (ds, loop_trns_finalize,
285                                      loop_trns_proc, loop_trns_free, loop);
286   loop->past_LOOP_index = next_transformation (ds);
287
288   ctl_stack_push (&loop_class, loop);
289
290   return loop;
291 }
292
293 /* Finalizes LOOP by clearing the control stack, thus ensuring
294    that all open LOOPs are closed. */
295 static void
296 loop_trns_finalize (void *do_if_ UNUSED)
297 {
298   /* This will be called multiple times if multiple LOOPs were
299      executed, which is slightly unclean, but at least it's
300      idempotent. */
301   ctl_stack_clear ();
302 }
303
304 /* Sets up LOOP for the first pass. */
305 static int
306 loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num)
307 {
308   struct loop_trns *loop = loop_;
309
310   if (loop->index_var != NULL)
311     {
312       /* Evaluate loop index expressions. */
313       loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
314       if (loop->by_expr != NULL)
315         loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
316       loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
317
318       /* Even if the loop is never entered, set the index
319          variable to the initial value. */
320       case_data_rw (c, loop->index_var)->f = loop->cur;
321
322       /* Throw out pathological cases. */
323       if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
324           || loop->by == 0.0
325           || (loop->by > 0.0 && loop->cur > loop->last)
326           || (loop->by < 0.0 && loop->cur < loop->last))
327         goto zero_pass;
328     }
329
330   /* Initialize pass count. */
331   loop->pass = 0;
332   if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
333     goto zero_pass;
334
335   /* Check condition. */
336   if (loop->loop_condition != NULL
337       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
338     goto zero_pass;
339
340   return loop->past_LOOP_index;
341
342  zero_pass:
343   return loop->past_END_LOOP_index;
344 }
345
346 /* Frees LOOP. */
347 static bool
348 loop_trns_free (void *loop_)
349 {
350   struct loop_trns *loop = loop_;
351
352   pool_destroy (loop->pool);
353   return true;
354 }
355
356 /* Finishes a pass through the loop and starts the next. */
357 static int
358 end_loop_trns_proc (void *loop_, struct ccase *c, casenumber case_num UNUSED)
359 {
360   struct loop_trns *loop = loop_;
361
362   if (loop->end_loop_condition != NULL
363       && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 0.0)
364     goto break_out;
365
366   /* MXLOOPS limiter. */
367   if (loop->max_pass_count >= 0)
368     {
369       if (loop->pass >= loop->max_pass_count)
370         goto break_out;
371       loop->pass++;
372     }
373
374   /* Indexing clause limiter: counting downward. */
375   if (loop->index_var != NULL)
376     {
377       loop->cur += loop->by;
378       if ((loop->by > 0.0 && loop->cur > loop->last)
379           || (loop->by < 0.0 && loop->cur < loop->last))
380         goto break_out;
381       case_data_rw (c, loop->index_var)->f = loop->cur;
382     }
383
384   if (loop->loop_condition != NULL
385       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
386     goto break_out;
387
388   return loop->past_LOOP_index;
389
390  break_out:
391   return loop->past_END_LOOP_index;
392 }
393
394 /* Executes BREAK. */
395 static int
396 break_trns_proc (void *loop_, struct ccase *c UNUSED, casenumber case_num UNUSED)
397 {
398   struct loop_trns *loop = loop_;
399
400   return loop->past_END_LOOP_index;
401 }
402
403 /* LOOP control structure class definition. */
404 static const struct ctl_class loop_class =
405   {
406     "LOOP",
407     "END LOOP",
408     close_loop,
409   };