pintos-os.org Git - pspp/blob - src/language/control/loop.c

   1 /* PSPP - a program for statistical analysis.
   2    Copyright (C) 1997-9, 2000, 2009-2011 Free Software Foundation, Inc.
   3
   4    This program is free software: you can redistribute it and/or modify
   5    it under the terms of the GNU General Public License as published by
   6    the Free Software Foundation, either version 3 of the License, or
   7    (at your option) any later version.
   8
   9    This program is distributed in the hope that it will be useful,
  10    but WITHOUT ANY WARRANTY; without even the implied warranty of
  11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12    GNU General Public License for more details.
  13
  14    You should have received a copy of the GNU General Public License
  15    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  16
  17 #include <config.h>
  18
  19 #include <limits.h>
  20
  21 #include "data/case.h"
  22 #include "data/dataset.h"
  23 #include "data/dictionary.h"
  24 #include "data/settings.h"
  25 #include "data/transformations.h"
  26 #include "data/variable.h"
  27 #include "language/command.h"
  28 #include "language/expressions/public.h"
  29 #include "language/lexer/lexer.h"
  30 #include "libpspp/compiler.h"
  31 #include "libpspp/message.h"
  32 #include "libpspp/misc.h"
  33 #include "libpspp/pool.h"
  34 #include "libpspp/str.h"
  35
  36 #include "gl/xalloc.h"
  37
  38 #include "gettext.h"
  39 #define _(msgid) gettext (msgid)
  40
  41 struct loop_trns
  42   {
  43     /* a=a TO b [BY c]. */
  44     struct variable *index_var; /* Index variable. */
  45     struct expression *first;   /* Starting index. */
  46     struct expression *by;      /* Index increment (or NULL). */
  47     struct expression *last;    /* Terminal index. */
  48
  49     /* IF condition for LOOP or END LOOP. */
  50     struct expression *loop_condition;
  51     struct expression *end_loop_condition;
  52
  53     /* Inner transformations. */
  54     struct trns_chain xforms;
  55   };
  56
  57 static struct trns_class loop_trns_class;
  58
  59 static int in_loop;
  60
  61 static bool parse_if_clause (struct lexer *, struct dataset *,
  62                              struct expression **);
  63 static bool parse_index_clause (struct dataset *, struct lexer *,
  64                                 struct loop_trns *);
  65 \f
  66 /* LOOP. */
  67
  68 /* Parses LOOP. */
  69 int
  70 cmd_loop (struct lexer *lexer, struct dataset *ds)
  71 {
  72   struct loop_trns *loop = xmalloc (sizeof *loop);
  73   *loop = (struct loop_trns) { .index_var = NULL };
  74
  75   bool ok = true;
  76   while (lex_token (lexer) != T_ENDCMD && ok)
  77     {
  78       if (lex_match_id (lexer, "IF"))
  79         ok = parse_if_clause (lexer, ds, &loop->loop_condition);
  80       else
  81         ok = parse_index_clause (ds, lexer, loop);
  82     }
  83   lex_end_of_command (lexer);
  84
  85   proc_push_transformations (ds);
  86   in_loop++;
  87   for (;;)
  88     {
  89       if (lex_token (lexer) == T_STOP)
  90         {
  91           lex_error (lexer, NULL);
  92           ok = false;
  93           break;
  94         }
  95       else if (lex_match_phrase (lexer, "END LOOP"))
  96         {
  97           if (lex_match_id (lexer, "IF"))
  98             ok = parse_if_clause (lexer, ds, &loop->end_loop_condition) && ok;
  99           break;
 100         }
 101       else
 102         cmd_parse_in_state (lexer, ds, CMD_STATE_NESTED);
 103     }
 104   in_loop--;
 105   proc_pop_transformations (ds, &loop->xforms);
 106   printf ("%zu loop transvformations\n", loop->xforms.n);
 107
 108   add_transformation (ds, &loop_trns_class, loop);
 109
 110   return ok ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
 111 }
 112
 113 static enum trns_result
 114 break_trns_proc (void *aux UNUSED, struct ccase **c UNUSED,
 115                  casenumber case_num UNUSED)
 116 {
 117   return TRNS_BREAK;
 118 }
 119
 120 /* Parses BREAK. */
 121 int
 122 cmd_break (struct lexer *lexer UNUSED, struct dataset *ds)
 123 {
 124   if (!in_loop)
 125     {
 126       msg (SE, _("BREAK cannot appear outside LOOP...END LOOP."));
 127       return CMD_FAILURE;
 128     }
 129
 130   static const struct trns_class trns_class = {
 131     .name = "BREAK",
 132     .execute = break_trns_proc
 133   };
 134   add_transformation (ds, &trns_class, NULL);
 135
 136   return CMD_SUCCESS;
 137 }
 138
 139 /* Parses an IF clause for LOOP or END LOOP and stores the
 140    resulting expression to *CONDITION.
 141    Returns true if successful, false on failure. */
 142 static bool
 143 parse_if_clause (struct lexer *lexer, struct dataset *ds,
 144                  struct expression **condition)
 145 {
 146   if (*condition != NULL)
 147     {
 148       lex_sbc_only_once ("IF");
 149       return false;
 150     }
 151
 152   *condition = expr_parse_bool (lexer, ds);
 153   return *condition != NULL;
 154 }
 155
 156 /* Parses an indexing clause into LOOP.  Returns true if successful, false on
 157    failure. */
 158 static bool
 159 parse_index_clause (struct dataset *ds, struct lexer *lexer,
 160                     struct loop_trns *loop)
 161 {
 162   if (loop->index_var != NULL)
 163     {
 164       msg (SE, _("Only one index clause may be specified."));
 165       return false;
 166     }
 167
 168   if (lex_token (lexer) != T_ID)
 169     {
 170       lex_error (lexer, NULL);
 171       return false;
 172     }
 173
 174   loop->index_var = dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer));
 175   if (!loop->index_var)
 176     loop->index_var = dict_create_var_assert (dataset_dict (ds),
 177                                               lex_tokcstr (lexer), 0);
 178   lex_get (lexer);
 179
 180   if (!lex_force_match (lexer, T_EQUALS))
 181     return false;
 182
 183   loop->first = expr_parse (lexer, ds, VAL_NUMERIC);
 184   if (loop->first == NULL)
 185     return false;
 186
 187   for (;;)
 188     {
 189       struct expression **e;
 190       if (lex_match (lexer, T_TO))
 191         e = &loop->last;
 192       else if (lex_match (lexer, T_BY))
 193         e = &loop->by;
 194       else
 195         break;
 196
 197       if (*e != NULL)
 198         {
 199           lex_sbc_only_once (e == &loop->last ? "TO" : "BY");
 200           return false;
 201         }
 202       *e = expr_parse (lexer, ds, VAL_NUMERIC);
 203       if (*e == NULL)
 204         return false;
 205     }
 206   if (loop->last == NULL)
 207     {
 208       lex_sbc_missing ("TO");
 209       return false;
 210     }
 211
 212   return true;
 213 }
 214
 215 /* Sets up LOOP for the first pass. */
 216 static enum trns_result
 217 loop_trns_proc (void *loop_, struct ccase **c, casenumber case_num)
 218 {
 219   struct loop_trns *loop = loop_;
 220
 221   double cur, by, last;
 222   if (loop->index_var)
 223     {
 224       /* Evaluate loop index expressions. */
 225       cur = expr_evaluate_num (loop->first, *c, case_num);
 226       by = loop->by ? expr_evaluate_num (loop->by, *c, case_num) : 1.0;
 227       last = expr_evaluate_num (loop->last, *c, case_num);
 228
 229       /* Even if the loop is never entered, set the index
 230          variable to the initial value. */
 231       *c = case_unshare (*c);
 232       *case_num_rw (*c, loop->index_var) = cur;
 233
 234       /* Throw out pathological cases. */
 235       if (!isfinite (cur) || !isfinite (by) || !isfinite (last)
 236           || by == 0.0
 237           || (by > 0.0 && cur > last)
 238           || (by < 0.0 && cur < last))
 239         return TRNS_CONTINUE;
 240     }
 241   else
 242     cur = by = last = 0.0;
 243
 244   for (int i = 0; loop->index_var || i < settings_get_mxloops (); i++)
 245     {
 246       printf ("loop %g %g %g\n", cur, by, last);
 247       if (loop->loop_condition
 248           && expr_evaluate_num (loop->loop_condition, *c, case_num) != 1.0)
 249         break;
 250
 251       enum trns_result r = trns_chain_execute (&loop->xforms, case_num, c);
 252       if (r != TRNS_CONTINUE)
 253         return r == TRNS_BREAK ? TRNS_CONTINUE : r;
 254
 255       if (loop->end_loop_condition != NULL
 256           && expr_evaluate_num (loop->end_loop_condition, *c, case_num) != 0.0)
 257         break;
 258
 259       if (loop->index_var)
 260         {
 261           cur += by;
 262           if (by > 0.0 ? cur > last : cur < last)
 263             break;
 264
 265           *c = case_unshare (*c);
 266           *case_num_rw (*c, loop->index_var) = cur;
 267         }
 268     }
 269   return TRNS_CONTINUE;
 270 }
 271
 272 /* Frees LOOP. */
 273 static bool
 274 loop_trns_free (void *loop_)
 275 {
 276   struct loop_trns *loop = loop_;
 277
 278   expr_free (loop->first);
 279   expr_free (loop->by);
 280   expr_free (loop->last);
 281
 282   expr_free (loop->loop_condition);
 283   expr_free (loop->end_loop_condition);
 284
 285   trns_chain_uninit (&loop->xforms);
 286
 287   free (loop);
 288   return true;
 289 }
 290
 291 static struct trns_class loop_trns_class = {
 292   .name = "LOOP",
 293   .execute = loop_trns_proc,
 294   .destroy = loop_trns_free,
 295 };