1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/src/glpmpl02.c Mon Dec 06 13:09:21 2010 +0100
1.3 @@ -0,0 +1,1205 @@
1.4 +/* glpmpl02.c */
1.5 +
1.6 +/***********************************************************************
1.7 +* This code is part of GLPK (GNU Linear Programming Kit).
1.8 +*
1.9 +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
1.10 +* 2009, 2010 Andrew Makhorin, Department for Applied Informatics,
1.11 +* Moscow Aviation Institute, Moscow, Russia. All rights reserved.
1.12 +* E-mail: <mao@gnu.org>.
1.13 +*
1.14 +* GLPK is free software: you can redistribute it and/or modify it
1.15 +* under the terms of the GNU General Public License as published by
1.16 +* the Free Software Foundation, either version 3 of the License, or
1.17 +* (at your option) any later version.
1.18 +*
1.19 +* GLPK is distributed in the hope that it will be useful, but WITHOUT
1.20 +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
1.21 +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
1.22 +* License for more details.
1.23 +*
1.24 +* You should have received a copy of the GNU General Public License
1.25 +* along with GLPK. If not, see <http://www.gnu.org/licenses/>.
1.26 +***********************************************************************/
1.27 +
1.28 +#define _GLPSTD_STDIO
1.29 +#include "glpenv.h"
1.30 +#include "glpmpl.h"
1.31 +
1.32 +/**********************************************************************/
1.33 +/* * * PROCESSING DATA SECTION * * */
1.34 +/**********************************************************************/
1.35 +
1.36 +/*----------------------------------------------------------------------
1.37 +-- create_slice - create slice.
1.38 +--
1.39 +-- This routine creates a slice, which initially has no components. */
1.40 +
1.41 +SLICE *create_slice(MPL *mpl)
1.42 +{ SLICE *slice;
1.43 + xassert(mpl == mpl);
1.44 + slice = NULL;
1.45 + return slice;
1.46 +}
1.47 +
1.48 +/*----------------------------------------------------------------------
1.49 +-- expand_slice - append new component to slice.
1.50 +--
1.51 +-- This routine expands slice appending to it either a given symbol or
1.52 +-- null component, which becomes the last component of the slice. */
1.53 +
1.54 +SLICE *expand_slice
1.55 +( MPL *mpl,
1.56 + SLICE *slice, /* destroyed */
1.57 + SYMBOL *sym /* destroyed */
1.58 +)
1.59 +{ SLICE *tail, *temp;
1.60 + /* create a new component */
1.61 + tail = dmp_get_atom(mpl->tuples, sizeof(SLICE));
1.62 + tail->sym = sym;
1.63 + tail->next = NULL;
1.64 + /* and append it to the component list */
1.65 + if (slice == NULL)
1.66 + slice = tail;
1.67 + else
1.68 + { for (temp = slice; temp->next != NULL; temp = temp->next);
1.69 + temp->next = tail;
1.70 + }
1.71 + return slice;
1.72 +}
1.73 +
1.74 +/*----------------------------------------------------------------------
1.75 +-- slice_dimen - determine dimension of slice.
1.76 +--
1.77 +-- This routine returns dimension of slice, which is number of all its
1.78 +-- components including null ones. */
1.79 +
1.80 +int slice_dimen
1.81 +( MPL *mpl,
1.82 + SLICE *slice /* not changed */
1.83 +)
1.84 +{ SLICE *temp;
1.85 + int dim;
1.86 + xassert(mpl == mpl);
1.87 + dim = 0;
1.88 + for (temp = slice; temp != NULL; temp = temp->next) dim++;
1.89 + return dim;
1.90 +}
1.91 +
1.92 +/*----------------------------------------------------------------------
1.93 +-- slice_arity - determine arity of slice.
1.94 +--
1.95 +-- This routine returns arity of slice, i.e. number of null components
1.96 +-- (indicated by asterisks) in the slice. */
1.97 +
1.98 +int slice_arity
1.99 +( MPL *mpl,
1.100 + SLICE *slice /* not changed */
1.101 +)
1.102 +{ SLICE *temp;
1.103 + int arity;
1.104 + xassert(mpl == mpl);
1.105 + arity = 0;
1.106 + for (temp = slice; temp != NULL; temp = temp->next)
1.107 + if (temp->sym == NULL) arity++;
1.108 + return arity;
1.109 +}
1.110 +
1.111 +/*----------------------------------------------------------------------
1.112 +-- fake_slice - create fake slice of all asterisks.
1.113 +--
1.114 +-- This routine creates a fake slice of given dimension, which contains
1.115 +-- asterisks in all components. Zero dimension is allowed. */
1.116 +
1.117 +SLICE *fake_slice(MPL *mpl, int dim)
1.118 +{ SLICE *slice;
1.119 + slice = create_slice(mpl);
1.120 + while (dim-- > 0) slice = expand_slice(mpl, slice, NULL);
1.121 + return slice;
1.122 +}
1.123 +
1.124 +/*----------------------------------------------------------------------
1.125 +-- delete_slice - delete slice.
1.126 +--
1.127 +-- This routine deletes specified slice. */
1.128 +
1.129 +void delete_slice
1.130 +( MPL *mpl,
1.131 + SLICE *slice /* destroyed */
1.132 +)
1.133 +{ SLICE *temp;
1.134 + while (slice != NULL)
1.135 + { temp = slice;
1.136 + slice = temp->next;
1.137 + if (temp->sym != NULL) delete_symbol(mpl, temp->sym);
1.138 +xassert(sizeof(SLICE) == sizeof(TUPLE));
1.139 + dmp_free_atom(mpl->tuples, temp, sizeof(TUPLE));
1.140 + }
1.141 + return;
1.142 +}
1.143 +
1.144 +/*----------------------------------------------------------------------
1.145 +-- is_number - check if current token is number.
1.146 +--
1.147 +-- If the current token is a number, this routine returns non-zero.
1.148 +-- Otherwise zero is returned. */
1.149 +
1.150 +int is_number(MPL *mpl)
1.151 +{ return
1.152 + mpl->token == T_NUMBER;
1.153 +}
1.154 +
1.155 +/*----------------------------------------------------------------------
1.156 +-- is_symbol - check if current token is symbol.
1.157 +--
1.158 +-- If the current token is suitable to be a symbol, the routine returns
1.159 +-- non-zero. Otherwise zero is returned. */
1.160 +
1.161 +int is_symbol(MPL *mpl)
1.162 +{ return
1.163 + mpl->token == T_NUMBER ||
1.164 + mpl->token == T_SYMBOL ||
1.165 + mpl->token == T_STRING;
1.166 +}
1.167 +
1.168 +/*----------------------------------------------------------------------
1.169 +-- is_literal - check if current token is given symbolic literal.
1.170 +--
1.171 +-- If the current token is given symbolic literal, this routine returns
1.172 +-- non-zero. Otherwise zero is returned.
1.173 +--
1.174 +-- This routine is used on processing the data section in the same way
1.175 +-- as the routine is_keyword on processing the model section. */
1.176 +
1.177 +int is_literal(MPL *mpl, char *literal)
1.178 +{ return
1.179 + is_symbol(mpl) && strcmp(mpl->image, literal) == 0;
1.180 +}
1.181 +
1.182 +/*----------------------------------------------------------------------
1.183 +-- read_number - read number.
1.184 +--
1.185 +-- This routine reads the current token, which must be a number, and
1.186 +-- returns its numeric value. */
1.187 +
1.188 +double read_number(MPL *mpl)
1.189 +{ double num;
1.190 + xassert(is_number(mpl));
1.191 + num = mpl->value;
1.192 + get_token(mpl /* <number> */);
1.193 + return num;
1.194 +}
1.195 +
1.196 +/*----------------------------------------------------------------------
1.197 +-- read_symbol - read symbol.
1.198 +--
1.199 +-- This routine reads the current token, which must be a symbol, and
1.200 +-- returns its symbolic value. */
1.201 +
1.202 +SYMBOL *read_symbol(MPL *mpl)
1.203 +{ SYMBOL *sym;
1.204 + xassert(is_symbol(mpl));
1.205 + if (is_number(mpl))
1.206 + sym = create_symbol_num(mpl, mpl->value);
1.207 + else
1.208 + sym = create_symbol_str(mpl, create_string(mpl, mpl->image));
1.209 + get_token(mpl /* <symbol> */);
1.210 + return sym;
1.211 +}
1.212 +
1.213 +/*----------------------------------------------------------------------
1.214 +-- read_slice - read slice.
1.215 +--
1.216 +-- This routine reads slice using the syntax:
1.217 +--
1.218 +-- <slice> ::= [ <symbol list> ]
1.219 +-- <slice> ::= ( <symbol list> )
1.220 +-- <symbol list> ::= <symbol or star>
1.221 +-- <symbol list> ::= <symbol list> , <symbol or star>
1.222 +-- <symbol or star> ::= <symbol>
1.223 +-- <symbol or star> ::= *
1.224 +--
1.225 +-- The bracketed form of slice is used for members of multi-dimensional
1.226 +-- objects while the parenthesized form is used for elemental sets. */
1.227 +
1.228 +SLICE *read_slice
1.229 +( MPL *mpl,
1.230 + char *name, /* not changed */
1.231 + int dim
1.232 +)
1.233 +{ SLICE *slice;
1.234 + int close;
1.235 + xassert(name != NULL);
1.236 + switch (mpl->token)
1.237 + { case T_LBRACKET:
1.238 + close = T_RBRACKET;
1.239 + break;
1.240 + case T_LEFT:
1.241 + xassert(dim > 0);
1.242 + close = T_RIGHT;
1.243 + break;
1.244 + default:
1.245 + xassert(mpl != mpl);
1.246 + }
1.247 + if (dim == 0)
1.248 + error(mpl, "%s cannot be subscripted", name);
1.249 + get_token(mpl /* ( | [ */);
1.250 + /* read slice components */
1.251 + slice = create_slice(mpl);
1.252 + for (;;)
1.253 + { /* the current token must be a symbol or asterisk */
1.254 + if (is_symbol(mpl))
1.255 + slice = expand_slice(mpl, slice, read_symbol(mpl));
1.256 + else if (mpl->token == T_ASTERISK)
1.257 + { slice = expand_slice(mpl, slice, NULL);
1.258 + get_token(mpl /* * */);
1.259 + }
1.260 + else
1.261 + error(mpl, "number, symbol, or asterisk missing where expec"
1.262 + "ted");
1.263 + /* check a token that follows the symbol */
1.264 + if (mpl->token == T_COMMA)
1.265 + get_token(mpl /* , */);
1.266 + else if (mpl->token == close)
1.267 + break;
1.268 + else
1.269 + error(mpl, "syntax error in slice");
1.270 + }
1.271 + /* number of slice components must be the same as the appropriate
1.272 + dimension */
1.273 + if (slice_dimen(mpl, slice) != dim)
1.274 + { switch (close)
1.275 + { case T_RBRACKET:
1.276 + error(mpl, "%s must have %d subscript%s, not %d", name,
1.277 + dim, dim == 1 ? "" : "s", slice_dimen(mpl, slice));
1.278 + break;
1.279 + case T_RIGHT:
1.280 + error(mpl, "%s has dimension %d, not %d", name, dim,
1.281 + slice_dimen(mpl, slice));
1.282 + break;
1.283 + default:
1.284 + xassert(close != close);
1.285 + }
1.286 + }
1.287 + get_token(mpl /* ) | ] */);
1.288 + return slice;
1.289 +}
1.290 +
1.291 +/*----------------------------------------------------------------------
1.292 +-- select_set - select set to saturate it with elemental sets.
1.293 +--
1.294 +-- This routine selects set to saturate it with elemental sets provided
1.295 +-- in the data section. */
1.296 +
1.297 +SET *select_set
1.298 +( MPL *mpl,
1.299 + char *name /* not changed */
1.300 +)
1.301 +{ SET *set;
1.302 + AVLNODE *node;
1.303 + xassert(name != NULL);
1.304 + node = avl_find_node(mpl->tree, name);
1.305 + if (node == NULL || avl_get_node_type(node) != A_SET)
1.306 + error(mpl, "%s not a set", name);
1.307 + set = (SET *)avl_get_node_link(node);
1.308 + if (set->assign != NULL || set->gadget != NULL)
1.309 + error(mpl, "%s needs no data", name);
1.310 + set->data = 1;
1.311 + return set;
1.312 +}
1.313 +
1.314 +/*----------------------------------------------------------------------
1.315 +-- simple_format - read set data block in simple format.
1.316 +--
1.317 +-- This routine reads set data block using the syntax:
1.318 +--
1.319 +-- <simple format> ::= <symbol> , <symbol> , ... , <symbol>
1.320 +--
1.321 +-- where <symbols> are used to construct a complete n-tuple, which is
1.322 +-- included in elemental set assigned to the set member. Commae between
1.323 +-- symbols are optional and may be omitted anywhere.
1.324 +--
1.325 +-- Number of components in the slice must be the same as dimension of
1.326 +-- n-tuples in elemental sets assigned to the set members. To construct
1.327 +-- complete n-tuple the routine replaces null positions in the slice by
1.328 +-- corresponding <symbols>.
1.329 +--
1.330 +-- If the slice contains at least one null position, the current token
1.331 +-- must be symbol. Otherwise, the routine reads no symbols to construct
1.332 +-- the n-tuple, so the current token is not checked. */
1.333 +
1.334 +void simple_format
1.335 +( MPL *mpl,
1.336 + SET *set, /* not changed */
1.337 + MEMBER *memb, /* modified */
1.338 + SLICE *slice /* not changed */
1.339 +)
1.340 +{ TUPLE *tuple;
1.341 + SLICE *temp;
1.342 + SYMBOL *sym, *with = NULL;
1.343 + xassert(set != NULL);
1.344 + xassert(memb != NULL);
1.345 + xassert(slice != NULL);
1.346 + xassert(set->dimen == slice_dimen(mpl, slice));
1.347 + xassert(memb->value.set->dim == set->dimen);
1.348 + if (slice_arity(mpl, slice) > 0) xassert(is_symbol(mpl));
1.349 + /* read symbols and construct complete n-tuple */
1.350 + tuple = create_tuple(mpl);
1.351 + for (temp = slice; temp != NULL; temp = temp->next)
1.352 + { if (temp->sym == NULL)
1.353 + { /* substitution is needed; read symbol */
1.354 + if (!is_symbol(mpl))
1.355 + { int lack = slice_arity(mpl, temp);
1.356 + /* with cannot be null due to assertion above */
1.357 + xassert(with != NULL);
1.358 + if (lack == 1)
1.359 + error(mpl, "one item missing in data group beginning "
1.360 + "with %s", format_symbol(mpl, with));
1.361 + else
1.362 + error(mpl, "%d items missing in data group beginning "
1.363 + "with %s", lack, format_symbol(mpl, with));
1.364 + }
1.365 + sym = read_symbol(mpl);
1.366 + if (with == NULL) with = sym;
1.367 + }
1.368 + else
1.369 + { /* copy symbol from the slice */
1.370 + sym = copy_symbol(mpl, temp->sym);
1.371 + }
1.372 + /* append the symbol to the n-tuple */
1.373 + tuple = expand_tuple(mpl, tuple, sym);
1.374 + /* skip optional comma *between* <symbols> */
1.375 + if (temp->next != NULL && mpl->token == T_COMMA)
1.376 + get_token(mpl /* , */);
1.377 + }
1.378 + /* add constructed n-tuple to elemental set */
1.379 + check_then_add(mpl, memb->value.set, tuple);
1.380 + return;
1.381 +}
1.382 +
1.383 +/*----------------------------------------------------------------------
1.384 +-- matrix_format - read set data block in matrix format.
1.385 +--
1.386 +-- This routine reads set data block using the syntax:
1.387 +--
1.388 +-- <matrix format> ::= <column> <column> ... <column> :=
1.389 +-- <row> +/- +/- ... +/-
1.390 +-- <row> +/- +/- ... +/-
1.391 +-- . . . . . . . . . . .
1.392 +-- <row> +/- +/- ... +/-
1.393 +--
1.394 +-- where <rows> are symbols that denote rows of the matrix, <columns>
1.395 +-- are symbols that denote columns of the matrix, "+" and "-" indicate
1.396 +-- whether corresponding n-tuple needs to be included in the elemental
1.397 +-- set or not, respectively.
1.398 +--
1.399 +-- Number of the slice components must be the same as dimension of the
1.400 +-- elemental set. The slice must have two null positions. To construct
1.401 +-- complete n-tuple for particular element of the matrix the routine
1.402 +-- replaces first null position of the slice by the corresponding <row>
1.403 +-- (or <column>, if the flag tr is on) and second null position by the
1.404 +-- corresponding <column> (or by <row>, if the flag tr is on). */
1.405 +
1.406 +void matrix_format
1.407 +( MPL *mpl,
1.408 + SET *set, /* not changed */
1.409 + MEMBER *memb, /* modified */
1.410 + SLICE *slice, /* not changed */
1.411 + int tr
1.412 +)
1.413 +{ SLICE *list, *col, *temp;
1.414 + TUPLE *tuple;
1.415 + SYMBOL *row;
1.416 + xassert(set != NULL);
1.417 + xassert(memb != NULL);
1.418 + xassert(slice != NULL);
1.419 + xassert(set->dimen == slice_dimen(mpl, slice));
1.420 + xassert(memb->value.set->dim == set->dimen);
1.421 + xassert(slice_arity(mpl, slice) == 2);
1.422 + /* read the matrix heading that contains column symbols (there
1.423 + may be no columns at all) */
1.424 + list = create_slice(mpl);
1.425 + while (mpl->token != T_ASSIGN)
1.426 + { /* read column symbol and append it to the column list */
1.427 + if (!is_symbol(mpl))
1.428 + error(mpl, "number, symbol, or := missing where expected");
1.429 + list = expand_slice(mpl, list, read_symbol(mpl));
1.430 + }
1.431 + get_token(mpl /* := */);
1.432 + /* read zero or more rows that contain matrix data */
1.433 + while (is_symbol(mpl))
1.434 + { /* read row symbol (if the matrix has no columns, row symbols
1.435 + are just ignored) */
1.436 + row = read_symbol(mpl);
1.437 + /* read the matrix row accordingly to the column list */
1.438 + for (col = list; col != NULL; col = col->next)
1.439 + { int which = 0;
1.440 + /* check indicator */
1.441 + if (is_literal(mpl, "+"))
1.442 + ;
1.443 + else if (is_literal(mpl, "-"))
1.444 + { get_token(mpl /* - */);
1.445 + continue;
1.446 + }
1.447 + else
1.448 + { int lack = slice_dimen(mpl, col);
1.449 + if (lack == 1)
1.450 + error(mpl, "one item missing in data group beginning "
1.451 + "with %s", format_symbol(mpl, row));
1.452 + else
1.453 + error(mpl, "%d items missing in data group beginning "
1.454 + "with %s", lack, format_symbol(mpl, row));
1.455 + }
1.456 + /* construct complete n-tuple */
1.457 + tuple = create_tuple(mpl);
1.458 + for (temp = slice; temp != NULL; temp = temp->next)
1.459 + { if (temp->sym == NULL)
1.460 + { /* substitution is needed */
1.461 + switch (++which)
1.462 + { case 1:
1.463 + /* substitute in the first null position */
1.464 + tuple = expand_tuple(mpl, tuple,
1.465 + copy_symbol(mpl, tr ? col->sym : row));
1.466 + break;
1.467 + case 2:
1.468 + /* substitute in the second null position */
1.469 + tuple = expand_tuple(mpl, tuple,
1.470 + copy_symbol(mpl, tr ? row : col->sym));
1.471 + break;
1.472 + default:
1.473 + xassert(which != which);
1.474 + }
1.475 + }
1.476 + else
1.477 + { /* copy symbol from the slice */
1.478 + tuple = expand_tuple(mpl, tuple, copy_symbol(mpl,
1.479 + temp->sym));
1.480 + }
1.481 + }
1.482 + xassert(which == 2);
1.483 + /* add constructed n-tuple to elemental set */
1.484 + check_then_add(mpl, memb->value.set, tuple);
1.485 + get_token(mpl /* + */);
1.486 + }
1.487 + /* delete the row symbol */
1.488 + delete_symbol(mpl, row);
1.489 + }
1.490 + /* delete the column list */
1.491 + delete_slice(mpl, list);
1.492 + return;
1.493 +}
1.494 +
1.495 +/*----------------------------------------------------------------------
1.496 +-- set_data - read set data.
1.497 +--
1.498 +-- This routine reads set data using the syntax:
1.499 +--
1.500 +-- <set data> ::= set <set name> <assignments> ;
1.501 +-- <set data> ::= set <set name> [ <symbol list> ] <assignments> ;
1.502 +-- <set name> ::= <symbolic name>
1.503 +-- <assignments> ::= <empty>
1.504 +-- <assignments> ::= <assignments> , :=
1.505 +-- <assignments> ::= <assignments> , ( <symbol list> )
1.506 +-- <assignments> ::= <assignments> , <simple format>
1.507 +-- <assignments> ::= <assignments> , : <matrix format>
1.508 +-- <assignments> ::= <assignments> , (tr) <matrix format>
1.509 +-- <assignments> ::= <assignments> , (tr) : <matrix format>
1.510 +--
1.511 +-- Commae in <assignments> are optional and may be omitted anywhere. */
1.512 +
1.513 +void set_data(MPL *mpl)
1.514 +{ SET *set;
1.515 + TUPLE *tuple;
1.516 + MEMBER *memb;
1.517 + SLICE *slice;
1.518 + int tr = 0;
1.519 + xassert(is_literal(mpl, "set"));
1.520 + get_token(mpl /* set */);
1.521 + /* symbolic name of set must follows the keyword 'set' */
1.522 + if (!is_symbol(mpl))
1.523 + error(mpl, "set name missing where expected");
1.524 + /* select the set to saturate it with data */
1.525 + set = select_set(mpl, mpl->image);
1.526 + get_token(mpl /* <symbolic name> */);
1.527 + /* read optional subscript list, which identifies member of the
1.528 + set to be read */
1.529 + tuple = create_tuple(mpl);
1.530 + if (mpl->token == T_LBRACKET)
1.531 + { /* subscript list is specified */
1.532 + if (set->dim == 0)
1.533 + error(mpl, "%s cannot be subscripted", set->name);
1.534 + get_token(mpl /* [ */);
1.535 + /* read symbols and construct subscript list */
1.536 + for (;;)
1.537 + { if (!is_symbol(mpl))
1.538 + error(mpl, "number or symbol missing where expected");
1.539 + tuple = expand_tuple(mpl, tuple, read_symbol(mpl));
1.540 + if (mpl->token == T_COMMA)
1.541 + get_token(mpl /* , */);
1.542 + else if (mpl->token == T_RBRACKET)
1.543 + break;
1.544 + else
1.545 + error(mpl, "syntax error in subscript list");
1.546 + }
1.547 + if (set->dim != tuple_dimen(mpl, tuple))
1.548 + error(mpl, "%s must have %d subscript%s rather than %d",
1.549 + set->name, set->dim, set->dim == 1 ? "" : "s",
1.550 + tuple_dimen(mpl, tuple));
1.551 + get_token(mpl /* ] */);
1.552 + }
1.553 + else
1.554 + { /* subscript list is not specified */
1.555 + if (set->dim != 0)
1.556 + error(mpl, "%s must be subscripted", set->name);
1.557 + }
1.558 + /* there must be no member with the same subscript list */
1.559 + if (find_member(mpl, set->array, tuple) != NULL)
1.560 + error(mpl, "%s%s already defined",
1.561 + set->name, format_tuple(mpl, '[', tuple));
1.562 + /* add new member to the set and assign it empty elemental set */
1.563 + memb = add_member(mpl, set->array, tuple);
1.564 + memb->value.set = create_elemset(mpl, set->dimen);
1.565 + /* create an initial fake slice of all asterisks */
1.566 + slice = fake_slice(mpl, set->dimen);
1.567 + /* read zero or more data assignments */
1.568 + for (;;)
1.569 + { /* skip optional comma */
1.570 + if (mpl->token == T_COMMA) get_token(mpl /* , */);
1.571 + /* process assignment element */
1.572 + if (mpl->token == T_ASSIGN)
1.573 + { /* assignment ligature is non-significant element */
1.574 + get_token(mpl /* := */);
1.575 + }
1.576 + else if (mpl->token == T_LEFT)
1.577 + { /* left parenthesis begins either new slice or "transpose"
1.578 + indicator */
1.579 + int is_tr;
1.580 + get_token(mpl /* ( */);
1.581 + is_tr = is_literal(mpl, "tr");
1.582 + unget_token(mpl /* ( */);
1.583 + if (is_tr) goto left;
1.584 + /* delete the current slice and read new one */
1.585 + delete_slice(mpl, slice);
1.586 + slice = read_slice(mpl, set->name, set->dimen);
1.587 + /* each new slice resets the "transpose" indicator */
1.588 + tr = 0;
1.589 + /* if the new slice is 0-ary, formally there is one 0-tuple
1.590 + (in the simple format) that follows it */
1.591 + if (slice_arity(mpl, slice) == 0)
1.592 + simple_format(mpl, set, memb, slice);
1.593 + }
1.594 + else if (is_symbol(mpl))
1.595 + { /* number or symbol begins data in the simple format */
1.596 + simple_format(mpl, set, memb, slice);
1.597 + }
1.598 + else if (mpl->token == T_COLON)
1.599 + { /* colon begins data in the matrix format */
1.600 + if (slice_arity(mpl, slice) != 2)
1.601 +err1: error(mpl, "slice currently used must specify 2 asterisk"
1.602 + "s, not %d", slice_arity(mpl, slice));
1.603 + get_token(mpl /* : */);
1.604 + /* read elemental set data in the matrix format */
1.605 + matrix_format(mpl, set, memb, slice, tr);
1.606 + }
1.607 + else if (mpl->token == T_LEFT)
1.608 +left: { /* left parenthesis begins the "transpose" indicator, which
1.609 + is followed by data in the matrix format */
1.610 + get_token(mpl /* ( */);
1.611 + if (!is_literal(mpl, "tr"))
1.612 +err2: error(mpl, "transpose indicator (tr) incomplete");
1.613 + if (slice_arity(mpl, slice) != 2) goto err1;
1.614 + get_token(mpl /* tr */);
1.615 + if (mpl->token != T_RIGHT) goto err2;
1.616 + get_token(mpl /* ) */);
1.617 + /* in this case the colon is optional */
1.618 + if (mpl->token == T_COLON) get_token(mpl /* : */);
1.619 + /* set the "transpose" indicator */
1.620 + tr = 1;
1.621 + /* read elemental set data in the matrix format */
1.622 + matrix_format(mpl, set, memb, slice, tr);
1.623 + }
1.624 + else if (mpl->token == T_SEMICOLON)
1.625 + { /* semicolon terminates the data block */
1.626 + get_token(mpl /* ; */);
1.627 + break;
1.628 + }
1.629 + else
1.630 + error(mpl, "syntax error in set data block");
1.631 + }
1.632 + /* delete the current slice */
1.633 + delete_slice(mpl, slice);
1.634 + return;
1.635 +}
1.636 +
1.637 +/*----------------------------------------------------------------------
1.638 +-- select_parameter - select parameter to saturate it with data.
1.639 +--
1.640 +-- This routine selects parameter to saturate it with data provided in
1.641 +-- the data section. */
1.642 +
1.643 +PARAMETER *select_parameter
1.644 +( MPL *mpl,
1.645 + char *name /* not changed */
1.646 +)
1.647 +{ PARAMETER *par;
1.648 + AVLNODE *node;
1.649 + xassert(name != NULL);
1.650 + node = avl_find_node(mpl->tree, name);
1.651 + if (node == NULL || avl_get_node_type(node) != A_PARAMETER)
1.652 + error(mpl, "%s not a parameter", name);
1.653 + par = (PARAMETER *)avl_get_node_link(node);
1.654 + if (par->assign != NULL)
1.655 + error(mpl, "%s needs no data", name);
1.656 + if (par->data)
1.657 + error(mpl, "%s already provided with data", name);
1.658 + par->data = 1;
1.659 + return par;
1.660 +}
1.661 +
1.662 +/*----------------------------------------------------------------------
1.663 +-- set_default - set default parameter value.
1.664 +--
1.665 +-- This routine sets default value for specified parameter. */
1.666 +
1.667 +void set_default
1.668 +( MPL *mpl,
1.669 + PARAMETER *par, /* not changed */
1.670 + SYMBOL *altval /* destroyed */
1.671 +)
1.672 +{ xassert(par != NULL);
1.673 + xassert(altval != NULL);
1.674 + if (par->option != NULL)
1.675 + error(mpl, "default value for %s already specified in model se"
1.676 + "ction", par->name);
1.677 + xassert(par->defval == NULL);
1.678 + par->defval = altval;
1.679 + return;
1.680 +}
1.681 +
1.682 +/*----------------------------------------------------------------------
1.683 +-- read_value - read value and assign it to parameter member.
1.684 +--
1.685 +-- This routine reads numeric or symbolic value from the input stream
1.686 +-- and assigns to new parameter member specified by its n-tuple, which
1.687 +-- (the member) is created and added to the parameter array. */
1.688 +
1.689 +MEMBER *read_value
1.690 +( MPL *mpl,
1.691 + PARAMETER *par, /* not changed */
1.692 + TUPLE *tuple /* destroyed */
1.693 +)
1.694 +{ MEMBER *memb;
1.695 + xassert(par != NULL);
1.696 + xassert(is_symbol(mpl));
1.697 + /* there must be no member with the same n-tuple */
1.698 + if (find_member(mpl, par->array, tuple) != NULL)
1.699 + error(mpl, "%s%s already defined",
1.700 + par->name, format_tuple(mpl, '[', tuple));
1.701 + /* create new parameter member with given n-tuple */
1.702 + memb = add_member(mpl, par->array, tuple);
1.703 + /* read value and assigns it to the new parameter member */
1.704 + switch (par->type)
1.705 + { case A_NUMERIC:
1.706 + case A_INTEGER:
1.707 + case A_BINARY:
1.708 + if (!is_number(mpl))
1.709 + error(mpl, "%s requires numeric data", par->name);
1.710 + memb->value.num = read_number(mpl);
1.711 + break;
1.712 + case A_SYMBOLIC:
1.713 + memb->value.sym = read_symbol(mpl);
1.714 + break;
1.715 + default:
1.716 + xassert(par != par);
1.717 + }
1.718 + return memb;
1.719 +}
1.720 +
1.721 +/*----------------------------------------------------------------------
1.722 +-- plain_format - read parameter data block in plain format.
1.723 +--
1.724 +-- This routine reads parameter data block using the syntax:
1.725 +--
1.726 +-- <plain format> ::= <symbol> , <symbol> , ... , <symbol> , <value>
1.727 +--
1.728 +-- where <symbols> are used to determine a complete subscript list for
1.729 +-- parameter member, <value> is a numeric or symbolic value assigned to
1.730 +-- the parameter member. Commae between data items are optional and may
1.731 +-- be omitted anywhere.
1.732 +--
1.733 +-- Number of components in the slice must be the same as dimension of
1.734 +-- the parameter. To construct the complete subscript list the routine
1.735 +-- replaces null positions in the slice by corresponding <symbols>. */
1.736 +
1.737 +void plain_format
1.738 +( MPL *mpl,
1.739 + PARAMETER *par, /* not changed */
1.740 + SLICE *slice /* not changed */
1.741 +)
1.742 +{ TUPLE *tuple;
1.743 + SLICE *temp;
1.744 + SYMBOL *sym, *with = NULL;
1.745 + xassert(par != NULL);
1.746 + xassert(par->dim == slice_dimen(mpl, slice));
1.747 + xassert(is_symbol(mpl));
1.748 + /* read symbols and construct complete subscript list */
1.749 + tuple = create_tuple(mpl);
1.750 + for (temp = slice; temp != NULL; temp = temp->next)
1.751 + { if (temp->sym == NULL)
1.752 + { /* substitution is needed; read symbol */
1.753 + if (!is_symbol(mpl))
1.754 + { int lack = slice_arity(mpl, temp) + 1;
1.755 + xassert(with != NULL);
1.756 + xassert(lack > 1);
1.757 + error(mpl, "%d items missing in data group beginning wit"
1.758 + "h %s", lack, format_symbol(mpl, with));
1.759 + }
1.760 + sym = read_symbol(mpl);
1.761 + if (with == NULL) with = sym;
1.762 + }
1.763 + else
1.764 + { /* copy symbol from the slice */
1.765 + sym = copy_symbol(mpl, temp->sym);
1.766 + }
1.767 + /* append the symbol to the subscript list */
1.768 + tuple = expand_tuple(mpl, tuple, sym);
1.769 + /* skip optional comma */
1.770 + if (mpl->token == T_COMMA) get_token(mpl /* , */);
1.771 + }
1.772 + /* read value and assign it to new parameter member */
1.773 + if (!is_symbol(mpl))
1.774 + { xassert(with != NULL);
1.775 + error(mpl, "one item missing in data group beginning with %s",
1.776 + format_symbol(mpl, with));
1.777 + }
1.778 + read_value(mpl, par, tuple);
1.779 + return;
1.780 +}
1.781 +
1.782 +/*----------------------------------------------------------------------
1.783 +-- tabular_format - read parameter data block in tabular format.
1.784 +--
1.785 +-- This routine reads parameter data block using the syntax:
1.786 +--
1.787 +-- <tabular format> ::= <column> <column> ... <column> :=
1.788 +-- <row> <value> <value> ... <value>
1.789 +-- <row> <value> <value> ... <value>
1.790 +-- . . . . . . . . . . .
1.791 +-- <row> <value> <value> ... <value>
1.792 +--
1.793 +-- where <rows> are symbols that denote rows of the table, <columns>
1.794 +-- are symbols that denote columns of the table, <values> are numeric
1.795 +-- or symbolic values assigned to the corresponding parameter members.
1.796 +-- If <value> is specified as single point, no value is provided.
1.797 +--
1.798 +-- Number of components in the slice must be the same as dimension of
1.799 +-- the parameter. The slice must have two null positions. To construct
1.800 +-- complete subscript list for particular <value> the routine replaces
1.801 +-- the first null position of the slice by the corresponding <row> (or
1.802 +-- <column>, if the flag tr is on) and the second null position by the
1.803 +-- corresponding <column> (or by <row>, if the flag tr is on). */
1.804 +
1.805 +void tabular_format
1.806 +( MPL *mpl,
1.807 + PARAMETER *par, /* not changed */
1.808 + SLICE *slice, /* not changed */
1.809 + int tr
1.810 +)
1.811 +{ SLICE *list, *col, *temp;
1.812 + TUPLE *tuple;
1.813 + SYMBOL *row;
1.814 + xassert(par != NULL);
1.815 + xassert(par->dim == slice_dimen(mpl, slice));
1.816 + xassert(slice_arity(mpl, slice) == 2);
1.817 + /* read the table heading that contains column symbols (the table
1.818 + may have no columns) */
1.819 + list = create_slice(mpl);
1.820 + while (mpl->token != T_ASSIGN)
1.821 + { /* read column symbol and append it to the column list */
1.822 + if (!is_symbol(mpl))
1.823 + error(mpl, "number, symbol, or := missing where expected");
1.824 + list = expand_slice(mpl, list, read_symbol(mpl));
1.825 + }
1.826 + get_token(mpl /* := */);
1.827 + /* read zero or more rows that contain tabular data */
1.828 + while (is_symbol(mpl))
1.829 + { /* read row symbol (if the table has no columns, these symbols
1.830 + are just ignored) */
1.831 + row = read_symbol(mpl);
1.832 + /* read values accordingly to the column list */
1.833 + for (col = list; col != NULL; col = col->next)
1.834 + { int which = 0;
1.835 + /* if the token is single point, no value is provided */
1.836 + if (is_literal(mpl, "."))
1.837 + { get_token(mpl /* . */);
1.838 + continue;
1.839 + }
1.840 + /* construct complete subscript list */
1.841 + tuple = create_tuple(mpl);
1.842 + for (temp = slice; temp != NULL; temp = temp->next)
1.843 + { if (temp->sym == NULL)
1.844 + { /* substitution is needed */
1.845 + switch (++which)
1.846 + { case 1:
1.847 + /* substitute in the first null position */
1.848 + tuple = expand_tuple(mpl, tuple,
1.849 + copy_symbol(mpl, tr ? col->sym : row));
1.850 + break;
1.851 + case 2:
1.852 + /* substitute in the second null position */
1.853 + tuple = expand_tuple(mpl, tuple,
1.854 + copy_symbol(mpl, tr ? row : col->sym));
1.855 + break;
1.856 + default:
1.857 + xassert(which != which);
1.858 + }
1.859 + }
1.860 + else
1.861 + { /* copy symbol from the slice */
1.862 + tuple = expand_tuple(mpl, tuple, copy_symbol(mpl,
1.863 + temp->sym));
1.864 + }
1.865 + }
1.866 + xassert(which == 2);
1.867 + /* read value and assign it to new parameter member */
1.868 + if (!is_symbol(mpl))
1.869 + { int lack = slice_dimen(mpl, col);
1.870 + if (lack == 1)
1.871 + error(mpl, "one item missing in data group beginning "
1.872 + "with %s", format_symbol(mpl, row));
1.873 + else
1.874 + error(mpl, "%d items missing in data group beginning "
1.875 + "with %s", lack, format_symbol(mpl, row));
1.876 + }
1.877 + read_value(mpl, par, tuple);
1.878 + }
1.879 + /* delete the row symbol */
1.880 + delete_symbol(mpl, row);
1.881 + }
1.882 + /* delete the column list */
1.883 + delete_slice(mpl, list);
1.884 + return;
1.885 +}
1.886 +
1.887 +/*----------------------------------------------------------------------
1.888 +-- tabbing_format - read parameter data block in tabbing format.
1.889 +--
1.890 +-- This routine reads parameter data block using the syntax:
1.891 +--
1.892 +-- <tabbing format> ::= <prefix> <name> , ... , <name> , := ,
1.893 +-- <symbol> , ... , <symbol> , <value> , ... , <value> ,
1.894 +-- <symbol> , ... , <symbol> , <value> , ... , <value> ,
1.895 +-- . . . . . . . . . . . . . . . . .
1.896 +-- <symbol> , ... , <symbol> , <value> , ... , <value>
1.897 +-- <prefix> ::= <empty>
1.898 +-- <prefix> ::= <set name> :
1.899 +--
1.900 +-- where <names> are names of parameters (all the parameters must be
1.901 +-- subscripted and have identical dimensions), <symbols> are symbols
1.902 +-- used to define subscripts of parameter members, <values> are numeric
1.903 +-- or symbolic values assigned to the corresponding parameter members.
1.904 +-- Optional <prefix> may specify a simple set, in which case n-tuples
1.905 +-- built of <symbols> for each row of the data table (i.e. subscripts
1.906 +-- of parameter members) are added to the specified set. Commae between
1.907 +-- data items are optional and may be omitted anywhere.
1.908 +--
1.909 +-- If the parameter altval is not NULL, it specifies a default value
1.910 +-- provided for all the parameters specified in the data block. */
1.911 +
1.912 +void tabbing_format
1.913 +( MPL *mpl,
1.914 + SYMBOL *altval /* not changed */
1.915 +)
1.916 +{ SET *set = NULL;
1.917 + PARAMETER *par;
1.918 + SLICE *list, *col;
1.919 + TUPLE *tuple;
1.920 + int next_token, j, dim = 0;
1.921 + char *last_name = NULL;
1.922 + /* read the optional <prefix> */
1.923 + if (is_symbol(mpl))
1.924 + { get_token(mpl /* <symbol> */);
1.925 + next_token = mpl->token;
1.926 + unget_token(mpl /* <symbol> */);
1.927 + if (next_token == T_COLON)
1.928 + { /* select the set to saturate it with data */
1.929 + set = select_set(mpl, mpl->image);
1.930 + /* the set must be simple (i.e. not set of sets) */
1.931 + if (set->dim != 0)
1.932 + error(mpl, "%s must be a simple set", set->name);
1.933 + /* and must not be defined yet */
1.934 + if (set->array->head != NULL)
1.935 + error(mpl, "%s already defined", set->name);
1.936 + /* add new (the only) member to the set and assign it empty
1.937 + elemental set */
1.938 + add_member(mpl, set->array, NULL)->value.set =
1.939 + create_elemset(mpl, set->dimen);
1.940 + last_name = set->name, dim = set->dimen;
1.941 + get_token(mpl /* <symbol> */);
1.942 + xassert(mpl->token == T_COLON);
1.943 + get_token(mpl /* : */);
1.944 + }
1.945 + }
1.946 + /* read the table heading that contains parameter names */
1.947 + list = create_slice(mpl);
1.948 + while (mpl->token != T_ASSIGN)
1.949 + { /* there must be symbolic name of parameter */
1.950 + if (!is_symbol(mpl))
1.951 + error(mpl, "parameter name or := missing where expected");
1.952 + /* select the parameter to saturate it with data */
1.953 + par = select_parameter(mpl, mpl->image);
1.954 + /* the parameter must be subscripted */
1.955 + if (par->dim == 0)
1.956 + error(mpl, "%s not a subscripted parameter", mpl->image);
1.957 + /* the set (if specified) and all the parameters in the data
1.958 + block must have identical dimension */
1.959 + if (dim != 0 && par->dim != dim)
1.960 + { xassert(last_name != NULL);
1.961 + error(mpl, "%s has dimension %d while %s has dimension %d",
1.962 + last_name, dim, par->name, par->dim);
1.963 + }
1.964 + /* set default value for the parameter (if specified) */
1.965 + if (altval != NULL)
1.966 + set_default(mpl, par, copy_symbol(mpl, altval));
1.967 + /* append the parameter to the column list */
1.968 + list = expand_slice(mpl, list, (SYMBOL *)par);
1.969 + last_name = par->name, dim = par->dim;
1.970 + get_token(mpl /* <symbol> */);
1.971 + /* skip optional comma */
1.972 + if (mpl->token == T_COMMA) get_token(mpl /* , */);
1.973 + }
1.974 + if (slice_dimen(mpl, list) == 0)
1.975 + error(mpl, "at least one parameter name required");
1.976 + get_token(mpl /* := */);
1.977 + /* skip optional comma */
1.978 + if (mpl->token == T_COMMA) get_token(mpl /* , */);
1.979 + /* read rows that contain tabbing data */
1.980 + while (is_symbol(mpl))
1.981 + { /* read subscript list */
1.982 + tuple = create_tuple(mpl);
1.983 + for (j = 1; j <= dim; j++)
1.984 + { /* read j-th subscript */
1.985 + if (!is_symbol(mpl))
1.986 + { int lack = slice_dimen(mpl, list) + dim - j + 1;
1.987 + xassert(tuple != NULL);
1.988 + xassert(lack > 1);
1.989 + error(mpl, "%d items missing in data group beginning wit"
1.990 + "h %s", lack, format_symbol(mpl, tuple->sym));
1.991 + }
1.992 + /* read and append j-th subscript to the n-tuple */
1.993 + tuple = expand_tuple(mpl, tuple, read_symbol(mpl));
1.994 + /* skip optional comma *between* <symbols> */
1.995 + if (j < dim && mpl->token == T_COMMA)
1.996 + get_token(mpl /* , */);
1.997 + }
1.998 + /* if the set is specified, add to it new n-tuple, which is a
1.999 + copy of the subscript list just read */
1.1000 + if (set != NULL)
1.1001 + check_then_add(mpl, set->array->head->value.set,
1.1002 + copy_tuple(mpl, tuple));
1.1003 + /* skip optional comma between <symbol> and <value> */
1.1004 + if (mpl->token == T_COMMA) get_token(mpl /* , */);
1.1005 + /* read values accordingly to the column list */
1.1006 + for (col = list; col != NULL; col = col->next)
1.1007 + { /* if the token is single point, no value is provided */
1.1008 + if (is_literal(mpl, "."))
1.1009 + { get_token(mpl /* . */);
1.1010 + continue;
1.1011 + }
1.1012 + /* read value and assign it to new parameter member */
1.1013 + if (!is_symbol(mpl))
1.1014 + { int lack = slice_dimen(mpl, col);
1.1015 + xassert(tuple != NULL);
1.1016 + if (lack == 1)
1.1017 + error(mpl, "one item missing in data group beginning "
1.1018 + "with %s", format_symbol(mpl, tuple->sym));
1.1019 + else
1.1020 + error(mpl, "%d items missing in data group beginning "
1.1021 + "with %s", lack, format_symbol(mpl, tuple->sym));
1.1022 + }
1.1023 + read_value(mpl, (PARAMETER *)col->sym, copy_tuple(mpl,
1.1024 + tuple));
1.1025 + /* skip optional comma preceding the next value */
1.1026 + if (col->next != NULL && mpl->token == T_COMMA)
1.1027 + get_token(mpl /* , */);
1.1028 + }
1.1029 + /* delete the original subscript list */
1.1030 + delete_tuple(mpl, tuple);
1.1031 + /* skip optional comma (only if there is next data group) */
1.1032 + if (mpl->token == T_COMMA)
1.1033 + { get_token(mpl /* , */);
1.1034 + if (!is_symbol(mpl)) unget_token(mpl /* , */);
1.1035 + }
1.1036 + }
1.1037 + /* delete the column list (it contains parameters, not symbols,
1.1038 + so nullify it before) */
1.1039 + for (col = list; col != NULL; col = col->next) col->sym = NULL;
1.1040 + delete_slice(mpl, list);
1.1041 + return;
1.1042 +}
1.1043 +
1.1044 +/*----------------------------------------------------------------------
1.1045 +-- parameter_data - read parameter data.
1.1046 +--
1.1047 +-- This routine reads parameter data using the syntax:
1.1048 +--
1.1049 +-- <parameter data> ::= param <default value> : <tabbing format> ;
1.1050 +-- <parameter data> ::= param <parameter name> <default value>
1.1051 +-- <assignments> ;
1.1052 +-- <parameter name> ::= <symbolic name>
1.1053 +-- <default value> ::= <empty>
1.1054 +-- <default value> ::= default <symbol>
1.1055 +-- <assignments> ::= <empty>
1.1056 +-- <assignments> ::= <assignments> , :=
1.1057 +-- <assignments> ::= <assignments> , [ <symbol list> ]
1.1058 +-- <assignments> ::= <assignments> , <plain format>
1.1059 +-- <assignemnts> ::= <assignments> , : <tabular format>
1.1060 +-- <assignments> ::= <assignments> , (tr) <tabular format>
1.1061 +-- <assignments> ::= <assignments> , (tr) : <tabular format>
1.1062 +--
1.1063 +-- Commae in <assignments> are optional and may be omitted anywhere. */
1.1064 +
1.1065 +void parameter_data(MPL *mpl)
1.1066 +{ PARAMETER *par;
1.1067 + SYMBOL *altval = NULL;
1.1068 + SLICE *slice;
1.1069 + int tr = 0;
1.1070 + xassert(is_literal(mpl, "param"));
1.1071 + get_token(mpl /* param */);
1.1072 + /* read optional default value */
1.1073 + if (is_literal(mpl, "default"))
1.1074 + { get_token(mpl /* default */);
1.1075 + if (!is_symbol(mpl))
1.1076 + error(mpl, "default value missing where expected");
1.1077 + altval = read_symbol(mpl);
1.1078 + /* if the default value follows the keyword 'param', the next
1.1079 + token must be only the colon */
1.1080 + if (mpl->token != T_COLON)
1.1081 + error(mpl, "colon missing where expected");
1.1082 + }
1.1083 + /* being used after the keyword 'param' or the optional default
1.1084 + value the colon begins data in the tabbing format */
1.1085 + if (mpl->token == T_COLON)
1.1086 + { get_token(mpl /* : */);
1.1087 + /* skip optional comma */
1.1088 + if (mpl->token == T_COMMA) get_token(mpl /* , */);
1.1089 + /* read parameter data in the tabbing format */
1.1090 + tabbing_format(mpl, altval);
1.1091 + /* on reading data in the tabbing format the default value is
1.1092 + always copied, so delete the original symbol */
1.1093 + if (altval != NULL) delete_symbol(mpl, altval);
1.1094 + /* the next token must be only semicolon */
1.1095 + if (mpl->token != T_SEMICOLON)
1.1096 + error(mpl, "symbol, number, or semicolon missing where expe"
1.1097 + "cted");
1.1098 + get_token(mpl /* ; */);
1.1099 + goto done;
1.1100 + }
1.1101 + /* in other cases there must be symbolic name of parameter, which
1.1102 + follows the keyword 'param' */
1.1103 + if (!is_symbol(mpl))
1.1104 + error(mpl, "parameter name missing where expected");
1.1105 + /* select the parameter to saturate it with data */
1.1106 + par = select_parameter(mpl, mpl->image);
1.1107 + get_token(mpl /* <symbol> */);
1.1108 + /* read optional default value */
1.1109 + if (is_literal(mpl, "default"))
1.1110 + { get_token(mpl /* default */);
1.1111 + if (!is_symbol(mpl))
1.1112 + error(mpl, "default value missing where expected");
1.1113 + altval = read_symbol(mpl);
1.1114 + /* set default value for the parameter */
1.1115 + set_default(mpl, par, altval);
1.1116 + }
1.1117 + /* create initial fake slice of all asterisks */
1.1118 + slice = fake_slice(mpl, par->dim);
1.1119 + /* read zero or more data assignments */
1.1120 + for (;;)
1.1121 + { /* skip optional comma */
1.1122 + if (mpl->token == T_COMMA) get_token(mpl /* , */);
1.1123 + /* process current assignment */
1.1124 + if (mpl->token == T_ASSIGN)
1.1125 + { /* assignment ligature is non-significant element */
1.1126 + get_token(mpl /* := */);
1.1127 + }
1.1128 + else if (mpl->token == T_LBRACKET)
1.1129 + { /* left bracket begins new slice; delete the current slice
1.1130 + and read new one */
1.1131 + delete_slice(mpl, slice);
1.1132 + slice = read_slice(mpl, par->name, par->dim);
1.1133 + /* each new slice resets the "transpose" indicator */
1.1134 + tr = 0;
1.1135 + }
1.1136 + else if (is_symbol(mpl))
1.1137 + { /* number or symbol begins data in the plain format */
1.1138 + plain_format(mpl, par, slice);
1.1139 + }
1.1140 + else if (mpl->token == T_COLON)
1.1141 + { /* colon begins data in the tabular format */
1.1142 + if (par->dim == 0)
1.1143 +err1: error(mpl, "%s not a subscripted parameter",
1.1144 + par->name);
1.1145 + if (slice_arity(mpl, slice) != 2)
1.1146 +err2: error(mpl, "slice currently used must specify 2 asterisk"
1.1147 + "s, not %d", slice_arity(mpl, slice));
1.1148 + get_token(mpl /* : */);
1.1149 + /* read parameter data in the tabular format */
1.1150 + tabular_format(mpl, par, slice, tr);
1.1151 + }
1.1152 + else if (mpl->token == T_LEFT)
1.1153 + { /* left parenthesis begins the "transpose" indicator, which
1.1154 + is followed by data in the tabular format */
1.1155 + get_token(mpl /* ( */);
1.1156 + if (!is_literal(mpl, "tr"))
1.1157 +err3: error(mpl, "transpose indicator (tr) incomplete");
1.1158 + if (par->dim == 0) goto err1;
1.1159 + if (slice_arity(mpl, slice) != 2) goto err2;
1.1160 + get_token(mpl /* tr */);
1.1161 + if (mpl->token != T_RIGHT) goto err3;
1.1162 + get_token(mpl /* ) */);
1.1163 + /* in this case the colon is optional */
1.1164 + if (mpl->token == T_COLON) get_token(mpl /* : */);
1.1165 + /* set the "transpose" indicator */
1.1166 + tr = 1;
1.1167 + /* read parameter data in the tabular format */
1.1168 + tabular_format(mpl, par, slice, tr);
1.1169 + }
1.1170 + else if (mpl->token == T_SEMICOLON)
1.1171 + { /* semicolon terminates the data block */
1.1172 + get_token(mpl /* ; */);
1.1173 + break;
1.1174 + }
1.1175 + else
1.1176 + error(mpl, "syntax error in parameter data block");
1.1177 + }
1.1178 + /* delete the current slice */
1.1179 + delete_slice(mpl, slice);
1.1180 +done: return;
1.1181 +}
1.1182 +
1.1183 +/*----------------------------------------------------------------------
1.1184 +-- data_section - read data section.
1.1185 +--
1.1186 +-- This routine reads data section using the syntax:
1.1187 +--
1.1188 +-- <data section> ::= <empty>
1.1189 +-- <data section> ::= <data section> <data block> ;
1.1190 +-- <data block> ::= <set data>
1.1191 +-- <data block> ::= <parameter data>
1.1192 +--
1.1193 +-- Reading data section is terminated by either the keyword 'end' or
1.1194 +-- the end of file. */
1.1195 +
1.1196 +void data_section(MPL *mpl)
1.1197 +{ while (!(mpl->token == T_EOF || is_literal(mpl, "end")))
1.1198 + { if (is_literal(mpl, "set"))
1.1199 + set_data(mpl);
1.1200 + else if (is_literal(mpl, "param"))
1.1201 + parameter_data(mpl);
1.1202 + else
1.1203 + error(mpl, "syntax error in data section");
1.1204 + }
1.1205 + return;
1.1206 +}
1.1207 +
1.1208 +/* eof */