604af4556940bb2156c0048ce641b17d0cd73579
[pspp] / src / language / control / loop.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000, 2009-2011 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 <limits.h>
20
21 #include "data/case.h"
22 #include "data/dataset.h"
23 #include "data/dictionary.h"
24 #include "data/settings.h"
25 #include "data/transformations.h"
26 #include "data/variable.h"
27 #include "language/command.h"
28 #include "language/expressions/public.h"
29 #include "language/lexer/lexer.h"
30 #include "libpspp/compiler.h"
31 #include "libpspp/message.h"
32 #include "libpspp/misc.h"
33 #include "libpspp/pool.h"
34 #include "libpspp/str.h"
35
36 #include "gl/xalloc.h"
37
38 #include "gettext.h"
39 #define _(msgid) gettext (msgid)
40
41 struct loop_trns
42   {
43     /* a=a TO b [BY c]. */
44     struct variable *index_var; /* Index variable. */
45     struct expression *first;   /* Starting index. */
46     struct expression *by;      /* Index increment (or NULL). */
47     struct expression *last;    /* Terminal index. */
48
49     /* IF condition for LOOP or END LOOP. */
50     struct expression *loop_condition;
51     struct expression *end_loop_condition;
52
53     /* Inner transformations. */
54     struct transformation *xforms;
55     size_t n_xforms;
56   };
57
58 static trns_proc_func loop_trns_proc;
59 static trns_free_func loop_trns_free;
60
61 static bool parse_if_clause (struct lexer *, struct dataset *,
62                              struct expression **);
63 static bool parse_index_clause (struct dataset *, struct lexer *,
64                                 struct loop_trns *);
65 \f
66 /* LOOP. */
67
68 /* Parses LOOP. */
69 int
70 cmd_loop (struct lexer *lexer, struct dataset *ds)
71 {
72   struct loop_trns *loop = xmalloc (sizeof *loop);
73   *loop = (struct loop_trns) { .index_var = NULL };
74
75   bool ok = true;
76   while (lex_token (lexer) != T_ENDCMD && ok)
77     {
78       if (lex_match_id (lexer, "IF"))
79         ok = parse_if_clause (lexer, ds, &loop->loop_condition);
80       else
81         ok = parse_index_clause (ds, lexer, loop);
82     }
83   lex_end_of_command (lexer);
84
85   proc_push_transformations (ds);
86   for (;;)
87     {
88       if (lex_token (lexer) == T_STOP)
89         {
90           lex_error (lexer, NULL);
91           ok = false;
92           break;
93         }
94       else if (lex_match_phrase (lexer, "END LOOP"))
95         {
96           if (lex_match_id (lexer, "IF"))
97             ok = parse_if_clause (lexer, ds, &loop->end_loop_condition) && ok;
98           break;
99         }
100       else
101         cmd_parse_in_state (lexer, ds, CMD_STATE_NESTED);
102     }
103   proc_pop_transformations (ds, &loop->xforms, &loop->n_xforms);
104
105   add_transformation (ds, loop_trns_proc, loop_trns_free, loop);
106
107   return ok ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
108 }
109
110 /* Parses BREAK. */
111 int
112 cmd_break (struct lexer *lexer UNUSED, struct dataset *ds UNUSED)
113 {
114   //add_transformation (ds, break_trns_proc, NULL, NULL);
115
116   return CMD_SUCCESS;
117 }
118
119 /* Parses an IF clause for LOOP or END LOOP and stores the
120    resulting expression to *CONDITION.
121    Returns true if successful, false on failure. */
122 static bool
123 parse_if_clause (struct lexer *lexer, struct dataset *ds,
124                  struct expression **condition)
125 {
126   if (*condition != NULL)
127     {
128       lex_sbc_only_once ("IF");
129       return false;
130     }
131
132   *condition = expr_parse_bool (lexer, ds);
133   return *condition != NULL;
134 }
135
136 /* Parses an indexing clause into LOOP.  Returns true if successful, false on
137    failure. */
138 static bool
139 parse_index_clause (struct dataset *ds, struct lexer *lexer,
140                     struct loop_trns *loop)
141 {
142   if (loop->index_var != NULL)
143     {
144       msg (SE, _("Only one index clause may be specified."));
145       return false;
146     }
147
148   if (lex_token (lexer) != T_ID)
149     {
150       lex_error (lexer, NULL);
151       return false;
152     }
153
154   loop->index_var = dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer));
155   if (!loop->index_var)
156     loop->index_var = dict_create_var_assert (dataset_dict (ds),
157                                               lex_tokcstr (lexer), 0);
158   lex_get (lexer);
159
160   if (!lex_force_match (lexer, T_EQUALS))
161     return false;
162
163   loop->first = expr_parse (lexer, ds, VAL_NUMERIC);
164   if (loop->first == NULL)
165     return false;
166
167   for (;;)
168     {
169       struct expression **e;
170       if (lex_match (lexer, T_TO))
171         e = &loop->last;
172       else if (lex_match (lexer, T_BY))
173         e = &loop->by;
174       else
175         break;
176
177       if (*e != NULL)
178         {
179           lex_sbc_only_once (e == &loop->last ? "TO" : "BY");
180           return false;
181         }
182       *e = expr_parse (lexer, ds, VAL_NUMERIC);
183       if (*e == NULL)
184         return false;
185     }
186   if (loop->last == NULL)
187     {
188       lex_sbc_missing ("TO");
189       return false;
190     }
191
192   return true;
193 }
194
195 /* Sets up LOOP for the first pass. */
196 static enum trns_result
197 loop_trns_proc (void *loop_, struct ccase **c, casenumber case_num)
198 {
199   struct loop_trns *loop = loop_;
200
201   double cur, by, last;
202   if (loop->index_var)
203     {
204       /* Evaluate loop index expressions. */
205       cur = expr_evaluate_num (loop->first, *c, case_num);
206       by = loop->by ? expr_evaluate_num (loop->by, *c, case_num) : 1.0;
207       last = expr_evaluate_num (loop->last, *c, case_num);
208
209       /* Even if the loop is never entered, set the index
210          variable to the initial value. */
211       *c = case_unshare (*c);
212       *case_num_rw (*c, loop->index_var) = cur;
213
214       /* Throw out pathological cases. */
215       if (!isfinite (cur) || !isfinite (by) || !isfinite (last)
216           || by == 0.0
217           || (by > 0.0 && cur > last)
218           || (by < 0.0 && cur < last))
219         return TRNS_CONTINUE;
220     }
221   else
222     cur = by = last = 0.0;
223
224   int max_pass = loop->index_var ? settings_get_mxloops () : -1;
225   for (int i = 0; max_pass < 0 || i < max_pass; i++)
226     {
227       if (loop->loop_condition
228           && expr_evaluate_num (loop->loop_condition, *c, case_num) != 1.0)
229         break;
230
231       enum trns_result r = transformations_execute (
232         loop->xforms, loop->n_xforms, c, case_num);
233       if (r != TRNS_CONTINUE)
234         return r == TRNS_BREAK ? TRNS_CONTINUE : r;
235
236       if (loop->end_loop_condition != NULL
237           && expr_evaluate_num (loop->end_loop_condition, *c, case_num) != 0.0)
238         break;
239
240       if (loop->index_var)
241         {
242           cur += by;
243           if (by > 0.0 ? cur > last : cur < last)
244             break;
245
246           *c = case_unshare (*c);
247           *case_num_rw (*c, loop->index_var) = cur;
248         }
249     }
250   return TRNS_CONTINUE;
251 }
252
253 /* Frees LOOP. */
254 static bool
255 loop_trns_free (void *loop_)
256 {
257   struct loop_trns *loop = loop_;
258
259   expr_free (loop->first);
260   expr_free (loop->by);
261   expr_free (loop->last);
262
263   expr_free (loop->loop_condition);
264   expr_free (loop->end_loop_condition);
265
266   transformations_destroy (loop->xforms, loop->n_xforms);
267
268   free (loop);
269   return true;
270 }