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