glpmpl01.c

来自「著名的大规模线性规划求解器源码GLPK.C语言版本,可以修剪.内有详细帮助文档.」· C语言 代码 · 共 1,797 行 · 第 1/5 页

}

/*----------------------------------------------------------------------
-- make_unary - generate pseudo-code for unary operation.
--
-- This routine generates pseudo-code for unary operation. */

CODE *make_unary(MPL *mpl, int op, CODE *x, int type, int dim)
{     CODE *code;
      OPERANDS arg;
      xassert(x != NULL);
      arg.arg.x = x;
      code = make_code(mpl, op, &arg, type, dim);
      return code;
}

/*----------------------------------------------------------------------
-- make_binary - generate pseudo-code for binary operation.
--
-- This routine generates pseudo-code for binary operation. */

CODE *make_binary(MPL *mpl, int op, CODE *x, CODE *y, int type,
      int dim)
{     CODE *code;
      OPERANDS arg;
      xassert(x != NULL);
      xassert(y != NULL);
      arg.arg.x = x;
      arg.arg.y = y;
      code = make_code(mpl, op, &arg, type, dim);
      return code;
}

/*----------------------------------------------------------------------
-- make_ternary - generate pseudo-code for ternary operation.
--
-- This routine generates pseudo-code for ternary operation. */

CODE *make_ternary(MPL *mpl, int op, CODE *x, CODE *y, CODE *z,
      int type, int dim)
{     CODE *code;
      OPERANDS arg;
      xassert(x != NULL);
      xassert(y != NULL);
      /* third operand can be NULL */
      arg.arg.x = x;
      arg.arg.y = y;
      arg.arg.z = z;
      code = make_code(mpl, op, &arg, type, dim);
      return code;
}

/*----------------------------------------------------------------------
-- numeric_literal - parse reference to numeric literal.
--
-- This routine parses primary expression using the syntax:
--
-- <primary expression> ::= <numeric literal> */

CODE *numeric_literal(MPL *mpl)
{     CODE *code;
      OPERANDS arg;
      xassert(mpl->token == T_NUMBER);
      arg.num = mpl->value;
      code = make_code(mpl, O_NUMBER, &arg, A_NUMERIC, 0);
      get_token(mpl /* <numeric literal> */);
      return code;
}

/*----------------------------------------------------------------------
-- string_literal - parse reference to string literal.
--
-- This routine parses primary expression using the syntax:
--
-- <primary expression> ::= <string literal> */

CODE *string_literal(MPL *mpl)
{     CODE *code;
      OPERANDS arg;
      xassert(mpl->token == T_STRING);
      arg.str = dmp_get_atomv(mpl->pool, strlen(mpl->image)+1);
      strcpy(arg.str, mpl->image);
      code = make_code(mpl, O_STRING, &arg, A_SYMBOLIC, 0);
      get_token(mpl /* <string literal> */);
      return code;
}

/*----------------------------------------------------------------------
-- create_arg_list - create empty operands list.
--
-- This routine creates operands list, which is initially empty. */

ARG_LIST *create_arg_list(MPL *mpl)
{     ARG_LIST *list;
      xassert(mpl == mpl);
      list = NULL;
      return list;
}

/*----------------------------------------------------------------------
-- expand_arg_list - append operand to operands list.
--
-- This routine appends new operand to specified operands list. */

ARG_LIST *expand_arg_list(MPL *mpl, ARG_LIST *list, CODE *x)
{     ARG_LIST *tail, *temp;
      xassert(x != NULL);
      /* create new operands list entry */
      tail = alloc(ARG_LIST);
      tail->x = x;
      tail->next = NULL;
      /* and append it to the operands list */
      if (list == NULL)
         list = tail;
      else
      {  for (temp = list; temp->next != NULL; temp = temp->next);
         temp->next = tail;
      }
      return list;
}

/*----------------------------------------------------------------------
-- arg_list_len - determine length of operands list.
--
-- This routine returns the number of operands in operands list. */

int arg_list_len(MPL *mpl, ARG_LIST *list)
{     ARG_LIST *temp;
      int len;
      xassert(mpl == mpl);
      len = 0;
      for (temp = list; temp != NULL; temp = temp->next) len++;
      return len;
}

/*----------------------------------------------------------------------
-- subscript_list - parse subscript list.
--
-- This routine parses subscript list using the syntax:
--
-- <subscript list> ::= <subscript>
-- <subscript list> ::= <subscript list> , <subscript>
-- <subscript> ::= <expression 5> */

ARG_LIST *subscript_list(MPL *mpl)
{     ARG_LIST *list;
      CODE *x;
      list = create_arg_list(mpl);
      for (;;)
      {  /* parse subscript expression */
         x = expression_5(mpl);
         /* convert it to symbolic type, if necessary */
         if (x->type == A_NUMERIC)
            x = make_unary(mpl, O_CVTSYM, x, A_SYMBOLIC, 0);
         /* check that now the expression is of symbolic type */
         if (x->type != A_SYMBOLIC)
            error(mpl, "subscript expression has invalid type");
         xassert(x->dim == 0);
         /* and append it to the subscript list */
         list = expand_arg_list(mpl, list, x);
         /* check a token that follows the subscript expression */
         if (mpl->token == T_COMMA)
            get_token(mpl /* , */);
         else if (mpl->token == T_RBRACKET)
            break;
         else
            error(mpl, "syntax error in subscript list");
      }
      return list;
}

/*----------------------------------------------------------------------
-- object_reference - parse reference to named object.
--
-- This routine parses primary expression using the syntax:
--
-- <primary expression> ::= <dummy index>
-- <primary expression> ::= <set name>
-- <primary expression> ::= <set name> [ <subscript list> ]
-- <primary expression> ::= <parameter name>
-- <primary expression> ::= <parameter name> [ <subscript list> ]
-- <primary expression> ::= <variable name>
-- <primary expression> ::= <variable name> [ <subscript list> ]
-- <dummy index> ::= <symbolic name>
-- <set name> ::= <symbolic name>
-- <parameter name> ::= <symbolic name>
-- <variable name> ::= <symbolic name> */

CODE *object_reference(MPL *mpl)
{     AVLNODE *node;
      DOMAIN_SLOT *slot;
      SET *set;
      PARAMETER *par;
      VARIABLE *var;
      CONSTRAINT *con;
      ARG_LIST *list;
      OPERANDS arg;
      CODE *code;
      char *name;
      int dim;
      /* find the object in the symbolic name table */
      xassert(mpl->token == T_NAME);
      node = avl_find_node(mpl->tree, mpl->image);
      if (node == NULL)
         error(mpl, "%s not defined", mpl->image);
      /* check the object type and obtain its dimension */
      switch (avl_get_node_type(node))
      {  case A_INDEX:
            /* dummy index */
            slot = (DOMAIN_SLOT *)avl_get_node_link(node);
            name = slot->name;
            dim = 0;
            break;
         case A_SET:
            /* model set */
            set = (SET *)avl_get_node_link(node);
            name = set->name;
            dim = set->dim;
            /* if a set object is referenced in its own declaration and
               the dimen attribute is not specified yet, use dimen 1 by
               default */
            if (set->dimen == 0) set->dimen = 1;
            break;
         case A_PARAMETER:
            /* model parameter */
            par = (PARAMETER *)avl_get_node_link(node);
            name = par->name;
            dim = par->dim;
            break;
         case A_VARIABLE:
            /* model variable */
            var = (VARIABLE *)avl_get_node_link(node);
            name = var->name;
            dim = var->dim;
            break;
         case A_CONSTRAINT:
            /* model constraint or objective */
            con = (CONSTRAINT *)avl_get_node_link(node);
            error(mpl, "invalid reference to %s %s",
               con->type == A_CONSTRAINT ? "constraint" : "objective",
               mpl->image);
         default:
            xassert(node != node);
      }
      get_token(mpl /* <symbolic name> */);
      /* parse optional subscript list */
      if (mpl->token == T_LBRACKET)
      {  /* subscript list is specified */
         if (dim == 0)
            error(mpl, "%s cannot be subscripted", name);
         get_token(mpl /* [ */);
         list = subscript_list(mpl);
         if (dim != arg_list_len(mpl, list))
            error(mpl, "%s must have %d subscript%s rather than %d",
               name, dim, dim == 1 ? "" : "s", arg_list_len(mpl, list));
         xassert(mpl->token == T_RBRACKET);
         get_token(mpl /* ] */);
      }
      else
      {  /* subscript list is not specified */
         if (dim != 0)
            error(mpl, "%s must be subscripted", name);
         list = create_arg_list(mpl);
      }
      /* generate pseudo-code to take value of the object */
      switch (avl_get_node_type(node))
      {  case A_INDEX:
            arg.index.slot = slot;
            arg.index.next = slot->list;
            code = make_code(mpl, O_INDEX, &arg, A_SYMBOLIC, 0);
            slot->list = code;
            break;
         case A_SET:
            arg.set.set = set;
            arg.set.list = list;
            code = make_code(mpl, O_MEMSET, &arg, A_ELEMSET,
               set->dimen);
            break;
         case A_PARAMETER:
            arg.par.par = par;
            arg.par.list = list;
            if (par->type == A_SYMBOLIC)
               code = make_code(mpl, O_MEMSYM, &arg, A_SYMBOLIC, 0);
            else
               code = make_code(mpl, O_MEMNUM, &arg, A_NUMERIC, 0);
            break;
         case A_VARIABLE:
            arg.var.var = var;
            arg.var.list = list;
#if 0 /* 01/VIII-2004 */
            code = make_code(mpl, O_MEMVAR, &arg, A_FORMULA, 0);
#else
            if (!mpl->flag_s)
            {  /* variable is referenced above solve statement */
               code = make_code(mpl, O_MEMVAR, &arg, A_FORMULA, 0);
            }
            else
            {  /* variable is referenced below solve statement */
               code = make_code(mpl, O_MEMVAR, &arg, A_NUMERIC, 0);
            }
#endif
            break;
         default:
            xassert(node != node);
      }
      return code;
}

/*----------------------------------------------------------------------
-- numeric_argument - parse argument passed to built-in function.
--
-- This routine parses an argument passed to numeric built-in function
-- using the syntax:
--
-- <arg> ::= <expression 5> */

CODE *numeric_argument(MPL *mpl, char *func)
{     CODE *x;
      x = expression_5(mpl);
      /* convert the argument to numeric type, if necessary */
      if (x->type == A_SYMBOLIC)
         x = make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0);
      /* check that now the argument is of numeric type */
      if (x->type != A_NUMERIC)
         error(mpl, "argument for %s has invalid type", func);
      xassert(x->dim == 0);
      return x;
}

#if 1 /* 15/VII-2006 */
CODE *symbolic_argument(MPL *mpl, char *func)
{     CODE *x;
      x = expression_5(mpl);
      /* convert the argument to symbolic type, if necessary */
      if (x->type == A_NUMERIC)
         x = make_unary(mpl, O_CVTSYM, x, A_SYMBOLIC, 0);
      /* check that now the argument is of symbolic type */
      if (x->type != A_SYMBOLIC)
         error(mpl, "argument for %s has invalid type", func);
      xassert(x->dim == 0);
      return x;
}
#endif

#if 1 /* 15/VII-2006 */
CODE *elemset_argument(MPL *mpl, char *func)
{     CODE *x;
      x = expression_9(mpl);
      if (x->type != A_ELEMSET)
         error(mpl, "argument for %s has invalid type", func);
      xassert(x->dim > 0);
      return x;
}
#endif

/*----------------------------------------------------------------------
-- function_reference - parse reference to built-in function.
--
-- This routine parses primary expression using the syntax:
--