matchexp.c

gcc-fortran,linux使用fortran的编译软件。很好用的。

  if (all == NULL)
    {
      gfc_free_expr (e);
      return MATCH_ERROR;
    }

  all->where = where;
  *result = all;
  return MATCH_YES;
}


/* Match a level 2 expression.  */

static match
match_level_2 (gfc_expr ** result)
{
  gfc_expr *all, *e, *total;
  locus where;
  match m;
  int i;

  where = gfc_current_locus;
  i = match_add_op ();

  if (i != 0)
    {
      m = match_ext_add_operand (&e);
      if (m == MATCH_NO)
	{
	  gfc_error (expression_syntax);
	  m = MATCH_ERROR;
	}
    }
  else
    m = match_add_operand (&e);

  if (m != MATCH_YES)
    return m;

  if (i == 0)
    all = e;
  else
    {
      if (i == -1)
	all = gfc_uminus (e);
      else
	all = gfc_uplus (e);

      if (all == NULL)
	{
	  gfc_free_expr (e);
	  return MATCH_ERROR;
	}
    }

  all->where = where;

/* Append add-operands to the sum */

  for (;;)
    {
      where = gfc_current_locus;
      i = match_add_op ();
      if (i == 0)
	break;

      m = match_ext_add_operand (&e);
      if (m == MATCH_NO)
	gfc_error (expression_syntax);
      if (m != MATCH_YES)
	{
	  gfc_free_expr (all);
	  return MATCH_ERROR;
	}

      if (i == -1)
	total = gfc_subtract (all, e);
      else
	total = gfc_add (all, e);

      if (total == NULL)
	{
	  gfc_free_expr (all);
	  gfc_free_expr (e);
	  return MATCH_ERROR;
	}

      all = total;
      all->where = where;
    }

  *result = all;
  return MATCH_YES;
}


/* Match a level three expression.  */

static match
match_level_3 (gfc_expr ** result)
{
  gfc_expr *all, *e, *total;
  locus where;
  match m;

  m = match_level_2 (&all);
  if (m != MATCH_YES)
    return m;

  for (;;)
    {
      if (!next_operator (INTRINSIC_CONCAT))
	break;

      where = gfc_current_locus;

      m = match_level_2 (&e);
      if (m == MATCH_NO)
	{
	  gfc_error (expression_syntax);
	  gfc_free_expr (all);
	}
      if (m != MATCH_YES)
	return MATCH_ERROR;

      total = gfc_concat (all, e);
      if (total == NULL)
	{
	  gfc_free_expr (all);
	  gfc_free_expr (e);
	  return MATCH_ERROR;
	}

      all = total;
      all->where = where;
    }

  *result = all;
  return MATCH_YES;
}


/* Match a level 4 expression.  */

static match
match_level_4 (gfc_expr ** result)
{
  gfc_expr *left, *right, *r;
  gfc_intrinsic_op i;
  locus old_loc;
  locus where;
  match m;

  m = match_level_3 (&left);
  if (m != MATCH_YES)
    return m;

  old_loc = gfc_current_locus;

  if (gfc_match_intrinsic_op (&i) != MATCH_YES)
    {
      *result = left;
      return MATCH_YES;
    }

  if (i != INTRINSIC_EQ && i != INTRINSIC_NE && i != INTRINSIC_GE
      && i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT)
    {
      gfc_current_locus = old_loc;
      *result = left;
      return MATCH_YES;
    }

  where = gfc_current_locus;

  m = match_level_3 (&right);
  if (m == MATCH_NO)
    gfc_error (expression_syntax);
  if (m != MATCH_YES)
    {
      gfc_free_expr (left);
      return MATCH_ERROR;
    }

  switch (i)
    {
    case INTRINSIC_EQ:
      r = gfc_eq (left, right);
      break;

    case INTRINSIC_NE:
      r = gfc_ne (left, right);
      break;

    case INTRINSIC_LT:
      r = gfc_lt (left, right);
      break;

    case INTRINSIC_LE:
      r = gfc_le (left, right);
      break;

    case INTRINSIC_GT:
      r = gfc_gt (left, right);
      break;

    case INTRINSIC_GE:
      r = gfc_ge (left, right);
      break;

    default:
      gfc_internal_error ("match_level_4(): Bad operator");
    }

  if (r == NULL)
    {
      gfc_free_expr (left);
      gfc_free_expr (right);
      return MATCH_ERROR;
    }

  r->where = where;
  *result = r;

  return MATCH_YES;
}


static match
match_and_operand (gfc_expr ** result)
{
  gfc_expr *e, *r;
  locus where;
  match m;
  int i;

  i = next_operator (INTRINSIC_NOT);
  where = gfc_current_locus;

  m = match_level_4 (&e);
  if (m != MATCH_YES)
    return m;

  r = e;
  if (i)
    {
      r = gfc_not (e);
      if (r == NULL)
	{
	  gfc_free_expr (e);
	  return MATCH_ERROR;
	}
    }

  r->where = where;
  *result = r;

  return MATCH_YES;
}


static match
match_or_operand (gfc_expr ** result)
{
  gfc_expr *all, *e, *total;
  locus where;
  match m;

  m = match_and_operand (&all);
  if (m != MATCH_YES)
    return m;

  for (;;)
    {
      if (!next_operator (INTRINSIC_AND))
	break;
      where = gfc_current_locus;

      m = match_and_operand (&e);
      if (m == MATCH_NO)
	gfc_error (expression_syntax);
      if (m != MATCH_YES)
	{
	  gfc_free_expr (all);
	  return MATCH_ERROR;
	}

      total = gfc_and (all, e);
      if (total == NULL)
	{
	  gfc_free_expr (all);
	  gfc_free_expr (e);
	  return MATCH_ERROR;
	}

      all = total;
      all->where = where;
    }

  *result = all;
  return MATCH_YES;
}


static match
match_equiv_operand (gfc_expr ** result)
{
  gfc_expr *all, *e, *total;
  locus where;
  match m;

  m = match_or_operand (&all);
  if (m != MATCH_YES)
    return m;

  for (;;)
    {
      if (!next_operator (INTRINSIC_OR))
	break;
      where = gfc_current_locus;

      m = match_or_operand (&e);
      if (m == MATCH_NO)
	gfc_error (expression_syntax);
      if (m != MATCH_YES)
	{
	  gfc_free_expr (all);
	  return MATCH_ERROR;
	}

      total = gfc_or (all, e);
      if (total == NULL)
	{
	  gfc_free_expr (all);
	  gfc_free_expr (e);
	  return MATCH_ERROR;
	}

      all = total;
      all->where = where;
    }

  *result = all;
  return MATCH_YES;
}


/* Match a level 5 expression.  */

static match
match_level_5 (gfc_expr ** result)
{
  gfc_expr *all, *e, *total;
  locus where;
  match m;
  gfc_intrinsic_op i;

  m = match_equiv_operand (&all);
  if (m != MATCH_YES)
    return m;

  for (;;)
    {
      if (next_operator (INTRINSIC_EQV))
	i = INTRINSIC_EQV;
      else
	{
	  if (next_operator (INTRINSIC_NEQV))
	    i = INTRINSIC_NEQV;
	  else
	    break;
	}

      where = gfc_current_locus;

      m = match_equiv_operand (&e);
      if (m == MATCH_NO)
	gfc_error (expression_syntax);
      if (m != MATCH_YES)
	{
	  gfc_free_expr (all);
	  return MATCH_ERROR;
	}

      if (i == INTRINSIC_EQV)
	total = gfc_eqv (all, e);
      else
	total = gfc_neqv (all, e);

      if (total == NULL)
	{
	  gfc_free_expr (all);
	  gfc_free_expr (e);
	  return MATCH_ERROR;
	}

      all = total;
      all->where = where;
    }

  *result = all;
  return MATCH_YES;
}


/* Match an expression.  At this level, we are stringing together
   level 5 expressions separated by binary operators.  */

match
gfc_match_expr (gfc_expr ** result)
{
  gfc_expr *all, *e;
  gfc_user_op *uop;
  locus where;
  match m;

  m = match_level_5 (&all);
  if (m != MATCH_YES)
    return m;

  for (;;)
    {
      uop = NULL;
      m = match_defined_operator (&uop);
      if (m == MATCH_NO)
	break;
      if (m == MATCH_ERROR)
	{
	  gfc_free_expr (all);
	  return MATCH_ERROR;
	}

      where = gfc_current_locus;

      m = match_level_5 (&e);
      if (m == MATCH_NO)
	gfc_error (expression_syntax);
      if (m != MATCH_YES)
	{
	  gfc_free_expr (all);
	  return MATCH_ERROR;
	}

      all = build_node (INTRINSIC_USER, &where, all, e);
      all->value.op.uop = uop;
    }

  *result = all;
  return MATCH_YES;
}