glpmpl01.c

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

               scanner, so the current character is the second dot */
            mpl->token = T_DOTS;
            mpl->imlen = 2;
            strcpy(mpl->image, "..");
            mpl->f_dots = 0;
         }
         else if (mpl->c == '.')
            mpl->token = T_DOTS, append_char(mpl);
         else if (isdigit(mpl->c))
         {  /* numeric literal that begins with the decimal point */
            mpl->token = T_NUMBER, append_char(mpl);
            goto frac;
         }
      }
      else if (mpl->c == ',')
         mpl->token = T_COMMA, append_char(mpl);
      else if (mpl->c == ':')
      {  mpl->token = T_COLON, append_char(mpl);
         if (mpl->c == '=')
            mpl->token = T_ASSIGN, append_char(mpl);
      }
      else if (mpl->c == ';')
         mpl->token = T_SEMICOLON, append_char(mpl);
      else if (mpl->c == '(')
         mpl->token = T_LEFT, append_char(mpl);
      else if (mpl->c == ')')
         mpl->token = T_RIGHT, append_char(mpl);
      else if (mpl->c == '[')
         mpl->token = T_LBRACKET, append_char(mpl);
      else if (mpl->c == ']')
         mpl->token = T_RBRACKET, append_char(mpl);
      else if (mpl->c == '{')
         mpl->token = T_LBRACE, append_char(mpl);
      else if (mpl->c == '}')
         mpl->token = T_RBRACE, append_char(mpl);
#if 1 /* 11/II-2008 */
      else if (mpl->c == '~')
         mpl->token = T_TILDE, append_char(mpl);
#endif
      else if (isalnum(mpl->c) || strchr("+-._", mpl->c) != NULL)
      {  /* symbol */
         xassert(mpl->flag_d);
         mpl->token = T_SYMBOL;
         while (isalnum(mpl->c) || strchr("+-._", mpl->c) != NULL)
            append_char(mpl);
         switch (str2num(mpl->image, &mpl->value))
         {  case 0:
               mpl->token = T_NUMBER;
               break;
            case 1:
               goto err;
            case 2:
               break;
            default:
               xassert(mpl != mpl);
         }
      }
      else
      {  enter_context(mpl);
         error(mpl, "character %c not allowed", mpl->c);
      }
      /* enter the current token into the context queue */
      enter_context(mpl);
      /* reset the flag, which may be set by indexing_expression() and
         is used by expression_list() */
      mpl->flag_x = 0;
done: return;
}

/*----------------------------------------------------------------------
-- unget_token - return current token back to input stream.
--
-- This routine returns the current token back to the input stream, so
-- the previously scanned token becomes the current one. */

void unget_token(MPL *mpl)
{     /* save the current token, which becomes the next one */
      xassert(!mpl->f_scan);
      mpl->f_scan = 1;
      mpl->f_token = mpl->token;
      mpl->f_imlen = mpl->imlen;
      strcpy(mpl->f_image, mpl->image);
      mpl->f_value = mpl->value;
      /* restore the previous token, which becomes the current one */
      mpl->token = mpl->b_token;
      mpl->imlen = mpl->b_imlen;
      strcpy(mpl->image, mpl->b_image);
      mpl->value = mpl->b_value;
      return;
}

/*----------------------------------------------------------------------
-- is_keyword - check if current token is given non-reserved keyword.
--
-- If the current token is given (non-reserved) keyword, this routine
-- returns non-zero. Otherwise zero is returned. */

int is_keyword(MPL *mpl, char *keyword)
{     return
         mpl->token == T_NAME && strcmp(mpl->image, keyword) == 0;
}

/*----------------------------------------------------------------------
-- is_reserved - check if current token is reserved keyword.
--
-- If the current token is a reserved keyword, this routine returns
-- non-zero. Otherwise zero is returned. */

int is_reserved(MPL *mpl)
{     return
         mpl->token == T_AND && mpl->image[0] == 'a' ||
         mpl->token == T_BY ||
         mpl->token == T_CROSS ||
         mpl->token == T_DIFF ||
         mpl->token == T_DIV ||
         mpl->token == T_ELSE ||
         mpl->token == T_IF ||
         mpl->token == T_IN ||
         mpl->token == T_INTER ||
         mpl->token == T_LESS ||
         mpl->token == T_MOD ||
         mpl->token == T_NOT && mpl->image[0] == 'n' ||
         mpl->token == T_OR && mpl->image[0] == 'o' ||
         mpl->token == T_SYMDIFF ||
         mpl->token == T_THEN ||
         mpl->token == T_UNION ||
         mpl->token == T_WITHIN;
}

/*----------------------------------------------------------------------
-- make_code - generate pseudo-code (basic routine).
--
-- This routine generates specified pseudo-code. It is assumed that all
-- other translator routines use this basic routine. */

CODE *make_code(MPL *mpl, int op, OPERANDS *arg, int type, int dim)
{     CODE *code;
      DOMAIN *domain;
      DOMAIN_BLOCK *block;
      ARG_LIST *e;
      /* generate pseudo-code */
      code = alloc(CODE);
      code->op = op;
      code->vflag = 0; /* is inherited from operand(s) */
      /* copy operands and also make them referring to the pseudo-code
         being generated, because the latter becomes the parent for all
         its operands */
      memset(&code->arg, '?', sizeof(OPERANDS));
      switch (op)
      {  case O_NUMBER:
            code->arg.num = arg->num;
            break;
         case O_STRING:
            code->arg.str = arg->str;
            break;
         case O_INDEX:
            code->arg.index.slot = arg->index.slot;
            code->arg.index.next = arg->index.next;
            break;
         case O_MEMNUM:
         case O_MEMSYM:
            for (e = arg->par.list; e != NULL; e = e->next)
            {  xassert(e->x != NULL);
               xassert(e->x->up == NULL);
               e->x->up = code;
               code->vflag |= e->x->vflag;
            }
            code->arg.par.par = arg->par.par;
            code->arg.par.list = arg->par.list;
            break;
         case O_MEMSET:
            for (e = arg->set.list; e != NULL; e = e->next)
            {  xassert(e->x != NULL);
               xassert(e->x->up == NULL);
               e->x->up = code;
               code->vflag |= e->x->vflag;
            }
            code->arg.set.set = arg->set.set;
            code->arg.set.list = arg->set.list;
            break;
         case O_MEMVAR:
            for (e = arg->var.list; e != NULL; e = e->next)
            {  xassert(e->x != NULL);
               xassert(e->x->up == NULL);
               e->x->up = code;
               code->vflag |= e->x->vflag;
            }
            code->arg.var.var = arg->var.var;
            code->arg.var.list = arg->var.list;
            break;
         case O_TUPLE:
         case O_MAKE:
            for (e = arg->list; e != NULL; e = e->next)
            {  xassert(e->x != NULL);
               xassert(e->x->up == NULL);
               e->x->up = code;
               code->vflag |= e->x->vflag;
            }
            code->arg.list = arg->list;
            break;
         case O_SLICE:
            xassert(arg->slice != NULL);
            code->arg.slice = arg->slice;
            break;
         case O_IRAND224:
         case O_UNIFORM01:
         case O_NORMAL01:
         case O_GMTIME:
            code->vflag = 1;
            break;
         case O_CVTNUM:
         case O_CVTSYM:
         case O_CVTLOG:
         case O_CVTTUP:
         case O_CVTLFM:
         case O_PLUS:
         case O_MINUS:
         case O_NOT:
         case O_ABS:
         case O_CEIL:
         case O_FLOOR:
         case O_EXP:
         case O_LOG:
         case O_LOG10:
         case O_SQRT:
         case O_SIN:
         case O_COS:
         case O_ATAN:
         case O_ROUND:
         case O_TRUNC:
         case O_CARD:
         case O_LENGTH:
            /* unary operation */
            xassert(arg->arg.x != NULL);
            xassert(arg->arg.x->up == NULL);
            arg->arg.x->up = code;
            code->vflag |= arg->arg.x->vflag;
            code->arg.arg.x = arg->arg.x;
            break;
         case O_ADD:
         case O_SUB:
         case O_LESS:
         case O_MUL:
         case O_DIV:
         case O_IDIV:
         case O_MOD:
         case O_POWER:
         case O_ATAN2:
         case O_ROUND2:
         case O_TRUNC2:
         case O_UNIFORM:
            if (op == O_UNIFORM) code->vflag = 1;
         case O_NORMAL:
            if (op == O_NORMAL) code->vflag = 1;
         case O_CONCAT:
         case O_LT:
         case O_LE:
         case O_EQ:
         case O_GE:
         case O_GT:
         case O_NE:
         case O_AND:
         case O_OR:
         case O_UNION:
         case O_DIFF:
         case O_SYMDIFF:
         case O_INTER:
         case O_CROSS:
         case O_IN:
         case O_NOTIN:
         case O_WITHIN:
         case O_NOTWITHIN:
         case O_SUBSTR:
         case O_STR2TIME:
         case O_TIME2STR:
            /* binary operation */
            xassert(arg->arg.x != NULL);
            xassert(arg->arg.x->up == NULL);
            arg->arg.x->up = code;
            code->vflag |= arg->arg.x->vflag;
            xassert(arg->arg.y != NULL);
            xassert(arg->arg.y->up == NULL);
            arg->arg.y->up = code;
            code->vflag |= arg->arg.y->vflag;
            code->arg.arg.x = arg->arg.x;
            code->arg.arg.y = arg->arg.y;
            break;
         case O_DOTS:
         case O_FORK:
         case O_SUBSTR3:
            /* ternary operation */
            xassert(arg->arg.x != NULL);
            xassert(arg->arg.x->up == NULL);
            arg->arg.x->up = code;
            code->vflag |= arg->arg.x->vflag;
            xassert(arg->arg.y != NULL);
            xassert(arg->arg.y->up == NULL);
            arg->arg.y->up = code;
            code->vflag |= arg->arg.y->vflag;
            if (arg->arg.z != NULL)
            {  xassert(arg->arg.z->up == NULL);
               arg->arg.z->up = code;
               code->vflag |= arg->arg.z->vflag;
            }
            code->arg.arg.x = arg->arg.x;
            code->arg.arg.y = arg->arg.y;
            code->arg.arg.z = arg->arg.z;
            break;
         case O_MIN:
         case O_MAX:
            /* n-ary operation */
            for (e = arg->list; e != NULL; e = e->next)
            {  xassert(e->x != NULL);
               xassert(e->x->up == NULL);
               e->x->up = code;
               code->vflag |= e->x->vflag;
            }
            code->arg.list = arg->list;
            break;
         case O_SUM:
         case O_PROD:
         case O_MINIMUM:
         case O_MAXIMUM:
         case O_FORALL:
         case O_EXISTS:
         case O_SETOF:
         case O_BUILD:
            /* iterated operation */
            domain = arg->loop.domain;
            xassert(domain != NULL);
            if (domain->code != NULL)
            {  xassert(domain->code->up == NULL);
               domain->code->up = code;
               code->vflag |= domain->code->vflag;
            }
            for (block = domain->list; block != NULL; block =
               block->next)
            {  xassert(block->code != NULL);
               xassert(block->code->up == NULL);
               block->code->up = code;
               code->vflag |= block->code->vflag;
            }
            if (arg->loop.x != NULL)
            {  xassert(arg->loop.x->up == NULL);
               arg->loop.x->up = code;
               code->vflag |= arg->loop.x->vflag;
            }
            code->arg.loop.domain = arg->loop.domain;
            code->arg.loop.x = arg->loop.x;
            break;
         default:
            xassert(op != op);
      }
      /* set other attributes of the pseudo-code */
      code->type = type;
      code->dim = dim;
      code->up = NULL;
      code->valid = 0;
      memset(&code->value, '?', sizeof(VALUE));
      return code;