tests
[pspp] / src / language / expressions / evaluate.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000, 2006, 2007, 2009, 2010, 2011, 2012 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 #include "evaluate.h"
21
22 #include <ctype.h>
23
24 #include "libpspp/assertion.h"
25 #include "libpspp/message.h"
26 #include "language/expressions/helpers.h"
27 #include "language/lexer/value-parser.h"
28 #include "libpspp/pool.h"
29 #include "output/driver.h"
30
31 #include "xalloc.h"
32
33 static void
34 expr_evaluate (struct expression *e, const struct ccase *c, int case_idx,
35                void *result)
36 {
37   struct dataset *ds = e->ds;
38   union operation_data *op = e->ops;
39
40   double *ns = e->number_stack;
41   struct substring *ss = e->string_stack;
42
43   /* Without a dictionary/dataset, the expression can't refer to variables,
44      and you don't need to specify a case when you evaluate the
45      expression.  With a dictionary/dataset, the expression can refer
46      to variables, so you must specify a case when you evaluate the
47      expression. */
48   assert ((c != NULL) == (e->ds != NULL));
49
50   pool_clear (e->eval_pool);
51
52   for (;;)
53     {
54       assert (op < e->ops + e->n_ops);
55       switch (op++->operation)
56         {
57         case OP_number:
58         case OP_boolean:
59           *ns++ = op++->number;
60           break;
61
62         case OP_string:
63           {
64             const struct substring *s = &op++->string;
65             *ss++ = copy_string (e, s->string, s->length);
66           }
67           break;
68
69         case OP_return_number:
70           *(double *) result = isfinite (ns[-1]) ? ns[-1] : SYSMIS;
71           return;
72
73         case OP_return_string:
74           *(struct substring *) result = ss[-1];
75           return;
76
77 #include "evaluate.inc"
78
79         default:
80           NOT_REACHED ();
81         }
82     }
83 }
84
85 double
86 expr_evaluate_num (struct expression *e, const struct ccase *c, int case_idx)
87 {
88   double d;
89
90   assert (e->type == OP_number || e->type == OP_boolean);
91   expr_evaluate (e, c, case_idx, &d);
92   return d;
93 }
94
95 void
96 expr_evaluate_str (struct expression *e, const struct ccase *c, int case_idx,
97                    char *dst, size_t dst_size)
98 {
99   struct substring s;
100
101   assert (e->type == OP_string);
102   assert ((dst == NULL) == (dst_size == 0));
103   expr_evaluate (e, c, case_idx, &s);
104
105   buf_copy_rpad (dst, dst_size, s.string, s.length, ' ');
106 }
107 \f
108 #include "language/lexer/lexer.h"
109 #include "language/command.h"
110
111 static bool default_optimize = true;
112
113 int
114 cmd_debug_evaluate (struct lexer *lexer, struct dataset *dsother UNUSED)
115 {
116   bool optimize = default_optimize;
117   int retval = CMD_FAILURE;
118   bool dump_postfix = false;
119   bool set_defaults = false;
120
121   struct ccase *c = NULL;
122
123   struct dataset *ds = NULL;
124
125   char *name = NULL;
126   char *title = NULL;
127
128   struct expression *expr;
129
130   struct dictionary *d = NULL;
131
132   for (;;)
133     {
134       if (lex_match_id (lexer, "NOOPTIMIZE"))
135         optimize = false;
136       else if (lex_match_id (lexer, "OPTIMIZE"))
137         optimize = true;
138       else if (lex_match_id (lexer, "POSTFIX"))
139         dump_postfix = 1;
140       else if (lex_match_id (lexer, "SET"))
141         set_defaults = true;
142       else if (lex_match (lexer, T_LPAREN))
143         {
144           struct variable *v;
145
146           if (!lex_force_id (lexer))
147             goto done;
148           name = xstrdup (lex_tokcstr (lexer));
149
150           lex_get (lexer);
151           if (!lex_force_match (lexer, T_EQUALS))
152             goto done;
153
154           union value value;
155           int width;
156           if (lex_is_number (lexer))
157             {
158               width = 0;
159               value.f = lex_number (lexer);
160               lex_get (lexer);
161             }
162           else if (lex_match_id (lexer, "SYSMIS"))
163             {
164               width = 0;
165               value.f = SYSMIS;
166             }
167           else if (lex_is_string (lexer))
168             {
169               width = ss_length (lex_tokss (lexer));
170               value.s = CHAR_CAST (uint8_t *, ss_xstrdup (lex_tokss (lexer)));
171               lex_get (lexer);
172             }
173           else
174             {
175               lex_error (lexer, _("expecting number or string"));
176               goto done;
177             }
178
179           if  (ds == NULL)
180             {
181               ds = dataset_create (NULL, "");
182               d = dataset_dict (ds);
183             }
184
185           v = dict_create_var (d, name, width);
186           if (v == NULL)
187             {
188               msg (SE, _("Duplicate variable name %s."), name);
189               value_destroy (&value, width);
190               goto done;
191             }
192           free (name);
193           name = NULL;
194
195           if (c == NULL)
196             c = case_create (dict_get_proto (d));
197           else
198             c = case_unshare_and_resize (c, dict_get_proto (d));
199
200           *case_data_rw (c, v) = value;
201
202           if (lex_match_id (lexer, "MISSING"))
203             {
204               struct missing_values mv;
205               mv_init (&mv, width);
206               mv_add_value (&mv, &value);
207               var_set_missing_values (v, &mv);
208               mv_destroy (&mv);
209             }
210
211           if (!lex_force_match (lexer, T_RPAREN))
212             goto done;
213         }
214       else if (lex_match_id (lexer, "VECTOR"))
215         {
216           struct variable **vars;
217           size_t n;
218           dict_get_vars_mutable (d, &vars, &n, 0);
219           dict_create_vector_assert (d, "V", vars, n);
220           free (vars);
221         }
222       else
223         break;
224     }
225
226   if (set_defaults)
227     {
228       retval = CMD_SUCCESS;
229       default_optimize = optimize;
230       goto done;
231     }
232
233   if (!lex_force_match (lexer, T_SLASH))
234     goto done;
235
236   for (size_t i = 1; ; i++)
237     if (lex_next_token (lexer, i) == T_ENDCMD)
238       {
239         title = lex_next_representation (lexer, 0, i - 1);
240         break;
241       }
242
243   expr = expr_parse_any (lexer, ds, optimize);
244   if (!expr || lex_end_of_command (lexer) != CMD_SUCCESS)
245     {
246       if (expr != NULL)
247         expr_free (expr);
248       output_log ("%s => error", title);
249       goto done;
250     }
251
252   if (dump_postfix)
253     expr_debug_print_postfix (expr);
254   else
255     switch (expr->type)
256       {
257       case OP_number:
258         {
259           double d = expr_evaluate_num (expr, c, 0);
260           if (d == SYSMIS)
261             output_log ("%s => sysmis", title);
262           else
263             output_log ("%s => %.2f", title, d);
264         }
265         break;
266
267       case OP_boolean:
268         {
269           double b = expr_evaluate_num (expr, c, 0);
270           output_log ("%s => %s", title,
271                       b == SYSMIS ? "sysmis" : b == 0.0 ? "false" : "true");
272         }
273         break;
274
275       case OP_string:
276         {
277           struct substring out;
278           expr_evaluate (expr, c, 0, &out);
279           output_log ("%s => \"%.*s\"", title, (int) out.length, out.string);
280           break;
281         }
282
283       default:
284         NOT_REACHED ();
285       }
286
287   expr_free (expr);
288   retval = CMD_SUCCESS;
289
290  done:
291   dataset_destroy (ds);
292
293   case_unref (c);
294
295   free (name);
296   free (title);
297
298   return retval;
299 }
300
301 void
302 expr_debug_print_postfix (const struct expression *e)
303 {
304   struct string s = DS_EMPTY_INITIALIZER;
305
306   for (size_t i = 0; i < e->n_ops; i++)
307     {
308       union operation_data *op = &e->ops[i];
309       if (i > 0)
310         ds_put_byte (&s, ' ');
311       switch (e->op_types[i])
312         {
313         case OP_operation:
314           if (op->operation == OP_return_number)
315             ds_put_cstr (&s, "return_number");
316           else if (op->operation == OP_return_string)
317             ds_put_cstr (&s, "return_string");
318           else if (is_function (op->operation))
319             ds_put_format (&s, "%s", operations[op->operation].prototype);
320           else if (is_composite (op->operation))
321             ds_put_format (&s, "%s", operations[op->operation].name);
322           else
323             ds_put_format (&s, "%s:", operations[op->operation].name);
324           break;
325         case OP_number:
326           if (op->number != SYSMIS)
327             ds_put_format (&s, "n<%g>", op->number);
328           else
329             ds_put_cstr (&s, "n<SYSMIS>");
330           break;
331         case OP_string:
332           ds_put_cstr (&s, "s<");
333           ds_put_substring (&s, op->string);
334           ds_put_byte (&s, '>');
335           break;
336         case OP_format:
337           {
338             char str[FMT_STRING_LEN_MAX + 1];
339             fmt_to_string (op->format, str);
340             ds_put_format (&s, "f<%s>", str);
341           }
342           break;
343         case OP_variable:
344           ds_put_format (&s, "v<%s>", var_get_name (op->variable));
345           break;
346         case OP_vector:
347           ds_put_format (&s, "vec<%s>", vector_get_name (op->vector));
348           break;
349         case OP_integer:
350           ds_put_format (&s, "i<%d>", op->integer);
351           break;
352         case OP_expr_node:
353           ds_put_cstr (&s, "expr_node");
354           break;
355         default:
356           NOT_REACHED ();
357         }
358     }
359   output_log_nocopy (ds_steal_cstr (&s));
360 }