xalloc.h-instead-of-alloc.h.patch from patch #6230.
[pspp-builds.git] / src / language / expressions / evaluate.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000, 2006, 2007 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 = finite (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[LONG_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             {
174               c = xmalloc (sizeof *c);
175               case_create (c, dict_get_next_value_idx (d));
176             }
177           else
178             case_resize (c, dict_get_next_value_idx (d));
179
180           if (lex_is_number (lexer))
181             case_data_rw (c, v)->f = lex_tokval (lexer);
182           else
183             memcpy (case_data_rw (c, v)->s, ds_data (lex_tokstr (lexer)),
184                     var_get_width (v));
185           lex_get (lexer);
186
187           if (!lex_force_match (lexer, ')'))
188             goto done;
189         }
190       else
191         break;
192     }
193   if (lex_token (lexer) != '/')
194     {
195       lex_force_match (lexer, '/');
196       goto done;
197     }
198
199   if ( ds != NULL )
200     fprintf(stderr, "; ");
201   fprintf (stderr, "%s => ", lex_rest_of_line (lexer));
202   lex_get (lexer);
203
204   expr = expr_parse_any (lexer, ds, optimize);
205   if (!expr || lex_end_of_command (lexer) != CMD_SUCCESS)
206     {
207       if (expr != NULL)
208         expr_free (expr);
209       fprintf (stderr, "error\n");
210       goto done;
211     }
212
213   if (dump_postfix)
214     expr_debug_print_postfix (expr);
215   else
216     switch (expr->type)
217       {
218       case OP_number:
219         {
220           double d = expr_evaluate_num (expr, c, 0);
221           if (d == SYSMIS)
222             fprintf (stderr, "sysmis\n");
223           else
224             fprintf (stderr, "%.2f\n", d);
225         }
226         break;
227
228       case OP_boolean:
229         {
230           double b = expr_evaluate_num (expr, c, 0);
231           fprintf (stderr, "%s\n",
232                    b == SYSMIS ? "sysmis" : b == 0.0 ? "false" : "true");
233         }
234         break;
235
236       case OP_string:
237         {
238           struct substring s;
239           expr_evaluate (expr, c, 0, &s);
240
241           fputc ('"', stderr);
242           fwrite (s.string, s.length, 1, stderr);
243           fputs ("\"\n", stderr);
244           break;
245         }
246
247       default:
248         NOT_REACHED ();
249       }
250
251   expr_free (expr);
252   retval = CMD_SUCCESS;
253
254  done:
255   if (ds)
256     destroy_dataset (ds);
257
258   if (c != NULL)
259     {
260       case_destroy (c);
261       free (c);
262     }
263
264   return retval;
265 }
266
267 void
268 expr_debug_print_postfix (const struct expression *e)
269 {
270   size_t i;
271
272   for (i = 0; i < e->op_cnt; i++)
273     {
274       union operation_data *op = &e->ops[i];
275       if (i > 0)
276         putc (' ', stderr);
277       switch (e->op_types[i])
278         {
279         case OP_operation:
280           if (op->operation == OP_return_number)
281             fprintf (stderr, "return_number");
282           else if (op->operation == OP_return_string)
283             fprintf (stderr, "return_string");
284           else if (is_function (op->operation))
285             fprintf (stderr, "%s", operations[op->operation].prototype);
286           else if (is_composite (op->operation))
287             fprintf (stderr, "%s", operations[op->operation].name);
288           else
289             fprintf (stderr, "%s:", operations[op->operation].name);
290           break;
291         case OP_number:
292           if (op->number != SYSMIS)
293             fprintf (stderr, "n<%g>", op->number);
294           else
295             fprintf (stderr, "n<SYSMIS>");
296           break;
297         case OP_string:
298           fprintf (stderr, "s<%.*s>",
299                    (int) op->string.length,
300                    op->string.string != NULL ? op->string.string : "");
301           break;
302         case OP_format:
303           {
304             char str[FMT_STRING_LEN_MAX + 1];
305             fmt_to_string (op->format, str);
306             fprintf (stderr, "f<%s>", str);
307           }
308           break;
309         case OP_variable:
310           fprintf (stderr, "v<%s>", var_get_name (op->variable));
311           break;
312         case OP_vector:
313           fprintf (stderr, "vec<%s>", vector_get_name (op->vector));
314           break;
315         case OP_integer:
316           fprintf (stderr, "i<%d>", op->integer);
317           break;
318         default:
319           NOT_REACHED ();
320         }
321     }
322   fprintf (stderr, "\n");
323 }