[flang] Better shape analysis for CSHIFT, EOSHIFT, SPREAD

Original-commit: flang-compiler/f18@eb43df85a6
Reviewed-on: https://github.com/flang-compiler/f18/pull/782
Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler 2019-10-16 10:35:34 -07:00
parent 3a4091b5e3
commit f090eb878e
2 changed files with 31 additions and 1 deletions

View File

@ -471,6 +471,7 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
} else if (const auto *intrinsic{call.proc().GetSpecificIntrinsic()}) {
if (intrinsic->name == "shape" || intrinsic->name == "lbound" ||
intrinsic->name == "ubound") {
// These are the array-valued cases for LBOUND and UBOUND (no DIM=).
const auto *expr{call.arguments().front().value().UnwrapExpr()};
CHECK(expr != nullptr);
return Shape{MaybeExtentExpr{ExtentExpr{expr->Rank()}}};
@ -492,6 +493,30 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
}
}
}
} else if (intrinsic->name == "cshift" || intrinsic->name == "eoshift") {
if (!call.arguments().empty()) {
return (*this)(call.arguments()[0]);
}
} else if (intrinsic->name == "spread") {
// SHAPE(SPREAD(ARRAY,DIM,NCOPIES)) = SHAPE(ARRAY) with NCOPIES inserted
// at position DIM.
if (call.arguments().size() == 3) {
auto arrayShape{
(*this)(UnwrapExpr<Expr<SomeType>>(call.arguments().at(0)))};
const auto *dimArg{UnwrapExpr<Expr<SomeType>>(call.arguments().at(1))};
const auto *nCopies{
UnwrapExpr<Expr<SomeInteger>>(call.arguments().at(2))};
if (arrayShape.has_value() && dimArg != nullptr && nCopies != nullptr) {
if (auto dim{ToInt64(*dimArg)}) {
if (*dim >= 1 &&
static_cast<std::size_t>(*dim) <= arrayShape->size() + 1) {
arrayShape->emplace(arrayShape->begin() + *dim - 1,
ConvertToType<ExtentType>(common::Clone(*nCopies)));
return std::move(*arrayShape);
}
}
}
}
} else if (intrinsic->characteristics.value().attrs.test(characteristics::
Procedure::Attr::NullPointer)) { // NULL(MOLD=)
return (*this)(call.arguments());

View File

@ -46,7 +46,8 @@ module ieee_exceptions
ieee_support_flag_4, ieee_support_flag_8, ieee_support_flag_10, &
ieee_support_flag_16
interface ieee_support_flag
module procedure :: ieee_support_flag_2, ieee_support_flag_3, &
module procedure :: ieee_support_flag, &
ieee_support_flag_2, ieee_support_flag_3, &
ieee_support_flag_4, ieee_support_flag_8, ieee_support_flag_10, &
ieee_support_flag_16
end interface
@ -88,6 +89,10 @@ module ieee_exceptions
type(ieee_status_type), intent(in) :: status
end subroutine ieee_set_status
pure logical function ieee_support_flag(flag)
type(ieee_flag_type), intent(in) :: flag
ieee_support_flag = .true.
end function
pure logical function ieee_support_flag_2(flag, x)
type(ieee_flag_type), intent(in) :: flag
real(kind=2), intent(in) :: x(..)