MEMBER *read_value
( MPL *mpl,
PARAMETER *par, /* not changed */
TUPLE *tuple /* destroyed */
)
{ MEMBER *memb;
insist(par != NULL);
insist(is_symbol(mpl));
/* there must be no member with the same n-tuple */
if (find_member(mpl, par->array, tuple) != NULL)
error(mpl, "%s%s already defined",
par->name, format_tuple(mpl, '[', tuple));
/* create new parameter member with given n-tuple */
memb = add_member(mpl, par->array, tuple);
/* read value and assigns it to the new parameter member */
switch (par->type)
{ case A_NUMERIC:
case A_INTEGER:
case A_BINARY:
if (!is_number(mpl))
error(mpl, "%s requires numeric data", par->name);
memb->value.num = read_number(mpl);
break;
case A_SYMBOLIC:
memb->value.sym = read_symbol(mpl);
break;
default:
insist(par != par);
}
return memb;
}
char *mpl_get_row_name(MPL *mpl, int i)
{ char *name = mpl->mpl_buf, *t;
int len;
if (mpl->phase != 3)
fault("mpl_get_row_name: invalid call sequence");
if (!(1 <= i && i <= mpl->m))
fault("mpl_get_row_name: i = %d; row number out of range", i);
strcpy(name, mpl->row[i]->con->name);
len = strlen(name);
insist(len <= 255);
t = format_tuple(mpl, '[', mpl->row[i]->memb->tuple);
while (*t)
{ if (len == 255) break;
name[len++] = *t++;
}
name[len] = '\0';
if (len == 255) strcpy(name+252, "...");
insist(strlen(name) <= 255);
return name;
}
char *mpl_get_col_name(MPL *mpl, int j)
{ char *name = mpl->mpl_buf, *t;
int len;
if (mpl->phase != 3)
xfault("mpl_get_col_name: invalid call sequence\n");
if (!(1 <= j && j <= mpl->n))
xfault("mpl_get_col_name: j = %d; column number out of range\n"
, j);
strcpy(name, mpl->col[j]->var->name);
len = strlen(name);
xassert(len <= 255);
t = format_tuple(mpl, '[', mpl->col[j]->memb->tuple);
while (*t)
{ if (len == 255) break;
name[len++] = *t++;
}
name[len] = '\0';
if (len == 255) strcpy(name+252, "...");
xassert(strlen(name) <= 255);
return name;
}
void set_data(MPL *mpl)
{ SET *set;
TUPLE *tuple;
MEMBER *memb;
SLICE *slice;
int tr = 0;
insist(is_literal(mpl, "set"));
get_token(mpl /* set */);
/* symbolic name of set must follows the keyword 'set' */
if (!is_symbol(mpl))
error(mpl, "set name missing where expected");
/* select the set to saturate it with data */
set = select_set(mpl, mpl->image);
get_token(mpl /* <symbolic name> */);
/* read optional subscript list, which identifies member of the
set to be read */
tuple = create_tuple(mpl);
if (mpl->token == T_LBRACKET)
{ /* subscript list is specified */
if (set->dim == 0)
error(mpl, "%s cannot be subscripted", set->name);
get_token(mpl /* [ */);
/* read symbols and construct subscript list */
for (;;)
{ if (!is_symbol(mpl))
error(mpl, "number or symbol missing where expected");
tuple = expand_tuple(mpl, tuple, read_symbol(mpl));
if (mpl->token == T_COMMA)
get_token(mpl /* , */);
else if (mpl->token == T_RBRACKET)
break;
else
error(mpl, "syntax error in subscript list");
}
if (set->dim != tuple_dimen(mpl, tuple))
error(mpl, "%s must have %d subscript%s rather than %d",
set->name, set->dim, set->dim == 1 ? "" : "s",
tuple_dimen(mpl, tuple));
get_token(mpl /* ] */);
}
else
{ /* subscript list is not specified */
if (set->dim != 0)
error(mpl, "%s must be subscripted", set->name);
}
/* there must be no member with the same subscript list */
if (find_member(mpl, set->array, tuple) != NULL)
error(mpl, "%s%s already defined",
set->name, format_tuple(mpl, '[', tuple));
/* add new member to the set and assign it empty elemental set */
memb = add_member(mpl, set->array, tuple);
memb->value.set = create_elemset(mpl, set->dimen);
/* create an initial fake slice of all asterisks */
slice = fake_slice(mpl, set->dimen);
/* read zero or more data assignments */
for (;;)
{ /* skip optional comma */
if (mpl->token == T_COMMA) get_token(mpl /* , */);
/* process assignment element */
if (mpl->token == T_ASSIGN)
{ /* assignment ligature is non-significant element */
get_token(mpl /* := */);
}
else if (mpl->token == T_LEFT)
{ /* left parenthesis begins either new slice or "transpose"
indicator */
int is_tr;
get_token(mpl /* ( */);
is_tr = is_literal(mpl, "tr");
unget_token(mpl /* ( */);
if (is_tr) goto left;
/* delete the current slice and read new one */
delete_slice(mpl, slice);
slice = read_slice(mpl, set->name, set->dimen);
/* each new slice resets the "transpose" indicator */
tr = 0;
/* if the new slice is 0-ary, formally there is one 0-tuple
(in the simple format) that follows it */
if (slice_arity(mpl, slice) == 0)
simple_format(mpl, set, memb, slice);
}
else if (is_symbol(mpl))
{ /* number or symbol begins data in the simple format */
simple_format(mpl, set, memb, slice);
}
else if (mpl->token == T_COLON)
{ /* colon begins data in the matrix format */
if (slice_arity(mpl, slice) != 2)
err1: error(mpl, "slice currently used must specify 2 asterisk"
"s, not %d", slice_arity(mpl, slice));
get_token(mpl /* : */);
/* read elemental set data in the matrix format */
matrix_format(mpl, set, memb, slice, tr);
}
else if (mpl->token == T_LEFT)
left: { /* left parenthesis begins the "transpose" indicator, which
is followed by data in the matrix format */
get_token(mpl /* ( */);
if (!is_literal(mpl, "tr"))
err2: error(mpl, "transpose indicator (tr) incomplete");
if (slice_arity(mpl, slice) != 2) goto err1;
get_token(mpl /* tr */);
if (mpl->token != T_RIGHT) goto err2;
get_token(mpl /* ) */);
/* in this case the colon is optional */
if (mpl->token == T_COLON) get_token(mpl /* : */);
/* set the "transpose" indicator */
tr = 1;
/* read elemental set data in the matrix format */
matrix_format(mpl, set, memb, slice, tr);
}
else if (mpl->token == T_SEMICOLON)
{ /* semicolon terminates the data block */
get_token(mpl /* ; */);
break;
}
else
error(mpl, "syntax error in set data block");
}
/* delete the current slice */
delete_slice(mpl, slice);
return;
}