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