[flang-commits] [flang] e8f9689 - [flang] Allow array constructor implied DO loop indices as constant expressions
peter klausler via flang-commits
flang-commits at lists.llvm.org
Mon Nov 2 11:00:30 PST 2020
Author: peter klausler
Date: 2020-11-02T11:00:17-08:00
New Revision: e8f96899e17b11292940d8826338e2e0a64a22b9
URL: https://github.com/llvm/llvm-project/commit/e8f96899e17b11292940d8826338e2e0a64a22b9
DIFF: https://github.com/llvm/llvm-project/commit/e8f96899e17b11292940d8826338e2e0a64a22b9.diff
LOG: [flang] Allow array constructor implied DO loop indices as constant expressions
When the bounds of an implied DO loop in an array constructor are
constant, the index variable of that loop is considered a constant
expression and can be used as such in the items in the value list
of the implied DO loop. Since the KIND type parameter values of items
in the value list can depend on the various values taken by such an
index, it is not possible to represent those values with a single
typed expression. So implement such loops by taking multiple passes
over the parse tree of the implied DO loop instead.
Differential revision: https://reviews.llvm.org/D90494
Added:
flang/test/Evaluate/folding13.f90
Modified:
flang/include/flang/Parser/message.h
flang/include/flang/Semantics/expression.h
flang/lib/Semantics/expression.cpp
flang/test/Semantics/array-constr-values.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Parser/message.h b/flang/include/flang/Parser/message.h
index cd1df0a968e7..cbb42df97351 100644
--- a/flang/include/flang/Parser/message.h
+++ b/flang/include/flang/Parser/message.h
@@ -293,7 +293,7 @@ class ContextualMessages {
common::Restorer<Messages *> SetMessages(Messages &buffer) {
return common::ScopedSet(messages_, &buffer);
}
- // Discard messages; destination restored when the returned value is deleted.
+ // Discard future messages until the returned value is deleted.
common::Restorer<Messages *> DiscardMessages() {
return common::ScopedSet(messages_, nullptr);
}
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index 75cf4fe53664..4862e98a0bdc 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -146,6 +146,10 @@ class ExpressionAnalyzer {
return common::ScopedSet(isWholeAssumedSizeArrayOk_, true);
}
+ common::Restorer<bool> DoNotUseSavedTypedExprs() {
+ return common::ScopedSet(useSavedTypedExprs_, false);
+ }
+
Expr<SubscriptInteger> AnalyzeKindSelector(common::TypeCategory category,
const std::optional<parser::KindSelector> &);
@@ -378,8 +382,8 @@ class ExpressionAnalyzer {
semantics::SemanticsContext &context_;
FoldingContext &foldingContext_{context_.foldingContext()};
std::map<parser::CharBlock, int> impliedDos_; // values are INTEGER kinds
- bool fatalErrors_{false};
bool isWholeAssumedSizeArrayOk_{false};
+ bool useSavedTypedExprs_{true};
friend class ArgumentAnalyzer;
};
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 73534c3caa18..8ffa54758d8c 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1184,15 +1184,24 @@ class ArrayConstructorContext {
}
private:
+ using ImpliedDoIntType = ResultType<ImpliedDoIndex>;
+
void Push(MaybeExpr &&);
+ void Add(const parser::AcValue::Triplet &);
+ void Add(const parser::Expr &);
+ void Add(const parser::AcImpliedDo &);
+ void UnrollConstantImpliedDo(const parser::AcImpliedDo &,
+ parser::CharBlock name, std::int64_t lower, std::int64_t upper,
+ std::int64_t stride);
template <int KIND, typename A>
std::optional<Expr<Type<TypeCategory::Integer, KIND>>> GetSpecificIntExpr(
const A &x) {
if (MaybeExpr y{exprAnalyzer_.Analyze(x)}) {
Expr<SomeInteger> *intExpr{UnwrapExpr<Expr<SomeInteger>>(*y)};
- return ConvertToType<Type<TypeCategory::Integer, KIND>>(
- std::move(DEREF(intExpr)));
+ return Fold(exprAnalyzer_.GetFoldingContext(),
+ ConvertToType<Type<TypeCategory::Integer, KIND>>(
+ std::move(DEREF(intExpr))));
}
return std::nullopt;
}
@@ -1204,7 +1213,7 @@ class ArrayConstructorContext {
bool explicitType_{type_.has_value()};
std::optional<std::int64_t> constantLength_;
ArrayConstructorValues<SomeType> values_;
- bool messageDisplayedOnce{false};
+ std::uint64_t messageDisplayedSet_{0};
};
void ArrayConstructorContext::Push(MaybeExpr &&x) {
@@ -1238,9 +1247,12 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
if (constantLength_) {
if (exprAnalyzer_.context().warnOnNonstandardUsage() &&
*thisLen != *constantLength_) {
- exprAnalyzer_.Say(
- "Character literal in array constructor without explicit "
- "type has
diff erent length than earlier element"_en_US);
+ if (!(messageDisplayedSet_ & 1)) {
+ exprAnalyzer_.Say(
+ "Character literal in array constructor without explicit "
+ "type has
diff erent length than earlier elements"_en_US);
+ messageDisplayedSet_ |= 1;
+ }
}
if (*thisLen > *constantLength_) {
// Language extension: use the longest literal to determine the
@@ -1255,111 +1267,176 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
}
}
} else {
- if (!messageDisplayedOnce) {
+ if (!(messageDisplayedSet_ & 2)) {
exprAnalyzer_.Say(
"Values in array constructor must have the same declared type "
"when no explicit type appears"_err_en_US); // C7110
- messageDisplayedOnce = true;
+ messageDisplayedSet_ |= 2;
}
}
} else {
if (auto cast{ConvertToType(*type_, std::move(*x))}) {
values_.Push(std::move(*cast));
- } else {
+ } else if (!(messageDisplayedSet_ & 4)) {
exprAnalyzer_.Say(
"Value in array constructor of type '%s' could not "
"be converted to the type of the array '%s'"_err_en_US,
x->GetType()->AsFortran(), type_->AsFortran()); // C7111, C7112
+ messageDisplayedSet_ |= 4;
}
}
}
}
void ArrayConstructorContext::Add(const parser::AcValue &x) {
- using IntType = ResultType<ImpliedDoIndex>;
std::visit(
common::visitors{
- [&](const parser::AcValue::Triplet &triplet) {
- // Transform l:u(:s) into (_,_=l,u(,s)) with an anonymous index '_'
- std::optional<Expr<IntType>> lower{
- GetSpecificIntExpr<IntType::kind>(std::get<0>(triplet.t))};
- std::optional<Expr<IntType>> upper{
- GetSpecificIntExpr<IntType::kind>(std::get<1>(triplet.t))};
- std::optional<Expr<IntType>> stride{
- GetSpecificIntExpr<IntType::kind>(std::get<2>(triplet.t))};
- if (lower && upper) {
- if (!stride) {
- stride = Expr<IntType>{1};
- }
- if (!type_) {
- type_ = DynamicTypeWithLength{IntType::GetType()};
- }
- auto v{std::move(values_)};
- parser::CharBlock anonymous;
- Push(Expr<SomeType>{
- Expr<SomeInteger>{Expr<IntType>{ImpliedDoIndex{anonymous}}}});
- std::swap(v, values_);
- values_.Push(ImpliedDo<SomeType>{anonymous, std::move(*lower),
- std::move(*upper), std::move(*stride), std::move(v)});
- }
- },
+ [&](const parser::AcValue::Triplet &triplet) { Add(triplet); },
[&](const common::Indirection<parser::Expr> &expr) {
- auto restorer{exprAnalyzer_.GetContextualMessages().SetLocation(
- expr.value().source)};
- if (MaybeExpr v{exprAnalyzer_.Analyze(expr.value())}) {
- if (auto exprType{v->GetType()}) {
- if (exprType->IsUnlimitedPolymorphic()) {
- exprAnalyzer_.Say(
- "Cannot have an unlimited polymorphic value in an "
- "array constructor"_err_en_US); // C7113
- }
- }
- Push(std::move(*v));
- }
+ Add(expr.value());
},
[&](const common::Indirection<parser::AcImpliedDo> &impliedDo) {
- const auto &control{
- std::get<parser::AcImpliedDoControl>(impliedDo.value().t)};
- const auto &bounds{
- std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
- exprAnalyzer_.Analyze(bounds.name);
- parser::CharBlock name{bounds.name.thing.thing.source};
- const Symbol *symbol{bounds.name.thing.thing.symbol};
- int kind{IntType::kind};
- if (const auto dynamicType{DynamicType::From(symbol)}) {
- kind = dynamicType->kind();
- }
- if (exprAnalyzer_.AddImpliedDo(name, kind)) {
- std::optional<Expr<IntType>> lower{
- GetSpecificIntExpr<IntType::kind>(bounds.lower)};
- std::optional<Expr<IntType>> upper{
- GetSpecificIntExpr<IntType::kind>(bounds.upper)};
- if (lower && upper) {
- std::optional<Expr<IntType>> stride{
- GetSpecificIntExpr<IntType::kind>(bounds.step)};
- auto v{std::move(values_)};
- for (const auto &value :
- std::get<std::list<parser::AcValue>>(impliedDo.value().t)) {
- Add(value);
- }
- if (!stride) {
- stride = Expr<IntType>{1};
- }
- std::swap(v, values_);
- values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
- std::move(*upper), std::move(*stride), std::move(v)});
- }
- exprAnalyzer_.RemoveImpliedDo(name);
- } else {
- exprAnalyzer_.SayAt(name,
- "Implied DO index is active in surrounding implied DO loop "
- "and may not have the same name"_err_en_US); // C7115
- }
+ Add(impliedDo.value());
},
},
x.u);
}
+// Transforms l:u(:s) into (_,_=l,u(,s)) with an anonymous index '_'
+void ArrayConstructorContext::Add(const parser::AcValue::Triplet &triplet) {
+ std::optional<Expr<ImpliedDoIntType>> lower{
+ GetSpecificIntExpr<ImpliedDoIntType::kind>(std::get<0>(triplet.t))};
+ std::optional<Expr<ImpliedDoIntType>> upper{
+ GetSpecificIntExpr<ImpliedDoIntType::kind>(std::get<1>(triplet.t))};
+ std::optional<Expr<ImpliedDoIntType>> stride{
+ GetSpecificIntExpr<ImpliedDoIntType::kind>(std::get<2>(triplet.t))};
+ if (lower && upper) {
+ if (!stride) {
+ stride = Expr<ImpliedDoIntType>{1};
+ }
+ if (!type_) {
+ type_ = DynamicTypeWithLength{ImpliedDoIntType::GetType()};
+ }
+ auto v{std::move(values_)};
+ parser::CharBlock anonymous;
+ Push(Expr<SomeType>{
+ Expr<SomeInteger>{Expr<ImpliedDoIntType>{ImpliedDoIndex{anonymous}}}});
+ std::swap(v, values_);
+ values_.Push(ImpliedDo<SomeType>{anonymous, std::move(*lower),
+ std::move(*upper), std::move(*stride), std::move(v)});
+ }
+}
+
+void ArrayConstructorContext::Add(const parser::Expr &expr) {
+ auto restorer{exprAnalyzer_.GetContextualMessages().SetLocation(expr.source)};
+ if (MaybeExpr v{exprAnalyzer_.Analyze(expr)}) {
+ if (auto exprType{v->GetType()}) {
+ if (!(messageDisplayedSet_ & 8) && exprType->IsUnlimitedPolymorphic()) {
+ exprAnalyzer_.Say("Cannot have an unlimited polymorphic value in an "
+ "array constructor"_err_en_US); // C7113
+ messageDisplayedSet_ |= 8;
+ }
+ }
+ Push(std::move(*v));
+ }
+}
+
+void ArrayConstructorContext::Add(const parser::AcImpliedDo &impliedDo) {
+ const auto &control{std::get<parser::AcImpliedDoControl>(impliedDo.t)};
+ const auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
+ exprAnalyzer_.Analyze(bounds.name);
+ parser::CharBlock name{bounds.name.thing.thing.source};
+ const Symbol *symbol{bounds.name.thing.thing.symbol};
+ int kind{ImpliedDoIntType::kind};
+ if (const auto dynamicType{DynamicType::From(symbol)}) {
+ kind = dynamicType->kind();
+ }
+ if (!exprAnalyzer_.AddImpliedDo(name, kind)) {
+ if (!(messageDisplayedSet_ & 0x20)) {
+ exprAnalyzer_.SayAt(name,
+ "Implied DO index is active in surrounding implied DO loop "
+ "and may not have the same name"_err_en_US); // C7115
+ messageDisplayedSet_ |= 0x20;
+ }
+ return;
+ }
+ std::optional<Expr<ImpliedDoIntType>> lower{
+ GetSpecificIntExpr<ImpliedDoIntType::kind>(bounds.lower)};
+ std::optional<Expr<ImpliedDoIntType>> upper{
+ GetSpecificIntExpr<ImpliedDoIntType::kind>(bounds.upper)};
+ if (lower && upper) {
+ std::optional<Expr<ImpliedDoIntType>> stride{
+ GetSpecificIntExpr<ImpliedDoIntType::kind>(bounds.step)};
+ if (!stride) {
+ stride = Expr<ImpliedDoIntType>{1};
+ }
+ // Check for constant bounds; the loop may require complete unrolling
+ // of the parse tree if all bounds are constant in order to allow the
+ // implied DO loop index to qualify as a constant expression.
+ auto cLower{ToInt64(lower)};
+ auto cUpper{ToInt64(upper)};
+ auto cStride{ToInt64(stride)};
+ if (!(messageDisplayedSet_ & 0x10) && cStride && *cStride == 0) {
+ exprAnalyzer_.SayAt(bounds.step.value().thing.thing.value().source,
+ "The stride of an implied DO loop must not be zero"_err_en_US);
+ messageDisplayedSet_ |= 0x10;
+ }
+ bool isConstant{cLower && cUpper && cStride && *cStride != 0};
+ bool isNonemptyConstant{isConstant &&
+ ((*cStride > 0 && *cLower <= *cUpper) ||
+ (*cStride < 0 && *cLower >= *cUpper))};
+ bool unrollConstantLoop{false};
+ parser::Messages buffer;
+ auto saveMessagesDisplayed{messageDisplayedSet_};
+ {
+ auto messageRestorer{
+ exprAnalyzer_.GetContextualMessages().SetMessages(buffer)};
+ auto v{std::move(values_)};
+ for (const auto &value :
+ std::get<std::list<parser::AcValue>>(impliedDo.t)) {
+ Add(value);
+ }
+ std::swap(v, values_);
+ if (isNonemptyConstant && buffer.AnyFatalError()) {
+ unrollConstantLoop = true;
+ } else {
+ values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
+ std::move(*upper), std::move(*stride), std::move(v)});
+ }
+ }
+ if (unrollConstantLoop) {
+ messageDisplayedSet_ = saveMessagesDisplayed;
+ UnrollConstantImpliedDo(impliedDo, name, *cLower, *cUpper, *cStride);
+ } else if (auto *messages{
+ exprAnalyzer_.GetContextualMessages().messages()}) {
+ messages->Annex(std::move(buffer));
+ }
+ }
+ exprAnalyzer_.RemoveImpliedDo(name);
+}
+
+// Fortran considers an implied DO index of an array constructor to be
+// a constant expression if the bounds of the implied DO loop are constant.
+// Usually this doesn't matter, but if we emitted spurious messages as a
+// result of not using constant values for the index while analyzing the
+// items, we need to do it again the "hard" way with multiple iterations over
+// the parse tree.
+void ArrayConstructorContext::UnrollConstantImpliedDo(
+ const parser::AcImpliedDo &impliedDo, parser::CharBlock name,
+ std::int64_t lower, std::int64_t upper, std::int64_t stride) {
+ auto &foldingContext{exprAnalyzer_.GetFoldingContext()};
+ auto restorer{exprAnalyzer_.DoNotUseSavedTypedExprs()};
+ for (auto &at{foldingContext.StartImpliedDo(name, lower)};
+ (stride > 0 && at <= upper) || (stride < 0 && at >= upper);
+ at += stride) {
+ for (const auto &value :
+ std::get<std::list<parser::AcValue>>(impliedDo.t)) {
+ Add(value);
+ }
+ }
+ foldingContext.EndImpliedDo(name);
+}
+
MaybeExpr ArrayConstructorContext::ToExpr() {
return common::SearchTypes(std::move(*this));
}
@@ -2525,7 +2602,7 @@ static void FixMisparsedFunctionReference(
// representation of the analyzed expression.
template <typename PARSED>
MaybeExpr ExpressionAnalyzer::ExprOrVariable(const PARSED &x) {
- if (x.typedExpr) {
+ if (useSavedTypedExprs_ && x.typedExpr) {
return x.typedExpr->v;
}
if constexpr (std::is_same_v<PARSED, parser::Expr> ||
@@ -2546,7 +2623,6 @@ MaybeExpr ExpressionAnalyzer::ExprOrVariable(const PARSED &x) {
Say("Internal error: Expression analysis failed on: %s"_err_en_US,
dump.str());
}
- fatalErrors_ = true;
return std::nullopt;
}
diff --git a/flang/test/Evaluate/folding13.f90 b/flang/test/Evaluate/folding13.f90
new file mode 100644
index 000000000000..753b7be068c2
--- /dev/null
+++ b/flang/test/Evaluate/folding13.f90
@@ -0,0 +1,11 @@
+! RUN: %S/test_folding.sh %s %t %f18
+! Test folding of array constructors with constant implied DO bounds;
+! their indices are constant expressions and can be used as such.
+module m1
+ integer, parameter :: kinds(*) = [1, 2, 4, 8]
+ integer(kind=8), parameter :: clipping(*) = [integer(kind=8) :: &
+ (int(z'100010101', kind=kinds(j)), j=1,4)]
+ integer(kind=8), parameter :: expected(*) = [ &
+ int(z'01',8), int(z'0101',8), int(z'00010101',8), int(z'100010101',8)]
+ logical, parameter :: test_clipping = all(clipping == expected)
+end module
diff --git a/flang/test/Semantics/array-constr-values.f90 b/flang/test/Semantics/array-constr-values.f90
index 30739f8c095b..2d815a3559c9 100644
--- a/flang/test/Semantics/array-constr-values.f90
+++ b/flang/test/Semantics/array-constr-values.f90
@@ -57,4 +57,7 @@ subroutine checkC7115()
!ERROR: Implied DO index is active in surrounding implied DO loop and may not have the same name
!ERROR: 'i' is already declared in this scoping unit
real, dimension(100), parameter :: bad = [((88.8, i = 1, 10), i = 1, 10)]
+
+ !ERROR: The stride of an implied DO loop must not be zero
+ integer, parameter :: bad2(*) = [(j, j=1,1,0)]
end subroutine checkC7115
More information about the flang-commits
mailing list