+Sun Mar 6 17:07:20 2005 Ben Pfaff <blp@gnu.org>
+
+ When the lexer sees something like `-5' in the input, it has to
+ decide whether it's a negative numeric constant token or a '-'
+ token followed by a positive numeric constant token. It always
+ decides on the former, and then the parser can call
+ lex_negative_to_dash() if it wants the latter. However, this
+ doesn't work for the case of `-0', because negative zero is
+ (portably) indistinguishable from positive zero. So now we divide
+ T_NUM into two tokens, T_POS_NUM and T_NEG_NUM, to make the
+ distinction clear. This requires a little bit of extra effort,
+ because there were several references to T_NUM in the code base.
+
+ * lexer.c: (lex_get) Use T_NEG_NUM and T_POS_NUM to distinguish
+ positive and negative numeric constants.
+ (lex_double_p) Renamed lex_is_number(). Changed return type to
+ bool. Updated all relevant references to T_NUM to instead use
+ this function.
+ (lex_double) Renamed lex_number(). All references updated.
+ (lex_integer_p) Renamed lex_is_integer(). Changed return type to
+ bool. All references updated.
+ (lex_token_representation) Understand T_NEG_NUM and T_POS_NUM.
+ (lex_negative_to_dash) Ditto.
+ (dump_token) Ditto.
+
+ * lexer.h: (enum) Add T_POS_NUM, T_NEG_NUM. Remove T_NUM.
+
Thu Mar 3 22:08:35 WST 2005 John Darrington <john@darrington.wattle.id.au>
* Makefile.am : Fixed up CLEANFILES target.
arg[i].c = xstrdup (ds_c_str (&tokstr));
type = ALPHA;
}
- else if (token == T_NUM)
+ else if (lex_is_number ())
{
arg[i].f = tokval;
type = NUMERIC;
}
cur = &c->crit.n[n++];
- if (token == T_NUM)
+ if (lex_is_number ())
{
cur->a = tokval;
lex_get ();
if (lex_match_id ("THRU"))
{
- if (token == T_NUM)
+ if (lex_is_number ())
{
if (!lex_force_num ())
return 0;
{
if (!lex_force_match_id ("THRU"))
return 0;
- if (token == T_NUM)
+ if (lex_is_number ())
{
cur->type = CNT_LOW;
cur->a = tokval;
while (lex_match ('/'))
{
fx.recno++;
- if (lex_integer_p ())
+ if (lex_is_integer ())
{
if (lex_integer () < fx.recno)
{
if (!parse_DATA_LIST_vars (&fx.name, &fx.name_cnt, PV_NONE))
return 0;
- if (token == T_NUM)
+ if (lex_is_number ())
{
if (!fixed_parse_compatible (&fx, &dls->first, &dls->last))
goto fail;
else
input.type = FMT_F;
- if (lex_integer_p ())
+ if (lex_is_integer ())
{
if (lex_integer () < 1)
{
tail = new;
/* Parse count. */
- if (lex_integer_p ())
+ if (lex_is_integer ())
{
new->count = lex_integer ();
lex_get ();
return 0;
}
}
- else if (lex_integer_p ())
+ else if (lex_is_integer ())
{
value->num = lex_integer ();
if (!parse_DATA_LIST_vars (&fx.name, &fx.name_cnt, PV_NONE))
return 0;
- if (token == T_NUM)
+ if (lex_is_number ())
{
if (!fixed_parse_compatible (&fx, first, last))
goto fail;
lex_match('(');
- while ( lex_double_p() )
+ while ( lex_is_number() )
{
- subc_list_double_push(&percentile_list,lex_double());
+ subc_list_double_push(&percentile_list,lex_number());
lex_get();
+Sun Mar 6 17:51:05 2005 Ben Pfaff <blp@gnu.org>
+
+ * optimize.c: (optimize_tree) Fix optimization bug for x**2.
+
+ * parse.c: (type_coercion_core) Set *node to NULL on failure, as
+ indicated by function comment.
+ (parse_binary_operators) Always return NULL on type_coercion()
+ failure. Should have been doing this anyway, but bug in
+ type_coercion_core() filtered through.
+ (parse_add) Fix typo in user message.
+ (parse_primary) Understand T_NEG_NUM and T_POS_NUM.
+
Sun Mar 6 10:47:13 2005 Ben Pfaff <blp@gnu.org>
* operations.def: Add VALUE function.
if (!lex_force_match ('='))
goto done;
- if (token == T_NUM)
+ if (lex_is_number ())
{
width = 0;
fprintf (stderr, "(%s = %.2f)", name, tokval);
}
case_resize (c, old_value_cnt, dict_get_next_value_idx (d));
- if (token == T_NUM)
+ if (lex_is_number ())
case_data_rw (c, v->fv)->f = tokval;
else
memcpy (case_data_rw (c, v->fv)->s, ds_data (&tokstr),
lex_get ();
expr = expr_parse_any (d, optimize);
- if (!expr || token != '.')
+ if (!expr || lex_end_of_command () != CMD_SUCCESS)
{
if (expr != NULL)
expr_free (expr);
struct composite_node *n = &node->composite;
assert (is_composite (node->type));
+ /* If you add to these optimizations, please also add a
+ correctness test in tests/expressions/expressions.sh. */
+
/* x+0, x-0, 0+x => x. */
if ((n->type == OP_ADD || n->type == OP_SUB) && eq_double (n->args[1], 0.))
return n->args[0];
else if (n->type == OP_MUL && eq_double (n->args[0], 1.))
return n->args[1];
- /* 0*x, 0/x, x*0, MOD(0,x) => x. */
+ /* 0*x, 0/x, x*0, MOD(0,x) => 0. */
else if (((n->type == OP_MUL || n->type == OP_DIV || n->type == OP_MOD_nn)
&& eq_double (n->args[0], 0.))
|| (n->type == OP_MUL && eq_double (n->args[1], 0.)))
return n->args[0];
/* x**2 => SQUARE(x). */
- else if (n->type == OP_POW && eq_double (n->args[2], 2))
- return expr_allocate_unary (e,OP_SQUARE, node);
+ else if (n->type == OP_POW && eq_double (n->args[1], 2))
+ return expr_allocate_unary (e, OP_SQUARE, n->args[0]);
/* Otherwise, nothing to do. */
else
/* Considers whether *NODE may be coerced to type REQUIRED_TYPE.
Returns true if possible, false if disallowed.
- If DO_COERCION is zero, then *NODE is not modified and there
+ If DO_COERCION is false, then *NODE is not modified and there
are no side effects.
- Otherwise, DO_COERCION is nonzero. In this case, we perform
- the coercion if possible, possibly modifying *NODE. If the
- coercion is not possible then we free *NODE and set *NODE to
- a null pointer.
+ If DO_COERCION is true, we perform the coercion if possible,
+ modifying *NODE if necessary. If the coercion is not possible
+ then we free *NODE and set *NODE to a null pointer.
This function's interface is somewhat awkward. Use one of the
wrapper functions type_coercion(), type_coercion_assert(), or
}
if (do_coercion)
- msg (SE, _("Type mismatch while applying %s operator: "
- "cannot convert %s to %s."),
- operator_name,
- atom_type_name (actual_type), atom_type_name (required_type));
+ {
+ msg (SE, _("Type mismatch while applying %s operator: "
+ "cannot convert %s to %s."),
+ operator_name,
+ atom_type_name (actual_type), atom_type_name (required_type));
+ *node = NULL;
+ }
return false;
}
/* Convert the left-hand side to type OPERAND_TYPE. */
if (!type_coercion (e, operand_type, &node, operator->name))
- return node;
+ return NULL;
/* Parse the right-hand side and coerce to type
OPERAND_TYPE. */
static const struct operator ops[] =
{
{ '+', OP_ADD, "addition (\"+\")" },
- { '-', OP_SUB, "subtraction (\"-\")-" },
+ { '-', OP_SUB, "subtraction (\"-\")" },
};
return parse_binary_operators (e, parse_mul (e),
}
break;
- case T_NUM:
+ case T_POS_NUM:
+ case T_NEG_NUM:
{
union any_node *node = expr_allocate_number (e, tokval);
lex_get ();
{
int mv = 0;
- while (token == T_NUM || token == T_STRING)
+ while (lex_is_number () || token == T_STRING)
{
if (rct->nv >= mv)
{
{
nl = ml = 0;
dl = NULL;
- while (token == T_NUM)
+ while (lex_integer ())
{
if (nl >= ml)
{
/* Current token. */
int token;
-/* T_NUM: the token's value. */
+/* T_POS_NUM, T_NEG_NUM: the token's value. */
double tokval;
/* T_ID: the identifier. */
token = '-';
break;
}
+ token = T_NEG_NUM;
}
-
+ else
+ token = T_POS_NUM;
+
/* Parse the number, copying it into tokstr. */
while (isdigit ((unsigned char) *prog))
ds_putc (&tokstr, *prog++);
ds_putc (&tokstr, '0');
}
- token = T_NUM;
break;
}
\f
/* Token testing functions. */
-/* Returns nonzero if the current token is an integer. */
-int
-lex_integer_p (void)
+/* Returns true if the current token is a number. */
+bool
+lex_is_number (void)
+{
+ return token == T_POS_NUM || token == T_NEG_NUM;
+}
+
+/* Returns the value of the current token, which must be a
+ floating point number. */
+double
+lex_number (void)
+{
+ assert (lex_is_number ());
+ return tokval;
+}
+
+/* Returns true iff the current token is an integer. */
+bool
+lex_is_integer (void)
{
- return (token == T_NUM
+ return (lex_is_number ()
&& tokval != NOT_LONG
&& tokval >= LONG_MIN
&& tokval <= LONG_MAX
long
lex_integer (void)
{
- assert (lex_integer_p ());
+ assert (lex_is_integer ());
return tokval;
}
-/* Returns nonzero if the current token is an floating point. */
-int
-lex_double_p (void)
-{
- return ( token == T_NUM
- && tokval != NOT_DOUBLE );
-}
-
-/* Returns the value of the current token, which must be a
- floating point number. */
-double
-lex_double (void)
-{
- assert (lex_double_p ());
- return tokval;
-}
-
\f
/* Token matching functions. */
int
lex_match_int (int x)
{
- if (lex_integer_p () && lex_integer () == x)
+ if (lex_is_integer () && lex_integer () == x)
{
lex_get ();
return 1;
int
lex_force_int (void)
{
- if (lex_integer_p ())
+ if (lex_is_integer ())
return 1;
else
{
int
lex_force_num (void)
{
- if (token == T_NUM)
+ if (lex_is_number ())
return 1;
else
{
switch (token)
{
case T_ID:
- case T_NUM:
+ case T_POS_NUM:
+ case T_NEG_NUM:
return xstrdup (ds_c_str (&tokstr));
break;
void
lex_negative_to_dash (void)
{
- if (token == T_NUM && tokval < 0.0)
+ if (token == T_NEG_NUM)
{
- token = T_NUM;
+ token = T_POS_NUM;
tokval = -tokval;
ds_replace (&tokstr, ds_c_str (&tokstr) + 1);
save_token ();
fprintf (stderr, "ID\t%s\n", tokid);
break;
- case T_NUM:
+ case T_POS_NUM:
+ case T_NEG_NUM:
fprintf (stderr, "NUM\t%f\n", tokval);
break;
#if !lexer_h
#define lexer_h 1
+#include "bool.h"
+
/* Returns nonzero if character CH may be the first character in an
identifier. */
#define CHAR_IS_ID1(CH) \
enum
{
T_ID = 256, /* Identifier. */
- T_NUM, /* Number. */
+ T_POS_NUM, /* Positive number. */
+ T_NEG_NUM, /* Negative number. */
T_STRING, /* Quoted string. */
T_STOP, /* End of input. */
int lex_end_of_command (void);
/* Token testing functions. */
-int lex_integer_p (void);
+bool lex_is_number (void);
+double lex_number (void);
+bool lex_is_integer (void);
long lex_integer (void);
-int lex_double_p (void);
-double lex_double (void);
/* Token matching functions. */
int lex_match (int);
goto lossage;
}
- if (!lex_integer_p () || lex_integer () < 1)
+ if (!lex_is_integer () || lex_integer () < 1)
{
lex_error (_("expecting positive integer"));
goto lossage;
goto lossage;
}
- if (!lex_integer_p () || lex_integer () < 1)
+ if (!lex_is_integer () || lex_integer () < 1)
{
lex_error (_("expecting positive integer"));
goto lossage;
nor->d[0] = LOWEST;
nor->d[1] = tokval;
}
- else if (token == T_NUM)
+ else if (lex_is_number ())
{
nor->d[0] = tokval;
lex_get ();
*values = NULL;
*weights = NULL;
*cnt = 0;
- while (token == T_NUM)
+ while (lex_is_number ())
{
double value = tokval;
double weight = 1.;
lex_get ();
if (lex_match ('*'))
{
- if (token != T_NUM)
+ if (!lex_is_number ())
{
lex_error (_("expecting weight value"));
return 0;
int prev_recno = fx.recno;
fx.recno++;
- if (token == T_NUM)
+ if (lex_is_number ())
{
if (!lex_force_int ())
return 0;
lex_get ();
/* Parse the included column range. */
- if (token == T_NUM)
+ if (lex_is_number ())
{
/* Width of column range in characters. */
int c_len;
/* 1-based index of last column in range. */
int lc;
- if (!lex_integer_p () || lex_integer () <= 0)
+ if (!lex_is_integer () || lex_integer () <= 0)
{
msg (SE, _("%g is not a valid column location."), tokval);
goto fail;
lex_negative_to_dash ();
if (lex_match ('-'))
{
- if (!lex_integer_p ())
+ if (!lex_is_integer ())
{
msg (SE, _("Column location expected following `%d-'."),
fx.spec.fc + 1);
if (!parse_variables (default_dict, &fx.v, &fx.nv, PV_DUPLICATE))
return 0;
- if (token == T_NUM)
+ if (lex_is_number ())
{
if (!fixed_parse_compatible ())
goto fail;
else
fx.spec.u.v.f.type = FMT_F;
- if (token == T_NUM)
+ if (lex_is_number ())
{
if (!lex_force_int ())
return 0;
else
head = fl = xmalloc (sizeof *fl);
- if (token == T_NUM)
+ if (lex_is_number ())
{
- if (!lex_integer_p ())
+ if (!lex_is_integer ())
goto fail;
fl->count = lex_integer ();
lex_get ();
if (s->value == VAL_INT)
{
- dump (1, "if (!lex_integer_p ())");
+ dump (1, "if (!lex_is_integer ())");
dump (1, "{");
dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
"requires an integer argument.\"));",
}
else
{
- dump (1, "if (token != T_NUM)");
+ dump (1, "if (!lex_is_number ())");
dump (1, "{");
dump (0, "msg (SE, _(\"Number expected after %s "
"specifier of %s subcommand.\"));",
{
dump (1, "if (!lex_force_num ())");
dump (0, "goto lossage;");
- dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_double ();",
+ dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number ();",
st_lower (sbc->name), st_lower (sbc->name) );
dump (0, "lex_get();");
}
dump (0, "goto lossage;");
dump (-1,"}");
- dump (0, "subc_list_double_push(&p->dl_%s[p->sbc_%s-1],lex_double ());",
+ dump (0, "subc_list_double_push(&p->dl_%s[p->sbc_%s-1],lex_number ());",
st_lower (sbc->name),st_lower (sbc->name)
);
v->c = NULL;
- if (token == T_NUM)
+ if (lex_is_number ())
{
v->f = tokval;
lex_get ();
return 0;
if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
c->type = RCD_ELSE;
- else if (token == T_NUM)
+ else if (lex_is_number ())
{
c->type = RCD_LOW;
c->f1.f = tokval;
return 0;
}
}
- else if (token == T_NUM)
+ else if (lex_is_number ())
{
c->f1.f = tokval;
lex_get ();
{
if (lex_match_id ("HI") || lex_match_id ("HIGHEST"))
c->type = RCD_HIGH;
- else if (token == T_NUM)
+ else if (lex_is_number ())
{
c->type = RCD_RANGE;
c->f2.f = tokval;
if (token == T_ID)
result = parse_ids (e);
- else if (token == T_NUM)
+ else if (lex_is_number ())
result = parse_numbers (e);
else if (token == T_STRING)
result = parse_strings (e);
if (!lex_force_num ())
return CMD_FAILURE;
- if (!lex_integer_p ())
+ if (!lex_is_integer ())
{
unsigned long min = gsl_rng_min (get_rng ());
unsigned long max = gsl_rng_max (get_rng ());
lex_match ('=');
if (lex_match_id ("AUTOMATIC"))
set_epoch = -1;
- else if (lex_integer_p ())
+ else if (lex_is_integer ())
{
int new_epoch = lex_integer ();
lex_get ();
}
else
{
- if (token != T_NUM)
+ if (!lex_is_number ())
{
lex_error (_("expecting integer"));
return 0;
}
- if (!lex_integer_p ())
+ if (!lex_is_integer ())
msg (SW, _("Value label `%g' is not integer."), tokval);
value.f = tokval;
}
+Sun Mar 6 17:56:27 2005 Ben Pfaff <blp@gnu.org>
+
+ * expressions/expressions.sh: Add tests for generic optimizations.
+
Sun Mar 6 11:03:58 2005 Ben Pfaff <blp@gnu.org>
* Makefile.am: Add expressions/variables.sh. Remove expr.stat.
SYSMIS(1 + $SYSMIS) => true
# FIXME: out-of-range and nearly out-of-range values on dates
+
+# Tests correctness of generic optimizations in optimize_tree().
+(X = 10.00); x + 0 => 10.00
+(X = -3.00); x - 0 => -3.00
+(X = 5.00); 0 + x => 5.00
+(X = 10.00); x * 1 => 10.00
+(X = -3.00); 1 * x => -3.00
+(X = 5.00); x / 1 => 5.00
+(X = 10.00); 0 * x => 0.00
+(X = -3.00); x * 0 => 0.00
+(X = 5.00); 0 / x => 0.00
+(X = 5.00); mod(0, x) => 0.00
+(X = 5.00); x ** 1 => 5.00
+(X = 5.00); x ** 2 => 25.00
EOF
if [ $? -ne 0 ] ; then no_result ; fi