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
F(ARSIN, "ARSIN", m_e, "a[-1,1]") \
F(ARTAN, "ARTAN", m_e, NULL) \
F(BLOCK, "BLOCK", m_any, NULL) \
- F(CHOL, "CHOL", m_me, 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(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(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_me_MIN_ARGS = 1, m_me_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_me (gsl_matrix *, const struct matrix_expr *);
+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 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)
{
*e = (struct matrix_expr) {
.op = MOP_NUMBER,
.number = number,
- .location = lex_get_location (lexer, 0, 0),
};
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);
matrix_parse_curly_semi (struct matrix_state *s)
{
if (lex_token (s->lexer) == T_RCURLY)
- {
- struct matrix_expr *e = matrix_expr_create_0 (MOP_EMPTY);
- e->location = lex_get_location (s->lexer, -1, 0);
- return e;
- }
+ return matrix_expr_create_0 (MOP_EMPTY);
struct matrix_expr *lhs = matrix_parse_curly_comma (s);
if (!lhs)
}
else
{
- msg_at (SE, e->location,
+ 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_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;
}
return false;
struct matrix_expr *e = xmalloc (sizeof *e);
- *e = (struct matrix_expr) {
- .op = f->op,
- .location = lex_get_location (s->lexer, 0, 0)
- };
+ *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;
do
{
- struct msg_location *arg_location = lex_get_location (s->lexer, 0, 0);
struct matrix_expr *sub = matrix_parse_expr (s);
if (!sub)
- {
- msg_location_destroy (arg_location);
- goto error;
- }
- if (!sub->location)
- {
- //lex_extend_location (s->lexer, 0, arg_location);
- sub->location = arg_location;
- }
- else
- msg_location_destroy (arg_location);
+ goto error;
if (e->n_subs >= allocated_subs)
e->subs = x2nrealloc (e->subs, &allocated_subs, sizeof *e->subs);
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);
- return matrix_expr_create_number (s->lexer, number);
- }
+ return matrix_expr_create_number (s->lexer, lex_number (s->lexer));
else if (lex_is_string (s->lexer))
{
char string[sizeof (double)];
}
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 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[], const struct matrix_expr *e,
- matrix_proto_m_dd *f)
-{
- assert (e->n_subs == 2);
-
- double d[2];
- return to_scalar_args (props->name, subs, e->n_subs, d) ? f(d[0], d[1]) : NULL;
-}
-
static gsl_matrix *
matrix_expr_evaluate_m_ddd (const struct matrix_function_properties *props,
gsl_matrix *subs[], const struct matrix_expr *e,
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_ddn (const struct matrix_function_properties *props,
+ gsl_matrix *subs[], const struct matrix_expr *e,
+ matrix_proto_m_ddn *f)
+{
+ assert (e->n_subs == 2);
+
+ 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[], const struct matrix_expr *e,
}
static gsl_matrix *
-matrix_expr_evaluate_m_me (const struct matrix_function_properties *props UNUSED,
+matrix_expr_evaluate_m_mn (const struct matrix_function_properties *props UNUSED,
gsl_matrix *subs[], const struct matrix_expr *e,
- matrix_proto_m_me *f)
+ matrix_proto_m_mn *f)
{
assert (e->n_subs == 1);
return f (subs[0], e);
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[], const struct matrix_expr *e,
}
static gsl_matrix *
-matrix_expr_evaluate_m_mdd (const struct matrix_function_properties *props UNUSED,
- gsl_matrix *subs[], const struct matrix_expr *e,
- 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 (e->n_subs == 3);
- if (!check_scalar_arg (props->name, subs, 1) || !check_scalar_arg (props->name, subs, 2))
+ 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 *
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;
}
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[], const struct matrix_expr *e,
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;
}
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:
else if (dm->size1 == 0 || dm->size2 == 0)
{
msg_at (SE, lvalue->index_location,
- _("Cannot index %zu×%zu matrix."), dm->size1, dm->size2);
+ _("Cannot index %zu×%zu matrix %s."),
+ dm->size1, dm->size2, lvalue->var->name);
return false;
}
else if (lvalue->n_indexes == 1)
projects / pspp / blobdiff