glpmpl01.c

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

-- <primary expression> ::= abs ( <arg> )
-- <primary expression> ::= ceil ( <arg> )
-- <primary expression> ::= floor ( <arg> )
-- <primary expression> ::= exp ( <arg> )
-- <primary expression> ::= log ( <arg> )
-- <primary expression> ::= log10 ( <arg> )
-- <primary expression> ::= max ( <arg list> )
-- <primary expression> ::= min ( <arg list> )
-- <primary expression> ::= sqrt ( <arg> )
-- <primary expression> ::= sin ( <arg> )
-- <primary expression> ::= cos ( <arg> )
-- <primary expression> ::= atan ( <arg> )
-- <primary expression> ::= atan2 ( <arg> , <arg> )
-- <primary expression> ::= round ( <arg> )
-- <primary expression> ::= round ( <arg> , <arg> )
-- <primary expression> ::= trunc ( <arg> )
-- <primary expression> ::= trunc ( <arg> , <arg> )
-- <primary expression> ::= Irand224 ( )
-- <primary expression> ::= Uniform01 ( )
-- <primary expression> ::= Uniform ( <arg> , <arg> )
-- <primary expression> ::= Normal01 ( )
-- <primary expression> ::= Normal ( <arg> , <arg> )
-- <primary expression> ::= card ( <arg> )
-- <primary expression> ::= length ( <arg> )
-- <primary expression> ::= substr ( <arg> , <arg> )
-- <primary expression> ::= substr ( <arg> , <arg> , <arg> )
-- <primary expression> ::= str2time ( <arg> , <arg> )
-- <primary expression> ::= time2str ( <arg> , <arg> )
-- <primary expression> ::= gmtime ( )
-- <arg list> ::= <arg>
-- <arg list> ::= <arg list> , <arg> */

CODE *function_reference(MPL *mpl)
{     CODE *code;
      OPERANDS arg;
      int op;
      char func[15+1];
      /* determine operation code */
      xassert(mpl->token == T_NAME);
      if (strcmp(mpl->image, "abs") == 0)
         op = O_ABS;
      else if (strcmp(mpl->image, "ceil") == 0)
         op = O_CEIL;
      else if (strcmp(mpl->image, "floor") == 0)
         op = O_FLOOR;
      else if (strcmp(mpl->image, "exp") == 0)
         op = O_EXP;
      else if (strcmp(mpl->image, "log") == 0)
         op = O_LOG;
      else if (strcmp(mpl->image, "log10") == 0)
         op = O_LOG10;
      else if (strcmp(mpl->image, "sqrt") == 0)
         op = O_SQRT;
      else if (strcmp(mpl->image, "sin") == 0)
         op = O_SIN;
      else if (strcmp(mpl->image, "cos") == 0)
         op = O_COS;
      else if (strcmp(mpl->image, "atan") == 0)
         op = O_ATAN;
      else if (strcmp(mpl->image, "min") == 0)
         op = O_MIN;
      else if (strcmp(mpl->image, "max") == 0)
         op = O_MAX;
      else if (strcmp(mpl->image, "round") == 0)
         op = O_ROUND;
      else if (strcmp(mpl->image, "trunc") == 0)
         op = O_TRUNC;
      else if (strcmp(mpl->image, "Irand224") == 0)
         op = O_IRAND224;
      else if (strcmp(mpl->image, "Uniform01") == 0)
         op = O_UNIFORM01;
      else if (strcmp(mpl->image, "Uniform") == 0)
         op = O_UNIFORM;
      else if (strcmp(mpl->image, "Normal01") == 0)
         op = O_NORMAL01;
      else if (strcmp(mpl->image, "Normal") == 0)
         op = O_NORMAL;
      else if (strcmp(mpl->image, "card") == 0)
         op = O_CARD;
      else if (strcmp(mpl->image, "length") == 0)
         op = O_LENGTH;
      else if (strcmp(mpl->image, "substr") == 0)
         op = O_SUBSTR;
      else if (strcmp(mpl->image, "str2time") == 0)
         op = O_STR2TIME;
      else if (strcmp(mpl->image, "time2str") == 0)
         op = O_TIME2STR;
      else if (strcmp(mpl->image, "gmtime") == 0)
         op = O_GMTIME;
      else
         error(mpl, "function %s unknown", mpl->image);
      /* save symbolic name of the function */
      strcpy(func, mpl->image);
      xassert(strlen(func) < sizeof(func));
      get_token(mpl /* <symbolic name> */);
      /* check the left parenthesis that follows the function name */
      xassert(mpl->token == T_LEFT);
      get_token(mpl /* ( */);
      /* parse argument list */
      if (op == O_MIN || op == O_MAX)
      {  /* min and max allow arbitrary number of arguments */
         arg.list = create_arg_list(mpl);
         /* parse argument list */
         for (;;)
         {  /* parse argument and append it to the operands list */
            arg.list = expand_arg_list(mpl, arg.list,
               numeric_argument(mpl, func));
            /* check a token that follows the argument */
            if (mpl->token == T_COMMA)
               get_token(mpl /* , */);
            else if (mpl->token == T_RIGHT)
               break;
            else
               error(mpl, "syntax error in argument list for %s", func);
         }
      }
      else if (op == O_IRAND224 || op == O_UNIFORM01 || op ==
         O_NORMAL01 || op == O_GMTIME)
      {  /* Irand224, Uniform01, Normal01, gmtime need no arguments */
         if (mpl->token != T_RIGHT)
            error(mpl, "%s needs no arguments", func);
      }
      else if (op == O_UNIFORM || op == O_NORMAL)
      {  /* Uniform and Normal need two arguments */
         /* parse the first argument */
         arg.arg.x = numeric_argument(mpl, func);
         /* check a token that follows the first argument */
         if (mpl->token == T_COMMA)
            ;
         else if (mpl->token == T_RIGHT)
            error(mpl, "%s needs two arguments", func);
         else
            error(mpl, "syntax error in argument for %s", func);
         get_token(mpl /* , */);
         /* parse the second argument */
         arg.arg.y = numeric_argument(mpl, func);
         /* check a token that follows the second argument */
         if (mpl->token == T_COMMA)
            error(mpl, "%s needs two argument", func);
         else if (mpl->token == T_RIGHT)
            ;
         else
            error(mpl, "syntax error in argument for %s", func);
      }
      else if (op == O_ATAN || op == O_ROUND || op == O_TRUNC)
      {  /* atan, round, and trunc need one or two arguments */
         /* parse the first argument */
         arg.arg.x = numeric_argument(mpl, func);
         /* parse the second argument, if specified */
         if (mpl->token == T_COMMA)
         {  switch (op)
            {  case O_ATAN:  op = O_ATAN2;  break;
               case O_ROUND: op = O_ROUND2; break;
               case O_TRUNC: op = O_TRUNC2; break;
               default: xassert(op != op);
            }
            get_token(mpl /* , */);
            arg.arg.y = numeric_argument(mpl, func);
         }
         /* check a token that follows the last argument */
         if (mpl->token == T_COMMA)
            error(mpl, "%s needs one or two arguments", func);
         else if (mpl->token == T_RIGHT)
            ;
         else
            error(mpl, "syntax error in argument for %s", func);
      }
      else if (op == O_SUBSTR)
      {  /* substr needs two or three arguments */
         /* parse the first argument */
         arg.arg.x = symbolic_argument(mpl, func);
         /* check a token that follows the first argument */
         if (mpl->token == T_COMMA)
            ;
         else if (mpl->token == T_RIGHT)
            error(mpl, "%s needs two or three arguments", func);
         else
            error(mpl, "syntax error in argument for %s", func);
         get_token(mpl /* , */);
         /* parse the second argument */
         arg.arg.y = numeric_argument(mpl, func);
         /* parse the third argument, if specified */
         if (mpl->token == T_COMMA)
         {  op = O_SUBSTR3;
            get_token(mpl /* , */);
            arg.arg.z = numeric_argument(mpl, func);
         }
         /* check a token that follows the last argument */
         if (mpl->token == T_COMMA)
            error(mpl, "%s needs two or three arguments", func);
         else if (mpl->token == T_RIGHT)
            ;
         else
            error(mpl, "syntax error in argument for %s", func);
      }
      else if (op == O_STR2TIME)
      {  /* str2time needs two arguments, both symbolic */
         /* parse the first argument */
         arg.arg.x = symbolic_argument(mpl, func);
         /* check a token that follows the first argument */
         if (mpl->token == T_COMMA)
            ;
         else if (mpl->token == T_RIGHT)
            error(mpl, "%s needs two arguments", func);
         else
            error(mpl, "syntax error in argument for %s", func);
         get_token(mpl /* , */);
         /* parse the second argument */
         arg.arg.y = symbolic_argument(mpl, func);
         /* check a token that follows the second argument */
         if (mpl->token == T_COMMA)
            error(mpl, "%s needs two argument", func);
         else if (mpl->token == T_RIGHT)
            ;
         else
            error(mpl, "syntax error in argument for %s", func);
      }
      else if (op == O_TIME2STR)
      {  /* time2str needs two arguments, numeric and symbolic */
         /* parse the first argument */
         arg.arg.x = numeric_argument(mpl, func);
         /* check a token that follows the first argument */
         if (mpl->token == T_COMMA)
            ;
         else if (mpl->token == T_RIGHT)
            error(mpl, "%s needs two arguments", func);
         else
            error(mpl, "syntax error in argument for %s", func);
         get_token(mpl /* , */);
         /* parse the second argument */
         arg.arg.y = symbolic_argument(mpl, func);
         /* check a token that follows the second argument */
         if (mpl->token == T_COMMA)
            error(mpl, "%s needs two argument", func);
         else if (mpl->token == T_RIGHT)
            ;
         else
            error(mpl, "syntax error in argument for %s", func);
      }
      else
      {  /* other functions need one argument */
         if (op == O_CARD)
            arg.arg.x = elemset_argument(mpl, func);
         else if (op == O_LENGTH)
            arg.arg.x = symbolic_argument(mpl, func);
         else
            arg.arg.x = numeric_argument(mpl, func);
         /* check a token that follows the argument */
         if (mpl->token == T_COMMA)
            error(mpl, "%s needs one argument", func);
         else if (mpl->token == T_RIGHT)
            ;
         else
            error(mpl, "syntax error in argument for %s", func);
      }
      /* make pseudo-code to call the built-in function */
      if (op == O_SUBSTR || op == O_SUBSTR3 || op == O_TIME2STR)
         code = make_code(mpl, op, &arg, A_SYMBOLIC, 0);
      else
         code = make_code(mpl, op, &arg, A_NUMERIC, 0);
      /* the reference ends with the right parenthesis */
      xassert(mpl->token == T_RIGHT);
      get_token(mpl /* ) */);
      return code;
}

/*----------------------------------------------------------------------
-- create_domain - create empty domain.
--
-- This routine creates empty domain, which is initially empty, i.e.
-- has no domain blocks. */

DOMAIN *create_domain(MPL *mpl)
{     DOMAIN *domain;
      domain = alloc(DOMAIN);
      domain->list = NULL;
      domain->code = NULL;
      return domain;
}

/*----------------------------------------------------------------------
-- create_block - create empty domain block.
--
-- This routine creates empty domain block, which is initially empty,
-- i.e. has no domain slots. */

DOMAIN_BLOCK *create_block(MPL *mpl)
{     DOMAIN_BLOCK *block;
      block = alloc(DOMAIN_BLOCK);
      block->list = NULL;
      block->code = NULL;
      block->backup = NULL;
      block->next = NULL;
      return block;
}

/*----------------------------------------------------------------------
-- append_block - append domain block to specified domain.
--
-- This routine adds given domain block to the end of the block list of
-- specified domain. */

void append_block(MPL *mpl, DOMAIN *domain, DOMAIN_BLOCK *block)
{     DOMAIN_BLOCK *temp;
      xassert(mpl == mpl);
      xassert(domain != NULL);
      xassert(block != NULL);
      xassert(block->next == NULL);
      if (domain->list == NULL)
         domain->list = block;
      else
      {  for (temp = domain->list; temp->next != NULL; temp =
            temp->next);
         temp->next = block;
      }
      return;
}

/*----------------------------------------------------------------------
-- append_slot - create and append new slot to domain block.
--
-- This routine creates new domain slot and adds it to the end of slot
-- list of specified domain block.
--
-- The parameter name is symbolic name of the dummy index associated
-- with the slot (the character string must be allocated). NULL means
-- the dummy index is not explicitly specified.
--
-- The parameter code is pseudo-code for computing symbolic value, at
-- which the dummy index is bounded. NULL means the dummy index is free
-- in the domain scope. */

DOMAIN_SLOT *append_slot(MPL *mpl, DOMAIN_BLOCK *block, char *name,
      CODE *code)
{     DOMAIN_SLOT *slot, *temp;
      xassert(block != NULL);
      slot = alloc(DOMAIN_SLOT);
      slot->name = name;
      slot->code = code;
      slot->value = NULL;
      slot->list = NULL;
      slot->next = NULL;
      if (block->list == NULL)
         block->list = slot;
      else
      {  for (temp = block->list; temp->next != NULL; temp =
            temp->next);
         temp->next = slot;
      }
      return slot;
}

/*----------------------------------------------------------------------
-- expression_list - parse expression list.
--
-- This routine parses a list of one or more expressions enclosed into
-- the parentheses using the syntax:
--
-- <primary expression> ::= ( <expression list> )
-- <expression list> ::= <expression 13>