lemon-project-template-glpk
view deps/glpk/src/glpmpl02.c @ 11:4fc6ad2fb8a6
Test GLPK in src/main.cc
| author | Alpar Juttner <alpar@cs.elte.hu> |
|---|---|
| date | Sun, 06 Nov 2011 21:43:29 +0100 |
| parents | |
| children |
line source
1 /* glpmpl02.c */
3 /***********************************************************************
4 * This code is part of GLPK (GNU Linear Programming Kit).
5 *
6 * Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
7 * 2009, 2010, 2011 Andrew Makhorin, Department for Applied Informatics,
8 * Moscow Aviation Institute, Moscow, Russia. All rights reserved.
9 * E-mail: <mao@gnu.org>.
10 *
11 * GLPK is free software: you can redistribute it and/or modify it
12 * under the terms of the GNU General Public License as published by
13 * the Free Software Foundation, either version 3 of the License, or
14 * (at your option) any later version.
15 *
16 * GLPK is distributed in the hope that it will be useful, but WITHOUT
17 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
19 * License for more details.
20 *
21 * You should have received a copy of the GNU General Public License
22 * along with GLPK. If not, see <http://www.gnu.org/licenses/>.
23 ***********************************************************************/
25 #define _GLPSTD_STDIO
26 #include "glpenv.h"
27 #include "glpmpl.h"
29 /**********************************************************************/
30 /* * * PROCESSING DATA SECTION * * */
31 /**********************************************************************/
33 /*----------------------------------------------------------------------
34 -- create_slice - create slice.
35 --
36 -- This routine creates a slice, which initially has no components. */
38 SLICE *create_slice(MPL *mpl)
39 { SLICE *slice;
40 xassert(mpl == mpl);
41 slice = NULL;
42 return slice;
43 }
45 /*----------------------------------------------------------------------
46 -- expand_slice - append new component to slice.
47 --
48 -- This routine expands slice appending to it either a given symbol or
49 -- null component, which becomes the last component of the slice. */
51 SLICE *expand_slice
52 ( MPL *mpl,
53 SLICE *slice, /* destroyed */
54 SYMBOL *sym /* destroyed */
55 )
56 { SLICE *tail, *temp;
57 /* create a new component */
58 tail = dmp_get_atom(mpl->tuples, sizeof(SLICE));
59 tail->sym = sym;
60 tail->next = NULL;
61 /* and append it to the component list */
62 if (slice == NULL)
63 slice = tail;
64 else
65 { for (temp = slice; temp->next != NULL; temp = temp->next);
66 temp->next = tail;
67 }
68 return slice;
69 }
71 /*----------------------------------------------------------------------
72 -- slice_dimen - determine dimension of slice.
73 --
74 -- This routine returns dimension of slice, which is number of all its
75 -- components including null ones. */
77 int slice_dimen
78 ( MPL *mpl,
79 SLICE *slice /* not changed */
80 )
81 { SLICE *temp;
82 int dim;
83 xassert(mpl == mpl);
84 dim = 0;
85 for (temp = slice; temp != NULL; temp = temp->next) dim++;
86 return dim;
87 }
89 /*----------------------------------------------------------------------
90 -- slice_arity - determine arity of slice.
91 --
92 -- This routine returns arity of slice, i.e. number of null components
93 -- (indicated by asterisks) in the slice. */
95 int slice_arity
96 ( MPL *mpl,
97 SLICE *slice /* not changed */
98 )
99 { SLICE *temp;
100 int arity;
101 xassert(mpl == mpl);
102 arity = 0;
103 for (temp = slice; temp != NULL; temp = temp->next)
104 if (temp->sym == NULL) arity++;
105 return arity;
106 }
108 /*----------------------------------------------------------------------
109 -- fake_slice - create fake slice of all asterisks.
110 --
111 -- This routine creates a fake slice of given dimension, which contains
112 -- asterisks in all components. Zero dimension is allowed. */
114 SLICE *fake_slice(MPL *mpl, int dim)
115 { SLICE *slice;
116 slice = create_slice(mpl);
117 while (dim-- > 0) slice = expand_slice(mpl, slice, NULL);
118 return slice;
119 }
121 /*----------------------------------------------------------------------
122 -- delete_slice - delete slice.
123 --
124 -- This routine deletes specified slice. */
126 void delete_slice
127 ( MPL *mpl,
128 SLICE *slice /* destroyed */
129 )
130 { SLICE *temp;
131 while (slice != NULL)
132 { temp = slice;
133 slice = temp->next;
134 if (temp->sym != NULL) delete_symbol(mpl, temp->sym);
135 xassert(sizeof(SLICE) == sizeof(TUPLE));
136 dmp_free_atom(mpl->tuples, temp, sizeof(TUPLE));
137 }
138 return;
139 }
141 /*----------------------------------------------------------------------
142 -- is_number - check if current token is number.
143 --
144 -- If the current token is a number, this routine returns non-zero.
145 -- Otherwise zero is returned. */
147 int is_number(MPL *mpl)
148 { return
149 mpl->token == T_NUMBER;
150 }
152 /*----------------------------------------------------------------------
153 -- is_symbol - check if current token is symbol.
154 --
155 -- If the current token is suitable to be a symbol, the routine returns
156 -- non-zero. Otherwise zero is returned. */
158 int is_symbol(MPL *mpl)
159 { return
160 mpl->token == T_NUMBER ||
161 mpl->token == T_SYMBOL ||
162 mpl->token == T_STRING;
163 }
165 /*----------------------------------------------------------------------
166 -- is_literal - check if current token is given symbolic literal.
167 --
168 -- If the current token is given symbolic literal, this routine returns
169 -- non-zero. Otherwise zero is returned.
170 --
171 -- This routine is used on processing the data section in the same way
172 -- as the routine is_keyword on processing the model section. */
174 int is_literal(MPL *mpl, char *literal)
175 { return
176 is_symbol(mpl) && strcmp(mpl->image, literal) == 0;
177 }
179 /*----------------------------------------------------------------------
180 -- read_number - read number.
181 --
182 -- This routine reads the current token, which must be a number, and
183 -- returns its numeric value. */
185 double read_number(MPL *mpl)
186 { double num;
187 xassert(is_number(mpl));
188 num = mpl->value;
189 get_token(mpl /* <number> */);
190 return num;
191 }
193 /*----------------------------------------------------------------------
194 -- read_symbol - read symbol.
195 --
196 -- This routine reads the current token, which must be a symbol, and
197 -- returns its symbolic value. */
199 SYMBOL *read_symbol(MPL *mpl)
200 { SYMBOL *sym;
201 xassert(is_symbol(mpl));
202 if (is_number(mpl))
203 sym = create_symbol_num(mpl, mpl->value);
204 else
205 sym = create_symbol_str(mpl, create_string(mpl, mpl->image));
206 get_token(mpl /* <symbol> */);
207 return sym;
208 }
210 /*----------------------------------------------------------------------
211 -- read_slice - read slice.
212 --
213 -- This routine reads slice using the syntax:
214 --
215 -- <slice> ::= [ <symbol list> ]
216 -- <slice> ::= ( <symbol list> )
217 -- <symbol list> ::= <symbol or star>
218 -- <symbol list> ::= <symbol list> , <symbol or star>
219 -- <symbol or star> ::= <symbol>
220 -- <symbol or star> ::= *
221 --
222 -- The bracketed form of slice is used for members of multi-dimensional
223 -- objects while the parenthesized form is used for elemental sets. */
225 SLICE *read_slice
226 ( MPL *mpl,
227 char *name, /* not changed */
228 int dim
229 )
230 { SLICE *slice;
231 int close;
232 xassert(name != NULL);
233 switch (mpl->token)
234 { case T_LBRACKET:
235 close = T_RBRACKET;
236 break;
237 case T_LEFT:
238 xassert(dim > 0);
239 close = T_RIGHT;
240 break;
241 default:
242 xassert(mpl != mpl);
243 }
244 if (dim == 0)
245 error(mpl, "%s cannot be subscripted", name);
246 get_token(mpl /* ( | [ */);
247 /* read slice components */
248 slice = create_slice(mpl);
249 for (;;)
250 { /* the current token must be a symbol or asterisk */
251 if (is_symbol(mpl))
252 slice = expand_slice(mpl, slice, read_symbol(mpl));
253 else if (mpl->token == T_ASTERISK)
254 { slice = expand_slice(mpl, slice, NULL);
255 get_token(mpl /* * */);
256 }
257 else
258 error(mpl, "number, symbol, or asterisk missing where expec"
259 "ted");
260 /* check a token that follows the symbol */
261 if (mpl->token == T_COMMA)
262 get_token(mpl /* , */);
263 else if (mpl->token == close)
264 break;
265 else
266 error(mpl, "syntax error in slice");
267 }
268 /* number of slice components must be the same as the appropriate
269 dimension */
270 if (slice_dimen(mpl, slice) != dim)
271 { switch (close)
272 { case T_RBRACKET:
273 error(mpl, "%s must have %d subscript%s, not %d", name,
274 dim, dim == 1 ? "" : "s", slice_dimen(mpl, slice));
275 break;
276 case T_RIGHT:
277 error(mpl, "%s has dimension %d, not %d", name, dim,
278 slice_dimen(mpl, slice));
279 break;
280 default:
281 xassert(close != close);
282 }
283 }
284 get_token(mpl /* ) | ] */);
285 return slice;
286 }
288 /*----------------------------------------------------------------------
289 -- select_set - select set to saturate it with elemental sets.
290 --
291 -- This routine selects set to saturate it with elemental sets provided
292 -- in the data section. */
294 SET *select_set
295 ( MPL *mpl,
296 char *name /* not changed */
297 )
298 { SET *set;
299 AVLNODE *node;
300 xassert(name != NULL);
301 node = avl_find_node(mpl->tree, name);
302 if (node == NULL || avl_get_node_type(node) != A_SET)
303 error(mpl, "%s not a set", name);
304 set = (SET *)avl_get_node_link(node);
305 if (set->assign != NULL || set->gadget != NULL)
306 error(mpl, "%s needs no data", name);
307 set->data = 1;
308 return set;
309 }
311 /*----------------------------------------------------------------------
312 -- simple_format - read set data block in simple format.
313 --
314 -- This routine reads set data block using the syntax:
315 --
316 -- <simple format> ::= <symbol> , <symbol> , ... , <symbol>
317 --
318 -- where <symbols> are used to construct a complete n-tuple, which is
319 -- included in elemental set assigned to the set member. Commae between
320 -- symbols are optional and may be omitted anywhere.
321 --
322 -- Number of components in the slice must be the same as dimension of
323 -- n-tuples in elemental sets assigned to the set members. To construct
324 -- complete n-tuple the routine replaces null positions in the slice by
325 -- corresponding <symbols>.
326 --
327 -- If the slice contains at least one null position, the current token
328 -- must be symbol. Otherwise, the routine reads no symbols to construct
329 -- the n-tuple, so the current token is not checked. */
331 void simple_format
332 ( MPL *mpl,
333 SET *set, /* not changed */
334 MEMBER *memb, /* modified */
335 SLICE *slice /* not changed */
336 )
337 { TUPLE *tuple;
338 SLICE *temp;
339 SYMBOL *sym, *with = NULL;
340 xassert(set != NULL);
341 xassert(memb != NULL);
342 xassert(slice != NULL);
343 xassert(set->dimen == slice_dimen(mpl, slice));
344 xassert(memb->value.set->dim == set->dimen);
345 if (slice_arity(mpl, slice) > 0) xassert(is_symbol(mpl));
346 /* read symbols and construct complete n-tuple */
347 tuple = create_tuple(mpl);
348 for (temp = slice; temp != NULL; temp = temp->next)
349 { if (temp->sym == NULL)
350 { /* substitution is needed; read symbol */
351 if (!is_symbol(mpl))
352 { int lack = slice_arity(mpl, temp);
353 /* with cannot be null due to assertion above */
354 xassert(with != NULL);
355 if (lack == 1)
356 error(mpl, "one item missing in data group beginning "
357 "with %s", format_symbol(mpl, with));
358 else
359 error(mpl, "%d items missing in data group beginning "
360 "with %s", lack, format_symbol(mpl, with));
361 }
362 sym = read_symbol(mpl);
363 if (with == NULL) with = sym;
364 }
365 else
366 { /* copy symbol from the slice */
367 sym = copy_symbol(mpl, temp->sym);
368 }
369 /* append the symbol to the n-tuple */
370 tuple = expand_tuple(mpl, tuple, sym);
371 /* skip optional comma *between* <symbols> */
372 if (temp->next != NULL && mpl->token == T_COMMA)
373 get_token(mpl /* , */);
374 }
375 /* add constructed n-tuple to elemental set */
376 check_then_add(mpl, memb->value.set, tuple);
377 return;
378 }
380 /*----------------------------------------------------------------------
381 -- matrix_format - read set data block in matrix format.
382 --
383 -- This routine reads set data block using the syntax:
384 --
385 -- <matrix format> ::= <column> <column> ... <column> :=
386 -- <row> +/- +/- ... +/-
387 -- <row> +/- +/- ... +/-
388 -- . . . . . . . . . . .
389 -- <row> +/- +/- ... +/-
390 --
391 -- where <rows> are symbols that denote rows of the matrix, <columns>
392 -- are symbols that denote columns of the matrix, "+" and "-" indicate
393 -- whether corresponding n-tuple needs to be included in the elemental
394 -- set or not, respectively.
395 --
396 -- Number of the slice components must be the same as dimension of the
397 -- elemental set. The slice must have two null positions. To construct
398 -- complete n-tuple for particular element of the matrix the routine
399 -- replaces first null position of the slice by the corresponding <row>
400 -- (or <column>, if the flag tr is on) and second null position by the
401 -- corresponding <column> (or by <row>, if the flag tr is on). */
403 void matrix_format
404 ( MPL *mpl,
405 SET *set, /* not changed */
406 MEMBER *memb, /* modified */
407 SLICE *slice, /* not changed */
408 int tr
409 )
410 { SLICE *list, *col, *temp;
411 TUPLE *tuple;
412 SYMBOL *row;
413 xassert(set != NULL);
414 xassert(memb != NULL);
415 xassert(slice != NULL);
416 xassert(set->dimen == slice_dimen(mpl, slice));
417 xassert(memb->value.set->dim == set->dimen);
418 xassert(slice_arity(mpl, slice) == 2);
419 /* read the matrix heading that contains column symbols (there
420 may be no columns at all) */
421 list = create_slice(mpl);
422 while (mpl->token != T_ASSIGN)
423 { /* read column symbol and append it to the column list */
424 if (!is_symbol(mpl))
425 error(mpl, "number, symbol, or := missing where expected");
426 list = expand_slice(mpl, list, read_symbol(mpl));
427 }
428 get_token(mpl /* := */);
429 /* read zero or more rows that contain matrix data */
430 while (is_symbol(mpl))
431 { /* read row symbol (if the matrix has no columns, row symbols
432 are just ignored) */
433 row = read_symbol(mpl);
434 /* read the matrix row accordingly to the column list */
435 for (col = list; col != NULL; col = col->next)
436 { int which = 0;
437 /* check indicator */
438 if (is_literal(mpl, "+"))
439 ;
440 else if (is_literal(mpl, "-"))
441 { get_token(mpl /* - */);
442 continue;
443 }
444 else
445 { int lack = slice_dimen(mpl, col);
446 if (lack == 1)
447 error(mpl, "one item missing in data group beginning "
448 "with %s", format_symbol(mpl, row));
449 else
450 error(mpl, "%d items missing in data group beginning "
451 "with %s", lack, format_symbol(mpl, row));
452 }
453 /* construct complete n-tuple */
454 tuple = create_tuple(mpl);
455 for (temp = slice; temp != NULL; temp = temp->next)
456 { if (temp->sym == NULL)
457 { /* substitution is needed */
458 switch (++which)
459 { case 1:
460 /* substitute in the first null position */
461 tuple = expand_tuple(mpl, tuple,
462 copy_symbol(mpl, tr ? col->sym : row));
463 break;
464 case 2:
465 /* substitute in the second null position */
466 tuple = expand_tuple(mpl, tuple,
467 copy_symbol(mpl, tr ? row : col->sym));
468 break;
469 default:
470 xassert(which != which);
471 }
472 }
473 else
474 { /* copy symbol from the slice */
475 tuple = expand_tuple(mpl, tuple, copy_symbol(mpl,
476 temp->sym));
477 }
478 }
479 xassert(which == 2);
480 /* add constructed n-tuple to elemental set */
481 check_then_add(mpl, memb->value.set, tuple);
482 get_token(mpl /* + */);
483 }
484 /* delete the row symbol */
485 delete_symbol(mpl, row);
486 }
487 /* delete the column list */
488 delete_slice(mpl, list);
489 return;
490 }
492 /*----------------------------------------------------------------------
493 -- set_data - read set data.
494 --
495 -- This routine reads set data using the syntax:
496 --
497 -- <set data> ::= set <set name> <assignments> ;
498 -- <set data> ::= set <set name> [ <symbol list> ] <assignments> ;
499 -- <set name> ::= <symbolic name>
500 -- <assignments> ::= <empty>
501 -- <assignments> ::= <assignments> , :=
502 -- <assignments> ::= <assignments> , ( <symbol list> )
503 -- <assignments> ::= <assignments> , <simple format>
504 -- <assignments> ::= <assignments> , : <matrix format>
505 -- <assignments> ::= <assignments> , (tr) <matrix format>
506 -- <assignments> ::= <assignments> , (tr) : <matrix format>
507 --
508 -- Commae in <assignments> are optional and may be omitted anywhere. */
510 void set_data(MPL *mpl)
511 { SET *set;
512 TUPLE *tuple;
513 MEMBER *memb;
514 SLICE *slice;
515 int tr = 0;
516 xassert(is_literal(mpl, "set"));
517 get_token(mpl /* set */);
518 /* symbolic name of set must follows the keyword 'set' */
519 if (!is_symbol(mpl))
520 error(mpl, "set name missing where expected");
521 /* select the set to saturate it with data */
522 set = select_set(mpl, mpl->image);
523 get_token(mpl /* <symbolic name> */);
524 /* read optional subscript list, which identifies member of the
525 set to be read */
526 tuple = create_tuple(mpl);
527 if (mpl->token == T_LBRACKET)
528 { /* subscript list is specified */
529 if (set->dim == 0)
530 error(mpl, "%s cannot be subscripted", set->name);
531 get_token(mpl /* [ */);
532 /* read symbols and construct subscript list */
533 for (;;)
534 { if (!is_symbol(mpl))
535 error(mpl, "number or symbol missing where expected");
536 tuple = expand_tuple(mpl, tuple, read_symbol(mpl));
537 if (mpl->token == T_COMMA)
538 get_token(mpl /* , */);
539 else if (mpl->token == T_RBRACKET)
540 break;
541 else
542 error(mpl, "syntax error in subscript list");
543 }
544 if (set->dim != tuple_dimen(mpl, tuple))
545 error(mpl, "%s must have %d subscript%s rather than %d",
546 set->name, set->dim, set->dim == 1 ? "" : "s",
547 tuple_dimen(mpl, tuple));
548 get_token(mpl /* ] */);
549 }
550 else
551 { /* subscript list is not specified */
552 if (set->dim != 0)
553 error(mpl, "%s must be subscripted", set->name);
554 }
555 /* there must be no member with the same subscript list */
556 if (find_member(mpl, set->array, tuple) != NULL)
557 error(mpl, "%s%s already defined",
558 set->name, format_tuple(mpl, '[', tuple));
559 /* add new member to the set and assign it empty elemental set */
560 memb = add_member(mpl, set->array, tuple);
561 memb->value.set = create_elemset(mpl, set->dimen);
562 /* create an initial fake slice of all asterisks */
563 slice = fake_slice(mpl, set->dimen);
564 /* read zero or more data assignments */
565 for (;;)
566 { /* skip optional comma */
567 if (mpl->token == T_COMMA) get_token(mpl /* , */);
568 /* process assignment element */
569 if (mpl->token == T_ASSIGN)
570 { /* assignment ligature is non-significant element */
571 get_token(mpl /* := */);
572 }
573 else if (mpl->token == T_LEFT)
574 { /* left parenthesis begins either new slice or "transpose"
575 indicator */
576 int is_tr;
577 get_token(mpl /* ( */);
578 is_tr = is_literal(mpl, "tr");
579 unget_token(mpl /* ( */);
580 if (is_tr) goto left;
581 /* delete the current slice and read new one */
582 delete_slice(mpl, slice);
583 slice = read_slice(mpl, set->name, set->dimen);
584 /* each new slice resets the "transpose" indicator */
585 tr = 0;
586 /* if the new slice is 0-ary, formally there is one 0-tuple
587 (in the simple format) that follows it */
588 if (slice_arity(mpl, slice) == 0)
589 simple_format(mpl, set, memb, slice);
590 }
591 else if (is_symbol(mpl))
592 { /* number or symbol begins data in the simple format */
593 simple_format(mpl, set, memb, slice);
594 }
595 else if (mpl->token == T_COLON)
596 { /* colon begins data in the matrix format */
597 if (slice_arity(mpl, slice) != 2)
598 err1: error(mpl, "slice currently used must specify 2 asterisk"
599 "s, not %d", slice_arity(mpl, slice));
600 get_token(mpl /* : */);
601 /* read elemental set data in the matrix format */
602 matrix_format(mpl, set, memb, slice, tr);
603 }
604 else if (mpl->token == T_LEFT)
605 left: { /* left parenthesis begins the "transpose" indicator, which
606 is followed by data in the matrix format */
607 get_token(mpl /* ( */);
608 if (!is_literal(mpl, "tr"))
609 err2: error(mpl, "transpose indicator (tr) incomplete");
610 if (slice_arity(mpl, slice) != 2) goto err1;
611 get_token(mpl /* tr */);
612 if (mpl->token != T_RIGHT) goto err2;
613 get_token(mpl /* ) */);
614 /* in this case the colon is optional */
615 if (mpl->token == T_COLON) get_token(mpl /* : */);
616 /* set the "transpose" indicator */
617 tr = 1;
618 /* read elemental set data in the matrix format */
619 matrix_format(mpl, set, memb, slice, tr);
620 }
621 else if (mpl->token == T_SEMICOLON)
622 { /* semicolon terminates the data block */
623 get_token(mpl /* ; */);
624 break;
625 }
626 else
627 error(mpl, "syntax error in set data block");
628 }
629 /* delete the current slice */
630 delete_slice(mpl, slice);
631 return;
632 }
634 /*----------------------------------------------------------------------
635 -- select_parameter - select parameter to saturate it with data.
636 --
637 -- This routine selects parameter to saturate it with data provided in
638 -- the data section. */
640 PARAMETER *select_parameter
641 ( MPL *mpl,
642 char *name /* not changed */
643 )
644 { PARAMETER *par;
645 AVLNODE *node;
646 xassert(name != NULL);
647 node = avl_find_node(mpl->tree, name);
648 if (node == NULL || avl_get_node_type(node) != A_PARAMETER)
649 error(mpl, "%s not a parameter", name);
650 par = (PARAMETER *)avl_get_node_link(node);
651 if (par->assign != NULL)
652 error(mpl, "%s needs no data", name);
653 if (par->data)
654 error(mpl, "%s already provided with data", name);
655 par->data = 1;
656 return par;
657 }
659 /*----------------------------------------------------------------------
660 -- set_default - set default parameter value.
661 --
662 -- This routine sets default value for specified parameter. */
664 void set_default
665 ( MPL *mpl,
666 PARAMETER *par, /* not changed */
667 SYMBOL *altval /* destroyed */
668 )
669 { xassert(par != NULL);
670 xassert(altval != NULL);
671 if (par->option != NULL)
672 error(mpl, "default value for %s already specified in model se"
673 "ction", par->name);
674 xassert(par->defval == NULL);
675 par->defval = altval;
676 return;
677 }
679 /*----------------------------------------------------------------------
680 -- read_value - read value and assign it to parameter member.
681 --
682 -- This routine reads numeric or symbolic value from the input stream
683 -- and assigns to new parameter member specified by its n-tuple, which
684 -- (the member) is created and added to the parameter array. */
686 MEMBER *read_value
687 ( MPL *mpl,
688 PARAMETER *par, /* not changed */
689 TUPLE *tuple /* destroyed */
690 )
691 { MEMBER *memb;
692 xassert(par != NULL);
693 xassert(is_symbol(mpl));
694 /* there must be no member with the same n-tuple */
695 if (find_member(mpl, par->array, tuple) != NULL)
696 error(mpl, "%s%s already defined",
697 par->name, format_tuple(mpl, '[', tuple));
698 /* create new parameter member with given n-tuple */
699 memb = add_member(mpl, par->array, tuple);
700 /* read value and assigns it to the new parameter member */
701 switch (par->type)
702 { case A_NUMERIC:
703 case A_INTEGER:
704 case A_BINARY:
705 if (!is_number(mpl))
706 error(mpl, "%s requires numeric data", par->name);
707 memb->value.num = read_number(mpl);
708 break;
709 case A_SYMBOLIC:
710 memb->value.sym = read_symbol(mpl);
711 break;
712 default:
713 xassert(par != par);
714 }
715 return memb;
716 }
718 /*----------------------------------------------------------------------
719 -- plain_format - read parameter data block in plain format.
720 --
721 -- This routine reads parameter data block using the syntax:
722 --
723 -- <plain format> ::= <symbol> , <symbol> , ... , <symbol> , <value>
724 --
725 -- where <symbols> are used to determine a complete subscript list for
726 -- parameter member, <value> is a numeric or symbolic value assigned to
727 -- the parameter member. Commae between data items are optional and may
728 -- be omitted anywhere.
729 --
730 -- Number of components in the slice must be the same as dimension of
731 -- the parameter. To construct the complete subscript list the routine
732 -- replaces null positions in the slice by corresponding <symbols>. */
734 void plain_format
735 ( MPL *mpl,
736 PARAMETER *par, /* not changed */
737 SLICE *slice /* not changed */
738 )
739 { TUPLE *tuple;
740 SLICE *temp;
741 SYMBOL *sym, *with = NULL;
742 xassert(par != NULL);
743 xassert(par->dim == slice_dimen(mpl, slice));
744 xassert(is_symbol(mpl));
745 /* read symbols and construct complete subscript list */
746 tuple = create_tuple(mpl);
747 for (temp = slice; temp != NULL; temp = temp->next)
748 { if (temp->sym == NULL)
749 { /* substitution is needed; read symbol */
750 if (!is_symbol(mpl))
751 { int lack = slice_arity(mpl, temp) + 1;
752 xassert(with != NULL);
753 xassert(lack > 1);
754 error(mpl, "%d items missing in data group beginning wit"
755 "h %s", lack, format_symbol(mpl, with));
756 }
757 sym = read_symbol(mpl);
758 if (with == NULL) with = sym;
759 }
760 else
761 { /* copy symbol from the slice */
762 sym = copy_symbol(mpl, temp->sym);
763 }
764 /* append the symbol to the subscript list */
765 tuple = expand_tuple(mpl, tuple, sym);
766 /* skip optional comma */
767 if (mpl->token == T_COMMA) get_token(mpl /* , */);
768 }
769 /* read value and assign it to new parameter member */
770 if (!is_symbol(mpl))
771 { xassert(with != NULL);
772 error(mpl, "one item missing in data group beginning with %s",
773 format_symbol(mpl, with));
774 }
775 read_value(mpl, par, tuple);
776 return;
777 }
779 /*----------------------------------------------------------------------
780 -- tabular_format - read parameter data block in tabular format.
781 --
782 -- This routine reads parameter data block using the syntax:
783 --
784 -- <tabular format> ::= <column> <column> ... <column> :=
785 -- <row> <value> <value> ... <value>
786 -- <row> <value> <value> ... <value>
787 -- . . . . . . . . . . .
788 -- <row> <value> <value> ... <value>
789 --
790 -- where <rows> are symbols that denote rows of the table, <columns>
791 -- are symbols that denote columns of the table, <values> are numeric
792 -- or symbolic values assigned to the corresponding parameter members.
793 -- If <value> is specified as single point, no value is provided.
794 --
795 -- Number of components in the slice must be the same as dimension of
796 -- the parameter. The slice must have two null positions. To construct
797 -- complete subscript list for particular <value> the routine replaces
798 -- the first null position of the slice by the corresponding <row> (or
799 -- <column>, if the flag tr is on) and the second null position by the
800 -- corresponding <column> (or by <row>, if the flag tr is on). */
802 void tabular_format
803 ( MPL *mpl,
804 PARAMETER *par, /* not changed */
805 SLICE *slice, /* not changed */
806 int tr
807 )
808 { SLICE *list, *col, *temp;
809 TUPLE *tuple;
810 SYMBOL *row;
811 xassert(par != NULL);
812 xassert(par->dim == slice_dimen(mpl, slice));
813 xassert(slice_arity(mpl, slice) == 2);
814 /* read the table heading that contains column symbols (the table
815 may have no columns) */
816 list = create_slice(mpl);
817 while (mpl->token != T_ASSIGN)
818 { /* read column symbol and append it to the column list */
819 if (!is_symbol(mpl))
820 error(mpl, "number, symbol, or := missing where expected");
821 list = expand_slice(mpl, list, read_symbol(mpl));
822 }
823 get_token(mpl /* := */);
824 /* read zero or more rows that contain tabular data */
825 while (is_symbol(mpl))
826 { /* read row symbol (if the table has no columns, these symbols
827 are just ignored) */
828 row = read_symbol(mpl);
829 /* read values accordingly to the column list */
830 for (col = list; col != NULL; col = col->next)
831 { int which = 0;
832 /* if the token is single point, no value is provided */
833 if (is_literal(mpl, "."))
834 { get_token(mpl /* . */);
835 continue;
836 }
837 /* construct complete subscript list */
838 tuple = create_tuple(mpl);
839 for (temp = slice; temp != NULL; temp = temp->next)
840 { if (temp->sym == NULL)
841 { /* substitution is needed */
842 switch (++which)
843 { case 1:
844 /* substitute in the first null position */
845 tuple = expand_tuple(mpl, tuple,
846 copy_symbol(mpl, tr ? col->sym : row));
847 break;
848 case 2:
849 /* substitute in the second null position */
850 tuple = expand_tuple(mpl, tuple,
851 copy_symbol(mpl, tr ? row : col->sym));
852 break;
853 default:
854 xassert(which != which);
855 }
856 }
857 else
858 { /* copy symbol from the slice */
859 tuple = expand_tuple(mpl, tuple, copy_symbol(mpl,
860 temp->sym));
861 }
862 }
863 xassert(which == 2);
864 /* read value and assign it to new parameter member */
865 if (!is_symbol(mpl))
866 { int lack = slice_dimen(mpl, col);
867 if (lack == 1)
868 error(mpl, "one item missing in data group beginning "
869 "with %s", format_symbol(mpl, row));
870 else
871 error(mpl, "%d items missing in data group beginning "
872 "with %s", lack, format_symbol(mpl, row));
873 }
874 read_value(mpl, par, tuple);
875 }
876 /* delete the row symbol */
877 delete_symbol(mpl, row);
878 }
879 /* delete the column list */
880 delete_slice(mpl, list);
881 return;
882 }
884 /*----------------------------------------------------------------------
885 -- tabbing_format - read parameter data block in tabbing format.
886 --
887 -- This routine reads parameter data block using the syntax:
888 --
889 -- <tabbing format> ::= <prefix> <name> , ... , <name> , := ,
890 -- <symbol> , ... , <symbol> , <value> , ... , <value> ,
891 -- <symbol> , ... , <symbol> , <value> , ... , <value> ,
892 -- . . . . . . . . . . . . . . . . .
893 -- <symbol> , ... , <symbol> , <value> , ... , <value>
894 -- <prefix> ::= <empty>
895 -- <prefix> ::= <set name> :
896 --
897 -- where <names> are names of parameters (all the parameters must be
898 -- subscripted and have identical dimensions), <symbols> are symbols
899 -- used to define subscripts of parameter members, <values> are numeric
900 -- or symbolic values assigned to the corresponding parameter members.
901 -- Optional <prefix> may specify a simple set, in which case n-tuples
902 -- built of <symbols> for each row of the data table (i.e. subscripts
903 -- of parameter members) are added to the specified set. Commae between
904 -- data items are optional and may be omitted anywhere.
905 --
906 -- If the parameter altval is not NULL, it specifies a default value
907 -- provided for all the parameters specified in the data block. */
909 void tabbing_format
910 ( MPL *mpl,
911 SYMBOL *altval /* not changed */
912 )
913 { SET *set = NULL;
914 PARAMETER *par;
915 SLICE *list, *col;
916 TUPLE *tuple;
917 int next_token, j, dim = 0;
918 char *last_name = NULL;
919 /* read the optional <prefix> */
920 if (is_symbol(mpl))
921 { get_token(mpl /* <symbol> */);
922 next_token = mpl->token;
923 unget_token(mpl /* <symbol> */);
924 if (next_token == T_COLON)
925 { /* select the set to saturate it with data */
926 set = select_set(mpl, mpl->image);
927 /* the set must be simple (i.e. not set of sets) */
928 if (set->dim != 0)
929 error(mpl, "%s must be a simple set", set->name);
930 /* and must not be defined yet */
931 if (set->array->head != NULL)
932 error(mpl, "%s already defined", set->name);
933 /* add new (the only) member to the set and assign it empty
934 elemental set */
935 add_member(mpl, set->array, NULL)->value.set =
936 create_elemset(mpl, set->dimen);
937 last_name = set->name, dim = set->dimen;
938 get_token(mpl /* <symbol> */);
939 xassert(mpl->token == T_COLON);
940 get_token(mpl /* : */);
941 }
942 }
943 /* read the table heading that contains parameter names */
944 list = create_slice(mpl);
945 while (mpl->token != T_ASSIGN)
946 { /* there must be symbolic name of parameter */
947 if (!is_symbol(mpl))
948 error(mpl, "parameter name or := missing where expected");
949 /* select the parameter to saturate it with data */
950 par = select_parameter(mpl, mpl->image);
951 /* the parameter must be subscripted */
952 if (par->dim == 0)
953 error(mpl, "%s not a subscripted parameter", mpl->image);
954 /* the set (if specified) and all the parameters in the data
955 block must have identical dimension */
956 if (dim != 0 && par->dim != dim)
957 { xassert(last_name != NULL);
958 error(mpl, "%s has dimension %d while %s has dimension %d",
959 last_name, dim, par->name, par->dim);
960 }
961 /* set default value for the parameter (if specified) */
962 if (altval != NULL)
963 set_default(mpl, par, copy_symbol(mpl, altval));
964 /* append the parameter to the column list */
965 list = expand_slice(mpl, list, (SYMBOL *)par);
966 last_name = par->name, dim = par->dim;
967 get_token(mpl /* <symbol> */);
968 /* skip optional comma */
969 if (mpl->token == T_COMMA) get_token(mpl /* , */);
970 }
971 if (slice_dimen(mpl, list) == 0)
972 error(mpl, "at least one parameter name required");
973 get_token(mpl /* := */);
974 /* skip optional comma */
975 if (mpl->token == T_COMMA) get_token(mpl /* , */);
976 /* read rows that contain tabbing data */
977 while (is_symbol(mpl))
978 { /* read subscript list */
979 tuple = create_tuple(mpl);
980 for (j = 1; j <= dim; j++)
981 { /* read j-th subscript */
982 if (!is_symbol(mpl))
983 { int lack = slice_dimen(mpl, list) + dim - j + 1;
984 xassert(tuple != NULL);
985 xassert(lack > 1);
986 error(mpl, "%d items missing in data group beginning wit"
987 "h %s", lack, format_symbol(mpl, tuple->sym));
988 }
989 /* read and append j-th subscript to the n-tuple */
990 tuple = expand_tuple(mpl, tuple, read_symbol(mpl));
991 /* skip optional comma *between* <symbols> */
992 if (j < dim && mpl->token == T_COMMA)
993 get_token(mpl /* , */);
994 }
995 /* if the set is specified, add to it new n-tuple, which is a
996 copy of the subscript list just read */
997 if (set != NULL)
998 check_then_add(mpl, set->array->head->value.set,
999 copy_tuple(mpl, tuple));
1000 /* skip optional comma between <symbol> and <value> */
1001 if (mpl->token == T_COMMA) get_token(mpl /* , */);
1002 /* read values accordingly to the column list */
1003 for (col = list; col != NULL; col = col->next)
1004 { /* if the token is single point, no value is provided */
1005 if (is_literal(mpl, "."))
1006 { get_token(mpl /* . */);
1007 continue;
1008 }
1009 /* read value and assign it to new parameter member */
1010 if (!is_symbol(mpl))
1011 { int lack = slice_dimen(mpl, col);
1012 xassert(tuple != NULL);
1013 if (lack == 1)
1014 error(mpl, "one item missing in data group beginning "
1015 "with %s", format_symbol(mpl, tuple->sym));
1016 else
1017 error(mpl, "%d items missing in data group beginning "
1018 "with %s", lack, format_symbol(mpl, tuple->sym));
1019 }
1020 read_value(mpl, (PARAMETER *)col->sym, copy_tuple(mpl,
1021 tuple));
1022 /* skip optional comma preceding the next value */
1023 if (col->next != NULL && mpl->token == T_COMMA)
1024 get_token(mpl /* , */);
1025 }
1026 /* delete the original subscript list */
1027 delete_tuple(mpl, tuple);
1028 /* skip optional comma (only if there is next data group) */
1029 if (mpl->token == T_COMMA)
1030 { get_token(mpl /* , */);
1031 if (!is_symbol(mpl)) unget_token(mpl /* , */);
1032 }
1033 }
1034 /* delete the column list (it contains parameters, not symbols,
1035 so nullify it before) */
1036 for (col = list; col != NULL; col = col->next) col->sym = NULL;
1037 delete_slice(mpl, list);
1038 return;
1039 }
1041 /*----------------------------------------------------------------------
1042 -- parameter_data - read parameter data.
1043 --
1044 -- This routine reads parameter data using the syntax:
1045 --
1046 -- <parameter data> ::= param <default value> : <tabbing format> ;
1047 -- <parameter data> ::= param <parameter name> <default value>
1048 -- <assignments> ;
1049 -- <parameter name> ::= <symbolic name>
1050 -- <default value> ::= <empty>
1051 -- <default value> ::= default <symbol>
1052 -- <assignments> ::= <empty>
1053 -- <assignments> ::= <assignments> , :=
1054 -- <assignments> ::= <assignments> , [ <symbol list> ]
1055 -- <assignments> ::= <assignments> , <plain format>
1056 -- <assignemnts> ::= <assignments> , : <tabular format>
1057 -- <assignments> ::= <assignments> , (tr) <tabular format>
1058 -- <assignments> ::= <assignments> , (tr) : <tabular format>
1059 --
1060 -- Commae in <assignments> are optional and may be omitted anywhere. */
1062 void parameter_data(MPL *mpl)
1063 { PARAMETER *par;
1064 SYMBOL *altval = NULL;
1065 SLICE *slice;
1066 int tr = 0;
1067 xassert(is_literal(mpl, "param"));
1068 get_token(mpl /* param */);
1069 /* read optional default value */
1070 if (is_literal(mpl, "default"))
1071 { get_token(mpl /* default */);
1072 if (!is_symbol(mpl))
1073 error(mpl, "default value missing where expected");
1074 altval = read_symbol(mpl);
1075 /* if the default value follows the keyword 'param', the next
1076 token must be only the colon */
1077 if (mpl->token != T_COLON)
1078 error(mpl, "colon missing where expected");
1079 }
1080 /* being used after the keyword 'param' or the optional default
1081 value the colon begins data in the tabbing format */
1082 if (mpl->token == T_COLON)
1083 { get_token(mpl /* : */);
1084 /* skip optional comma */
1085 if (mpl->token == T_COMMA) get_token(mpl /* , */);
1086 /* read parameter data in the tabbing format */
1087 tabbing_format(mpl, altval);
1088 /* on reading data in the tabbing format the default value is
1089 always copied, so delete the original symbol */
1090 if (altval != NULL) delete_symbol(mpl, altval);
1091 /* the next token must be only semicolon */
1092 if (mpl->token != T_SEMICOLON)
1093 error(mpl, "symbol, number, or semicolon missing where expe"
1094 "cted");
1095 get_token(mpl /* ; */);
1096 goto done;
1097 }
1098 /* in other cases there must be symbolic name of parameter, which
1099 follows the keyword 'param' */
1100 if (!is_symbol(mpl))
1101 error(mpl, "parameter name missing where expected");
1102 /* select the parameter to saturate it with data */
1103 par = select_parameter(mpl, mpl->image);
1104 get_token(mpl /* <symbol> */);
1105 /* read optional default value */
1106 if (is_literal(mpl, "default"))
1107 { get_token(mpl /* default */);
1108 if (!is_symbol(mpl))
1109 error(mpl, "default value missing where expected");
1110 altval = read_symbol(mpl);
1111 /* set default value for the parameter */
1112 set_default(mpl, par, altval);
1113 }
1114 /* create initial fake slice of all asterisks */
1115 slice = fake_slice(mpl, par->dim);
1116 /* read zero or more data assignments */
1117 for (;;)
1118 { /* skip optional comma */
1119 if (mpl->token == T_COMMA) get_token(mpl /* , */);
1120 /* process current assignment */
1121 if (mpl->token == T_ASSIGN)
1122 { /* assignment ligature is non-significant element */
1123 get_token(mpl /* := */);
1124 }
1125 else if (mpl->token == T_LBRACKET)
1126 { /* left bracket begins new slice; delete the current slice
1127 and read new one */
1128 delete_slice(mpl, slice);
1129 slice = read_slice(mpl, par->name, par->dim);
1130 /* each new slice resets the "transpose" indicator */
1131 tr = 0;
1132 }
1133 else if (is_symbol(mpl))
1134 { /* number or symbol begins data in the plain format */
1135 plain_format(mpl, par, slice);
1136 }
1137 else if (mpl->token == T_COLON)
1138 { /* colon begins data in the tabular format */
1139 if (par->dim == 0)
1140 err1: error(mpl, "%s not a subscripted parameter",
1141 par->name);
1142 if (slice_arity(mpl, slice) != 2)
1143 err2: error(mpl, "slice currently used must specify 2 asterisk"
1144 "s, not %d", slice_arity(mpl, slice));
1145 get_token(mpl /* : */);
1146 /* read parameter data in the tabular format */
1147 tabular_format(mpl, par, slice, tr);
1148 }
1149 else if (mpl->token == T_LEFT)
1150 { /* left parenthesis begins the "transpose" indicator, which
1151 is followed by data in the tabular format */
1152 get_token(mpl /* ( */);
1153 if (!is_literal(mpl, "tr"))
1154 err3: error(mpl, "transpose indicator (tr) incomplete");
1155 if (par->dim == 0) goto err1;
1156 if (slice_arity(mpl, slice) != 2) goto err2;
1157 get_token(mpl /* tr */);
1158 if (mpl->token != T_RIGHT) goto err3;
1159 get_token(mpl /* ) */);
1160 /* in this case the colon is optional */
1161 if (mpl->token == T_COLON) get_token(mpl /* : */);
1162 /* set the "transpose" indicator */
1163 tr = 1;
1164 /* read parameter data in the tabular format */
1165 tabular_format(mpl, par, slice, tr);
1166 }
1167 else if (mpl->token == T_SEMICOLON)
1168 { /* semicolon terminates the data block */
1169 get_token(mpl /* ; */);
1170 break;
1171 }
1172 else
1173 error(mpl, "syntax error in parameter data block");
1174 }
1175 /* delete the current slice */
1176 delete_slice(mpl, slice);
1177 done: return;
1178 }
1180 /*----------------------------------------------------------------------
1181 -- data_section - read data section.
1182 --
1183 -- This routine reads data section using the syntax:
1184 --
1185 -- <data section> ::= <empty>
1186 -- <data section> ::= <data section> <data block> ;
1187 -- <data block> ::= <set data>
1188 -- <data block> ::= <parameter data>
1189 --
1190 -- Reading data section is terminated by either the keyword 'end' or
1191 -- the end of file. */
1193 void data_section(MPL *mpl)
1194 { while (!(mpl->token == T_EOF || is_literal(mpl, "end")))
1195 { if (is_literal(mpl, "set"))
1196 set_data(mpl);
1197 else if (is_literal(mpl, "param"))
1198 parameter_data(mpl);
1199 else
1200 error(mpl, "syntax error in data section");
1201 }
1202 return;
1203 }
1205 /* eof */