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_create (c, dict_get_next_value_idx (d));
 167             }
 168           else
 169             case_resize (c, old_value_cnt, dict_get_next_value_idx (d));
 170
 171           if (lex_is_number ())
 172             case_data_rw (c, v->fv)->f = tokval;
 173           else
 174             memcpy (case_data_rw (c, v->fv)->s, ds_data (&tokstr),
 175                     v->width);
 176           lex_get ();
 177
 178           if (!lex_force_match (')'))
 179             goto done;
 180         }
 181       else
 182         break;
 183     }
 184   if (token != '/')
 185     {
 186       lex_force_match ('/');
 187       goto done;
 188     }
 189   if (d != NULL)
 190     fprintf (stderr, "; ");
 191   fprintf (stderr, "%s => ", lex_rest_of_line (NULL));
 192   lex_get ();
 193
 194   expr = expr_parse_any (d, optimize);
 195   if (!expr || lex_end_of_command () != CMD_SUCCESS)
 196     {
 197       if (expr != NULL)
 198         expr_free (expr);
 199       fprintf (stderr, "error\n");
 200       goto done;
 201     }
 202
 203   if (dump_postfix)
 204     expr_debug_print_postfix (expr);
 205   else
 206     switch (expr->type)
 207       {
 208       case OP_number:
 209         {
 210           double d = expr_evaluate_num (expr, c, 0);
 211           if (d == SYSMIS)
 212             fprintf (stderr, "sysmis\n");
 213           else
 214             fprintf (stderr, "%.2f\n", d);
 215         }
 216         break;
 217
 218       case OP_boolean:
 219         {
 220           double b = expr_evaluate_num (expr, c, 0);
 221           fprintf (stderr, "%s\n",
 222                    b == SYSMIS ? "sysmis" : b == 0.0 ? "false" : "true");
 223         }
 224         break;
 225
 226       case OP_string:
 227         {
 228           struct substring s;
 229           expr_evaluate (expr, c, 0, &s);
 230
 231           fputc ('"', stderr);
 232           fwrite (s.string, s.length, 1, stderr);
 233           fputs ("\"\n", stderr);
 234           break;
 235         }
 236
 237       default:
 238         NOT_REACHED ();
 239       }
 240
 241   expr_free (expr);
 242   retval = CMD_SUCCESS;
 243
 244  done:
 245   if (c != NULL)
 246     {
 247       case_destroy (c);
 248       free (c);
 249     }
 250   dict_destroy (d);
 251   return retval;
 252 }
 253
 254 void
 255 expr_debug_print_postfix (const struct expression *e)
 256 {
 257   size_t i;
 258
 259   for (i = 0; i < e->op_cnt; i++)
 260     {
 261       union operation_data *op = &e->ops[i];
 262       if (i > 0)
 263         putc (' ', stderr);
 264       switch (e->op_types[i])
 265         {
 266         case OP_operation:
 267           if (op->operation == OP_return_number)
 268             fprintf (stderr, "return_number");
 269           else if (op->operation == OP_return_string)
 270             fprintf (stderr, "return_string");
 271           else if (is_function (op->operation))
 272             fprintf (stderr, "%s", operations[op->operation].prototype);
 273           else if (is_composite (op->operation))
 274             fprintf (stderr, "%s", operations[op->operation].name);
 275           else
 276             fprintf (stderr, "%s:", operations[op->operation].name);
 277           break;
 278         case OP_number:
 279           if (op->number != SYSMIS)
 280             fprintf (stderr, "n<%g>", op->number);
 281           else
 282             fprintf (stderr, "n<SYSMIS>");
 283           break;
 284         case OP_string:
 285           fprintf (stderr, "s<%.*s>",
 286                    (int) op->string.length,
 287                    op->string.string != NULL ? op->string.string : "");
 288           break;
 289         case OP_format:
 290           fprintf (stderr, "f<%s%d.%d>",
 291                   formats[op->format->type].name,
 292                   op->format->w, op->format->d);
 293           break;
 294         case OP_variable:
 295           fprintf (stderr, "v<%s>", op->variable->name);
 296           break;
 297         case OP_vector:
 298           fprintf (stderr, "vec<%s>", op->vector->name);
 299           break;
 300         case OP_integer:
 301           fprintf (stderr, "i<%d>", op->integer);
 302           break;
 303         default:
 304           NOT_REACHED ();
 305         }
 306     }
 307   fprintf (stderr, "\n");
 308 }