alpar@1: /* glpmpl02.c */ alpar@1: alpar@1: /*********************************************************************** alpar@1: * This code is part of GLPK (GNU Linear Programming Kit). alpar@1: * alpar@1: * Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, alpar@1: * 2009, 2010 Andrew Makhorin, Department for Applied Informatics, alpar@1: * Moscow Aviation Institute, Moscow, Russia. All rights reserved. alpar@1: * E-mail: . alpar@1: * alpar@1: * GLPK is free software: you can redistribute it and/or modify it alpar@1: * under the terms of the GNU General Public License as published by alpar@1: * the Free Software Foundation, either version 3 of the License, or alpar@1: * (at your option) any later version. alpar@1: * alpar@1: * GLPK is distributed in the hope that it will be useful, but WITHOUT alpar@1: * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY alpar@1: * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public alpar@1: * License for more details. alpar@1: * alpar@1: * You should have received a copy of the GNU General Public License alpar@1: * along with GLPK. If not, see . alpar@1: ***********************************************************************/ alpar@1: alpar@1: #define _GLPSTD_STDIO alpar@1: #include "glpenv.h" alpar@1: #include "glpmpl.h" alpar@1: alpar@1: /**********************************************************************/ alpar@1: /* * * PROCESSING DATA SECTION * * */ alpar@1: /**********************************************************************/ alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- create_slice - create slice. alpar@1: -- alpar@1: -- This routine creates a slice, which initially has no components. */ alpar@1: alpar@1: SLICE *create_slice(MPL *mpl) alpar@1: { SLICE *slice; alpar@1: xassert(mpl == mpl); alpar@1: slice = NULL; alpar@1: return slice; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- expand_slice - append new component to slice. alpar@1: -- alpar@1: -- This routine expands slice appending to it either a given symbol or alpar@1: -- null component, which becomes the last component of the slice. */ alpar@1: alpar@1: SLICE *expand_slice alpar@1: ( MPL *mpl, alpar@1: SLICE *slice, /* destroyed */ alpar@1: SYMBOL *sym /* destroyed */ alpar@1: ) alpar@1: { SLICE *tail, *temp; alpar@1: /* create a new component */ alpar@1: tail = dmp_get_atom(mpl->tuples, sizeof(SLICE)); alpar@1: tail->sym = sym; alpar@1: tail->next = NULL; alpar@1: /* and append it to the component list */ alpar@1: if (slice == NULL) alpar@1: slice = tail; alpar@1: else alpar@1: { for (temp = slice; temp->next != NULL; temp = temp->next); alpar@1: temp->next = tail; alpar@1: } alpar@1: return slice; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- slice_dimen - determine dimension of slice. alpar@1: -- alpar@1: -- This routine returns dimension of slice, which is number of all its alpar@1: -- components including null ones. */ alpar@1: alpar@1: int slice_dimen alpar@1: ( MPL *mpl, alpar@1: SLICE *slice /* not changed */ alpar@1: ) alpar@1: { SLICE *temp; alpar@1: int dim; alpar@1: xassert(mpl == mpl); alpar@1: dim = 0; alpar@1: for (temp = slice; temp != NULL; temp = temp->next) dim++; alpar@1: return dim; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- slice_arity - determine arity of slice. alpar@1: -- alpar@1: -- This routine returns arity of slice, i.e. number of null components alpar@1: -- (indicated by asterisks) in the slice. */ alpar@1: alpar@1: int slice_arity alpar@1: ( MPL *mpl, alpar@1: SLICE *slice /* not changed */ alpar@1: ) alpar@1: { SLICE *temp; alpar@1: int arity; alpar@1: xassert(mpl == mpl); alpar@1: arity = 0; alpar@1: for (temp = slice; temp != NULL; temp = temp->next) alpar@1: if (temp->sym == NULL) arity++; alpar@1: return arity; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- fake_slice - create fake slice of all asterisks. alpar@1: -- alpar@1: -- This routine creates a fake slice of given dimension, which contains alpar@1: -- asterisks in all components. Zero dimension is allowed. */ alpar@1: alpar@1: SLICE *fake_slice(MPL *mpl, int dim) alpar@1: { SLICE *slice; alpar@1: slice = create_slice(mpl); alpar@1: while (dim-- > 0) slice = expand_slice(mpl, slice, NULL); alpar@1: return slice; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- delete_slice - delete slice. alpar@1: -- alpar@1: -- This routine deletes specified slice. */ alpar@1: alpar@1: void delete_slice alpar@1: ( MPL *mpl, alpar@1: SLICE *slice /* destroyed */ alpar@1: ) alpar@1: { SLICE *temp; alpar@1: while (slice != NULL) alpar@1: { temp = slice; alpar@1: slice = temp->next; alpar@1: if (temp->sym != NULL) delete_symbol(mpl, temp->sym); alpar@1: xassert(sizeof(SLICE) == sizeof(TUPLE)); alpar@1: dmp_free_atom(mpl->tuples, temp, sizeof(TUPLE)); alpar@1: } alpar@1: return; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- is_number - check if current token is number. alpar@1: -- alpar@1: -- If the current token is a number, this routine returns non-zero. alpar@1: -- Otherwise zero is returned. */ alpar@1: alpar@1: int is_number(MPL *mpl) alpar@1: { return alpar@1: mpl->token == T_NUMBER; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- is_symbol - check if current token is symbol. alpar@1: -- alpar@1: -- If the current token is suitable to be a symbol, the routine returns alpar@1: -- non-zero. Otherwise zero is returned. */ alpar@1: alpar@1: int is_symbol(MPL *mpl) alpar@1: { return alpar@1: mpl->token == T_NUMBER || alpar@1: mpl->token == T_SYMBOL || alpar@1: mpl->token == T_STRING; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- is_literal - check if current token is given symbolic literal. alpar@1: -- alpar@1: -- If the current token is given symbolic literal, this routine returns alpar@1: -- non-zero. Otherwise zero is returned. alpar@1: -- alpar@1: -- This routine is used on processing the data section in the same way alpar@1: -- as the routine is_keyword on processing the model section. */ alpar@1: alpar@1: int is_literal(MPL *mpl, char *literal) alpar@1: { return alpar@1: is_symbol(mpl) && strcmp(mpl->image, literal) == 0; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- read_number - read number. alpar@1: -- alpar@1: -- This routine reads the current token, which must be a number, and alpar@1: -- returns its numeric value. */ alpar@1: alpar@1: double read_number(MPL *mpl) alpar@1: { double num; alpar@1: xassert(is_number(mpl)); alpar@1: num = mpl->value; alpar@1: get_token(mpl /* */); alpar@1: return num; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- read_symbol - read symbol. alpar@1: -- alpar@1: -- This routine reads the current token, which must be a symbol, and alpar@1: -- returns its symbolic value. */ alpar@1: alpar@1: SYMBOL *read_symbol(MPL *mpl) alpar@1: { SYMBOL *sym; alpar@1: xassert(is_symbol(mpl)); alpar@1: if (is_number(mpl)) alpar@1: sym = create_symbol_num(mpl, mpl->value); alpar@1: else alpar@1: sym = create_symbol_str(mpl, create_string(mpl, mpl->image)); alpar@1: get_token(mpl /* */); alpar@1: return sym; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- read_slice - read slice. alpar@1: -- alpar@1: -- This routine reads slice using the syntax: alpar@1: -- alpar@1: -- ::= [ ] alpar@1: -- ::= ( ) alpar@1: -- ::= alpar@1: -- ::= , alpar@1: -- ::= alpar@1: -- ::= * alpar@1: -- alpar@1: -- The bracketed form of slice is used for members of multi-dimensional alpar@1: -- objects while the parenthesized form is used for elemental sets. */ alpar@1: alpar@1: SLICE *read_slice alpar@1: ( MPL *mpl, alpar@1: char *name, /* not changed */ alpar@1: int dim alpar@1: ) alpar@1: { SLICE *slice; alpar@1: int close; alpar@1: xassert(name != NULL); alpar@1: switch (mpl->token) alpar@1: { case T_LBRACKET: alpar@1: close = T_RBRACKET; alpar@1: break; alpar@1: case T_LEFT: alpar@1: xassert(dim > 0); alpar@1: close = T_RIGHT; alpar@1: break; alpar@1: default: alpar@1: xassert(mpl != mpl); alpar@1: } alpar@1: if (dim == 0) alpar@1: error(mpl, "%s cannot be subscripted", name); alpar@1: get_token(mpl /* ( | [ */); alpar@1: /* read slice components */ alpar@1: slice = create_slice(mpl); alpar@1: for (;;) alpar@1: { /* the current token must be a symbol or asterisk */ alpar@1: if (is_symbol(mpl)) alpar@1: slice = expand_slice(mpl, slice, read_symbol(mpl)); alpar@1: else if (mpl->token == T_ASTERISK) alpar@1: { slice = expand_slice(mpl, slice, NULL); alpar@1: get_token(mpl /* * */); alpar@1: } alpar@1: else alpar@1: error(mpl, "number, symbol, or asterisk missing where expec" alpar@1: "ted"); alpar@1: /* check a token that follows the symbol */ alpar@1: if (mpl->token == T_COMMA) alpar@1: get_token(mpl /* , */); alpar@1: else if (mpl->token == close) alpar@1: break; alpar@1: else alpar@1: error(mpl, "syntax error in slice"); alpar@1: } alpar@1: /* number of slice components must be the same as the appropriate alpar@1: dimension */ alpar@1: if (slice_dimen(mpl, slice) != dim) alpar@1: { switch (close) alpar@1: { case T_RBRACKET: alpar@1: error(mpl, "%s must have %d subscript%s, not %d", name, alpar@1: dim, dim == 1 ? "" : "s", slice_dimen(mpl, slice)); alpar@1: break; alpar@1: case T_RIGHT: alpar@1: error(mpl, "%s has dimension %d, not %d", name, dim, alpar@1: slice_dimen(mpl, slice)); alpar@1: break; alpar@1: default: alpar@1: xassert(close != close); alpar@1: } alpar@1: } alpar@1: get_token(mpl /* ) | ] */); alpar@1: return slice; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- select_set - select set to saturate it with elemental sets. alpar@1: -- alpar@1: -- This routine selects set to saturate it with elemental sets provided alpar@1: -- in the data section. */ alpar@1: alpar@1: SET *select_set alpar@1: ( MPL *mpl, alpar@1: char *name /* not changed */ alpar@1: ) alpar@1: { SET *set; alpar@1: AVLNODE *node; alpar@1: xassert(name != NULL); alpar@1: node = avl_find_node(mpl->tree, name); alpar@1: if (node == NULL || avl_get_node_type(node) != A_SET) alpar@1: error(mpl, "%s not a set", name); alpar@1: set = (SET *)avl_get_node_link(node); alpar@1: if (set->assign != NULL || set->gadget != NULL) alpar@1: error(mpl, "%s needs no data", name); alpar@1: set->data = 1; alpar@1: return set; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- simple_format - read set data block in simple format. alpar@1: -- alpar@1: -- This routine reads set data block using the syntax: alpar@1: -- alpar@1: -- ::= , , ... , alpar@1: -- alpar@1: -- where are used to construct a complete n-tuple, which is alpar@1: -- included in elemental set assigned to the set member. Commae between alpar@1: -- symbols are optional and may be omitted anywhere. alpar@1: -- alpar@1: -- Number of components in the slice must be the same as dimension of alpar@1: -- n-tuples in elemental sets assigned to the set members. To construct alpar@1: -- complete n-tuple the routine replaces null positions in the slice by alpar@1: -- corresponding . alpar@1: -- alpar@1: -- If the slice contains at least one null position, the current token alpar@1: -- must be symbol. Otherwise, the routine reads no symbols to construct alpar@1: -- the n-tuple, so the current token is not checked. */ alpar@1: alpar@1: void simple_format alpar@1: ( MPL *mpl, alpar@1: SET *set, /* not changed */ alpar@1: MEMBER *memb, /* modified */ alpar@1: SLICE *slice /* not changed */ alpar@1: ) alpar@1: { TUPLE *tuple; alpar@1: SLICE *temp; alpar@1: SYMBOL *sym, *with = NULL; alpar@1: xassert(set != NULL); alpar@1: xassert(memb != NULL); alpar@1: xassert(slice != NULL); alpar@1: xassert(set->dimen == slice_dimen(mpl, slice)); alpar@1: xassert(memb->value.set->dim == set->dimen); alpar@1: if (slice_arity(mpl, slice) > 0) xassert(is_symbol(mpl)); alpar@1: /* read symbols and construct complete n-tuple */ alpar@1: tuple = create_tuple(mpl); alpar@1: for (temp = slice; temp != NULL; temp = temp->next) alpar@1: { if (temp->sym == NULL) alpar@1: { /* substitution is needed; read symbol */ alpar@1: if (!is_symbol(mpl)) alpar@1: { int lack = slice_arity(mpl, temp); alpar@1: /* with cannot be null due to assertion above */ alpar@1: xassert(with != NULL); alpar@1: if (lack == 1) alpar@1: error(mpl, "one item missing in data group beginning " alpar@1: "with %s", format_symbol(mpl, with)); alpar@1: else alpar@1: error(mpl, "%d items missing in data group beginning " alpar@1: "with %s", lack, format_symbol(mpl, with)); alpar@1: } alpar@1: sym = read_symbol(mpl); alpar@1: if (with == NULL) with = sym; alpar@1: } alpar@1: else alpar@1: { /* copy symbol from the slice */ alpar@1: sym = copy_symbol(mpl, temp->sym); alpar@1: } alpar@1: /* append the symbol to the n-tuple */ alpar@1: tuple = expand_tuple(mpl, tuple, sym); alpar@1: /* skip optional comma *between* */ alpar@1: if (temp->next != NULL && mpl->token == T_COMMA) alpar@1: get_token(mpl /* , */); alpar@1: } alpar@1: /* add constructed n-tuple to elemental set */ alpar@1: check_then_add(mpl, memb->value.set, tuple); alpar@1: return; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- matrix_format - read set data block in matrix format. alpar@1: -- alpar@1: -- This routine reads set data block using the syntax: alpar@1: -- alpar@1: -- ::= ... := alpar@1: -- +/- +/- ... +/- alpar@1: -- +/- +/- ... +/- alpar@1: -- . . . . . . . . . . . alpar@1: -- +/- +/- ... +/- alpar@1: -- alpar@1: -- where are symbols that denote rows of the matrix, alpar@1: -- are symbols that denote columns of the matrix, "+" and "-" indicate alpar@1: -- whether corresponding n-tuple needs to be included in the elemental alpar@1: -- set or not, respectively. alpar@1: -- alpar@1: -- Number of the slice components must be the same as dimension of the alpar@1: -- elemental set. The slice must have two null positions. To construct alpar@1: -- complete n-tuple for particular element of the matrix the routine alpar@1: -- replaces first null position of the slice by the corresponding alpar@1: -- (or , if the flag tr is on) and second null position by the alpar@1: -- corresponding (or by , if the flag tr is on). */ alpar@1: alpar@1: void matrix_format alpar@1: ( MPL *mpl, alpar@1: SET *set, /* not changed */ alpar@1: MEMBER *memb, /* modified */ alpar@1: SLICE *slice, /* not changed */ alpar@1: int tr alpar@1: ) alpar@1: { SLICE *list, *col, *temp; alpar@1: TUPLE *tuple; alpar@1: SYMBOL *row; alpar@1: xassert(set != NULL); alpar@1: xassert(memb != NULL); alpar@1: xassert(slice != NULL); alpar@1: xassert(set->dimen == slice_dimen(mpl, slice)); alpar@1: xassert(memb->value.set->dim == set->dimen); alpar@1: xassert(slice_arity(mpl, slice) == 2); alpar@1: /* read the matrix heading that contains column symbols (there alpar@1: may be no columns at all) */ alpar@1: list = create_slice(mpl); alpar@1: while (mpl->token != T_ASSIGN) alpar@1: { /* read column symbol and append it to the column list */ alpar@1: if (!is_symbol(mpl)) alpar@1: error(mpl, "number, symbol, or := missing where expected"); alpar@1: list = expand_slice(mpl, list, read_symbol(mpl)); alpar@1: } alpar@1: get_token(mpl /* := */); alpar@1: /* read zero or more rows that contain matrix data */ alpar@1: while (is_symbol(mpl)) alpar@1: { /* read row symbol (if the matrix has no columns, row symbols alpar@1: are just ignored) */ alpar@1: row = read_symbol(mpl); alpar@1: /* read the matrix row accordingly to the column list */ alpar@1: for (col = list; col != NULL; col = col->next) alpar@1: { int which = 0; alpar@1: /* check indicator */ alpar@1: if (is_literal(mpl, "+")) alpar@1: ; alpar@1: else if (is_literal(mpl, "-")) alpar@1: { get_token(mpl /* - */); alpar@1: continue; alpar@1: } alpar@1: else alpar@1: { int lack = slice_dimen(mpl, col); alpar@1: if (lack == 1) alpar@1: error(mpl, "one item missing in data group beginning " alpar@1: "with %s", format_symbol(mpl, row)); alpar@1: else alpar@1: error(mpl, "%d items missing in data group beginning " alpar@1: "with %s", lack, format_symbol(mpl, row)); alpar@1: } alpar@1: /* construct complete n-tuple */ alpar@1: tuple = create_tuple(mpl); alpar@1: for (temp = slice; temp != NULL; temp = temp->next) alpar@1: { if (temp->sym == NULL) alpar@1: { /* substitution is needed */ alpar@1: switch (++which) alpar@1: { case 1: alpar@1: /* substitute in the first null position */ alpar@1: tuple = expand_tuple(mpl, tuple, alpar@1: copy_symbol(mpl, tr ? col->sym : row)); alpar@1: break; alpar@1: case 2: alpar@1: /* substitute in the second null position */ alpar@1: tuple = expand_tuple(mpl, tuple, alpar@1: copy_symbol(mpl, tr ? row : col->sym)); alpar@1: break; alpar@1: default: alpar@1: xassert(which != which); alpar@1: } alpar@1: } alpar@1: else alpar@1: { /* copy symbol from the slice */ alpar@1: tuple = expand_tuple(mpl, tuple, copy_symbol(mpl, alpar@1: temp->sym)); alpar@1: } alpar@1: } alpar@1: xassert(which == 2); alpar@1: /* add constructed n-tuple to elemental set */ alpar@1: check_then_add(mpl, memb->value.set, tuple); alpar@1: get_token(mpl /* + */); alpar@1: } alpar@1: /* delete the row symbol */ alpar@1: delete_symbol(mpl, row); alpar@1: } alpar@1: /* delete the column list */ alpar@1: delete_slice(mpl, list); alpar@1: return; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- set_data - read set data. alpar@1: -- alpar@1: -- This routine reads set data using the syntax: alpar@1: -- alpar@1: -- ::= set ; alpar@1: -- ::= set [ ] ; alpar@1: -- ::= alpar@1: -- ::= alpar@1: -- ::= , := alpar@1: -- ::= , ( ) alpar@1: -- ::= , alpar@1: -- ::= , : alpar@1: -- ::= , (tr) alpar@1: -- ::= , (tr) : alpar@1: -- alpar@1: -- Commae in are optional and may be omitted anywhere. */ alpar@1: alpar@1: void set_data(MPL *mpl) alpar@1: { SET *set; alpar@1: TUPLE *tuple; alpar@1: MEMBER *memb; alpar@1: SLICE *slice; alpar@1: int tr = 0; alpar@1: xassert(is_literal(mpl, "set")); alpar@1: get_token(mpl /* set */); alpar@1: /* symbolic name of set must follows the keyword 'set' */ alpar@1: if (!is_symbol(mpl)) alpar@1: error(mpl, "set name missing where expected"); alpar@1: /* select the set to saturate it with data */ alpar@1: set = select_set(mpl, mpl->image); alpar@1: get_token(mpl /* */); alpar@1: /* read optional subscript list, which identifies member of the alpar@1: set to be read */ alpar@1: tuple = create_tuple(mpl); alpar@1: if (mpl->token == T_LBRACKET) alpar@1: { /* subscript list is specified */ alpar@1: if (set->dim == 0) alpar@1: error(mpl, "%s cannot be subscripted", set->name); alpar@1: get_token(mpl /* [ */); alpar@1: /* read symbols and construct subscript list */ alpar@1: for (;;) alpar@1: { if (!is_symbol(mpl)) alpar@1: error(mpl, "number or symbol missing where expected"); alpar@1: tuple = expand_tuple(mpl, tuple, read_symbol(mpl)); alpar@1: if (mpl->token == T_COMMA) alpar@1: get_token(mpl /* , */); alpar@1: else if (mpl->token == T_RBRACKET) alpar@1: break; alpar@1: else alpar@1: error(mpl, "syntax error in subscript list"); alpar@1: } alpar@1: if (set->dim != tuple_dimen(mpl, tuple)) alpar@1: error(mpl, "%s must have %d subscript%s rather than %d", alpar@1: set->name, set->dim, set->dim == 1 ? "" : "s", alpar@1: tuple_dimen(mpl, tuple)); alpar@1: get_token(mpl /* ] */); alpar@1: } alpar@1: else alpar@1: { /* subscript list is not specified */ alpar@1: if (set->dim != 0) alpar@1: error(mpl, "%s must be subscripted", set->name); alpar@1: } alpar@1: /* there must be no member with the same subscript list */ alpar@1: if (find_member(mpl, set->array, tuple) != NULL) alpar@1: error(mpl, "%s%s already defined", alpar@1: set->name, format_tuple(mpl, '[', tuple)); alpar@1: /* add new member to the set and assign it empty elemental set */ alpar@1: memb = add_member(mpl, set->array, tuple); alpar@1: memb->value.set = create_elemset(mpl, set->dimen); alpar@1: /* create an initial fake slice of all asterisks */ alpar@1: slice = fake_slice(mpl, set->dimen); alpar@1: /* read zero or more data assignments */ alpar@1: for (;;) alpar@1: { /* skip optional comma */ alpar@1: if (mpl->token == T_COMMA) get_token(mpl /* , */); alpar@1: /* process assignment element */ alpar@1: if (mpl->token == T_ASSIGN) alpar@1: { /* assignment ligature is non-significant element */ alpar@1: get_token(mpl /* := */); alpar@1: } alpar@1: else if (mpl->token == T_LEFT) alpar@1: { /* left parenthesis begins either new slice or "transpose" alpar@1: indicator */ alpar@1: int is_tr; alpar@1: get_token(mpl /* ( */); alpar@1: is_tr = is_literal(mpl, "tr"); alpar@1: unget_token(mpl /* ( */); alpar@1: if (is_tr) goto left; alpar@1: /* delete the current slice and read new one */ alpar@1: delete_slice(mpl, slice); alpar@1: slice = read_slice(mpl, set->name, set->dimen); alpar@1: /* each new slice resets the "transpose" indicator */ alpar@1: tr = 0; alpar@1: /* if the new slice is 0-ary, formally there is one 0-tuple alpar@1: (in the simple format) that follows it */ alpar@1: if (slice_arity(mpl, slice) == 0) alpar@1: simple_format(mpl, set, memb, slice); alpar@1: } alpar@1: else if (is_symbol(mpl)) alpar@1: { /* number or symbol begins data in the simple format */ alpar@1: simple_format(mpl, set, memb, slice); alpar@1: } alpar@1: else if (mpl->token == T_COLON) alpar@1: { /* colon begins data in the matrix format */ alpar@1: if (slice_arity(mpl, slice) != 2) alpar@1: err1: error(mpl, "slice currently used must specify 2 asterisk" alpar@1: "s, not %d", slice_arity(mpl, slice)); alpar@1: get_token(mpl /* : */); alpar@1: /* read elemental set data in the matrix format */ alpar@1: matrix_format(mpl, set, memb, slice, tr); alpar@1: } alpar@1: else if (mpl->token == T_LEFT) alpar@1: left: { /* left parenthesis begins the "transpose" indicator, which alpar@1: is followed by data in the matrix format */ alpar@1: get_token(mpl /* ( */); alpar@1: if (!is_literal(mpl, "tr")) alpar@1: err2: error(mpl, "transpose indicator (tr) incomplete"); alpar@1: if (slice_arity(mpl, slice) != 2) goto err1; alpar@1: get_token(mpl /* tr */); alpar@1: if (mpl->token != T_RIGHT) goto err2; alpar@1: get_token(mpl /* ) */); alpar@1: /* in this case the colon is optional */ alpar@1: if (mpl->token == T_COLON) get_token(mpl /* : */); alpar@1: /* set the "transpose" indicator */ alpar@1: tr = 1; alpar@1: /* read elemental set data in the matrix format */ alpar@1: matrix_format(mpl, set, memb, slice, tr); alpar@1: } alpar@1: else if (mpl->token == T_SEMICOLON) alpar@1: { /* semicolon terminates the data block */ alpar@1: get_token(mpl /* ; */); alpar@1: break; alpar@1: } alpar@1: else alpar@1: error(mpl, "syntax error in set data block"); alpar@1: } alpar@1: /* delete the current slice */ alpar@1: delete_slice(mpl, slice); alpar@1: return; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- select_parameter - select parameter to saturate it with data. alpar@1: -- alpar@1: -- This routine selects parameter to saturate it with data provided in alpar@1: -- the data section. */ alpar@1: alpar@1: PARAMETER *select_parameter alpar@1: ( MPL *mpl, alpar@1: char *name /* not changed */ alpar@1: ) alpar@1: { PARAMETER *par; alpar@1: AVLNODE *node; alpar@1: xassert(name != NULL); alpar@1: node = avl_find_node(mpl->tree, name); alpar@1: if (node == NULL || avl_get_node_type(node) != A_PARAMETER) alpar@1: error(mpl, "%s not a parameter", name); alpar@1: par = (PARAMETER *)avl_get_node_link(node); alpar@1: if (par->assign != NULL) alpar@1: error(mpl, "%s needs no data", name); alpar@1: if (par->data) alpar@1: error(mpl, "%s already provided with data", name); alpar@1: par->data = 1; alpar@1: return par; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- set_default - set default parameter value. alpar@1: -- alpar@1: -- This routine sets default value for specified parameter. */ alpar@1: alpar@1: void set_default alpar@1: ( MPL *mpl, alpar@1: PARAMETER *par, /* not changed */ alpar@1: SYMBOL *altval /* destroyed */ alpar@1: ) alpar@1: { xassert(par != NULL); alpar@1: xassert(altval != NULL); alpar@1: if (par->option != NULL) alpar@1: error(mpl, "default value for %s already specified in model se" alpar@1: "ction", par->name); alpar@1: xassert(par->defval == NULL); alpar@1: par->defval = altval; alpar@1: return; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- read_value - read value and assign it to parameter member. alpar@1: -- alpar@1: -- This routine reads numeric or symbolic value from the input stream alpar@1: -- and assigns to new parameter member specified by its n-tuple, which alpar@1: -- (the member) is created and added to the parameter array. */ alpar@1: alpar@1: MEMBER *read_value alpar@1: ( MPL *mpl, alpar@1: PARAMETER *par, /* not changed */ alpar@1: TUPLE *tuple /* destroyed */ alpar@1: ) alpar@1: { MEMBER *memb; alpar@1: xassert(par != NULL); alpar@1: xassert(is_symbol(mpl)); alpar@1: /* there must be no member with the same n-tuple */ alpar@1: if (find_member(mpl, par->array, tuple) != NULL) alpar@1: error(mpl, "%s%s already defined", alpar@1: par->name, format_tuple(mpl, '[', tuple)); alpar@1: /* create new parameter member with given n-tuple */ alpar@1: memb = add_member(mpl, par->array, tuple); alpar@1: /* read value and assigns it to the new parameter member */ alpar@1: switch (par->type) alpar@1: { case A_NUMERIC: alpar@1: case A_INTEGER: alpar@1: case A_BINARY: alpar@1: if (!is_number(mpl)) alpar@1: error(mpl, "%s requires numeric data", par->name); alpar@1: memb->value.num = read_number(mpl); alpar@1: break; alpar@1: case A_SYMBOLIC: alpar@1: memb->value.sym = read_symbol(mpl); alpar@1: break; alpar@1: default: alpar@1: xassert(par != par); alpar@1: } alpar@1: return memb; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- plain_format - read parameter data block in plain format. alpar@1: -- alpar@1: -- This routine reads parameter data block using the syntax: alpar@1: -- alpar@1: -- ::= , , ... , , alpar@1: -- alpar@1: -- where are used to determine a complete subscript list for alpar@1: -- parameter member, is a numeric or symbolic value assigned to alpar@1: -- the parameter member. Commae between data items are optional and may alpar@1: -- be omitted anywhere. alpar@1: -- alpar@1: -- Number of components in the slice must be the same as dimension of alpar@1: -- the parameter. To construct the complete subscript list the routine alpar@1: -- replaces null positions in the slice by corresponding . */ alpar@1: alpar@1: void plain_format alpar@1: ( MPL *mpl, alpar@1: PARAMETER *par, /* not changed */ alpar@1: SLICE *slice /* not changed */ alpar@1: ) alpar@1: { TUPLE *tuple; alpar@1: SLICE *temp; alpar@1: SYMBOL *sym, *with = NULL; alpar@1: xassert(par != NULL); alpar@1: xassert(par->dim == slice_dimen(mpl, slice)); alpar@1: xassert(is_symbol(mpl)); alpar@1: /* read symbols and construct complete subscript list */ alpar@1: tuple = create_tuple(mpl); alpar@1: for (temp = slice; temp != NULL; temp = temp->next) alpar@1: { if (temp->sym == NULL) alpar@1: { /* substitution is needed; read symbol */ alpar@1: if (!is_symbol(mpl)) alpar@1: { int lack = slice_arity(mpl, temp) + 1; alpar@1: xassert(with != NULL); alpar@1: xassert(lack > 1); alpar@1: error(mpl, "%d items missing in data group beginning wit" alpar@1: "h %s", lack, format_symbol(mpl, with)); alpar@1: } alpar@1: sym = read_symbol(mpl); alpar@1: if (with == NULL) with = sym; alpar@1: } alpar@1: else alpar@1: { /* copy symbol from the slice */ alpar@1: sym = copy_symbol(mpl, temp->sym); alpar@1: } alpar@1: /* append the symbol to the subscript list */ alpar@1: tuple = expand_tuple(mpl, tuple, sym); alpar@1: /* skip optional comma */ alpar@1: if (mpl->token == T_COMMA) get_token(mpl /* , */); alpar@1: } alpar@1: /* read value and assign it to new parameter member */ alpar@1: if (!is_symbol(mpl)) alpar@1: { xassert(with != NULL); alpar@1: error(mpl, "one item missing in data group beginning with %s", alpar@1: format_symbol(mpl, with)); alpar@1: } alpar@1: read_value(mpl, par, tuple); alpar@1: return; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- tabular_format - read parameter data block in tabular format. alpar@1: -- alpar@1: -- This routine reads parameter data block using the syntax: alpar@1: -- alpar@1: -- ::= ... := alpar@1: -- ... alpar@1: -- ... alpar@1: -- . . . . . . . . . . . alpar@1: -- ... alpar@1: -- alpar@1: -- where are symbols that denote rows of the table, alpar@1: -- are symbols that denote columns of the table, are numeric alpar@1: -- or symbolic values assigned to the corresponding parameter members. alpar@1: -- If is specified as single point, no value is provided. alpar@1: -- alpar@1: -- Number of components in the slice must be the same as dimension of alpar@1: -- the parameter. The slice must have two null positions. To construct alpar@1: -- complete subscript list for particular the routine replaces alpar@1: -- the first null position of the slice by the corresponding (or alpar@1: -- , if the flag tr is on) and the second null position by the alpar@1: -- corresponding (or by , if the flag tr is on). */ alpar@1: alpar@1: void tabular_format alpar@1: ( MPL *mpl, alpar@1: PARAMETER *par, /* not changed */ alpar@1: SLICE *slice, /* not changed */ alpar@1: int tr alpar@1: ) alpar@1: { SLICE *list, *col, *temp; alpar@1: TUPLE *tuple; alpar@1: SYMBOL *row; alpar@1: xassert(par != NULL); alpar@1: xassert(par->dim == slice_dimen(mpl, slice)); alpar@1: xassert(slice_arity(mpl, slice) == 2); alpar@1: /* read the table heading that contains column symbols (the table alpar@1: may have no columns) */ alpar@1: list = create_slice(mpl); alpar@1: while (mpl->token != T_ASSIGN) alpar@1: { /* read column symbol and append it to the column list */ alpar@1: if (!is_symbol(mpl)) alpar@1: error(mpl, "number, symbol, or := missing where expected"); alpar@1: list = expand_slice(mpl, list, read_symbol(mpl)); alpar@1: } alpar@1: get_token(mpl /* := */); alpar@1: /* read zero or more rows that contain tabular data */ alpar@1: while (is_symbol(mpl)) alpar@1: { /* read row symbol (if the table has no columns, these symbols alpar@1: are just ignored) */ alpar@1: row = read_symbol(mpl); alpar@1: /* read values accordingly to the column list */ alpar@1: for (col = list; col != NULL; col = col->next) alpar@1: { int which = 0; alpar@1: /* if the token is single point, no value is provided */ alpar@1: if (is_literal(mpl, ".")) alpar@1: { get_token(mpl /* . */); alpar@1: continue; alpar@1: } alpar@1: /* construct complete subscript list */ alpar@1: tuple = create_tuple(mpl); alpar@1: for (temp = slice; temp != NULL; temp = temp->next) alpar@1: { if (temp->sym == NULL) alpar@1: { /* substitution is needed */ alpar@1: switch (++which) alpar@1: { case 1: alpar@1: /* substitute in the first null position */ alpar@1: tuple = expand_tuple(mpl, tuple, alpar@1: copy_symbol(mpl, tr ? col->sym : row)); alpar@1: break; alpar@1: case 2: alpar@1: /* substitute in the second null position */ alpar@1: tuple = expand_tuple(mpl, tuple, alpar@1: copy_symbol(mpl, tr ? row : col->sym)); alpar@1: break; alpar@1: default: alpar@1: xassert(which != which); alpar@1: } alpar@1: } alpar@1: else alpar@1: { /* copy symbol from the slice */ alpar@1: tuple = expand_tuple(mpl, tuple, copy_symbol(mpl, alpar@1: temp->sym)); alpar@1: } alpar@1: } alpar@1: xassert(which == 2); alpar@1: /* read value and assign it to new parameter member */ alpar@1: if (!is_symbol(mpl)) alpar@1: { int lack = slice_dimen(mpl, col); alpar@1: if (lack == 1) alpar@1: error(mpl, "one item missing in data group beginning " alpar@1: "with %s", format_symbol(mpl, row)); alpar@1: else alpar@1: error(mpl, "%d items missing in data group beginning " alpar@1: "with %s", lack, format_symbol(mpl, row)); alpar@1: } alpar@1: read_value(mpl, par, tuple); alpar@1: } alpar@1: /* delete the row symbol */ alpar@1: delete_symbol(mpl, row); alpar@1: } alpar@1: /* delete the column list */ alpar@1: delete_slice(mpl, list); alpar@1: return; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- tabbing_format - read parameter data block in tabbing format. alpar@1: -- alpar@1: -- This routine reads parameter data block using the syntax: alpar@1: -- alpar@1: -- ::= , ... , , := , alpar@1: -- , ... , , , ... , , alpar@1: -- , ... , , , ... , , alpar@1: -- . . . . . . . . . . . . . . . . . alpar@1: -- , ... , , , ... , alpar@1: -- ::= alpar@1: -- ::= : alpar@1: -- alpar@1: -- where are names of parameters (all the parameters must be alpar@1: -- subscripted and have identical dimensions), are symbols alpar@1: -- used to define subscripts of parameter members, are numeric alpar@1: -- or symbolic values assigned to the corresponding parameter members. alpar@1: -- Optional may specify a simple set, in which case n-tuples alpar@1: -- built of for each row of the data table (i.e. subscripts alpar@1: -- of parameter members) are added to the specified set. Commae between alpar@1: -- data items are optional and may be omitted anywhere. alpar@1: -- alpar@1: -- If the parameter altval is not NULL, it specifies a default value alpar@1: -- provided for all the parameters specified in the data block. */ alpar@1: alpar@1: void tabbing_format alpar@1: ( MPL *mpl, alpar@1: SYMBOL *altval /* not changed */ alpar@1: ) alpar@1: { SET *set = NULL; alpar@1: PARAMETER *par; alpar@1: SLICE *list, *col; alpar@1: TUPLE *tuple; alpar@1: int next_token, j, dim = 0; alpar@1: char *last_name = NULL; alpar@1: /* read the optional */ alpar@1: if (is_symbol(mpl)) alpar@1: { get_token(mpl /* */); alpar@1: next_token = mpl->token; alpar@1: unget_token(mpl /* */); alpar@1: if (next_token == T_COLON) alpar@1: { /* select the set to saturate it with data */ alpar@1: set = select_set(mpl, mpl->image); alpar@1: /* the set must be simple (i.e. not set of sets) */ alpar@1: if (set->dim != 0) alpar@1: error(mpl, "%s must be a simple set", set->name); alpar@1: /* and must not be defined yet */ alpar@1: if (set->array->head != NULL) alpar@1: error(mpl, "%s already defined", set->name); alpar@1: /* add new (the only) member to the set and assign it empty alpar@1: elemental set */ alpar@1: add_member(mpl, set->array, NULL)->value.set = alpar@1: create_elemset(mpl, set->dimen); alpar@1: last_name = set->name, dim = set->dimen; alpar@1: get_token(mpl /* */); alpar@1: xassert(mpl->token == T_COLON); alpar@1: get_token(mpl /* : */); alpar@1: } alpar@1: } alpar@1: /* read the table heading that contains parameter names */ alpar@1: list = create_slice(mpl); alpar@1: while (mpl->token != T_ASSIGN) alpar@1: { /* there must be symbolic name of parameter */ alpar@1: if (!is_symbol(mpl)) alpar@1: error(mpl, "parameter name or := missing where expected"); alpar@1: /* select the parameter to saturate it with data */ alpar@1: par = select_parameter(mpl, mpl->image); alpar@1: /* the parameter must be subscripted */ alpar@1: if (par->dim == 0) alpar@1: error(mpl, "%s not a subscripted parameter", mpl->image); alpar@1: /* the set (if specified) and all the parameters in the data alpar@1: block must have identical dimension */ alpar@1: if (dim != 0 && par->dim != dim) alpar@1: { xassert(last_name != NULL); alpar@1: error(mpl, "%s has dimension %d while %s has dimension %d", alpar@1: last_name, dim, par->name, par->dim); alpar@1: } alpar@1: /* set default value for the parameter (if specified) */ alpar@1: if (altval != NULL) alpar@1: set_default(mpl, par, copy_symbol(mpl, altval)); alpar@1: /* append the parameter to the column list */ alpar@1: list = expand_slice(mpl, list, (SYMBOL *)par); alpar@1: last_name = par->name, dim = par->dim; alpar@1: get_token(mpl /* */); alpar@1: /* skip optional comma */ alpar@1: if (mpl->token == T_COMMA) get_token(mpl /* , */); alpar@1: } alpar@1: if (slice_dimen(mpl, list) == 0) alpar@1: error(mpl, "at least one parameter name required"); alpar@1: get_token(mpl /* := */); alpar@1: /* skip optional comma */ alpar@1: if (mpl->token == T_COMMA) get_token(mpl /* , */); alpar@1: /* read rows that contain tabbing data */ alpar@1: while (is_symbol(mpl)) alpar@1: { /* read subscript list */ alpar@1: tuple = create_tuple(mpl); alpar@1: for (j = 1; j <= dim; j++) alpar@1: { /* read j-th subscript */ alpar@1: if (!is_symbol(mpl)) alpar@1: { int lack = slice_dimen(mpl, list) + dim - j + 1; alpar@1: xassert(tuple != NULL); alpar@1: xassert(lack > 1); alpar@1: error(mpl, "%d items missing in data group beginning wit" alpar@1: "h %s", lack, format_symbol(mpl, tuple->sym)); alpar@1: } alpar@1: /* read and append j-th subscript to the n-tuple */ alpar@1: tuple = expand_tuple(mpl, tuple, read_symbol(mpl)); alpar@1: /* skip optional comma *between* */ alpar@1: if (j < dim && mpl->token == T_COMMA) alpar@1: get_token(mpl /* , */); alpar@1: } alpar@1: /* if the set is specified, add to it new n-tuple, which is a alpar@1: copy of the subscript list just read */ alpar@1: if (set != NULL) alpar@1: check_then_add(mpl, set->array->head->value.set, alpar@1: copy_tuple(mpl, tuple)); alpar@1: /* skip optional comma between and */ alpar@1: if (mpl->token == T_COMMA) get_token(mpl /* , */); alpar@1: /* read values accordingly to the column list */ alpar@1: for (col = list; col != NULL; col = col->next) alpar@1: { /* if the token is single point, no value is provided */ alpar@1: if (is_literal(mpl, ".")) alpar@1: { get_token(mpl /* . */); alpar@1: continue; alpar@1: } alpar@1: /* read value and assign it to new parameter member */ alpar@1: if (!is_symbol(mpl)) alpar@1: { int lack = slice_dimen(mpl, col); alpar@1: xassert(tuple != NULL); alpar@1: if (lack == 1) alpar@1: error(mpl, "one item missing in data group beginning " alpar@1: "with %s", format_symbol(mpl, tuple->sym)); alpar@1: else alpar@1: error(mpl, "%d items missing in data group beginning " alpar@1: "with %s", lack, format_symbol(mpl, tuple->sym)); alpar@1: } alpar@1: read_value(mpl, (PARAMETER *)col->sym, copy_tuple(mpl, alpar@1: tuple)); alpar@1: /* skip optional comma preceding the next value */ alpar@1: if (col->next != NULL && mpl->token == T_COMMA) alpar@1: get_token(mpl /* , */); alpar@1: } alpar@1: /* delete the original subscript list */ alpar@1: delete_tuple(mpl, tuple); alpar@1: /* skip optional comma (only if there is next data group) */ alpar@1: if (mpl->token == T_COMMA) alpar@1: { get_token(mpl /* , */); alpar@1: if (!is_symbol(mpl)) unget_token(mpl /* , */); alpar@1: } alpar@1: } alpar@1: /* delete the column list (it contains parameters, not symbols, alpar@1: so nullify it before) */ alpar@1: for (col = list; col != NULL; col = col->next) col->sym = NULL; alpar@1: delete_slice(mpl, list); alpar@1: return; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- parameter_data - read parameter data. alpar@1: -- alpar@1: -- This routine reads parameter data using the syntax: alpar@1: -- alpar@1: -- ::= param : ; alpar@1: -- ::= param alpar@1: -- ; alpar@1: -- ::= alpar@1: -- ::= alpar@1: -- ::= default alpar@1: -- ::= alpar@1: -- ::= , := alpar@1: -- ::= , [ ] alpar@1: -- ::= , alpar@1: -- ::= , : alpar@1: -- ::= , (tr) alpar@1: -- ::= , (tr) : alpar@1: -- alpar@1: -- Commae in are optional and may be omitted anywhere. */ alpar@1: alpar@1: void parameter_data(MPL *mpl) alpar@1: { PARAMETER *par; alpar@1: SYMBOL *altval = NULL; alpar@1: SLICE *slice; alpar@1: int tr = 0; alpar@1: xassert(is_literal(mpl, "param")); alpar@1: get_token(mpl /* param */); alpar@1: /* read optional default value */ alpar@1: if (is_literal(mpl, "default")) alpar@1: { get_token(mpl /* default */); alpar@1: if (!is_symbol(mpl)) alpar@1: error(mpl, "default value missing where expected"); alpar@1: altval = read_symbol(mpl); alpar@1: /* if the default value follows the keyword 'param', the next alpar@1: token must be only the colon */ alpar@1: if (mpl->token != T_COLON) alpar@1: error(mpl, "colon missing where expected"); alpar@1: } alpar@1: /* being used after the keyword 'param' or the optional default alpar@1: value the colon begins data in the tabbing format */ alpar@1: if (mpl->token == T_COLON) alpar@1: { get_token(mpl /* : */); alpar@1: /* skip optional comma */ alpar@1: if (mpl->token == T_COMMA) get_token(mpl /* , */); alpar@1: /* read parameter data in the tabbing format */ alpar@1: tabbing_format(mpl, altval); alpar@1: /* on reading data in the tabbing format the default value is alpar@1: always copied, so delete the original symbol */ alpar@1: if (altval != NULL) delete_symbol(mpl, altval); alpar@1: /* the next token must be only semicolon */ alpar@1: if (mpl->token != T_SEMICOLON) alpar@1: error(mpl, "symbol, number, or semicolon missing where expe" alpar@1: "cted"); alpar@1: get_token(mpl /* ; */); alpar@1: goto done; alpar@1: } alpar@1: /* in other cases there must be symbolic name of parameter, which alpar@1: follows the keyword 'param' */ alpar@1: if (!is_symbol(mpl)) alpar@1: error(mpl, "parameter name missing where expected"); alpar@1: /* select the parameter to saturate it with data */ alpar@1: par = select_parameter(mpl, mpl->image); alpar@1: get_token(mpl /* */); alpar@1: /* read optional default value */ alpar@1: if (is_literal(mpl, "default")) alpar@1: { get_token(mpl /* default */); alpar@1: if (!is_symbol(mpl)) alpar@1: error(mpl, "default value missing where expected"); alpar@1: altval = read_symbol(mpl); alpar@1: /* set default value for the parameter */ alpar@1: set_default(mpl, par, altval); alpar@1: } alpar@1: /* create initial fake slice of all asterisks */ alpar@1: slice = fake_slice(mpl, par->dim); alpar@1: /* read zero or more data assignments */ alpar@1: for (;;) alpar@1: { /* skip optional comma */ alpar@1: if (mpl->token == T_COMMA) get_token(mpl /* , */); alpar@1: /* process current assignment */ alpar@1: if (mpl->token == T_ASSIGN) alpar@1: { /* assignment ligature is non-significant element */ alpar@1: get_token(mpl /* := */); alpar@1: } alpar@1: else if (mpl->token == T_LBRACKET) alpar@1: { /* left bracket begins new slice; delete the current slice alpar@1: and read new one */ alpar@1: delete_slice(mpl, slice); alpar@1: slice = read_slice(mpl, par->name, par->dim); alpar@1: /* each new slice resets the "transpose" indicator */ alpar@1: tr = 0; alpar@1: } alpar@1: else if (is_symbol(mpl)) alpar@1: { /* number or symbol begins data in the plain format */ alpar@1: plain_format(mpl, par, slice); alpar@1: } alpar@1: else if (mpl->token == T_COLON) alpar@1: { /* colon begins data in the tabular format */ alpar@1: if (par->dim == 0) alpar@1: err1: error(mpl, "%s not a subscripted parameter", alpar@1: par->name); alpar@1: if (slice_arity(mpl, slice) != 2) alpar@1: err2: error(mpl, "slice currently used must specify 2 asterisk" alpar@1: "s, not %d", slice_arity(mpl, slice)); alpar@1: get_token(mpl /* : */); alpar@1: /* read parameter data in the tabular format */ alpar@1: tabular_format(mpl, par, slice, tr); alpar@1: } alpar@1: else if (mpl->token == T_LEFT) alpar@1: { /* left parenthesis begins the "transpose" indicator, which alpar@1: is followed by data in the tabular format */ alpar@1: get_token(mpl /* ( */); alpar@1: if (!is_literal(mpl, "tr")) alpar@1: err3: error(mpl, "transpose indicator (tr) incomplete"); alpar@1: if (par->dim == 0) goto err1; alpar@1: if (slice_arity(mpl, slice) != 2) goto err2; alpar@1: get_token(mpl /* tr */); alpar@1: if (mpl->token != T_RIGHT) goto err3; alpar@1: get_token(mpl /* ) */); alpar@1: /* in this case the colon is optional */ alpar@1: if (mpl->token == T_COLON) get_token(mpl /* : */); alpar@1: /* set the "transpose" indicator */ alpar@1: tr = 1; alpar@1: /* read parameter data in the tabular format */ alpar@1: tabular_format(mpl, par, slice, tr); alpar@1: } alpar@1: else if (mpl->token == T_SEMICOLON) alpar@1: { /* semicolon terminates the data block */ alpar@1: get_token(mpl /* ; */); alpar@1: break; alpar@1: } alpar@1: else alpar@1: error(mpl, "syntax error in parameter data block"); alpar@1: } alpar@1: /* delete the current slice */ alpar@1: delete_slice(mpl, slice); alpar@1: done: return; alpar@1: } alpar@1: alpar@1: /*---------------------------------------------------------------------- alpar@1: -- data_section - read data section. alpar@1: -- alpar@1: -- This routine reads data section using the syntax: alpar@1: -- alpar@1: -- ::= alpar@1: -- ::= ; alpar@1: -- ::= alpar@1: -- ::= alpar@1: -- alpar@1: -- Reading data section is terminated by either the keyword 'end' or alpar@1: -- the end of file. */ alpar@1: alpar@1: void data_section(MPL *mpl) alpar@1: { while (!(mpl->token == T_EOF || is_literal(mpl, "end"))) alpar@1: { if (is_literal(mpl, "set")) alpar@1: set_data(mpl); alpar@1: else if (is_literal(mpl, "param")) alpar@1: parameter_data(mpl); alpar@1: else alpar@1: error(mpl, "syntax error in data section"); alpar@1: } alpar@1: return; alpar@1: } alpar@1: alpar@1: /* eof */