- struct pool *pool;
- struct matrix_data_pgm *mx;
- struct file_handle *fh = fh_inline_file ();
- bool ok;
-
- unsigned seen = 0;
-
- discard_variables (current_dataset);
-
- pool = pool_create ();
- mx = pool_alloc (pool, sizeof *mx);
- mx->container = pool;
- mx->reader = NULL;
- mx->fmt = LIST;
- mx->section = LOWER;
- mx->diag = DIAGONAL;
- mx->explicit_rowtype = 0;
- mx->rowtype_ = NULL;
- mx->varname_ = NULL;
- mx->single_split = NULL;
- mx->n_factors = 0;
- mx->factors = NULL;
- memset (mx->is_per_factor, 0, sizeof mx->is_per_factor);
- mx->cells = -1;
- mx->pop_n = -1;
- mx->n_contents = 0;
- mx->n_continuous = 0;
- mx->first_continuous = 0;
- while (token != '.')
- {
- lex_match ('/');
-
- if (lex_match_id ("VARIABLES"))
- {
- char **v;
- size_t nv;
-
- if (seen & 1)
- {
- msg (SE, _("VARIABLES subcommand multiply specified."));
- goto lossage;
- }
- seen |= 1;
-
- lex_match ('=');
- if (!parse_DATA_LIST_vars (&v, &nv, PV_NO_DUPLICATE))
- goto lossage;
-
- {
- size_t i;
-
- for (i = 0; i < nv; i++)
- if (!strcasecmp (v[i], "VARNAME_"))
- {
- msg (SE, _("VARNAME_ cannot be explicitly specified on "
- "VARIABLES."));
- for (i = 0; i < nv; i++)
- free (v[i]);
- free (v);
- goto lossage;
- }
- }
-
- {
- size_t i;
-
- for (i = 0; i < nv; i++)
- {
- struct variable *new_var;
-
- if (strcasecmp (v[i], "ROWTYPE_"))
- {
- new_var = dict_create_var_assert (dataset_dict (current_dataset), v[i], 0);
- attach_mxd_aux (new_var, MXD_CONTINUOUS, i);
- }
- else
- mx->explicit_rowtype = 1;
- free (v[i]);
- }
- free (v);
- }
-
- mx->rowtype_ = dict_create_var_assert (dataset_dict (current_dataset),
- "ROWTYPE_", 8);
- attach_mxd_aux (mx->rowtype_, MXD_ROWTYPE, 0);
- }
- else if (lex_match_id ("FILE"))
- {
- lex_match ('=');
- fh = fh_parse (FH_REF_FILE | FH_REF_INLINE);
- if (fh == NULL)
- goto lossage;
- }
- else if (lex_match_id ("FORMAT"))
- {
- lex_match ('=');
-
- while (token == T_ID)
- {
- if (lex_match_id ("LIST"))
- mx->fmt = LIST;
- else if (lex_match_id ("FREE"))
- mx->fmt = FREE;
- else if (lex_match_id ("LOWER"))
- mx->section = LOWER;
- else if (lex_match_id ("UPPER"))
- mx->section = UPPER;
- else if (lex_match_id ("FULL"))
- mx->section = FULL;
- else if (lex_match_id ("DIAGONAL"))
- mx->diag = DIAGONAL;
- else if (lex_match_id ("NODIAGONAL"))
- mx->diag = NODIAGONAL;
- else
- {
- lex_error (_("in FORMAT subcommand"));
- goto lossage;
- }
- }
- }
- else if (lex_match_id ("SPLIT"))
- {
- lex_match ('=');
-
- if (seen & 2)
- {
- msg (SE, _("SPLIT subcommand multiply specified."));
- goto lossage;
- }
- seen |= 2;
-
- if (token != T_ID)
- {
- lex_error (_("in SPLIT subcommand"));
- goto lossage;
- }
-
- if (dict_lookup_var (dataset_dict (current_dataset), tokid) == NULL
- && (lex_look_ahead () == '.' || lex_look_ahead () == '/'))
- {
- if (!strcasecmp (tokid, "ROWTYPE_")
- || !strcasecmp (tokid, "VARNAME_"))
- {
- msg (SE, _("Split variable may not be named ROWTYPE_ "
- "or VARNAME_."));
- goto lossage;
- }
-
- mx->single_split = dict_create_var_assert (dataset_dict (current_dataset),
- tokid, 0);
- attach_mxd_aux (mx->single_split, MXD_CONTINUOUS, 0);
- lex_get ();
-
- dict_set_split_vars (dataset_dict (current_dataset), &mx->single_split, 1);
- }
- else
- {
- struct variable **split;
- size_t n;
-
- if (!parse_variables (dataset_dict (current_dataset), &split, &n, PV_NO_DUPLICATE))
- goto lossage;
-
- dict_set_split_vars (dataset_dict (current_dataset), split, n);
- }
-
- {
- struct variable *const *split = dict_get_split_vars (dataset_dict (current_dataset));
- size_t split_cnt = dict_get_split_cnt (dataset_dict (current_dataset));
- int i;
-
- for (i = 0; i < split_cnt; i++)
- {
- struct mxd_var *mv = split[i]->aux;
- assert (mv != NULL);
- if (mv->var_type != MXD_CONTINUOUS)
- {
- msg (SE, _("Split variable %s is already another type."),
- tokid);
- goto lossage;
- }
- var_clear_aux (split[i]);
- attach_mxd_aux (split[i], MXD_SPLIT, i);
- }
- }
- }
- else if (lex_match_id ("FACTORS"))
- {
- lex_match ('=');
-
- if (seen & 4)
- {
- msg (SE, _("FACTORS subcommand multiply specified."));
- goto lossage;
- }
- seen |= 4;
-
- if (!parse_variables (dataset_dict (current_dataset), &mx->factors, &mx->n_factors,
- PV_NONE))
- goto lossage;
-
- {
- size_t i;
-
- for (i = 0; i < mx->n_factors; i++)
- {
- struct variable *v = mx->factors[i];
- struct mxd_var *mv = v->aux;
- assert (mv != NULL);
- if (mv->var_type != MXD_CONTINUOUS)
- {
- msg (SE, _("Factor variable %s is already another type."),
- tokid);
- goto lossage;
- }
- var_clear_aux (v);
- attach_mxd_aux (v, MXD_FACTOR, i);
- }
- }
- }
- else if (lex_match_id ("CELLS"))
- {
- lex_match ('=');
-
- if (mx->cells != -1)
- {
- msg (SE, _("CELLS subcommand multiply specified."));
- goto lossage;
- }
-
- if (!lex_is_integer () || lex_integer () < 1)
- {
- lex_error (_("expecting positive integer"));
- goto lossage;
- }
-
- mx->cells = lex_integer ();
- lex_get ();
- }
- else if (lex_match_id ("N"))
- {
- lex_match ('=');
-
- if (mx->pop_n != -1)
- {
- msg (SE, _("N subcommand multiply specified."));
- goto lossage;
- }
-
- if (!lex_is_integer () || lex_integer () < 1)
- {
- lex_error (_("expecting positive integer"));
- goto lossage;
- }
-
- mx->pop_n = lex_integer ();
- lex_get ();
- }
- else if (lex_match_id ("CONTENTS"))
- {
- int inside_parens = 0;
- unsigned collide = 0;
- int item;
-
- if (seen & 8)
- {
- msg (SE, _("CONTENTS subcommand multiply specified."));
- goto lossage;
- }
- seen |= 8;
-
- lex_match ('=');
-
- {
- int i;
-
- for (i = 0; i <= PROX; i++)
- mx->is_per_factor[i] = 0;
- }
-
- for (;;)
- {
- if (lex_match ('('))
- {
- if (inside_parens)
- {
- msg (SE, _("Nested parentheses not allowed."));
- goto lossage;
- }
- inside_parens = 1;
- item = LPAREN;
- }
- else if (lex_match (')'))
- {
- if (!inside_parens)
- {
- msg (SE, _("Mismatched right parenthesis (`(')."));
- goto lossage;
- }
- if (mx->contents[mx->n_contents - 1] == LPAREN)
- {
- msg (SE, _("Empty parentheses not allowed."));
- goto lossage;
- }
- inside_parens = 0;
- item = RPAREN;
- }
- else
- {
- int content_type;
- int collide_index;
-
- if (token != T_ID)
- {
- lex_error (_("in CONTENTS subcommand"));
- goto lossage;
- }
-
- content_type = string_to_content_type (tokid,
- &collide_index);
- if (content_type == -1)
- {
- lex_error (_("in CONTENTS subcommand"));
- goto lossage;
- }
- lex_get ();
-
- if (collide & (1 << collide_index))
- {
- msg (SE, _("Content multiply specified for %s."),
- content_names[content_type]);
- goto lossage;
- }
- collide |= (1 << collide_index);
-
- item = content_type;
- mx->is_per_factor[item] = inside_parens;
- }
- mx->contents[mx->n_contents++] = item;
-
- if (token == '/' || token == '.')
- break;
- }
-
- if (inside_parens)
- {
- msg (SE, _("Missing right parenthesis."));
- goto lossage;
- }
- mx->contents[mx->n_contents] = EOC;
- }
- else
- {
- lex_error (NULL);
- goto lossage;
- }
- }
-
- if (token != '.')
- {
- lex_error (_("expecting end of command"));
- goto lossage;
- }
-
- if (!(seen & 1))
- {
- msg (SE, _("Missing VARIABLES subcommand."));
- goto lossage;
- }
-
- if (!mx->n_contents && !mx->explicit_rowtype)
- {
- msg (SW, _("CONTENTS subcommand not specified: assuming file "
- "contains only CORR matrix."));
-
- mx->contents[0] = CORR;
- mx->contents[1] = EOC;
- mx->n_contents = 0;
- }