91b9c84249b76c0e7d799ad7dc089f66874c314a
[pspp-builds.git] / src / language / expressions / evaluate.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000, 2006, 2007, 2009 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 #include "private.h"
19
20 #include <ctype.h>
21 #include <libpspp/assertion.h>
22 #include <libpspp/message.h>
23 #include "helpers.h"
24 #include "evaluate.h"
25 #include <libpspp/pool.h>
26
27 #include "xalloc.h"
28
29 static void
30 expr_evaluate (struct expression *e, const struct ccase *c, int case_idx,
31                void *result)
32 {
33   struct dataset *ds = e->ds;
34   union operation_data *op = e->ops;
35
36   double *ns = e->number_stack;
37   struct substring *ss = e->string_stack;
38
39   /* Without a dictionary/dataset, the expression can't refer to variables,
40      and you don't need to specify a case when you evaluate the
41      expression.  With a dictionary/dataset, the expression can refer
42      to variables, so you must specify a case when you evaluate the
43      expression. */
44   assert ((c != NULL) == (e->ds != NULL));
45
46   pool_clear (e->eval_pool);
47
48   for (;;)
49     {
50       assert (op < e->ops + e->op_cnt);
51       switch (op++->operation)
52         {
53         case OP_number:
54         case OP_boolean:
55           *ns++ = op++->number;
56           break;
57
58         case OP_string:
59           {
60             const struct substring *s = &op++->string;
61             *ss++ = copy_string (e, s->string, s->length);
62           }
63           break;
64
65         case OP_return_number:
66           *(double *) result = isfinite (ns[-1]) ? ns[-1] : SYSMIS;
67           return;
68
69         case OP_return_string:
70           *(struct substring *) result = ss[-1];
71           return;
72
73 #include "evaluate.inc"
74
75         default:
76           NOT_REACHED ();
77         }
78     }
79 }
80
81 double
82 expr_evaluate_num (struct expression *e, const struct ccase *c, int case_idx)
83 {
84   double d;
85
86   assert (e->type == OP_number || e->type == OP_boolean);
87   expr_evaluate (e, c, case_idx, &d);
88   return d;
89 }
90
91 void
92 expr_evaluate_str (struct expression *e, const struct ccase *c, int case_idx,
93                    char *dst, size_t dst_size)
94 {
95   struct substring s;
96
97   assert (e->type == OP_string);
98   assert ((dst == NULL) == (dst_size == 0));
99   expr_evaluate (e, c, case_idx, &s);
100
101   buf_copy_rpad (dst, dst_size, s.string, s.length);
102 }
103 \f
104 #include <language/lexer/lexer.h>
105 #include <language/command.h>
106
107 int
108 cmd_debug_evaluate (struct lexer *lexer, struct dataset *dsother UNUSED)
109 {
110   bool optimize = true;
111   int retval = CMD_FAILURE;
112   bool dump_postfix = false;
113
114   struct ccase *c = NULL;
115
116   struct dataset *ds = NULL;
117
118   struct expression *expr;
119
120   for (;;)
121     {
122       struct dictionary *d = NULL;
123       if (lex_match_id (lexer, "NOOPTIMIZE"))
124         optimize = 0;
125       else if (lex_match_id (lexer, "POSTFIX"))
126         dump_postfix = 1;
127       else if (lex_match (lexer, '('))
128         {
129           char name[VAR_NAME_LEN + 1];
130           struct variable *v;
131           size_t old_value_cnt;
132           int width;
133
134           if (!lex_force_id (lexer))
135             goto done;
136           strcpy (name, lex_tokid (lexer));
137
138           lex_get (lexer);
139           if (!lex_force_match (lexer, '='))
140             goto done;
141
142           if (lex_is_number (lexer))
143             {
144               width = 0;
145               fprintf (stderr, "(%s = %.2f)", name, lex_tokval (lexer));
146             }
147           else if (lex_token (lexer) == T_STRING)
148             {
149               width = ds_length (lex_tokstr (lexer));
150               fprintf (stderr, "(%s = \"%.2s\")", name, ds_cstr (lex_tokstr (lexer)));
151             }
152           else
153             {
154               lex_error (lexer, _("expecting number or string"));
155               goto done;
156             }
157
158           if  ( ds == NULL )
159             {
160               ds = create_dataset ();
161               d = dataset_dict (ds);
162             }
163
164           old_value_cnt = dict_get_next_value_idx (d);
165           v = dict_create_var (d, name, width);
166           if (v == NULL)
167             {
168               msg (SE, _("Duplicate variable name %s."), name);
169               goto done;
170             }
171
172           if (c == NULL)
173             c = case_create (dict_get_next_value_idx (d));
174           else
175             c = case_resize (c, dict_get_next_value_idx (d));
176
177           if (lex_is_number (lexer))
178             case_data_rw (c, v)->f = lex_tokval (lexer);
179           else
180             memcpy (case_data_rw (c, v)->s, ds_data (lex_tokstr (lexer)),
181                     var_get_width (v));
182           lex_get (lexer);
183
184           if (!lex_force_match (lexer, ')'))
185             goto done;
186         }
187       else
188         break;
189     }
190   if (lex_token (lexer) != '/')
191     {
192       lex_force_match (lexer, '/');
193       goto done;
194     }
195
196   if ( ds != NULL )
197     fprintf(stderr, "; ");
198   fprintf (stderr, "%s => ", lex_rest_of_line (lexer));
199   lex_get (lexer);
200
201   expr = expr_parse_any (lexer, ds, optimize);
202   if (!expr || lex_end_of_command (lexer) != CMD_SUCCESS)
203     {
204       if (expr != NULL)
205         expr_free (expr);
206       fprintf (stderr, "error\n");
207       goto done;
208     }
209
210   if (dump_postfix)
211     expr_debug_print_postfix (expr);
212   else
213     switch (expr->type)
214       {
215       case OP_number:
216         {
217           double d = expr_evaluate_num (expr, c, 0);
218           if (d == SYSMIS)
219             fprintf (stderr, "sysmis\n");
220           else
221             fprintf (stderr, "%.2f\n", d);
222         }
223         break;
224
225       case OP_boolean:
226         {
227           double b = expr_evaluate_num (expr, c, 0);
228           fprintf (stderr, "%s\n",
229                    b == SYSMIS ? "sysmis" : b == 0.0 ? "false" : "true");
230         }
231         break;
232
233       case OP_string:
234         {
235           struct substring s;
236           expr_evaluate (expr, c, 0, &s);
237
238           fputc ('"', stderr);
239           fwrite (s.string, s.length, 1, stderr);
240           fputs ("\"\n", stderr);
241           break;
242         }
243
244       default:
245         NOT_REACHED ();
246       }
247
248   expr_free (expr);
249   retval = CMD_SUCCESS;
250
251  done:
252   if (ds)
253     destroy_dataset (ds);
254
255   case_unref (c);
256
257   return retval;
258 }
259
260 void
261 expr_debug_print_postfix (const struct expression *e)
262 {
263   size_t i;
264
265   for (i = 0; i < e->op_cnt; i++)
266     {
267       union operation_data *op = &e->ops[i];
268       if (i > 0)
269         putc (' ', stderr);
270       switch (e->op_types[i])
271         {
272         case OP_operation:
273           if (op->operation == OP_return_number)
274             fprintf (stderr, "return_number");
275           else if (op->operation == OP_return_string)
276             fprintf (stderr, "return_string");
277           else if (is_function (op->operation))
278             fprintf (stderr, "%s", operations[op->operation].prototype);
279           else if (is_composite (op->operation))
280             fprintf (stderr, "%s", operations[op->operation].name);
281           else
282             fprintf (stderr, "%s:", operations[op->operation].name);
283           break;
284         case OP_number:
285           if (op->number != SYSMIS)
286             fprintf (stderr, "n<%g>", op->number);
287           else
288             fprintf (stderr, "n<SYSMIS>");
289           break;
290         case OP_string:
291           fprintf (stderr, "s<%.*s>",
292                    (int) op->string.length,
293                    op->string.string != NULL ? op->string.string : "");
294           break;
295         case OP_format:
296           {
297             char str[FMT_STRING_LEN_MAX + 1];
298             fmt_to_string (op->format, str);
299             fprintf (stderr, "f<%s>", str);
300           }
301           break;
302         case OP_variable:
303           fprintf (stderr, "v<%s>", var_get_name (op->variable));
304           break;
305         case OP_vector:
306           fprintf (stderr, "vec<%s>", vector_get_name (op->vector));
307           break;
308         case OP_integer:
309           fprintf (stderr, "i<%d>", op->integer);
310           break;
311         default:
312           NOT_REACHED ();
313         }
314     }
315   fprintf (stderr, "\n");
316 }