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