Fix memory leak in AGGREGATE.
[pspp] / src / language / control / loop.c
1 /* PSPP - computes sample statistics.
2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3    Written by Ben Pfaff <blp@gnu.org>.
4
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.
9
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.
14
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
18    02110-1301, USA. */
19
20 #include <config.h>
21
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>
38
39 #include "gettext.h"
40 #define _(msgid) gettext (msgid)
41
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.
49
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. */
57
58 struct loop_trns
59   {
60     struct pool *pool;
61
62     /* Iteration limit. */
63     int max_pass_count;         /* Maximum number of passes (-1=unlimited). */
64     int pass;                   /* Number of passes thru the loop so far. */
65
66     /* a=a TO b [BY c]. */
67     struct variable *index_var; /* Index variable. */
68     struct expression *first_expr; /* Starting index. */
69     struct expression *by_expr; /* Index increment (default 1.0 if null). */
70     struct expression *last_expr; /* Terminal index. */
71     double cur, by, last;       /* Current value, increment, last value. */
72
73     /* IF condition for LOOP or END LOOP. */
74     struct expression *loop_condition;
75     struct expression *end_loop_condition;
76
77     /* Transformation indexes. */
78     int past_LOOP_index;        /* Just past LOOP transformation. */
79     int past_END_LOOP_index;    /* Just past END LOOP transformation. */
80   };
81
82 static struct ctl_class loop_class;
83
84 static trns_finalize_func loop_trns_finalize;
85 static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
86 static trns_free_func loop_trns_free;
87
88 static struct loop_trns *create_loop_trns (void);
89 static bool parse_if_clause (struct loop_trns *, struct expression **);
90 static bool parse_index_clause (struct loop_trns *, char index_var_name[]);
91 static void close_loop (void *);
92 \f
93 /* LOOP. */
94
95 /* Parses LOOP. */
96 int
97 cmd_loop (void)
98 {
99   struct loop_trns *loop;
100   char index_var_name[LONG_NAME_LEN + 1];
101   bool ok = true;
102
103   loop = create_loop_trns ();
104   while (token != '.' && ok) 
105     {
106       if (lex_match_id ("IF")) 
107         ok = parse_if_clause (loop, &loop->loop_condition);
108       else
109         ok = parse_index_clause (loop, index_var_name);
110     }
111
112   /* Find index variable and create if necessary. */
113   if (ok && index_var_name[0] != '\0')
114     {
115       loop->index_var = dict_lookup_var (default_dict, index_var_name);
116       if (loop->index_var == NULL)
117         loop->index_var = dict_create_var (default_dict, index_var_name, 0);
118     }
119   
120   if (!ok)
121     loop->max_pass_count = 0;
122   return ok ? CMD_SUCCESS : CMD_FAILURE;
123 }
124
125 /* Parses END LOOP. */
126 int
127 cmd_end_loop (void)
128 {
129   struct loop_trns *loop;
130   bool ok = true;
131
132   loop = ctl_stack_top (&loop_class);
133   if (loop == NULL)
134     return CMD_CASCADING_FAILURE;
135   
136   /* Parse syntax. */
137   if (lex_match_id ("IF"))
138     ok = parse_if_clause (loop, &loop->end_loop_condition);
139   if (ok)
140     ok = lex_end_of_command () == CMD_SUCCESS;
141
142   if (!ok)
143     loop->max_pass_count = 0;
144
145   ctl_stack_pop (loop);
146   
147   return ok ? CMD_SUCCESS : CMD_FAILURE;
148 }
149
150 /* Parses BREAK. */
151 int
152 cmd_break (void)
153 {
154   struct ctl_stmt *loop = ctl_stack_search (&loop_class);
155   if (loop == NULL)
156     return CMD_CASCADING_FAILURE;
157
158   add_transformation (break_trns_proc, NULL, loop);
159
160   return lex_end_of_command ();
161 }
162
163 /* Closes a LOOP construct by emitting the END LOOP
164    transformation and finalizing its members appropriately. */
165 static void
166 close_loop (void *loop_)
167 {
168   struct loop_trns *loop = loop_;
169   
170   add_transformation (end_loop_trns_proc, NULL, loop);
171   loop->past_END_LOOP_index = next_transformation ();
172
173   /* If there's nothing else limiting the number of loops, use
174      MXLOOPS as a limit. */
175   if (loop->max_pass_count == -1
176       && loop->index_var == NULL
177       && loop->loop_condition == NULL
178       && loop->end_loop_condition == NULL)
179     loop->max_pass_count = get_mxloops ();
180 }
181
182 /* Parses an IF clause for LOOP or END LOOP and stores the
183    resulting expression to *CONDITION.
184    Returns true if successful, false on failure. */
185 static bool
186 parse_if_clause (struct loop_trns *loop, struct expression **condition) 
187 {
188   *condition = expr_parse_pool (loop->pool, default_dict, EXPR_BOOLEAN);
189   return *condition != NULL;
190 }
191
192 /* Parses an indexing clause into LOOP.
193    Stores the index variable's name in INDEX_VAR_NAME[].
194    Returns true if successful, false on failure. */
195 static bool
196 parse_index_clause (struct loop_trns *loop, char index_var_name[]) 
197 {
198   if (token != T_ID) 
199     {
200       lex_error (NULL);
201       return false;
202     }
203   strcpy (index_var_name, tokid);
204   lex_get ();
205
206   if (!lex_force_match ('='))
207     return false;
208
209   loop->first_expr = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER);
210   if (loop->first_expr == NULL)
211     return false;
212
213   for (;;)
214     {
215       struct expression **e;
216       if (lex_match (T_TO)) 
217         e = &loop->last_expr;
218       else if (lex_match (T_BY)) 
219         e = &loop->by_expr;
220       else
221         break;
222
223       if (*e != NULL) 
224         {
225           lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
226           return false;
227         }
228       *e = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER);
229       if (*e == NULL)
230         return false;
231     }
232   if (loop->last_expr == NULL) 
233     {
234       lex_sbc_missing ("TO");
235       return false;
236     }
237   if (loop->by_expr == NULL)
238     loop->by = 1.0;
239
240   return true;
241 }
242
243 /* Creates, initializes, and returns a new loop_trns. */
244 static struct loop_trns *
245 create_loop_trns (void) 
246 {
247   struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
248   loop->max_pass_count = -1;
249   loop->pass = 0;
250   loop->index_var = NULL;
251   loop->first_expr = loop->by_expr = loop->last_expr = NULL;
252   loop->loop_condition = loop->end_loop_condition = NULL;
253
254   add_transformation_with_finalizer (loop_trns_finalize,
255                                      loop_trns_proc, loop_trns_free, loop);
256   loop->past_LOOP_index = next_transformation ();
257
258   ctl_stack_push (&loop_class, loop);
259
260   return loop;
261 }
262
263 /* Finalizes LOOP by clearing the control stack, thus ensuring
264    that all open LOOPs are closed. */ 
265 static void
266 loop_trns_finalize (void *do_if_ UNUSED) 
267 {
268   /* This will be called multiple times if multiple LOOPs were
269      executed, which is slightly unclean, but at least it's
270      idempotent. */
271   ctl_stack_clear ();
272 }
273
274 /* Sets up LOOP for the first pass. */
275 static int
276 loop_trns_proc (void *loop_, struct ccase *c, int case_num)
277 {
278   struct loop_trns *loop = loop_;
279
280   if (loop->index_var != NULL)
281     {
282       /* Evaluate loop index expressions. */
283       loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
284       if (loop->by_expr != NULL)
285         loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
286       loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
287
288       /* Even if the loop is never entered, set the index
289          variable to the initial value. */
290       case_data_rw (c, loop->index_var->fv)->f = loop->cur;
291
292       /* Throw out pathological cases. */
293       if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
294           || loop->by == 0.0
295           || (loop->by > 0.0 && loop->cur > loop->last)
296           || (loop->by < 0.0 && loop->cur < loop->last))
297         goto zero_pass;
298     }
299
300   /* Initialize pass count. */
301   loop->pass = 0;
302   if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
303     goto zero_pass;
304
305   /* Check condition. */
306   if (loop->loop_condition != NULL
307       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
308     goto zero_pass;
309
310   return loop->past_LOOP_index;
311
312  zero_pass:
313   return loop->past_END_LOOP_index;
314 }
315
316 /* Frees LOOP. */
317 static bool
318 loop_trns_free (void *loop_)
319 {
320   struct loop_trns *loop = loop_;
321
322   pool_destroy (loop->pool);
323   return true;
324 }
325
326 /* Finishes a pass through the loop and starts the next. */
327 static int
328 end_loop_trns_proc (void *loop_, struct ccase *c, int case_num UNUSED)
329 {
330   struct loop_trns *loop = loop_;
331
332   if (loop->end_loop_condition != NULL
333       && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 1.0)
334     goto break_out;
335
336   /* MXLOOPS limiter. */
337   if (loop->max_pass_count >= 0)
338     {
339       if (loop->pass >= loop->max_pass_count)
340         goto break_out;
341       loop->pass++;
342     }
343
344   /* Indexing clause limiter: counting downward. */
345   if (loop->index_var != NULL) 
346     {
347       loop->cur += loop->by;
348       if ((loop->by > 0.0 && loop->cur > loop->last)
349           || (loop->by < 0.0 && loop->cur < loop->last))
350         goto break_out;
351       case_data_rw (c, loop->index_var->fv)->f = loop->cur;
352     }
353
354   if (loop->loop_condition != NULL
355       && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
356     goto break_out;
357
358   return loop->past_LOOP_index;
359
360  break_out:
361   return loop->past_END_LOOP_index;
362 }
363
364 /* Executes BREAK. */
365 static int
366 break_trns_proc (void *loop_, struct ccase *c UNUSED, int case_num UNUSED)
367 {
368   struct loop_trns *loop = loop_;
369
370   return loop->past_END_LOOP_index;
371 }
372
373 /* LOOP control structure class definition. */
374 static struct ctl_class loop_class =
375   {
376     "LOOP",
377     "END LOOP",
378     close_loop,
379   };