src/language/expressions/evaluate.c

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