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