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