lemon-project-template-glpk
diff deps/glpk/src/glpmpl02.c @ 9:33de93886c88
Import GLPK 4.47
| author | Alpar Juttner <alpar@cs.elte.hu> |
|---|---|
| date | Sun, 06 Nov 2011 20:59:10 +0100 |
| parents | |
| children |
line diff
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 1.2 +++ b/deps/glpk/src/glpmpl02.c Sun Nov 06 20:59:10 2011 +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, 2011 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 */