src/language/expressions/evaluate.c

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