static bool
ref_same_as_full_array (gfc_ref *full_ref, gfc_ref *ref)
{
int i;
bool upper_or_lower;
if (full_ref->type != REF_ARRAY)
return false;
if (full_ref->u.ar.type != AR_FULL)
return false;
if (ref->type != REF_ARRAY)
return false;
if (ref->u.ar.type != AR_SECTION)
return false;
for (i = 0; i < ref->u.ar.dimen; i++)
{
/* If we have a single element in the reference, we need to check
that the array has a single element and that we actually reference
the correct element. */
if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
{
if (!full_ref->u.ar.as
|| !full_ref->u.ar.as->lower[i]
|| !full_ref->u.ar.as->upper[i]
|| gfc_dep_compare_expr (full_ref->u.ar.as->lower[i],
full_ref->u.ar.as->upper[i])
|| !ref->u.ar.start[i]
|| gfc_dep_compare_expr (ref->u.ar.start[i],
full_ref->u.ar.as->lower[i]))
return false;
}
/* Check the strides. */
if (full_ref->u.ar.stride[i] && !gfc_expr_is_one (full_ref->u.ar.stride[i], 0))
return false;
if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
return false;
upper_or_lower = false;
/* Check the lower bound. */
if (ref->u.ar.start[i]
&& (ref->u.ar.as
&& full_ref->u.ar.as->lower[i]
&& gfc_dep_compare_expr (ref->u.ar.start[i],
full_ref->u.ar.as->lower[i]) == 0))
upper_or_lower = true;
/* Check the upper bound. */
if (ref->u.ar.end[i]
&& (ref->u.ar.as
&& full_ref->u.ar.as->upper[i]
&& gfc_dep_compare_expr (ref->u.ar.end[i],
full_ref->u.ar.as->upper[i]) == 0))
upper_or_lower = true;
if (!upper_or_lower)
return false;
}
return true;
}
bool
gfc_full_array_ref_p (gfc_ref *ref)
{
int i;
if (ref->type != REF_ARRAY)
return false;
if (ref->u.ar.type == AR_FULL)
return true;
if (ref->u.ar.type != AR_SECTION)
return false;
if (ref->next)
return false;
for (i = 0; i < ref->u.ar.dimen; i++)
{
/* Check the lower bound. */
if (ref->u.ar.start[i]
&& (!ref->u.ar.as
|| !ref->u.ar.as->lower[i]
|| gfc_dep_compare_expr (ref->u.ar.start[i],
ref->u.ar.as->lower[i])))
return false;
/* Check the upper bound. */
if (ref->u.ar.end[i]
&& (!ref->u.ar.as
|| !ref->u.ar.as->upper[i]
|| gfc_dep_compare_expr (ref->u.ar.end[i],
ref->u.ar.as->upper[i])))
return false;
/* Check the stride. */
if (ref->u.ar.stride[i]
&& !gfc_expr_is_one (ref->u.ar.stride[i], 0))
return false;
}
return true;
}
int
gfc_is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n, int def)
{
gfc_expr *e1;
gfc_expr *e2;
int i;
/* TODO: More sophisticated range comparison. */
gcc_assert (ar1 && ar2);
gcc_assert (ar1->dimen_type[n] == ar2->dimen_type[n]);
e1 = ar1->stride[n];
e2 = ar2->stride[n];
/* Check for mismatching strides. A NULL stride means a stride of 1. */
if (e1 && !e2)
{
i = gfc_expr_is_one (e1, -1);
if (i == -1)
return def;
else if (i == 0)
return 0;
}
else if (e2 && !e1)
{
i = gfc_expr_is_one (e2, -1);
if (i == -1)
return def;
else if (i == 0)
return 0;
}
else if (e1 && e2)
{
i = gfc_dep_compare_expr (e1, e2);
if (i == -2)
return def;
else if (i != 0)
return 0;
}
/* The strides match. */
/* Check the range start. */
e1 = ar1->start[n];
e2 = ar2->start[n];
if (e1 || e2)
{
/* Use the bound of the array if no bound is specified. */
if (ar1->as && !e1)
e1 = ar1->as->lower[n];
if (ar2->as && !e2)
e2 = ar2->as->lower[n];
/* Check we have values for both. */
if (!(e1 && e2))
return def;
i = gfc_dep_compare_expr (e1, e2);
if (i == -2)
return def;
else if (i != 0)
return 0;
}
/* Check the range end. */
e1 = ar1->end[n];
e2 = ar2->end[n];
if (e1 || e2)
{
/* Use the bound of the array if no bound is specified. */
if (ar1->as && !e1)
e1 = ar1->as->upper[n];
if (ar2->as && !e2)
e2 = ar2->as->upper[n];
/* Check we have values for both. */
if (!(e1 && e2))
return def;
i = gfc_dep_compare_expr (e1, e2);
if (i == -2)
return def;
else if (i != 0)
return 0;
}
return 1;
}
bool
gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
{
int i;
int n;
bool lbound_OK = true;
bool ubound_OK = true;
if (contiguous)
*contiguous = false;
if (ref->type != REF_ARRAY)
return false;
if (ref->u.ar.type == AR_FULL)
{
if (contiguous)
*contiguous = true;
return true;
}
if (ref->u.ar.type != AR_SECTION)
return false;
if (ref->next)
return false;
for (i = 0; i < ref->u.ar.dimen; i++)
{
/* If we have a single element in the reference, for the reference
to be full, we need to ascertain that the array has a single
element in this dimension and that we actually reference the
correct element. */
if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
{
/* This is unconditionally a contiguous reference if all the
remaining dimensions are elements. */
if (contiguous)
{
*contiguous = true;
for (n = i + 1; n < ref->u.ar.dimen; n++)
if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
*contiguous = false;
}
if (!ref->u.ar.as
|| !ref->u.ar.as->lower[i]
|| !ref->u.ar.as->upper[i]
|| gfc_dep_compare_expr (ref->u.ar.as->lower[i],
ref->u.ar.as->upper[i])
|| !ref->u.ar.start[i]
|| gfc_dep_compare_expr (ref->u.ar.start[i],
ref->u.ar.as->lower[i]))
return false;
else
continue;
}
/* Check the lower bound. */
if (ref->u.ar.start[i]
&& (!ref->u.ar.as
|| !ref->u.ar.as->lower[i]
|| gfc_dep_compare_expr (ref->u.ar.start[i],
ref->u.ar.as->lower[i])))
lbound_OK = false;
/* Check the upper bound. */
if (ref->u.ar.end[i]
&& (!ref->u.ar.as
|| !ref->u.ar.as->upper[i]
|| gfc_dep_compare_expr (ref->u.ar.end[i],
ref->u.ar.as->upper[i])))
ubound_OK = false;
/* Check the stride. */
if (ref->u.ar.stride[i]
&& !gfc_expr_is_one (ref->u.ar.stride[i], 0))
return false;
/* This is unconditionally a contiguous reference as long as all
the subsequent dimensions are elements. */
if (contiguous)
{
*contiguous = true;
for (n = i + 1; n < ref->u.ar.dimen; n++)
if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
*contiguous = false;
}
if (!lbound_OK || !ubound_OK)
return false;
}
return true;
}
