unrestricted dimensions treated elementwise. Each element in the matrix
is passed to the implementation function separately.
+ - "n": This gets passed the "const struct matrix_expr *" that represents
+ the expression. This allows the evaluation function to grab the source
+ location of arguments so that it can report accurate error locations.
+
The fourth argument is an optional constraints string. For this purpose the
first argument is named "a", the second "b", and so on. The following kinds
of constraints are supported. For matrix arguments, the constraints are
- "ai": Restrict a to integer values.
- - "a>0", "a<0", "a>=0", "a<=0".
+ - "a>0", "a<0", "a>=0", "a<=0", "a!=0".
- - "a<b", "a>b", "a<=b", "a>=b".
+ - "a<b", "a>b", "a<=b", "a>=b", "b!=0".
*/
#define MATRIX_FUNCTIONS \
F(ABS, "ABS", m_e, NULL) \
F(ARSIN, "ARSIN", m_e, "a[-1,1]") \
F(ARTAN, "ARTAN", m_e, NULL) \
F(BLOCK, "BLOCK", m_any, NULL) \
- F(CHOL, "CHOL", m_m, NULL) \
+ F(CHOL, "CHOL", m_mn, NULL) \
F(CMIN, "CMIN", m_m, NULL) \
F(CMAX, "CMAX", m_m, NULL) \
F(COS, "COS", m_e, NULL) \
F(CSSQ, "CSSQ", m_m, NULL) \
F(CSUM, "CSUM", m_m, NULL) \
- F(DESIGN, "DESIGN", m_m, NULL) \
+ F(DESIGN, "DESIGN", m_mn, NULL) \
F(DET, "DET", d_m, NULL) \
F(DIAG, "DIAG", m_m, NULL) \
- F(EVAL, "EVAL", m_m, NULL) \
+ F(EVAL, "EVAL", m_mn, NULL) \
F(EXP, "EXP", m_e, NULL) \
F(GINV, "GINV", m_m, NULL) \
F(GRADE, "GRADE", m_m, NULL) \
- F(GSCH, "GSCH", m_m, NULL) \
- F(IDENT, "IDENT", IDENT, NULL) \
+ F(GSCH, "GSCH", m_mn, NULL) \
+ F(IDENT, "IDENT", IDENT, "ai>=0 bi>=0") \
F(INV, "INV", m_m, NULL) \
F(KRONEKER, "KRONEKER", m_mm, NULL) \
F(LG10, "LG10", m_e, "a>0") \
F(LN, "LN", m_e, "a>0") \
F(MAGIC, "MAGIC", m_d, "ai>=3") \
- F(MAKE, "MAKE", m_ddd, NULL) \
+ F(MAKE, "MAKE", m_ddd, "ai>=0 bi>=0") \
F(MDIAG, "MDIAG", m_v, NULL) \
F(MMAX, "MMAX", d_m, NULL) \
F(MMIN, "MMIN", d_m, NULL) \
- F(MOD, "MOD", m_md, NULL) \
+ F(MOD, "MOD", m_md, "b!=0") \
F(MSSQ, "MSSQ", d_m, NULL) \
F(MSUM, "MSUM", d_m, NULL) \
F(NCOL, "NCOL", d_m, NULL) \
F(NROW, "NROW", d_m, NULL) \
F(RANK, "RANK", d_m, NULL) \
- F(RESHAPE, "RESHAPE", m_mdd, NULL) \
+ F(RESHAPE, "RESHAPE", m_mddn, NULL) \
F(RMAX, "RMAX", m_m, NULL) \
F(RMIN, "RMIN", m_m, NULL) \
F(RND, "RND", m_e, NULL) \
F(RSSQ, "RSSQ", m_m, NULL) \
F(RSUM, "RSUM", m_m, NULL) \
F(SIN, "SIN", m_e, NULL) \
- F(SOLVE, "SOLVE", m_mm, NULL) \
+ F(SOLVE, "SOLVE", m_mmn, NULL) \
F(SQRT, "SQRT", m_e, "a>=0") \
F(SSCP, "SSCP", m_m, NULL) \
F(SVAL, "SVAL", m_m, NULL) \
- F(SWEEP, "SWEEP", m_md, NULL) \
+ F(SWEEP, "SWEEP", m_mdn, NULL) \
F(T, "T", m_m, NULL) \
F(TRACE, "TRACE", d_m, NULL) \
F(TRANSPOS, "TRANSPOS", m_m, NULL) \
F(TRUNC, "TRUNC", m_e, NULL) \
- F(UNIFORM, "UNIFORM", m_dd, "ai>=0 bi>=0") \
+ F(UNIFORM, "UNIFORM", m_ddn, "ai>=0 bi>=0") \
F(PDF_BETA, "PDF.BETA", m_edd, "a[0,1] b>0 c>0") \
F(CDF_BETA, "CDF.BETA", m_edd, "a[0,1] b>0 c>0") \
F(IDF_BETA, "IDF.BETA", m_edd, "a[0,1] b>0 c>0") \
const char *constraints;
};
-enum { d_none_MIN_ARGS = 0, d_none_MAX_ARGS = 0 };
+enum { IDENT_MIN_ARGS = 1, IDENT_MAX_ARGS = 2 };
enum { d_d_MIN_ARGS = 1, d_d_MAX_ARGS = 1 };
enum { d_dd_MIN_ARGS = 2, d_dd_MAX_ARGS = 2 };
enum { d_ddd_MIN_ARGS = 3, d_ddd_MAX_ARGS = 3 };
+enum { d_m_MIN_ARGS = 1, d_m_MAX_ARGS = 1 };
+enum { d_none_MIN_ARGS = 0, d_none_MAX_ARGS = 0 };
+enum { m_any_MIN_ARGS = 1, m_any_MAX_ARGS = INT_MAX };
enum { m_d_MIN_ARGS = 1, m_d_MAX_ARGS = 1 };
-enum { m_dd_MIN_ARGS = 2, m_dd_MAX_ARGS = 2 };
enum { m_ddd_MIN_ARGS = 3, m_ddd_MAX_ARGS = 3 };
-enum { m_m_MIN_ARGS = 1, m_m_MAX_ARGS = 1 };
+enum { m_ddn_MIN_ARGS = 2, m_ddn_MAX_ARGS = 2 };
enum { m_e_MIN_ARGS = 1, m_e_MAX_ARGS = 1 };
-enum { m_md_MIN_ARGS = 2, m_md_MAX_ARGS = 2 };
enum { m_ed_MIN_ARGS = 2, m_ed_MAX_ARGS = 2 };
-enum { m_mdd_MIN_ARGS = 3, m_mdd_MAX_ARGS = 3 };
enum { m_edd_MIN_ARGS = 3, m_edd_MAX_ARGS = 3 };
enum { m_eddd_MIN_ARGS = 4, m_eddd_MAX_ARGS = 4 };
enum { m_eed_MIN_ARGS = 3, m_eed_MAX_ARGS = 3 };
+enum { m_m_MIN_ARGS = 1, m_m_MAX_ARGS = 1 };
+enum { m_md_MIN_ARGS = 2, m_md_MAX_ARGS = 2 };
+enum { m_mddn_MIN_ARGS = 3, m_mddn_MAX_ARGS = 3 };
+enum { m_mdn_MIN_ARGS = 2, m_mdn_MAX_ARGS = 2 };
enum { m_mm_MIN_ARGS = 2, m_mm_MAX_ARGS = 2 };
+enum { m_mmn_MIN_ARGS = 2, m_mmn_MAX_ARGS = 2 };
+enum { m_mn_MIN_ARGS = 1, m_mn_MAX_ARGS = 1 };
enum { m_v_MIN_ARGS = 1, m_v_MAX_ARGS = 1 };
-enum { d_m_MIN_ARGS = 1, d_m_MAX_ARGS = 1 };
-enum { m_any_MIN_ARGS = 1, m_any_MAX_ARGS = INT_MAX };
-enum { IDENT_MIN_ARGS = 1, IDENT_MAX_ARGS = 2 };
typedef double matrix_proto_d_none (void);
typedef double matrix_proto_d_d (double);
typedef double matrix_proto_d_dd (double, double);
typedef double matrix_proto_d_ddd (double, double, double);
typedef gsl_matrix *matrix_proto_m_d (double);
-typedef gsl_matrix *matrix_proto_m_dd (double, double);
typedef gsl_matrix *matrix_proto_m_ddd (double, double, double);
+typedef gsl_matrix *matrix_proto_m_ddn (double, double,
+ const struct matrix_expr *);
typedef gsl_matrix *matrix_proto_m_m (gsl_matrix *);
+typedef gsl_matrix *matrix_proto_m_mn (gsl_matrix *,
+ const struct matrix_expr *);
typedef double matrix_proto_m_e (double);
typedef gsl_matrix *matrix_proto_m_md (gsl_matrix *, double);
+typedef gsl_matrix *matrix_proto_m_mdn (gsl_matrix *, double,
+ const struct matrix_expr *);
typedef double matrix_proto_m_ed (double, double);
-typedef gsl_matrix *matrix_proto_m_mdd (gsl_matrix *, double, double);
+typedef gsl_matrix *matrix_proto_m_mddn (gsl_matrix *, double, double,
+ const struct matrix_expr *);
typedef double matrix_proto_m_edd (double, double, double);
typedef double matrix_proto_m_eddd (double, double, double, double);
typedef double matrix_proto_m_eed (double, double, double);
typedef gsl_matrix *matrix_proto_m_mm (gsl_matrix *, gsl_matrix *);
+typedef gsl_matrix *matrix_proto_m_mmn (gsl_matrix *, gsl_matrix *,
+ const struct matrix_expr *);
typedef gsl_matrix *matrix_proto_m_v (gsl_vector *);
typedef double matrix_proto_d_m (gsl_matrix *);
typedef gsl_matrix *matrix_proto_m_any (gsl_matrix *[], size_t n);
struct matrix_var *variable;
struct read_file *eof;
};
+
+ struct msg_location *location;
};
+static void
+matrix_expr_location__ (const struct matrix_expr *e,
+ const struct msg_location **minp,
+ const struct msg_location **maxp)
+{
+ struct msg_location *loc = e->location;
+ if (loc)
+ {
+ if (loc->p[0].line
+ && (!minp
+ || loc->p[0].line < (*minp)->p[0].line
+ || (loc->p[0].line == (*minp)->p[0].line
+ && loc->p[0].column < (*minp)->p[0].column)))
+ *minp = loc;
+
+ if (loc->p[1].line
+ && (!maxp
+ || loc->p[1].line > (*maxp)->p[1].line
+ || (loc->p[1].line == (*maxp)->p[1].line
+ && loc->p[1].column > (*maxp)->p[1].column)))
+ *maxp = loc;
+ return;
+ }
+
+ assert (e->op != MOP_NUMBER && e->op != MOP_VARIABLE && e->op != MOP_EOF);
+ for (size_t i = 0; i < e->n_subs; i++)
+ matrix_expr_location__ (e->subs[i], minp, maxp);
+}
+
+static struct msg_location *
+matrix_expr_location (const struct matrix_expr *e_)
+{
+ struct matrix_expr *e = CONST_CAST (struct matrix_expr *, e_);
+
+ if (!e->location)
+ {
+ const struct msg_location *min = NULL;
+ const struct msg_location *max = NULL;
+ matrix_expr_location__ (e, &min, &max);
+ if (min && max)
+ {
+ e->location = msg_location_dup (min);
+ e->location->p[1] = max->p[1];
+ }
+ }
+
+ return e->location;
+}
+
+static struct matrix_expr *
+matrix_expr_wrap_location (struct matrix_state *s, int start_ofs,
+ struct matrix_expr *e)
+{
+ if (e && !e->location)
+ e->location = lex_ofs_location (s->lexer, start_ofs,
+ lex_ofs (s->lexer) - 1);
+ return e;
+}
+
static void
matrix_expr_destroy (struct matrix_expr *e)
{
case MOP_EOF:
break;
}
+ msg_location_destroy (e->location);
free (e);
}
.subs = xmemdup (subs, n_subs * sizeof *subs),
.n_subs = n_subs
};
+
return e;
}
}
static struct matrix_expr *
-matrix_expr_create_number (double number)
+matrix_expr_create_number (struct lexer *lexer, double number)
{
struct matrix_expr *e = xmalloc (sizeof *e);
- *e = (struct matrix_expr) { .op = MOP_NUMBER, .number = number };
+ *e = (struct matrix_expr) {
+ .op = MOP_NUMBER,
+ .number = number,
+ };
+ lex_get (lexer);
return e;
}
-static struct matrix_expr *matrix_parse_or_xor (struct matrix_state *);
+static struct matrix_expr *matrix_parse_expr (struct matrix_state *);
static struct matrix_expr *
matrix_parse_curly_comma (struct matrix_state *s)
{
- struct matrix_expr *lhs = matrix_parse_or_xor (s);
+ struct matrix_expr *lhs = matrix_parse_expr (s);
if (!lhs)
return NULL;
while (lex_match (s->lexer, T_COMMA))
{
- struct matrix_expr *rhs = matrix_parse_or_xor (s);
+ struct matrix_expr *rhs = matrix_parse_expr (s);
if (!rhs)
{
matrix_expr_destroy (lhs);
}
static gsl_matrix *
-matrix_eval_CHOL (gsl_matrix *m)
+matrix_eval_CHOL (gsl_matrix *m, const struct matrix_expr *e)
{
if (!gsl_linalg_cholesky_decomp1 (m))
{
}
else
{
- msg (SE, _("Input to CHOL function is not positive-definite."));
+ msg_at (SE, e->subs[0]->location,
+ _("Input to CHOL function is not positive-definite."));
return NULL;
}
}
}
static gsl_matrix *
-matrix_eval_DESIGN (gsl_matrix *m)
+matrix_eval_DESIGN (gsl_matrix *m, const struct matrix_expr *e)
{
double *tmp = xmalloc (m->size1 * m->size2 * sizeof *tmp);
gsl_matrix m2 = gsl_matrix_view_array (tmp, m->size2, m->size1).matrix;
}
if (n[i] <= 1)
- msg (MW, _("Column %zu in DESIGN argument has constant value."), i + 1);
+ msg_at (MW, e->subs[0]->location,
+ _("Column %zu in DESIGN argument has constant value."), i + 1);
else
n_total += n[i];
}
}
static gsl_matrix *
-matrix_eval_EVAL (gsl_matrix *m)
+matrix_eval_EVAL (gsl_matrix *m, const struct matrix_expr *e)
{
if (!is_symmetric (m))
{
- msg (SE, _("Argument of EVAL must be symmetric."));
+ msg_at (SE, e->subs[0]->location,
+ _("Argument of EVAL must be symmetric."));
return NULL;
}
}
static gsl_matrix *
-matrix_eval_GSCH (gsl_matrix *v)
+matrix_eval_GSCH (gsl_matrix *v, const struct matrix_expr *e)
{
if (v->size2 < v->size1)
{
- msg (SE, _("GSCH requires its argument to have at least as many columns "
- "as rows, but it has dimensions %zu×%zu."),
- v->size1, v->size2);
+ msg_at (SE, e->subs[0]->location,
+ _("GSCH requires its argument to have at least as many columns "
+ "as rows, but it has dimensions %zu×%zu."),
+ v->size1, v->size2);
return NULL;
}
if (!v->size1 || !v->size2)
if (ux < v->size1)
{
- msg (SE, _("%zu×%zu argument to GSCH contains only "
- "%zu linearly independent columns."),
- v->size1, v->size2, ux);
+ msg_at (SE, e->subs[0]->location,
+ _("%zu×%zu argument to GSCH contains only "
+ "%zu linearly independent columns."),
+ v->size1, v->size2, ux);
gsl_matrix_free (u);
return NULL;
}
static gsl_matrix *
matrix_eval_IDENT (double s1, double s2)
{
- if (s1 < 0 || s1 > SIZE_MAX || s2 < 0 || s2 > SIZE_MAX)
- {
- msg (SE, _("Arguments to IDENT must be non-negative integers."));
- return NULL;
- }
-
gsl_matrix *m = gsl_matrix_alloc (s1, s2);
MATRIX_FOR_ALL_ELEMENTS (d, y, x, m)
*d = x == y;
static gsl_matrix *
matrix_eval_MAKE (double r, double c, double value)
{
- if (r < 0 || r >= SIZE_MAX || c < 0 || c >= SIZE_MAX)
- {
- msg (SE, _("Size arguments to MAKE must be integers."));
- return NULL;
- }
-
gsl_matrix *m = gsl_matrix_alloc (r, c);
MATRIX_FOR_ALL_ELEMENTS (d, y, x, m)
*d = value;
static gsl_matrix *
matrix_eval_MOD (gsl_matrix *m, double divisor)
{
- if (divisor == 0.0)
- {
- msg (SE, _("Divisor argument to MOD function must be nonzero."));
- return NULL;
- }
-
MATRIX_FOR_ALL_ELEMENTS (d, y, x, m)
*d = fmod (*d, divisor);
return m;
}
static gsl_matrix *
-matrix_eval_RESHAPE (gsl_matrix *m, double r_, double c_)
+matrix_eval_RESHAPE (gsl_matrix *m, double r_, double c_,
+ const struct matrix_expr *e)
{
- if (r_ < 0 || r_ >= SIZE_MAX || c_ < 0 || c_ >= SIZE_MAX)
+ bool r_ok = r_ >= 0 && r_ < SIZE_MAX;
+ bool c_ok = c_ >= 0 && c_ < SIZE_MAX;
+ if (!r_ok || !c_ok)
{
- msg (SE, _("Arguments 2 and 3 to RESHAPE must be integers."));
+ msg_at (SE,
+ !r_ok ? e->subs[1]->location : e->subs[2]->location,
+ _("Arguments 2 and 3 to RESHAPE must be integers."));
return NULL;
}
size_t r = r_;
size_t c = c_;
if (size_overflow_p (xtimes (r, xmax (c, 1))) || c * r != m->size1 * m->size2)
{
- msg (SE, _("Product of RESHAPE arguments 2 and 3 differ from "
- "product of matrix dimensions."));
+ struct msg_location *loc = msg_location_dup (e->subs[1]->location);
+ loc->p[1] = e->subs[2]->location->p[1];
+ msg_at (SE, loc, _("Product of RESHAPE size arguments (%zu×%zu = %zu) "
+ "differs from product of matrix dimensions "
+ "(%zu×%zu = %zu)."),
+ r, c, r * c,
+ m->size1, m->size2, m->size1 * m->size2);
+ msg_location_destroy (loc);
return NULL;
}
}
static gsl_matrix *
-matrix_eval_SOLVE (gsl_matrix *m1, gsl_matrix *m2)
+matrix_eval_SOLVE (gsl_matrix *m1, gsl_matrix *m2, const struct matrix_expr *e)
{
if (m1->size1 != m2->size1)
{
- msg (SE, _("SOLVE requires its arguments to have the same number of "
- "rows, but the first argument has dimensions %zu×%zu and "
- "the second %zu×%zu."),
- m1->size1, m1->size2,
- m2->size1, m2->size2);
+ struct msg_location *loc = msg_location_dup (e->subs[0]->location);
+ loc->p[1] = e->subs[1]->location->p[1];
+
+#if 0
+ msg_at (SE, loc,
+ _("SOLVE requires its arguments to have the same number of "
+ "rows, but the first argument has dimensions %zu×%zu and "
+ "the second %zu×%zu."),
+ m1->size1, m1->size2,
+ m2->size1, m2->size2);
+#else
+ msg_at (SE, e->location, _("SOLVE requires its arguments to have the same "
+ "number of rows."));
+ msg_at (SN, e->subs[0]->location, _("Argument 1 has dimensions %zu×%zu."),
+ m1->size1, m1->size2);
+ msg_at (SN, e->subs[1]->location, _("Argument 2 has dimensions %zu×%zu."),
+ m2->size1, m2->size2);
+#endif
+
+ msg_location_destroy (loc);
return NULL;
}
}
static gsl_matrix *
-matrix_eval_SWEEP (gsl_matrix *m, double d)
+matrix_eval_SWEEP (gsl_matrix *m, double d, const struct matrix_expr *e)
{
if (d < 1 || d > SIZE_MAX)
{
- msg (SE, _("Scalar argument to SWEEP must be integer."));
+ msg_at (SE, e->subs[1]->location,
+ _("Scalar argument to SWEEP must be integer."));
return NULL;
}
size_t k = d - 1;
if (k >= MIN (m->size1, m->size2))
{
- msg (SE, _("Scalar argument to SWEEP must be integer less than or "
- "equal to the smaller of the matrix argument's rows and "
- "columns."));
+ msg_at (SE, e->subs[1]->location,
+ _("Scalar argument to SWEEP must be integer less than or "
+ "equal to the smaller of the matrix argument's rows and "
+ "columns."));
return NULL;
}
}
static gsl_matrix *
-matrix_eval_UNIFORM (double r_, double c_)
+matrix_eval_UNIFORM (double r_, double c_, const struct matrix_expr *e)
{
size_t r = r_;
size_t c = c_;
if (size_overflow_p (xtimes (r, xmax (c, 1))))
{
- msg (SE, _("Product of arguments to UNIFORM exceeds memory size."));
+ struct msg_location *loc = msg_location_dup (e->subs[0]->location);
+ loc->p[1] = e->subs[1]->location->p[1];
+
+ msg_at (SE, loc,
+ _("Product of arguments to UNIFORM exceeds memory size."));
+
+ msg_location_destroy (loc);
return NULL;
}
if (lex_next_token (s->lexer, 1) != T_LPAREN)
return false;
+ int start_ofs = lex_ofs (s->lexer);
if (lex_match_id (s->lexer, "EOF"))
{
lex_get (s->lexer);
struct matrix_expr *e = xmalloc (sizeof *e);
*e = (struct matrix_expr) { .op = MOP_EOF, .eof = rf };
+ matrix_expr_wrap_location (s, start_ofs, e);
*exprp = e;
return true;
}
if (!f)
return false;
- lex_get_n (s->lexer, 2);
-
struct matrix_expr *e = xmalloc (sizeof *e);
- *e = (struct matrix_expr) { .op = f->op, .subs = NULL };
+ *e = (struct matrix_expr) { .op = f->op };
+ lex_get_n (s->lexer, 2);
if (lex_token (s->lexer) != T_RPAREN)
{
size_t allocated_subs = 0;
if (e->n_subs < f->min_args || e->n_subs > f->max_args)
{
if (f->min_args == f->max_args)
- msg (SE, ngettext ("Matrix function %s requires %zu argument.",
- "Matrix function %s requires %zu arguments.",
- f->min_args),
+ msg_at (SE, e->location,
+ ngettext ("Matrix function %s requires %zu argument.",
+ "Matrix function %s requires %zu arguments.",
+ f->min_args),
f->name, f->min_args);
else if (f->min_args == 1 && f->max_args == 2)
- msg (SE, ngettext ("Matrix function %s requires 1 or 2 arguments, "
- "but %zu was provided.",
- "Matrix function %s requires 1 or 2 arguments, "
- "but %zu were provided.",
- e->n_subs),
+ msg_at (SE, e->location,
+ ngettext ("Matrix function %s requires 1 or 2 arguments, "
+ "but %zu was provided.",
+ "Matrix function %s requires 1 or 2 arguments, "
+ "but %zu were provided.",
+ e->n_subs),
f->name, e->n_subs);
else if (f->min_args == 1 && f->max_args == INT_MAX)
- msg (SE, _("Matrix function %s requires at least one argument."),
- f->name);
+ msg_at (SE, e->location,
+ _("Matrix function %s requires at least one argument."),
+ f->name);
else
NOT_REACHED ();
goto error;
}
+ matrix_expr_wrap_location (s, start_ofs, e);
+
*exprp = e;
return true;
}
static struct matrix_expr *
-matrix_parse_primary (struct matrix_state *s)
+matrix_parse_primary__ (struct matrix_state *s)
{
if (lex_is_number (s->lexer))
- {
- double number = lex_number (s->lexer);
- lex_get (s->lexer);
- return matrix_expr_create_number (number);
- }
+ return matrix_expr_create_number (s->lexer, lex_number (s->lexer));
else if (lex_is_string (s->lexer))
{
char string[sizeof (double)];
buf_copy_str_rpad (string, sizeof string, lex_tokcstr (s->lexer), ' ');
- lex_get (s->lexer);
double number;
memcpy (&number, string, sizeof number);
- return matrix_expr_create_number (number);
+ return matrix_expr_create_number (s->lexer, number);
}
else if (lex_match (s->lexer, T_LPAREN))
{
- struct matrix_expr *e = matrix_parse_or_xor (s);
+ struct matrix_expr *e = matrix_parse_expr (s);
if (!e || !lex_force_match (s->lexer, T_RPAREN))
{
matrix_expr_destroy (e);
return NULL;
}
+static struct matrix_expr *
+matrix_parse_primary (struct matrix_state *s)
+{
+ int start_ofs = lex_ofs (s->lexer);
+ return matrix_expr_wrap_location (s, start_ofs, matrix_parse_primary__ (s));
+}
+
static struct matrix_expr *matrix_parse_postfix (struct matrix_state *);
static bool
static struct matrix_expr *
matrix_parse_unary (struct matrix_state *s)
{
+ int start_ofs = lex_ofs (s->lexer);
+
+ struct matrix_expr *e;
if (lex_match (s->lexer, T_DASH))
{
- struct matrix_expr *lhs = matrix_parse_unary (s);
- return lhs ? matrix_expr_create_1 (MOP_NEGATE, lhs) : NULL;
+ struct matrix_expr *sub = matrix_parse_unary (s);
+ if (!sub)
+ return NULL;
+ e = matrix_expr_create_1 (MOP_NEGATE, sub);
}
else if (lex_match (s->lexer, T_PLUS))
- return matrix_parse_unary (s);
+ {
+ e = matrix_parse_unary (s);
+ if (!e)
+ return NULL;
+ }
else
return matrix_parse_postfix (s);
+
+ matrix_expr_wrap_location (s, start_ofs, e);
+ e->location->p[0] = lex_ofs_start_point (s->lexer, start_ofs);
+ return e;
}
static struct matrix_expr *
static struct matrix_expr *
matrix_parse_not (struct matrix_state *s)
{
+ int start_ofs = lex_ofs (s->lexer);
if (lex_match (s->lexer, T_NOT))
{
- struct matrix_expr *lhs = matrix_parse_not (s);
- return lhs ? matrix_expr_create_1 (MOP_NOT, lhs) : NULL;
+ struct matrix_expr *sub = matrix_parse_not (s);
+ if (!sub)
+ return NULL;
+
+ matrix_expr_wrap_location (s, start_ofs, sub);
+ sub->location->p[0] = lex_ofs_start_point (s->lexer, start_ofs);
+ return sub;
}
else
return matrix_parse_relational (s);
}
static struct matrix_expr *
-matrix_parse_or_xor (struct matrix_state *s)
+matrix_parse_expr__ (struct matrix_state *s)
{
struct matrix_expr *lhs = matrix_parse_and (s);
if (!lhs)
else if (lex_match_id (s->lexer, "XOR"))
op = MOP_XOR;
else
- return lhs;
+ {
+ return lhs;
+ }
struct matrix_expr *rhs = matrix_parse_and (s);
if (!rhs)
static struct matrix_expr *
matrix_parse_expr (struct matrix_state *s)
{
- return matrix_parse_or_xor (s);
+ int start_ofs = lex_ofs (s->lexer);
+ return matrix_expr_wrap_location (s, start_ofs, matrix_parse_expr__ (s));;
}
\f
/* Expression evaluation. */
}
static gsl_matrix *
-matrix_expr_evaluate_elementwise (enum matrix_op op,
+matrix_expr_evaluate_elementwise (const struct matrix_expr *e,
+ enum matrix_op op,
gsl_matrix *a, gsl_matrix *b)
{
if (is_scalar (b))
}
else
{
- msg (SE, _("Operands to %s must have the same dimensions or one "
- "must be a scalar, not %zu×%zu and %zu×%zu matrices."),
+ msg_at (SE, e->location,
+ _("Operands to %s must have the same dimensions or one "
+ "must be a scalar, not %zu×%zu and %zu×%zu matrices."),
matrix_op_name (op), a->size1, a->size2, b->size1, b->size2);
return NULL;
}
}
static gsl_matrix *
-matrix_expr_evaluate_mul_mat (gsl_matrix *a, gsl_matrix *b)
+matrix_expr_evaluate_mul_mat (const struct matrix_expr *e,
+ gsl_matrix *a, gsl_matrix *b)
{
if (is_scalar (a) || is_scalar (b))
- return matrix_expr_evaluate_elementwise (MOP_MUL_ELEMS, a, b);
+ return matrix_expr_evaluate_elementwise (e, MOP_MUL_ELEMS, a, b);
if (a->size2 != b->size1)
{
- msg (SE, _("Matrices with dimensions %zu×%zu and %zu×%zu are "
- "not conformable for multiplication."),
- a->size1, a->size2, b->size1, b->size2);
+ msg_at (SE, e->location,
+ _("Matrices with dimensions %zu×%zu and %zu×%zu are "
+ "not conformable for multiplication."),
+ a->size1, a->size2, b->size1, b->size2);
return NULL;
}
}
static gsl_matrix *
-matrix_expr_evaluate_exp_mat (gsl_matrix *x_, gsl_matrix *b)
+matrix_expr_evaluate_exp_mat (const struct matrix_expr *e,
+ gsl_matrix *x_, gsl_matrix *b)
{
gsl_matrix *x = x_;
if (x->size1 != x->size2)
{
- msg (SE, _("Matrix exponentation with ** requires a square matrix on "
- "the left-hand size, not one with dimensions %zu×%zu."),
- x->size1, x->size2);
+ msg_at (SE, matrix_expr_location (e->subs[0]),
+ _("Matrix exponentation with ** requires a square matrix on "
+ "the left-hand size, not one with dimensions %zu×%zu."),
+ x->size1, x->size2);
return NULL;
}
if (!is_scalar (b))
{
- msg (SE, _("Matrix exponentiation with ** requires a scalar on the "
- "right-hand side, not a matrix with dimensions %zu×%zu."),
- b->size1, b->size2);
+ msg_at (SE, matrix_expr_location (e->subs[1]),
+ _("Matrix exponentiation with ** requires a scalar on the "
+ "right-hand side, not a matrix with dimensions %zu×%zu."),
+ b->size1, b->size2);
return NULL;
}
double bf = to_scalar (b);
if (bf != floor (bf) || bf <= LONG_MIN || bf > LONG_MAX)
{
- msg (SE, _("Exponent %.1f in matrix multiplication is non-integer "
- "or outside the valid range."), bf);
+ msg_at (SE, matrix_expr_location (e->subs[1]),
+ _("Exponent %.1f in matrix multiplication is non-integer "
+ "or outside the valid range."), bf);
return NULL;
}
long int bl = bf;
return y;
}
+static void
+note_nonscalar (gsl_matrix *m, const struct matrix_expr *e)
+{
+ if (!is_scalar (m))
+ msg_at (SN, matrix_expr_location (e),
+ _("This operand is a %zu×%zu matrix."), m->size1, m->size2);
+}
+
static gsl_matrix *
-matrix_expr_evaluate_seq (gsl_matrix *start_, gsl_matrix *end_,
+matrix_expr_evaluate_seq (const struct matrix_expr *e,
+ gsl_matrix *start_, gsl_matrix *end_,
gsl_matrix *by_)
{
if (!is_scalar (start_) || !is_scalar (end_) || (by_ && !is_scalar (by_)))
{
- msg (SE, _("All operands of : operator must be scalars."));
+ msg_at (SE, matrix_expr_location (e),
+ _("All operands of : operator must be scalars."));
+
+ note_nonscalar (start_, e->subs[0]);
+ note_nonscalar (end_, e->subs[1]);
+ if (by_)
+ note_nonscalar (by_, e->subs[2]);
return NULL;
}
return dm;
}
-#define F(ENUM, STRING, PROTO, CONSTRAINTS) \
- static gsl_matrix *matrix_expr_evaluate_##PROTO ( \
- const struct matrix_function_properties *, gsl_matrix *[], size_t, \
- matrix_proto_##PROTO *);
+#define F(ENUM, STRING, PROTO, CONSTRAINTS) \
+ static gsl_matrix *matrix_expr_evaluate_##PROTO ( \
+ const struct matrix_function_properties *, gsl_matrix *[], \
+ const struct matrix_expr *, matrix_proto_##PROTO *);
MATRIX_FUNCTIONS
#undef F
gsl_matrix_get (a, y, x));
}
+enum matrix_argument_relop
+ {
+ MRR_GT, /* > */
+ MRR_GE, /* >= */
+ MRR_LT, /* < */
+ MRR_LE, /* <= */
+ MRR_NE, /* <> */
+ };
+
static void
argument_inequality_error (const struct matrix_function_properties *props,
size_t a_index, gsl_matrix *a, size_t y, size_t x,
size_t b_index, double b,
- bool greater, bool equal)
+ enum matrix_argument_relop relop)
{
struct string s = DS_EMPTY_INITIALIZER;
argument_invalid (props, a_index, a, y, x, &s);
ds_put_cstr (&s, " ");
- if (greater && equal)
- ds_put_format (&s, _("This argument must be greater than or "
- "equal to argument %zu, but that has value %g."),
- b_index, b);
- else if (greater && !equal)
- ds_put_format (&s, _("This argument must be greater than argument %zu, "
- "but that has value %g."),
- b_index, b);
- else if (equal)
- ds_put_format (&s, _("This argument must be less than or "
- "equal to argument %zu, but that has value %g."),
- b_index, b);
- else
- ds_put_format (&s, _("This argument must be less than argument %zu, "
- "but that has value %g."),
- b_index, b);
+ switch (relop)
+ {
+ case MRR_GE:
+ ds_put_format (&s, _("This argument must be greater than or "
+ "equal to argument %zu, but that has value %g."),
+ b_index, b);
+ break;
+
+ case MRR_GT:
+ ds_put_format (&s, _("This argument must be greater than argument %zu, "
+ "but that has value %g."),
+ b_index, b);
+ break;
+
+ case MRR_LE:
+ ds_put_format (&s, _("This argument must be less than or "
+ "equal to argument %zu, but that has value %g."),
+ b_index, b);
+ break;
+
+ case MRR_LT:
+ ds_put_format (&s, _("This argument must be less than argument %zu, "
+ "but that has value %g."),
+ b_index, b);
+ break;
+
+ case MRR_NE:
+ ds_put_format (&s,
+ _("This argument must not be the same as argument %zu."),
+ b_index);
+ break;
+ }
+
msg (ME, ds_cstr (&s));
ds_destroy (&s);
}
argument_value_error (const struct matrix_function_properties *props,
size_t a_index, gsl_matrix *a, size_t y, size_t x,
double b,
- bool greater, bool equal)
+ enum matrix_argument_relop relop)
{
struct string s = DS_EMPTY_INITIALIZER;
argument_invalid (props, a_index, a, y, x, &s);
ds_put_cstr (&s, " ");
- if (greater && equal)
- ds_put_format (&s, _("This argument must be greater than or equal to %g."),
- b);
- else if (greater && !equal)
- ds_put_format (&s, _("This argument must be greater than %g."), b);
- else if (equal)
- ds_put_format (&s, _("This argument must be less than or equal to %g."), b);
- else
- ds_put_format (&s, _("This argument must be less than %g."), b);
+ switch (relop)
+ {
+ case MRR_GE:
+ ds_put_format (&s,
+ _("This argument must be greater than or equal to %g."),
+ b);
+ break;
+
+ case MRR_GT:
+ ds_put_format (&s, _("This argument must be greater than %g."), b);
+ break;
+
+ case MRR_LE:
+ ds_put_format (&s, _("This argument must be less than or equal to %g."),
+ b);
+ break;
+
+ case MRR_LT:
+ ds_put_format (&s, _("This argument must be less than %g."), b);
+ break;
+
+ case MRR_NE:
+ ds_put_format (&s, _("This argument may not be %g."), b);
+ break;
+ }
+
msg (ME, ds_cstr (&s));
ds_destroy (&s);
}
+static bool
+matrix_argument_relop_is_satisfied (double a, double b,
+ enum matrix_argument_relop relop)
+{
+ switch (relop)
+ {
+ case MRR_GE: return a >= b;
+ case MRR_GT: return a > b;
+ case MRR_LE: return a <= b;
+ case MRR_LT: return a < b;
+ case MRR_NE: return a != b;
+ }
+
+ NOT_REACHED ();
+}
+
+static enum matrix_argument_relop
+matrix_argument_relop_flip (enum matrix_argument_relop relop)
+{
+ switch (relop)
+ {
+ case MRR_GE: return MRR_LE;
+ case MRR_GT: return MRR_LT;
+ case MRR_LE: return MRR_GE;
+ case MRR_LT: return MRR_GT;
+ case MRR_NE: return MRR_NE;
+ }
+
+ NOT_REACHED ();
+}
+
static bool
check_constraints (const struct matrix_function_properties *props,
gsl_matrix *args[], size_t n_args)
return false;
}
}
- else if (*constraints == '>' || *constraints == '<')
+ else if (*constraints == '>'
+ || *constraints == '<'
+ || *constraints == '!')
{
- bool greater = *constraints++ == '>';
- bool equal;
- if (*constraints == '=')
+ enum matrix_argument_relop relop;
+ switch (*constraints++)
{
- equal = true;
+ case '>':
+ if (*constraints == '=')
+ {
+ constraints++;
+ relop = MRR_GE;
+ }
+ else
+ relop = MRR_GT;
+ break;
+
+ case '<':
+ if (*constraints == '=')
+ {
+ constraints++;
+ relop = MRR_LE;
+ }
+ else
+ relop = MRR_LT;
+ break;
+
+ case '!':
+ assert (*constraints == '=');
constraints++;
+ relop = MRR_NE;
}
- else
- equal = false;
if (*constraints >= 'a' && *constraints <= 'd')
{
size_t tmp_index = a_index;
a_index = b_index;
b_index = tmp_index;
-
- greater = !greater;
+ relop = matrix_argument_relop_flip (relop);
}
double b = to_scalar (args[b_index]);
MATRIX_FOR_ALL_ELEMENTS (a, y, x, args[a_index])
- if (greater
- ? (equal ? !(*a >= b) : !(*a > b))
- : (equal ? !(*a <= b) : !(*a < b)))
+ if (!matrix_argument_relop_is_satisfied (*a, b, relop))
{
argument_inequality_error (props,
a_index + 1, args[a_index], y, x,
b_index + 1, b,
- greater, equal);
+ relop);
return false;
}
}
int comparand = parse_constraint_value (&constraints);
MATRIX_FOR_ALL_ELEMENTS (d, y, x, args[arg_index])
- if (greater
- ? (equal ? !(*d >= comparand) : !(*d > comparand))
- : (equal ? !(*d <= comparand) : !(*d < comparand)))
+ if (!matrix_argument_relop_is_satisfied (*d, comparand, relop))
{
argument_value_error (props,
arg_index + 1, args[arg_index], y, x,
comparand,
- greater, equal);
+ relop);
return false;
}
}
static gsl_matrix *
matrix_expr_evaluate_d_none (
const struct matrix_function_properties *props UNUSED,
- gsl_matrix *subs[] UNUSED, size_t n_subs,
+ gsl_matrix *subs[] UNUSED, const struct matrix_expr *e,
matrix_proto_d_none *f)
{
- assert (n_subs == 0);
+ assert (e->n_subs == 0);
gsl_matrix *m = gsl_matrix_alloc (1, 1);
gsl_matrix_set (m, 0, 0, f ());
static gsl_matrix *
matrix_expr_evaluate_d_d (const struct matrix_function_properties *props,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_d_d *f)
{
- assert (n_subs == 1);
+ assert (e->n_subs == 1);
double d;
- if (!to_scalar_args (props->name, subs, n_subs, &d))
+ if (!to_scalar_args (props->name, subs, e->n_subs, &d))
return NULL;
- if (!check_constraints (props, subs, n_subs))
+ if (!check_constraints (props, subs, e->n_subs))
return NULL;
gsl_matrix *m = gsl_matrix_alloc (1, 1);
static gsl_matrix *
matrix_expr_evaluate_d_dd (const struct matrix_function_properties *props,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_d_dd *f)
{
- assert (n_subs == 2);
+ assert (e->n_subs == 2);
double d[2];
- if (!to_scalar_args (props->name, subs, n_subs, d))
+ if (!to_scalar_args (props->name, subs, e->n_subs, d))
return NULL;
- if (!check_constraints (props, subs, n_subs))
+ if (!check_constraints (props, subs, e->n_subs))
return NULL;
gsl_matrix *m = gsl_matrix_alloc (1, 1);
static gsl_matrix *
matrix_expr_evaluate_d_ddd (const struct matrix_function_properties *props,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_d_ddd *f)
{
- assert (n_subs == 3);
+ assert (e->n_subs == 3);
double d[3];
- if (!to_scalar_args (props->name, subs, n_subs, d))
+ if (!to_scalar_args (props->name, subs, e->n_subs, d))
return NULL;
- if (!check_constraints (props, subs, n_subs))
+ if (!check_constraints (props, subs, e->n_subs))
return NULL;
gsl_matrix *m = gsl_matrix_alloc (1, 1);
static gsl_matrix *
matrix_expr_evaluate_m_d (const struct matrix_function_properties *props,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_m_d *f)
{
- assert (n_subs == 1);
+ assert (e->n_subs == 1);
double d;
- return to_scalar_args (props->name, subs, n_subs, &d) ? f (d) : NULL;
+ return to_scalar_args (props->name, subs, e->n_subs, &d) ? f (d) : NULL;
}
static gsl_matrix *
-matrix_expr_evaluate_m_dd (const struct matrix_function_properties *props,
- gsl_matrix *subs[], size_t n_subs,
- matrix_proto_m_dd *f)
+matrix_expr_evaluate_m_ddd (const struct matrix_function_properties *props,
+ gsl_matrix *subs[], const struct matrix_expr *e,
+ matrix_proto_m_ddd *f)
{
- assert (n_subs == 2);
+ assert (e->n_subs == 3);
- double d[2];
- return to_scalar_args (props->name, subs, n_subs, d) ? f(d[0], d[1]) : NULL;
+ double d[3];
+ return to_scalar_args (props->name, subs, e->n_subs, d) ? f(d[0], d[1], d[2]) : NULL;
}
static gsl_matrix *
-matrix_expr_evaluate_m_ddd (const struct matrix_function_properties *props,
- gsl_matrix *subs[], size_t n_subs,
- matrix_proto_m_ddd *f)
+matrix_expr_evaluate_m_ddn (const struct matrix_function_properties *props,
+ gsl_matrix *subs[], const struct matrix_expr *e,
+ matrix_proto_m_ddn *f)
{
- assert (n_subs == 3);
+ assert (e->n_subs == 2);
- double d[3];
- return to_scalar_args (props->name, subs, n_subs, d) ? f(d[0], d[1], d[2]) : NULL;
+ double d[2];
+ return (to_scalar_args (props->name, subs, e->n_subs, d)
+ ? f(d[0], d[1], e)
+ : NULL);
}
static gsl_matrix *
matrix_expr_evaluate_m_m (const struct matrix_function_properties *props UNUSED,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_m_m *f)
{
- assert (n_subs == 1);
+ assert (e->n_subs == 1);
return f (subs[0]);
}
+static gsl_matrix *
+matrix_expr_evaluate_m_mn (const struct matrix_function_properties *props UNUSED,
+ gsl_matrix *subs[], const struct matrix_expr *e,
+ matrix_proto_m_mn *f)
+{
+ assert (e->n_subs == 1);
+ return f (subs[0], e);
+}
+
static gsl_matrix *
matrix_expr_evaluate_m_e (const struct matrix_function_properties *props,
- gsl_matrix *subs[], size_t n_subs,
- matrix_proto_m_e *f)
+ gsl_matrix *subs[], const struct matrix_expr *e,
+ matrix_proto_m_e *f)
{
- assert (n_subs == 1);
+ assert (e->n_subs == 1);
- if (!check_constraints (props, subs, n_subs))
+ if (!check_constraints (props, subs, e->n_subs))
return NULL;
MATRIX_FOR_ALL_ELEMENTS (a, y, x, subs[0])
static gsl_matrix *
matrix_expr_evaluate_m_md (const struct matrix_function_properties *props UNUSED,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_m_md *f)
{
- assert (n_subs == 2);
+ assert (e->n_subs == 2);
if (!check_scalar_arg (props->name, subs, 1))
return NULL;
return f (subs[0], to_scalar (subs[1]));
}
+static gsl_matrix *
+matrix_expr_evaluate_m_mdn (const struct matrix_function_properties *props UNUSED,
+ gsl_matrix *subs[], const struct matrix_expr *e,
+ matrix_proto_m_mdn *f)
+{
+ assert (e->n_subs == 2);
+ if (!check_scalar_arg (props->name, subs, 1))
+ return NULL;
+ return f (subs[0], to_scalar (subs[1]), e);
+}
+
static gsl_matrix *
matrix_expr_evaluate_m_ed (const struct matrix_function_properties *props,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_m_ed *f)
{
- assert (n_subs == 2);
+ assert (e->n_subs == 2);
if (!check_scalar_arg (props->name, subs, 1))
return NULL;
- if (!check_constraints (props, subs, n_subs))
+ if (!check_constraints (props, subs, e->n_subs))
return NULL;
double b = to_scalar (subs[1]);
}
static gsl_matrix *
-matrix_expr_evaluate_m_mdd (const struct matrix_function_properties *props UNUSED,
- gsl_matrix *subs[], size_t n_subs,
- matrix_proto_m_mdd *f)
+matrix_expr_evaluate_m_mddn (const struct matrix_function_properties *props UNUSED,
+ gsl_matrix *subs[], const struct matrix_expr *e,
+ matrix_proto_m_mddn *f)
{
- assert (n_subs == 3);
- if (!check_scalar_arg (props->name, subs, 1) || !check_scalar_arg (props->name, subs, 2))
+ assert (e->n_subs == 3);
+ if (!check_scalar_arg (props->name, subs, 1)
+ || !check_scalar_arg (props->name, subs, 2))
return NULL;
- return f (subs[0], to_scalar (subs[1]), to_scalar (subs[2]));
+ return f (subs[0], to_scalar (subs[1]), to_scalar (subs[2]), e);
}
static gsl_matrix *
matrix_expr_evaluate_m_edd (const struct matrix_function_properties *props,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_m_edd *f)
{
- assert (n_subs == 3);
+ assert (e->n_subs == 3);
if (!check_scalar_arg (props->name, subs, 1) || !check_scalar_arg (props->name, subs, 2))
return NULL;
- if (!check_constraints (props, subs, n_subs))
+ if (!check_constraints (props, subs, e->n_subs))
return NULL;
double b = to_scalar (subs[1]);
static gsl_matrix *
matrix_expr_evaluate_m_eddd (const struct matrix_function_properties *props,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_m_eddd *f)
{
- assert (n_subs == 4);
+ assert (e->n_subs == 4);
for (size_t i = 1; i < 4; i++)
if (!check_scalar_arg (props->name, subs, i))
return NULL;
- if (!check_constraints (props, subs, n_subs))
+ if (!check_constraints (props, subs, e->n_subs))
return NULL;
double b = to_scalar (subs[1]);
static gsl_matrix *
matrix_expr_evaluate_m_eed (const struct matrix_function_properties *props,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_m_eed *f)
{
- assert (n_subs == 3);
+ assert (e->n_subs == 3);
if (!check_scalar_arg (props->name, subs, 2))
return NULL;
if (!is_scalar (subs[0]) && !is_scalar (subs[1])
&& (subs[0]->size1 != subs[1]->size1 || subs[0]->size2 != subs[1]->size2))
{
- msg (ME, _("Arguments 1 and 2 to %s have dimensions %zu×%zu and "
- "%zu×%zu, but %s requires these arguments either to have "
- "the same dimensions or for one of them to be a scalar."),
- props->name,
- subs[0]->size1, subs[0]->size2,
- subs[1]->size1, subs[1]->size2,
- props->name);
+ struct msg_location *loc = msg_location_dup (e->subs[0]->location);
+ loc->p[1] = e->subs[1]->location->p[1];
+
+ msg_at (ME, loc,
+ _("Arguments 1 and 2 to %s have dimensions %zu×%zu and "
+ "%zu×%zu, but %s requires these arguments either to have "
+ "the same dimensions or for one of them to be a scalar."),
+ props->name,
+ subs[0]->size1, subs[0]->size2,
+ subs[1]->size1, subs[1]->size2,
+ props->name);
+
+ msg_location_destroy (loc);
return NULL;
}
- if (!check_constraints (props, subs, n_subs))
+ if (!check_constraints (props, subs, e->n_subs))
return NULL;
double c = to_scalar (subs[2]);
static gsl_matrix *
matrix_expr_evaluate_m_mm (const struct matrix_function_properties *props UNUSED,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_m_mm *f)
{
- assert (n_subs == 2);
+ assert (e->n_subs == 2);
return f (subs[0], subs[1]);
}
+static gsl_matrix *
+matrix_expr_evaluate_m_mmn (const struct matrix_function_properties *props UNUSED,
+ gsl_matrix *subs[], const struct matrix_expr *e,
+ matrix_proto_m_mmn *f)
+{
+ assert (e->n_subs == 2);
+ return f (subs[0], subs[1], e);
+}
+
static gsl_matrix *
matrix_expr_evaluate_m_v (const struct matrix_function_properties *props,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_m_v *f)
{
- assert (n_subs == 1);
+ assert (e->n_subs == 1);
if (!check_vector_arg (props->name, subs, 0))
return NULL;
gsl_vector v = to_vector (subs[0]);
static gsl_matrix *
matrix_expr_evaluate_d_m (const struct matrix_function_properties *props UNUSED,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_d_m *f)
{
- assert (n_subs == 1);
+ assert (e->n_subs == 1);
gsl_matrix *m = gsl_matrix_alloc (1, 1);
gsl_matrix_set (m, 0, 0, f (subs[0]));
static gsl_matrix *
matrix_expr_evaluate_m_any (const struct matrix_function_properties *props UNUSED,
- gsl_matrix *subs[], size_t n_subs,
- matrix_proto_m_any *f)
+ gsl_matrix *subs[], const struct matrix_expr *e,
+ matrix_proto_m_any *f)
{
- return f (subs, n_subs);
+ return f (subs, e->n_subs);
}
static gsl_matrix *
matrix_expr_evaluate_IDENT (const struct matrix_function_properties *props,
- gsl_matrix *subs[], size_t n_subs,
+ gsl_matrix *subs[], const struct matrix_expr *e,
matrix_proto_IDENT *f)
{
- assert (n_subs <= 2);
+ assert (e->n_subs <= 2);
double d[2];
- if (!to_scalar_args (props->name, subs, n_subs, d))
+ if (!to_scalar_args (props->name, subs, e->n_subs, d))
return NULL;
- return f (d[0], d[n_subs - 1]);
+ return f (d[0], d[e->n_subs - 1]);
}
static gsl_matrix *
const gsl_matrix *src = e->variable->value;
if (!src)
{
- msg (SE, _("Uninitialized variable %s used in expression."),
- e->variable->name);
+ msg_at (SE, e->location,
+ _("Uninitialized variable %s used in expression."),
+ e->variable->name);
return NULL;
}
.name = STRING, \
.constraints = CONSTRAINTS, \
}; \
- result = matrix_expr_evaluate_##PROTO (&props, subs, e->n_subs, \
+ result = matrix_expr_evaluate_##PROTO (&props, subs, e, \
matrix_eval_##ENUM); \
} \
break;
case MOP_AND:
case MOP_OR:
case MOP_XOR:
- result = matrix_expr_evaluate_elementwise (e->op, subs[0], subs[1]);
+ result = matrix_expr_evaluate_elementwise (e, e->op, subs[0], subs[1]);
break;
case MOP_NOT:
break;
case MOP_SEQ:
- result = matrix_expr_evaluate_seq (subs[0], subs[1], NULL);
+ result = matrix_expr_evaluate_seq (e, subs[0], subs[1], NULL);
break;
case MOP_SEQ_BY:
- result = matrix_expr_evaluate_seq (subs[0], subs[1], subs[2]);
+ result = matrix_expr_evaluate_seq (e, subs[0], subs[1], subs[2]);
break;
case MOP_MUL_MAT:
- result = matrix_expr_evaluate_mul_mat (subs[0], subs[1]);
+ result = matrix_expr_evaluate_mul_mat (e, subs[0], subs[1]);
break;
case MOP_EXP_MAT:
- result = matrix_expr_evaluate_exp_mat (subs[0], subs[1]);
+ result = matrix_expr_evaluate_exp_mat (e, subs[0], subs[1]);
break;
case MOP_PASTE_HORZ:
struct matrix_var *var;
struct matrix_expr *indexes[2];
size_t n_indexes;
+
+ struct msg_location *var_location; /* Variable name. */
+ struct msg_location *index_location; /* Variable name plus indexing. */
};
static void
{
if (lvalue)
{
+ msg_location_destroy (lvalue->var_location);
+ msg_location_destroy (lvalue->index_location);
for (size_t i = 0; i < lvalue->n_indexes; i++)
matrix_expr_destroy (lvalue->indexes[i]);
free (lvalue);
struct matrix_lvalue *lvalue = xzalloc (sizeof *lvalue);
if (!lex_force_id (s->lexer))
goto error;
+ int start_ofs = lex_ofs (s->lexer);
+ lvalue->var_location = lex_get_location (s->lexer, 0, 0);
lvalue->var = matrix_var_lookup (s, lex_tokss (s->lexer));
if (lex_next_token (s->lexer, 1) == T_LPAREN)
{
if (!lvalue->var)
{
msg (SE, _("Undefined variable %s."), lex_tokcstr (s->lexer));
- free (lvalue);
- return NULL;
+ goto error;
}
lex_get_n (s->lexer, 2);
}
if (!lex_force_match (s->lexer, T_RPAREN))
goto error;
+
+ lvalue->index_location = lex_ofs_location (s->lexer, start_ofs,
+ lex_ofs (s->lexer) - 1);
}
else
{
gsl_matrix *dm = lvalue->var->value;
if (!dm)
{
- msg (SE, _("Undefined variable %s."), lvalue->var->name);
+ msg_at (SE, lvalue->var_location,
+ _("Undefined variable %s."), lvalue->var->name);
return false;
}
else if (dm->size1 == 0 || dm->size2 == 0)
{
- msg (SE, _("Cannot index %zu×%zu matrix."),
- dm->size1, dm->size2);
+ msg_at (SE, lvalue->index_location,
+ _("Cannot index %zu×%zu matrix %s."),
+ dm->size1, dm->size2, lvalue->var->name);
return false;
}
else if (lvalue->n_indexes == 1)
{
if (!is_vector (dm))
{
- msg (SE, _("Can't use vector indexing on %zu×%zu matrix %s."),
- dm->size1, dm->size2, lvalue->var->name);
+ msg_at (SE, lvalue->index_location,
+ _("Can't use vector indexing on %zu×%zu matrix %s."),
+ dm->size1, dm->size2, lvalue->var->name);
return false;
}
return matrix_lvalue_evaluate_vector (lvalue->indexes[0],
struct msg_location *location = xmalloc (sizeof *location);
*location = (struct msg_location) {
.file_name = intern_new (dfm_get_file_name (reader)),
- .first_line = line_number,
- .last_line = line_number + 1,
- .first_column = first_column,
- .last_column = last_column,
+ .p[0] = { .line = line_number, .column = first_column },
+ .p[1] = { .line = line_number, .column = last_column },
};
struct msg *m = xmalloc (sizeof *m);
*m = (struct msg) {
if (error)
{
int c1 = utf8_count_columns (line_start, p.string - line_start) + 1;
- int c2 = c1 + ss_utf8_count_columns (p) - 1;
+ int c2 = c1 + ss_utf8_count_columns (p);
parse_error (reader, read->format, p, y, x, c1, c2, error);
}
else
projects / pspp / blobdiff