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