09f237e0cd4e3664a0a57353ce2b0f0d2292becf
[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 (lex_match_id (lexer, "MISSING"))
196             {
197               struct missing_values mv;
198               mv_init (&mv, width);
199               mv_add_value (&mv, &value);
200               var_set_missing_values (v, &mv);
201               mv_destroy (&mv);
202             }
203
204           if (c == NULL)
205             c = case_create (dict_get_proto (d));
206           else
207             c = case_unshare_and_resize (c, dict_get_proto (d));
208           value_swap (case_data_rw (c, v), &value);
209           value_destroy (&value, width);
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       case OP_num_vec_elem:
259         {
260           double d = expr_evaluate_num (expr, c, 0);
261           if (d == SYSMIS)
262             output_log ("%s => sysmis", title);
263           else
264             output_log ("%s => %.2f", title, d);
265         }
266         break;
267
268       case OP_boolean:
269         {
270           double b = expr_evaluate_num (expr, c, 0);
271           output_log ("%s => %s", title,
272                       b == SYSMIS ? "sysmis" : b == 0.0 ? "false" : "true");
273         }
274         break;
275
276       case OP_string:
277         {
278           struct substring out;
279           expr_evaluate (expr, c, 0, &out);
280           output_log ("%s => \"%.*s\"", title, (int) out.length, out.string);
281           break;
282         }
283
284       default:
285         NOT_REACHED ();
286       }
287
288   expr_free (expr);
289   retval = CMD_SUCCESS;
290
291  done:
292   dataset_destroy (ds);
293
294   case_unref (c);
295
296   free (name);
297   free (title);
298
299   return retval;
300 }
301
302 void
303 expr_debug_print_postfix (const struct expression *e)
304 {
305   struct string s = DS_EMPTY_INITIALIZER;
306
307   for (size_t i = 0; i < e->n_ops; i++)
308     {
309       union operation_data *op = &e->ops[i];
310       if (i > 0)
311         ds_put_byte (&s, ' ');
312       switch (e->op_types[i])
313         {
314         case OP_operation:
315           if (op->operation == OP_return_number)
316             ds_put_cstr (&s, "return_number");
317           else if (op->operation == OP_return_string)
318             ds_put_cstr (&s, "return_string");
319           else if (is_function (op->operation))
320             ds_put_format (&s, "%s", operations[op->operation].prototype);
321           else if (is_composite (op->operation))
322             ds_put_format (&s, "%s", operations[op->operation].name);
323           else
324             ds_put_format (&s, "%s:", operations[op->operation].name);
325           break;
326         case OP_number:
327           if (op->number != SYSMIS)
328             ds_put_format (&s, "n<%g>", op->number);
329           else
330             ds_put_cstr (&s, "n<SYSMIS>");
331           break;
332         case OP_string:
333           ds_put_cstr (&s, "s<");
334           ds_put_substring (&s, op->string);
335           ds_put_byte (&s, '>');
336           break;
337         case OP_format:
338           {
339             char str[FMT_STRING_LEN_MAX + 1];
340             fmt_to_string (op->format, str);
341             ds_put_format (&s, "f<%s>", str);
342           }
343           break;
344         case OP_variable:
345           ds_put_format (&s, "v<%s>", var_get_name (op->variable));
346           break;
347         case OP_vector:
348           ds_put_format (&s, "vec<%s>", vector_get_name (op->vector));
349           break;
350         case OP_integer:
351           ds_put_format (&s, "i<%d>", op->integer);
352           break;
353         case OP_expr_node:
354           ds_put_cstr (&s, "expr_node");
355           break;
356         default:
357           NOT_REACHED ();
358         }
359     }
360   output_log_nocopy (ds_steal_cstr (&s));
361 }