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