expressions: Major work to improve error messages.
[pspp] / src / language / expressions / optimize.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000, 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 "language/expressions/private.h"
20
21 #include <math.h>
22 #include <ctype.h>
23 #include <errno.h>
24 #include <stdlib.h>
25
26 #include "data/calendar.h"
27 #include "data/data-in.h"
28 #include "data/variable.h"
29 #include "evaluate.h"
30 #include "language/expressions/helpers.h"
31 #include "language/expressions/public.h"
32 #include "libpspp/assertion.h"
33 #include "libpspp/message.h"
34 #include "libpspp/misc.h"
35 #include "libpspp/pool.h"
36 #include "libpspp/str.h"
37
38 #include "gl/xalloc.h"
39
40 static struct expr_node *evaluate_tree (struct expr_node *, struct expression *);
41 static struct expr_node *optimize_tree (struct expr_node *, struct expression *);
42
43 struct expr_node *
44 expr_optimize (struct expr_node *node, struct expression *e)
45 {
46   int n_nonconst = 0; /* Number of nonconstant children. */
47   int n_sysmis = 0;   /* Number of system-missing children. */
48   const struct operation *op;
49   int i;
50
51   /* We can't optimize an atom. */
52   if (is_atom (node->type))
53     return node;
54
55   /* Start by optimizing all the children. */
56   for (i = 0; i < node->n_args; i++)
57     {
58       node->args[i] = expr_optimize (node->args[i], e);
59       if (node->args[i]->type == OP_number)
60         {
61           if (node->args[i]->number == SYSMIS)
62             n_sysmis++;
63         }
64
65       if (!is_atom (node->args[i]->type))
66         n_nonconst++;
67     }
68
69   op = &operations[node->type];
70
71   struct expr_node *new;
72   if (n_sysmis && (op->flags & OPF_ABSORB_MISS) == 0)
73     {
74       /* Most operations produce SYSMIS given any SYSMIS
75          argument. */
76       assert (op->returns == OP_number || op->returns == OP_boolean);
77       new = (op->returns == OP_number
78              ? expr_allocate_number (e, SYSMIS)
79              : expr_allocate_boolean (e, SYSMIS));
80     }
81   else if (!n_nonconst && (op->flags & OPF_NONOPTIMIZABLE) == 0)
82     {
83       /* Evaluate constant expressions. */
84       new = evaluate_tree (node, e);
85     }
86   else
87     {
88       /* A few optimization possibilities are still left. */
89       new = optimize_tree (node, e);
90     }
91
92   if (new != node && !new->location)
93     {
94       const struct msg_location *loc = expr_location (e, node);
95       new->location = CONST_CAST (struct msg_location *, loc);
96     }
97   return new;
98 }
99
100 static int
101 eq_double (struct expr_node *node, double n)
102 {
103   return node->type == OP_number && node->number == n;
104 }
105
106 static struct expr_node *
107 optimize_tree (struct expr_node *n, struct expression *e)
108 {
109   assert (is_composite (n->type));
110
111   /* If you add to these optimizations, please also add a
112      correctness test in tests/expressions/expressions.sh. */
113
114   /* x+0, x-0, 0+x => x. */
115   if ((n->type == OP_ADD || n->type == OP_SUB) && eq_double (n->args[1], 0.))
116     return n->args[0];
117   else if (n->type == OP_ADD && eq_double (n->args[0], 0.))
118     return n->args[1];
119
120   /* x*1, x/1, 1*x => x. */
121   else if ((n->type == OP_MUL || n->type == OP_DIV)
122            && eq_double (n->args[1], 1.))
123     return n->args[0];
124   else if (n->type == OP_MUL && eq_double (n->args[0], 1.))
125     return n->args[1];
126
127   /* 0*x, 0/x, x*0, MOD(0,x) => 0. */
128   else if (((n->type == OP_MUL || n->type == OP_DIV || n->type == OP_MOD_nn)
129             && eq_double (n->args[0], 0.))
130            || (n->type == OP_MUL && eq_double (n->args[1], 0.)))
131     return expr_allocate_number (e, 0.);
132
133   /* x**1 => x. */
134   else if (n->type == OP_POW && eq_double (n->args[1], 1))
135     return n->args[0];
136
137   /* x**2 => SQUARE(x). */
138   else if (n->type == OP_POW && eq_double (n->args[1], 2))
139     return expr_allocate_unary (e, OP_SQUARE, n->args[0]);
140
141   /* Otherwise, nothing to do. */
142   else
143     return n;
144 }
145
146 static double
147 get_number_arg (struct expr_node *n, size_t arg_idx)
148 {
149   assert (arg_idx < n->n_args);
150   assert (n->args[arg_idx]->type == OP_number
151           || n->args[arg_idx]->type == OP_boolean
152           || n->args[arg_idx]->type == OP_integer);
153   return n->args[arg_idx]->number;
154 }
155
156 static double *
157 get_number_args (struct expr_node *n, size_t arg_idx, size_t n_args,
158                  struct expression *e)
159 {
160   double *d = pool_alloc (e->expr_pool, sizeof *d * n_args);
161   for (size_t i = 0; i < n_args; i++)
162     d[i] = get_number_arg (n, i + arg_idx);
163   return d;
164 }
165
166 static struct substring
167 get_string_arg (struct expr_node *n, size_t arg_idx)
168 {
169   assert (arg_idx < n->n_args);
170   assert (n->args[arg_idx]->type == OP_string);
171   return n->args[arg_idx]->string;
172 }
173
174 static struct substring *
175 get_string_args (struct expr_node *n, size_t arg_idx, size_t n_args,
176                  struct expression *e)
177 {
178   struct substring *s;
179   size_t i;
180
181   s = pool_alloc (e->expr_pool, sizeof *s * n_args);
182   for (i = 0; i < n_args; i++)
183     s[i] = get_string_arg (n, i + arg_idx);
184   return s;
185 }
186
187 static const struct fmt_spec *
188 get_format_arg (struct expr_node *n, size_t arg_idx)
189 {
190   assert (arg_idx < n->n_args);
191   assert (n->args[arg_idx]->type == OP_ni_format
192           || n->args[arg_idx]->type == OP_no_format);
193   return &n->args[arg_idx]->format;
194 }
195
196 static const struct expr_node *
197 get_expr_node_arg (struct expr_node *n, size_t arg_idx)
198 {
199   assert (arg_idx < n->n_args);
200   assert (n->args[arg_idx]->type == OP_expr_node);
201   return n->args[arg_idx]->expr_node;
202 }
203
204 static struct expr_node *
205 evaluate_tree (struct expr_node *node, struct expression *e)
206 {
207   switch (node->type)
208     {
209 #include "optimize.inc"
210
211     default:
212       NOT_REACHED ();
213     }
214
215   NOT_REACHED ();
216 }
217 \f
218 /* Expression flattening. */
219
220 static union operation_data *allocate_aux (struct expression *,
221                                                 operation_type);
222 static void flatten_node (struct expr_node *, struct expression *);
223
224 static void
225 emit_operation (struct expression *e, operation_type type)
226 {
227   allocate_aux (e, OP_operation)->operation = type;
228 }
229
230 static void
231 emit_number (struct expression *e, double n)
232 {
233   allocate_aux (e, OP_number)->number = n;
234 }
235
236 static void
237 emit_string (struct expression *e, struct substring s)
238 {
239   allocate_aux (e, OP_string)->string = s;
240 }
241
242 static void
243 emit_format (struct expression *e, const struct fmt_spec *f)
244 {
245   allocate_aux (e, OP_format)->format = pool_clone (e->expr_pool,
246                                                     f, sizeof *f);
247 }
248
249 static void
250 emit_variable (struct expression *e, const struct variable *v)
251 {
252   allocate_aux (e, OP_variable)->variable = v;
253 }
254
255 static void
256 emit_vector (struct expression *e, const struct vector *v)
257 {
258   allocate_aux (e, OP_vector)->vector = v;
259 }
260
261 static void
262 emit_integer (struct expression *e, int i)
263 {
264   allocate_aux (e, OP_integer)->integer = i;
265 }
266
267 void
268 expr_flatten (struct expr_node *n, struct expression *e)
269 {
270   flatten_node (n, e);
271   e->type = expr_node_returns (n);
272   emit_operation (e, (e->type == OP_string
273                       ? OP_return_string : OP_return_number));
274 }
275
276 static void
277 flatten_atom (struct expr_node *n, struct expression *e)
278 {
279   switch (n->type)
280     {
281     case OP_number:
282     case OP_boolean:
283       emit_operation (e, OP_number);
284       emit_number (e, n->number);
285       break;
286
287     case OP_string:
288       emit_operation (e, OP_string);
289       emit_string (e, n->string);
290       break;
291
292     case OP_num_var:
293     case OP_str_var:
294     case OP_vector:
295     case OP_no_format:
296     case OP_ni_format:
297     case OP_pos_int:
298     case OP_expr_node:
299       /* These are passed as aux data following the
300          operation. */
301       break;
302
303     default:
304       NOT_REACHED ();
305     }
306 }
307
308 static void
309 flatten_composite (struct expr_node *n, struct expression *e)
310 {
311   const struct operation *op = &operations[n->type];
312   size_t i;
313
314   for (i = 0; i < n->n_args; i++)
315     flatten_node (n->args[i], e);
316
317   if (n->type != OP_BOOLEAN_TO_NUM)
318     emit_operation (e, n->type);
319
320   for (i = 0; i < n->n_args; i++)
321     {
322       struct expr_node *arg = n->args[i];
323       switch (arg->type)
324         {
325         case OP_num_var:
326         case OP_str_var:
327           emit_variable (e, arg->variable);
328           break;
329
330         case OP_vector:
331           emit_vector (e, arg->vector);
332           break;
333
334         case OP_ni_format:
335         case OP_no_format:
336           emit_format (e, &arg->format);
337           break;
338
339         case OP_pos_int:
340           emit_integer (e, arg->integer);
341           break;
342
343         case OP_expr_node:
344           allocate_aux (e, OP_expr_node)->expr_node = arg->expr_node;
345           break;
346
347         default:
348           /* Nothing to do. */
349           break;
350         }
351     }
352
353   if (op->flags & OPF_ARRAY_OPERAND)
354     emit_integer (e, n->n_args - op->n_args + 1);
355   if (op->flags & OPF_MIN_VALID)
356     emit_integer (e, n->min_valid);
357   if (op->flags & OPF_EXPR_NODE)
358     allocate_aux (e, OP_expr_node)->expr_node = n;
359 }
360
361 void
362 flatten_node (struct expr_node *n, struct expression *e)
363 {
364   assert (is_operation (n->type));
365
366   if (is_atom (n->type))
367     flatten_atom (n, e);
368   else if (is_composite (n->type))
369     flatten_composite (n, e);
370   else
371     NOT_REACHED ();
372 }
373
374 static union operation_data *
375 allocate_aux (struct expression *e, operation_type type)
376 {
377   if (e->n_ops >= e->allocated_ops)
378     {
379       e->allocated_ops = (e->allocated_ops + 8) * 3 / 2;
380       e->ops = pool_realloc (e->expr_pool, e->ops,
381                              sizeof *e->ops * e->allocated_ops);
382       e->op_types = pool_realloc (e->expr_pool, e->op_types,
383                                   sizeof *e->op_types * e->allocated_ops);
384     }
385
386   e->op_types[e->n_ops] = type;
387   return &e->ops[e->n_ops++];
388 }