dictionary: Limit split file variables to 8, for compatibility.
[pspp] / src / language / xforms / compute.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000, 2009, 2010, 2011, 2014 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 <float.h>
20 #include <stdint.h>
21 #include <stdlib.h>
22
23 #include "data/case.h"
24 #include "data/dataset.h"
25 #include "data/dictionary.h"
26 #include "data/transformations.h"
27 #include "data/variable.h"
28 #include "data/vector.h"
29 #include "language/command.h"
30 #include "language/expressions/public.h"
31 #include "language/lexer/lexer.h"
32 #include "libpspp/message.h"
33 #include "libpspp/misc.h"
34 #include "libpspp/str.h"
35
36 #include "gl/xalloc.h"
37
38 #include "gettext.h"
39 #define _(msgid) gettext (msgid)
40
41 struct compute_trns;
42 struct lvalue;
43
44 /* COMPUTE or IF target variable or vector element.
45    For a variable, the `variable' member is non-null.
46    For a vector element, the `vector' member is non-null. */
47 struct lvalue
48   {
49     struct variable *variable;   /* Destination variable. */
50     bool is_new_variable;        /* Did we create the variable? */
51
52     const struct vector *vector; /* Destination vector, if any, or NULL. */
53     struct expression *element;  /* Destination vector element, or NULL. */
54   };
55
56 /* Target of a COMPUTE or IF assignment, either a variable or a
57    vector element. */
58 static struct lvalue *lvalue_parse (struct lexer *lexer, struct dataset *);
59 static int lvalue_get_type (const struct lvalue *);
60 static bool lvalue_is_vector (const struct lvalue *);
61 static void lvalue_finalize (struct lvalue *,
62                              struct compute_trns *, struct dictionary *);
63 static void lvalue_destroy (struct lvalue *, struct dictionary *);
64
65 /* COMPUTE and IF transformation. */
66 struct compute_trns
67   {
68     /* Test expression (IF only). */
69     struct expression *test;     /* Test expression. */
70
71     /* Variable lvalue, if variable != NULL. */
72     struct variable *variable;   /* Destination variable, if any. */
73     int width;                   /* Lvalue string width; 0=numeric. */
74
75     /* Vector lvalue, if vector != NULL. */
76     const struct vector *vector; /* Destination vector, if any. */
77     struct expression *element;  /* Destination vector element expr. */
78
79     /* Rvalue. */
80     struct expression *rvalue;   /* Rvalue expression. */
81   };
82
83 static struct expression *parse_rvalue (struct lexer *lexer,
84                                         const struct lvalue *,
85                                         struct dataset *);
86
87 static struct compute_trns *compute_trns_create (void);
88 static bool compute_trns_free (void *compute_);
89 static const struct trns_class *get_trns_class (const struct lvalue *);
90 \f
91 /* COMPUTE. */
92
93 int
94 cmd_compute (struct lexer *lexer, struct dataset *ds)
95 {
96   struct dictionary *dict = dataset_dict (ds);
97   struct lvalue *lvalue = NULL;
98   struct compute_trns *compute = NULL;
99
100   compute = compute_trns_create ();
101
102   lvalue = lvalue_parse (lexer, ds);
103   if (lvalue == NULL)
104     goto fail;
105
106   if (!lex_force_match (lexer, T_EQUALS))
107     goto fail;
108   compute->rvalue = parse_rvalue (lexer, lvalue, ds);
109   if (compute->rvalue == NULL)
110     goto fail;
111
112   add_transformation (ds, get_trns_class (lvalue), compute);
113
114   lvalue_finalize (lvalue, compute, dict);
115
116   return CMD_SUCCESS;
117
118  fail:
119   lvalue_destroy (lvalue, dict);
120   compute_trns_free (compute);
121   return CMD_CASCADING_FAILURE;
122 }
123 \f
124 /* Transformation functions. */
125
126 /* Handle COMPUTE or IF with numeric target variable. */
127 static enum trns_result
128 compute_num (void *compute_, struct ccase **c, casenumber case_num)
129 {
130   struct compute_trns *compute = compute_;
131
132   if (compute->test == NULL
133       || expr_evaluate_num (compute->test, *c, case_num) == 1.0)
134     {
135       *c = case_unshare (*c);
136       *case_num_rw (*c, compute->variable)
137         = expr_evaluate_num (compute->rvalue, *c, case_num);
138     }
139
140   return TRNS_CONTINUE;
141 }
142
143 /* Handle COMPUTE or IF with numeric vector element target
144    variable. */
145 static enum trns_result
146 compute_num_vec (void *compute_, struct ccase **c, casenumber case_num)
147 {
148   struct compute_trns *compute = compute_;
149
150   if (compute->test == NULL
151       || expr_evaluate_num (compute->test, *c, case_num) == 1.0)
152     {
153       double index;     /* Index into the vector. */
154       int rindx;        /* Rounded index value. */
155
156       index = expr_evaluate_num (compute->element, *c, case_num);
157       rindx = floor (index + EPSILON);
158       if (index == SYSMIS
159           || rindx < 1 || rindx > vector_get_n_vars (compute->vector))
160         {
161           if (index == SYSMIS)
162             msg (SW, _("When executing COMPUTE: SYSMIS is not a valid value "
163                        "as an index into vector %s."),
164                  vector_get_name (compute->vector));
165           else
166             msg (SW, _("When executing COMPUTE: %.*g is not a valid value as "
167                        "an index into vector %s."),
168                  DBL_DIG + 1, index, vector_get_name (compute->vector));
169           return TRNS_CONTINUE;
170         }
171
172       *c = case_unshare (*c);
173       *case_num_rw (*c, vector_get_var (compute->vector, rindx - 1))
174         = expr_evaluate_num (compute->rvalue, *c, case_num);
175     }
176
177   return TRNS_CONTINUE;
178 }
179
180 /* Handle COMPUTE or IF with string target variable. */
181 static enum trns_result
182 compute_str (void *compute_, struct ccase **c, casenumber case_num)
183 {
184   struct compute_trns *compute = compute_;
185
186   if (compute->test == NULL
187       || expr_evaluate_num (compute->test, *c, case_num) == 1.0)
188     {
189       char *s;
190
191       *c = case_unshare (*c);
192       s = CHAR_CAST_BUG (char *, case_str_rw (*c, compute->variable));
193       expr_evaluate_str (compute->rvalue, *c, case_num, s, compute->width);
194     }
195
196   return TRNS_CONTINUE;
197 }
198
199 /* Handle COMPUTE or IF with string vector element target
200    variable. */
201 static enum trns_result
202 compute_str_vec (void *compute_, struct ccase **c, casenumber case_num)
203 {
204   struct compute_trns *compute = compute_;
205
206   if (compute->test == NULL
207       || expr_evaluate_num (compute->test, *c, case_num) == 1.0)
208     {
209       double index;             /* Index into the vector. */
210       int rindx;                /* Rounded index value. */
211       struct variable *vr;      /* Variable reference by indexed vector. */
212
213       index = expr_evaluate_num (compute->element, *c, case_num);
214       rindx = floor (index + EPSILON);
215       if (index == SYSMIS)
216         {
217           msg (SW, _("When executing COMPUTE: SYSMIS is not a valid "
218                      "value as an index into vector %s."),
219                vector_get_name (compute->vector));
220           return TRNS_CONTINUE;
221         }
222       else if (rindx < 1 || rindx > vector_get_n_vars (compute->vector))
223         {
224           msg (SW, _("When executing COMPUTE: %.*g is not a valid value as "
225                      "an index into vector %s."),
226                DBL_DIG + 1, index, vector_get_name (compute->vector));
227           return TRNS_CONTINUE;
228         }
229
230       vr = vector_get_var (compute->vector, rindx - 1);
231       *c = case_unshare (*c);
232       expr_evaluate_str (compute->rvalue, *c, case_num,
233                          CHAR_CAST_BUG (char *, case_str_rw (*c, vr)),
234                          var_get_width (vr));
235     }
236
237   return TRNS_CONTINUE;
238 }
239 \f
240 /* IF. */
241
242 int
243 cmd_if (struct lexer *lexer, struct dataset *ds)
244 {
245   struct dictionary *dict = dataset_dict (ds);
246   struct compute_trns *compute = NULL;
247   struct lvalue *lvalue = NULL;
248
249   compute = compute_trns_create ();
250
251   /* Test expression. */
252   compute->test = expr_parse_bool (lexer, ds);
253   if (compute->test == NULL)
254     goto fail;
255
256   /* Lvalue variable. */
257   lvalue = lvalue_parse (lexer, ds);
258   if (lvalue == NULL)
259     goto fail;
260
261   /* Rvalue expression. */
262   if (!lex_force_match (lexer, T_EQUALS))
263     goto fail;
264   compute->rvalue = parse_rvalue (lexer, lvalue, ds);
265   if (compute->rvalue == NULL)
266     goto fail;
267
268   add_transformation (ds, get_trns_class (lvalue), compute);
269
270   lvalue_finalize (lvalue, compute, dict);
271
272   return CMD_SUCCESS;
273
274  fail:
275   lvalue_destroy (lvalue, dict);
276   compute_trns_free (compute);
277   return CMD_CASCADING_FAILURE;
278 }
279 \f
280 /* Code common to COMPUTE and IF. */
281
282 static const struct trns_class *
283 get_trns_class (const struct lvalue *lvalue)
284 {
285   static const struct trns_class classes[2][2] = {
286     [false][false] = {
287       .name = "COMPUTE",
288       .execute = compute_str,
289       .destroy = compute_trns_free
290     },
291     [false][true] = {
292       .name = "COMPUTE",
293       .execute = compute_str_vec,
294       .destroy = compute_trns_free
295     },
296     [true][false] = {
297       .name = "COMPUTE",
298       .execute = compute_num,
299       .destroy = compute_trns_free
300     },
301     [true][true] = {
302       .name = "COMPUTE",
303       .execute = compute_num_vec,
304       .destroy = compute_trns_free
305     },
306   };
307
308   bool is_numeric = lvalue_get_type (lvalue) == VAL_NUMERIC;
309   bool is_vector = lvalue_is_vector (lvalue);
310   return &classes[is_numeric][is_vector];
311 }
312
313 /* Parses and returns an rvalue expression of the same type as
314    LVALUE, or a null pointer on failure. */
315 static struct expression *
316 parse_rvalue (struct lexer *lexer,
317               const struct lvalue *lvalue, struct dataset *ds)
318 {
319   if (lvalue->is_new_variable)
320     return expr_parse_new_variable (lexer, ds, var_get_name (lvalue->variable));
321   else
322     return expr_parse (lexer, ds, lvalue_get_type (lvalue));
323 }
324
325 /* Returns a new struct compute_trns after initializing its fields. */
326 static struct compute_trns *
327 compute_trns_create (void)
328 {
329   struct compute_trns *compute = xmalloc (sizeof *compute);
330   compute->test = NULL;
331   compute->variable = NULL;
332   compute->vector = NULL;
333   compute->element = NULL;
334   compute->rvalue = NULL;
335   return compute;
336 }
337
338 /* Deletes all the fields in COMPUTE. */
339 static bool
340 compute_trns_free (void *compute_)
341 {
342   struct compute_trns *compute = compute_;
343
344   if (compute != NULL)
345     {
346       expr_free (compute->test);
347       expr_free (compute->element);
348       expr_free (compute->rvalue);
349       free (compute);
350     }
351   return true;
352 }
353 \f
354 /* Parses the target variable or vector element into a new
355    `struct lvalue', which is returned. */
356 static struct lvalue *
357 lvalue_parse (struct lexer *lexer, struct dataset *ds)
358 {
359   struct dictionary *dict = dataset_dict (ds);
360   struct lvalue *lvalue;
361
362   lvalue = xmalloc (sizeof *lvalue);
363   lvalue->variable = NULL;
364   lvalue->is_new_variable = false;
365   lvalue->vector = NULL;
366   lvalue->element = NULL;
367
368   if (!lex_force_id (lexer))
369     goto lossage;
370
371   if (lex_next_token (lexer, 1) == T_LPAREN)
372     {
373       /* Vector. */
374       lvalue->vector = dict_lookup_vector (dict, lex_tokcstr (lexer));
375       if (lvalue->vector == NULL)
376         {
377           msg (SE, _("There is no vector named %s."), lex_tokcstr (lexer));
378           goto lossage;
379         }
380
381       /* Vector element. */
382       lex_get (lexer);
383       if (!lex_force_match (lexer, T_LPAREN))
384         goto lossage;
385       lvalue->element = expr_parse (lexer, ds, VAL_NUMERIC);
386       if (lvalue->element == NULL)
387         goto lossage;
388       if (!lex_force_match (lexer, T_RPAREN))
389         goto lossage;
390     }
391   else
392     {
393       /* Variable name. */
394       const char *var_name = lex_tokcstr (lexer);
395       lvalue->variable = dict_lookup_var (dict, var_name);
396       if (lvalue->variable == NULL)
397         {
398           lvalue->variable = dict_create_var_assert (dict, var_name, 0);
399           lvalue->is_new_variable = true;
400         }
401       lex_get (lexer);
402     }
403   return lvalue;
404
405  lossage:
406   lvalue_destroy (lvalue, dict);
407   return NULL;
408 }
409
410 /* Returns the type (NUMERIC or ALPHA) of the target variable or
411    vector in LVALUE. */
412 static int
413 lvalue_get_type (const struct lvalue *lvalue)
414 {
415   return (lvalue->variable != NULL
416           ? var_get_type (lvalue->variable)
417           : vector_get_type (lvalue->vector));
418 }
419
420 /* Returns true if LVALUE has a vector as its target. */
421 static bool
422 lvalue_is_vector (const struct lvalue *lvalue)
423 {
424   return lvalue->vector != NULL;
425 }
426
427 /* Finalizes making LVALUE the target of COMPUTE, by creating the
428    target variable if necessary and setting fields in COMPUTE. */
429 static void
430 lvalue_finalize (struct lvalue *lvalue,
431                  struct compute_trns *compute,
432                  struct dictionary *dict)
433 {
434   if (lvalue->vector == NULL)
435     {
436       compute->variable = lvalue->variable;
437       compute->width = var_get_width (compute->variable);
438
439       /* Goofy behavior, but compatible: Turn off LEAVE. */
440       if (!var_must_leave (compute->variable))
441         var_set_leave (compute->variable, false);
442
443       /* Prevent lvalue_destroy from deleting variable. */
444       lvalue->is_new_variable = false;
445     }
446   else
447     {
448       compute->vector = lvalue->vector;
449       compute->element = lvalue->element;
450       lvalue->element = NULL;
451     }
452
453   lvalue_destroy (lvalue, dict);
454 }
455
456 /* Destroys LVALUE. */
457 static void
458 lvalue_destroy (struct lvalue *lvalue, struct dictionary *dict)
459 {
460   if (lvalue == NULL)
461      return;
462
463   if (lvalue->is_new_variable)
464     dict_delete_var (dict, lvalue->variable);
465   expr_free (lvalue->element);
466   free (lvalue);
467 }