Adopt use of gnulib for portability.
[pspp-builds.git] / src / loop.c
index 424e5aabaf6aba050e536cadc7472b067924e2d7..06936778ef0f990751174373f5b7499a339c4eee 100644 (file)
 
    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
-   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-   02111-1307, USA. */
+   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+   02110-1301, USA. */
 
 #include <config.h>
-#include <assert.h>
+#include "error.h"
 #include "alloc.h"
-#include "approx.h"
+#include "case.h"
 #include "command.h"
+#include "dictionary.h"
 #include "do-ifP.h"
 #include "error.h"
-#include "expr.h"
+#include "expressions/public.h"
 #include "lexer.h"
+#include "misc.h"
 #include "settings.h"
 #include "str.h"
 #include "var.h"
 
+#include "gettext.h"
+#define _(msgid) gettext (msgid)
+
 #include "debug-print.h"
 
-/* *INDENT-OFF* */
 /* LOOP strategy:
 
    Each loop causes 3 different transformations to be output.  The
    transformation to -1.  This ensures that the pass number is set to
    -1 every time the loop is encountered, before the first iteration.
 
-   The second transformation increments the pass number.  If there is
-   no indexing or test clause on either LOOP or END LOOP, then the
-   pass number is checked against MXLOOPS and control may pass out of
-   the loop; otherwise the indexing or test clause(s) on LOOP are
-   checked, and again control may pass out of the loop.
+   The second transformation increments the pass number.  If
+   there is no indexing or test clause on either LOOP or END
+   LOOP, then the pass number is checked against MXLOOPS and
+   control may pass out of the loop.  Otherwise the indexing or
+   test clause(s) on LOOP are checked, and again control may pass
+   out of the loop.
 
-   After the second transformation the body of the loop is executed.
+   After the second transformation the body of the loop is
+   executed.
 
    The last transformation checks the test clause if present and
-   either jumps back up to the second transformation or terminates the
-   loop.
-
-   Flow of control: (The characters ^V<> represents arrows.)
-
-     1. LOOP (sets pass # to -1)
-        V
-        V
-   >>2. LOOP (increment pass number)
-   ^         (test optional indexing clause)
-   ^         (test optional IF clause)
-   ^    if we need another trip     if we're done with the loop>>V
-   ^     V                                                       V
-   ^     V                                                         V
-   ^ *. execute loop body                                          V
-   ^    .                                                          V
-   ^    .   (any number of transformations)                        V
-   ^    .                                                          V
-   ^                                                             V
-   ^ 3. END LOOP (test optional IF clause)                         V
-   ^<<<<if we need another trip     if we're done with the loop>>V
-                                                                V
-                                                                V
-     *. transformations after loop body<<<<<<<<<<<<<<<<<<<<<<<<<<<
+   either jumps back up to the second transformation or
+   terminates the loop.
+
+   Flow of control:
+
+   1. LOOP.  Sets pass number to -1 and continues to next
+      transformation.
+
+   2. LOOP.  Increments pass number.  Tests optional indexing
+      clause and optional IF clause.  If we're done with the
+      loop, we jump to the transformation just after LOOP
+      transformation 3.
+
+      Otherwise, we continue through the transformations in the
+      loop body.
 
+   3. END LOOP.  We test the optional IF clause.  If we need to
+      make another pass through the loop, we jump to LOOP
+      transformation 2.
+
+      Otherwise, we continue with the transformation jump after
+      the loop.
  */
-/* *INDENT-ON* */
 
 /* Types of limits on loop execution. */
 enum
@@ -140,13 +142,9 @@ static struct loop_3_trns *thr;
 
 static int internal_cmd_loop (void);
 static int internal_cmd_end_loop (void);
-static int break_trns_proc (struct trns_header *, struct ccase *);
-static int loop_1_trns_proc (struct trns_header *, struct ccase *);
-static void loop_1_trns_free (struct trns_header *);
-static int loop_2_trns_proc (struct trns_header *, struct ccase *);
-static void loop_2_trns_free (struct trns_header *);
-static int loop_3_trns_proc (struct trns_header *, struct ccase *);
-static void loop_3_trns_free (struct trns_header *);
+static trns_proc_func break_trns_proc;
+static trns_proc_func loop_1_trns_proc, loop_2_trns_proc, loop_3_trns_proc;
+static trns_free_func loop_1_trns_free, loop_2_trns_free, loop_3_trns_free;
 static void pop_ctl_stack (void);
 \f
 /* LOOP. */
@@ -171,9 +169,7 @@ static int
 internal_cmd_loop (void)
 {
   /* Name of indexing variable if applicable. */
-  char name[9];
-
-  lex_match_id ("LOOP");
+  char name[LONG_NAME_LEN + 1];
 
   /* Create and initialize transformations to facilitate
      error-handling. */
@@ -207,7 +203,7 @@ internal_cmd_loop (void)
       assert (token == '=');
       lex_get ();
 
-      one->init = expr_parse (PXP_NUMERIC);
+      one->init = expr_parse (default_dict, EXPR_NUMBER);
       if (!one->init)
        return 0;
 
@@ -216,7 +212,7 @@ internal_cmd_loop (void)
          expr_free (one->init);
          return 0;
        }
-      one->term = expr_parse (PXP_NUMERIC);
+      one->term = expr_parse (default_dict, EXPR_NUMBER);
       if (!one->term)
        {
          expr_free (one->init);
@@ -225,20 +221,20 @@ internal_cmd_loop (void)
 
       if (lex_match (T_BY))
        {
-         one->incr = expr_parse (PXP_NUMERIC);
+         one->incr = expr_parse (default_dict, EXPR_NUMBER);
          if (!one->incr)
            return 0;
        }
     }
   else
-    name[0] = 0;
+    name[0] = '\0';
 
   /* Parse IF clause. */
   if (lex_match_id ("IF"))
     {
       two->flags |= LPC_COND;
 
-      two->cond = expr_parse (PXP_BOOLEAN);
+      two->cond = expr_parse (default_dict, EXPR_BOOLEAN);
       if (!two->cond)
        return 0;
     }
@@ -250,7 +246,7 @@ internal_cmd_loop (void)
     }
 
   /* Find variable; create if necessary. */
-  if (name[0])
+  if (name[0] != '\0')
     {
       two->index = dict_lookup_var (default_dict, name);
       if (!two->index)
@@ -268,15 +264,6 @@ internal_cmd_loop (void)
   add_transformation ((struct trns_header *) one);
   add_transformation ((struct trns_header *) two);
 
-#if DEBUGGING
-  printf ("LOOP");
-  if (two->flags & LPC_INDEX)
-    printf ("(INDEX)");
-  if (two->flags & LPC_COND)
-    printf ("(IF)");
-  printf ("\n");
-#endif
-
   return 1;
 }
 
@@ -322,7 +309,7 @@ internal_cmd_end_loop (void)
   /* Parse the expression if any. */
   if (lex_match_id ("IF"))
     {
-      thr->cond = expr_parse (PXP_BOOLEAN);
+      thr->cond = expr_parse (default_dict, EXPR_BOOLEAN);
       if (!thr->cond)
        return 0;
     }
@@ -337,19 +324,13 @@ internal_cmd_end_loop (void)
   /* Pop off the top of stack. */
   ctl_stack = ctl_stack->down;
 
-#if DEBUGGING
-  printf ("END LOOP");
-  if (thr->cond)
-    printf ("(IF)");
-  printf ("\n");
-#endif
-
   return 1;
 }
 
 /* Performs transformation 1. */
 static int
-loop_1_trns_proc (struct trns_header * trns, struct ccase * c)
+loop_1_trns_proc (struct trns_header * trns, struct ccase * c,
+                  int case_num)
 {
   struct loop_1_trns *one = (struct loop_1_trns *) trns;
   struct loop_2_trns *two = one->two;
@@ -357,32 +338,31 @@ loop_1_trns_proc (struct trns_header * trns, struct ccase * c)
   two->pass = -1;
   if (two->flags & LPC_INDEX)
     {
-      union value t1, t2, t3;
+      double t1, t2, t3;
 
-      expr_evaluate (one->init, c, &t1);
+      t1 = expr_evaluate_num (one->init, c, case_num);
       if (one->incr)
-       expr_evaluate (one->incr, c, &t2);
+       t2 = expr_evaluate_num (one->incr, c, case_num);
       else
-       t2.f = 1.0;
-      expr_evaluate (one->term, c, &t3);
+       t2 = 1.0;
+      t3 = expr_evaluate_num (one->term, c, case_num);
 
       /* Even if the loop is never entered, force the index variable
          to assume the initial value. */
-      c->data[two->index->fv].f = t1.f;
+      case_data_rw (c, two->index->fv)->f = t1;
 
       /* Throw out various pathological cases. */
-      if (!finite (t1.f) || !finite (t2.f) || !finite (t3.f)
-         || approx_eq (t2.f, 0.0))
+      if (!finite (t1) || !finite (t2) || !finite (t3) || t2 == 0.0)
        return two->loop_term;
       debug_printf (("LOOP %s=%g TO %g BY %g.\n", two->index->name,
-                    t1.f, t3.f, t2.f));
-      if (t2.f > 0.0)
+                    t1, t3, t2));
+      if (t2 > 0.0)
        {
          /* Loop counts upward: I=1 TO 5 BY 1. */
          two->flags &= ~LPC_RINDEX;
 
          /* incr>0 but init>term */
-         if (approx_gt (t1.f, t3.f))
+         if (t1 > t3)
            return two->loop_term;
        }
       else
@@ -391,13 +371,13 @@ loop_1_trns_proc (struct trns_header * trns, struct ccase * c)
          two->flags |= LPC_RINDEX;
 
          /* incr<0 but init<term */
-         if (approx_lt (t1.f, t3.f))
+         if (t1 < t3)
            return two->loop_term;
        }
 
-      two->curr = t1.f;
-      two->incr = t2.f;
-      two->term = t3.f;
+      two->curr = t1;
+      two->incr = t2;
+      two->term = t3;
     }
 
   return -1;
@@ -416,7 +396,8 @@ loop_1_trns_free (struct trns_header * trns)
 
 /* Performs transformation 2. */
 static int
-loop_2_trns_proc (struct trns_header * trns, struct ccase * c)
+loop_2_trns_proc (struct trns_header * trns, struct ccase * c,
+                  int case_num UNUSED)
 {
   struct loop_2_trns *two = (struct loop_2_trns *) trns;
 
@@ -424,7 +405,7 @@ loop_2_trns_proc (struct trns_header * trns, struct ccase * c)
   if (two->flags == 0)
     {
       two->pass++;
-      if (two->pass > set_mxloops)
+      if (two->pass > get_mxloops() )
          return two->loop_term;
     }
 
@@ -432,11 +413,11 @@ loop_2_trns_proc (struct trns_header * trns, struct ccase * c)
   if (two->flags & LPC_RINDEX)
     {
       /* Test if we're at the end of the looping. */
-      if (approx_lt (two->curr, two->term))
+      if (two->curr < two->term)
        return two->loop_term;
 
       /* Set the current value into the case. */
-      c->data[two->index->fv].f = two->curr;
+      case_data_rw (c, two->index->fv)->f = two->curr;
 
       /* Decrement the current value. */
       two->curr += two->incr;
@@ -445,11 +426,11 @@ loop_2_trns_proc (struct trns_header * trns, struct ccase * c)
   else if (two->flags & LPC_INDEX)
     {
       /* Test if we're at the end of the looping. */
-      if (approx_gt (two->curr, two->term))
+      if (two->curr > two->term)
        return two->loop_term;
 
       /* Set the current value into the case. */
-      c->data[two->index->fv].f = two->curr;
+      case_data_rw (c, two->index->fv)->f = two->curr;
 
       /* Increment the current value. */
       two->curr += two->incr;
@@ -457,7 +438,7 @@ loop_2_trns_proc (struct trns_header * trns, struct ccase * c)
 
   /* Conditional clause limiter. */
   if ((two->flags & LPC_COND)
-      && expr_evaluate (two->cond, c, NULL) != 1.0)
+      && expr_evaluate_num (two->cond, c, case_num) != 1.0)
     return two->loop_term;
 
   return -1;
@@ -474,13 +455,14 @@ loop_2_trns_free (struct trns_header * trns)
 
 /* Performs transformation 3. */
 static int
-loop_3_trns_proc (struct trns_header * trns, struct ccase * c)
+loop_3_trns_proc (struct trns_header * trns, struct ccase * c,
+                  int case_num)
 {
   struct loop_3_trns *thr = (struct loop_3_trns *) trns;
 
   /* Note that it breaks out of the loop if the expression is true *or
      missing*.  This is conformant. */
-  if (thr->cond && expr_evaluate (two->cond, c, NULL) != 0.0)
+  if (thr->cond && expr_evaluate_num (two->cond, c, case_num) != 0.0)
     return -1;
 
   return thr->loop_start;
@@ -507,8 +489,6 @@ cmd_break (void)
   /* New transformation. */
   struct break_trns *t;
 
-  lex_match_id ("BREAK");
-
   for (loop = ctl_stack; loop; loop = loop->down)
     if (loop->type == CST_LOOP)
       break;
@@ -533,7 +513,8 @@ cmd_break (void)
 }
 
 static int
-break_trns_proc (struct trns_header * trns, struct ccase * c UNUSED)
+break_trns_proc (struct trns_header * trns, struct ccase * c UNUSED,
+                 int case_num UNUSED)
 {
   return ((struct break_trns *) trns)->loop_term;
 }