size_t *ref_cnt; /* Number of lex_tokens that refer to macro_rep. */
};
+static struct msg_point lex_token_start_point (const struct lex_source *,
+ const struct lex_token *);
+static struct msg_point lex_token_end_point (const struct lex_source *,
+ const struct lex_token *);
+
+/* Source offset of the last byte in TOKEN. */
+static size_t
+lex_token_end (const struct lex_token *token)
+{
+ return token->token_pos + MAX (token->token_len, 1) - 1;
+}
+
static void
lex_token_destroy (struct lex_token *t)
{
struct lex_source
{
struct ll ll; /* In lexer's list of sources. */
+
+ /* Reference count:
+
+ - One for struct lexer.
+
+ - One for each struct msg_location that references this source. */
+ size_t n_refs;
+
struct lex_reader *reader;
struct lexer *lexer;
struct segmenter segmenter;
static struct lex_source *lex_source_create (struct lexer *,
struct lex_reader *);
-static void lex_source_destroy (struct lex_source *);
/* Lexer. */
struct lexer
struct lex_source *source, *next;
ll_for_each_safe (source, next, struct lex_source, ll, &lexer->sources)
- lex_source_destroy (source);
+ {
+ ll_remove (&source->ll);
+ lex_source_unref (source);
+ }
macro_set_destroy (lexer->macros);
free (lexer);
}
while (src->parse_ofs == src->n_parse)
if (!lex_source_get_parse (src))
{
- lex_source_destroy (src);
+ ll_remove (&src->ll);
+ lex_source_unref (src);
src = lex_source__ (lexer);
if (src == NULL)
return;
}
static const struct lex_token *
-lex_source_next__ (const struct lex_source *src_, int n)
+lex_source_ofs__ (const struct lex_source *src_, int ofs)
{
struct lex_source *src = CONST_CAST (struct lex_source *, src_);
- if (n < 0)
+ if (ofs < 0)
{
- if (-n <= src->parse_ofs)
- return src->parse[src->parse_ofs - (-n)];
- else
- {
- static const struct lex_token endcmd_token
- = { .token = { .type = T_ENDCMD } };
- return &endcmd_token;
- }
+ static const struct lex_token endcmd_token
+ = { .token = { .type = T_ENDCMD } };
+ return &endcmd_token;
}
- while (src->n_parse - src->parse_ofs <= n)
+ while (ofs >= src->n_parse)
{
if (src->n_parse > 0)
{
lex_source_get_parse (src);
}
- return src->parse[src->parse_ofs + n];
+ return src->parse[ofs];
+}
+
+static const struct lex_token *
+lex_source_next__ (const struct lex_source *src, int n)
+{
+ return lex_source_ofs__ (src, n + src->parse_ofs);
}
/* Returns the "struct token" of the token N after the current one in LEXER.
return lex_get_location (lexer, ofs0 - ofs, ofs1 - ofs);
}
+struct msg_point
+lex_ofs_start_point (const struct lexer *lexer, int ofs)
+{
+ const struct lex_source *src = lex_source__ (lexer);
+ return (src
+ ? lex_token_start_point (src, lex_source_ofs__ (src, ofs))
+ : (struct msg_point) { 0, 0 });
+}
+
+struct msg_point lex_ofs_end_point (const struct lexer *, int ofs);
+
/* Returns the text of the syntax in tokens N0 ahead of the current one,
through N1 ahead of the current one, inclusive. (For example, if N0 and N1
are both zero, this requests the syntax for the current token.) The caller
return n > 0;
}
+/* Returns the 1-based line number of the source text at the byte OFFSET in
+ SRC. */
static int
-count_newlines (char *s, size_t length)
+lex_source_ofs_to_line_number (const struct lex_source *src, size_t offset)
{
- int n_newlines = 0;
- char *newline;
-
- while ((newline = memchr (s, '\n', length)) != NULL)
+ size_t lo = 0;
+ size_t hi = src->n_lines;
+ for (;;)
{
- n_newlines++;
- length -= (newline + 1) - s;
- s = newline + 1;
+ size_t mid = (lo + hi) / 2;
+ if (mid + 1 >= src->n_lines)
+ return src->n_lines;
+ else if (offset >= src->lines[mid + 1])
+ lo = mid;
+ else if (offset < src->lines[mid])
+ hi = mid;
+ else
+ return mid + 1;
}
+}
- return n_newlines;
+/* Returns the 1-based column number of the source text at the byte OFFSET in
+ SRC. */
+static int
+lex_source_ofs_to_column_number (const struct lex_source *src, size_t offset)
+{
+ const char *newline = memrchr (src->buffer, '\n', offset);
+ size_t line_ofs = newline ? newline - src->buffer + 1 : 0;
+ return utf8_count_columns (&src->buffer[line_ofs], offset - line_ofs) + 1;
+}
+
+static struct msg_point
+lex_source_ofs_to_point__ (const struct lex_source *src, size_t offset)
+{
+ return (struct msg_point) {
+ .line = lex_source_ofs_to_line_number (src, offset),
+ .column = lex_source_ofs_to_column_number (src, offset),
+ };
}
static int
-lex_token_get_last_line_number (const struct lex_source *src,
- const struct lex_token *token)
+lex_token_get_first_line_number (const struct lex_source *src,
+ const struct lex_token *token)
{
- size_t end = token->token_pos + token->token_len
- return lex_source_ofs_to_line_number (src,
- if (token->first_line == 0)
- return 0;
- else
- {
- char *token_str = &src->buffer[token->token_pos];
- return token->first_line + count_newlines (token_str, token->token_len) + 1;
- }
+ return lex_source_ofs_to_line_number (src, token->token_pos);
}
static int
-lex_token_get_column__ (const struct lex_source *src, size_t offset)
+lex_token_get_last_line_number (const struct lex_source *src,
+ const struct lex_token *token)
{
- const char *newline = memrchr (src->buffer, '\n', offset);
- size_t line_ofs = newline ? newline - src->buffer + 1 : 0;
- return utf8_count_columns (&src->buffer[line_ofs], offset - line_ofs) + 1;
+ return lex_source_ofs_to_line_number (src, lex_token_end (token)) + 1;
}
static int
lex_token_get_first_column (const struct lex_source *src,
const struct lex_token *token)
{
- return lex_token_get_column__ (src, token->token_pos);
+ return lex_source_ofs_to_column_number (src, token->token_pos);
+}
+
+static struct msg_point
+lex_token_start_point (const struct lex_source *src,
+ const struct lex_token *token)
+{
+ return lex_source_ofs_to_point__ (src, token->token_pos);
+}
+
+static struct msg_point
+lex_token_end_point (const struct lex_source *src,
+ const struct lex_token *token)
+{
+ return lex_source_ofs_to_point__ (src, lex_token_end (token));
}
static int
lex_token_get_last_column (const struct lex_source *src,
const struct lex_token *token)
{
- return lex_token_get_column__ (src, token->token_pos + token->token_len);
+ return lex_source_ofs_to_column_number (
+ src, token->token_pos + token->token_len);
}
static struct msg_location
const struct lex_token *t0,
const struct lex_token *t1)
{
- int first_column = lex_token_get_first_column (src, t0);
- int last_line = lex_token_get_last_line_number (src, t1) - 1;
- int last_column = lex_token_get_last_column (src, t1) - 1;
return (struct msg_location) {
.file_name = intern_new_if_nonnull (src->reader->file_name),
- .p[0] = { .line = t0->first_line, .column = first_column },
- .p[1] = { .line = last_line, .column = last_column },
+ .p[0] = lex_token_start_point (src, t0),
+ .p[1] = lex_token_end_point (src, t1),
};
}
lex_get_first_line_number (const struct lexer *lexer, int n)
{
const struct lex_source *src = lex_source__ (lexer);
- return src ? lex_source_next__ (src, n)->first_line : 0;
+ return src ? lex_token_get_first_line_number (src,
+ lex_source_next__ (src, n)) : 0;
}
/* Returns the 1-based line number of the end of the syntax that represents the
struct msg_location *loc = lex_get_lines (lexer, n0, n1);
loc->p[0].column = lex_get_first_column (lexer, n0);
loc->p[1].column = lex_get_last_column (lexer, n1) - 1;
+ loc->src = lex_source__ (lexer);
+ lex_source_ref (loc->src);
return loc;
}
{
src->length = 0;
src->journal_pos = src->seg_pos = 0;
- src->n_newlines = 0;
+ src->n_lines = 0;
src->suppress_next_newline = false;
src->segmenter = segmenter_init (segmenter_get_mode (&src->segmenter),
false);
for (; src != NULL && src->reader->error != LEX_ERROR_TERMINAL;
src = lex_source__ (lexer))
- lex_source_destroy (src);
+ {
+ ll_remove (&src->ll);
+ lex_source_unref (src);
+ }
}
}
\f
token->macro_rep = NULL;
token->ref_cnt = NULL;
token->token_pos = src->seg_pos;
- if (src->reader->line_number > 0)
- token->first_line = src->reader->line_number + src->n_newlines;
- else
- token->first_line = 0;
/* Extract a segment. */
const char *segment;
token->token_len = seg_len;
src->seg_pos += seg_len;
if (seg_type == SEG_NEWLINE)
- src->n_newlines++;
+ {
+ if (src->n_lines >= src->allocated_lines)
+ src->lines = x2nrealloc (src->lines, &src->allocated_lines,
+ sizeof *src->lines);
+ src->lines[src->n_lines++] = src->seg_pos;
+ }
/* Get a token from the segment. */
enum tokenize_result result = token_from_segment (
}
const struct lex_token *t = lex_stage_nth (&src->pp, ofs);
- size_t start = t->token_pos;
- size_t end = t->token_pos + t->token_len;
const struct macro_token mt = {
.token = t->token,
- .syntax = ss_buffer (&src->buffer[start], end - start),
+ .syntax = ss_buffer (&src->buffer[t->token_pos], t->token_len),
};
const struct msg_location loc = lex_token_location (src, t, t);
n_call = macro_call_add (mc, &mt, &loc);
.token = expansion.mts[i].token,
.token_pos = c0->token_pos,
.token_len = (c1->token_pos + c1->token_len) - c0->token_pos,
- .first_line = c0->first_line,
.macro_rep = macro_rep,
.ofs = ofs[i],
.len = len[i],
.token = out,
.token_pos = first->token_pos,
.token_len = (last->token_pos - first->token_pos) + last->token_len,
- .first_line = first->first_line,
/* This works well if all the tokens were not expanded from macros,
or if they came from the same macro expansion. It just gives up
static struct lex_source *
lex_source_create (struct lexer *lexer, struct lex_reader *reader)
{
+ size_t allocated_lines = 4;
+ size_t *lines = xmalloc (allocated_lines * sizeof *lines);
+ *lines = 0;
+
struct lex_source *src = xmalloc (sizeof *src);
*src = (struct lex_source) {
+ .n_refs = 1,
.reader = reader,
.segmenter = segmenter_init (reader->syntax, false),
.lexer = lexer,
+ .lines = lines,
+ .n_lines = 1,
+ .allocated_lines = allocated_lines,
};
lex_source_push_endcmd__ (src);
return src;
}
-static void
-lex_source_destroy (struct lex_source *src)
+void
+lex_source_ref (const struct lex_source *src_)
+{
+ struct lex_source *src = CONST_CAST (struct lex_source *, src_);
+ if (src)
+ {
+ assert (src->n_refs > 0);
+ src->n_refs++;
+ }
+}
+
+void
+lex_source_unref (struct lex_source *src)
{
+ if (!src)
+ return;
+
+ assert (src->n_refs > 0);
+ if (--src->n_refs > 0)
+ return;
+
char *file_name = src->reader->file_name;
char *encoding = src->reader->encoding;
if (src->reader->class->destroy != NULL)
free (file_name);
free (encoding);
free (src->buffer);
+ free (src->lines);
lex_stage_uninit (&src->pp);
lex_stage_uninit (&src->merge);
lex_source_clear_parse (src);
free (src->parse);
- ll_remove (&src->ll);
free (src);
}
\f
lex_string_read,
lex_string_close
};
+\f
+struct substring
+lex_source_get_line (const struct lex_source *src, int line)
+{
+ if (line < 1 || line > src->n_lines)
+ return ss_empty ();
+
+ size_t ofs = src->lines[line - 1];
+ size_t end = line >= src->n_lines ? src->length : src->lines[line];
+ return ss_buffer (&src->buffer[ofs], end - ofs);
+}
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 / commitdiff