From 4313f4c762eae6f2e2ed641dbdaddc958bb42bf7 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Fri, 8 Feb 2019 10:39:10 -0800 Subject: [PATCH] [flang] checkpoint array/struct constructor work Original-commit: flang-compiler/f18@b0a574fa359938936712eada41994601c8df2713 Reviewed-on: https://github.com/flang-compiler/f18/pull/287 Tree-same-pre-rewrite: false --- flang/documentation/extensions.md | 3 +- flang/lib/evaluate/constant.cc | 58 +++++++++++++------- flang/lib/evaluate/constant.h | 38 +++++++------ flang/lib/evaluate/expression.cc | 82 ++++++++++++++++++++++++++++- flang/lib/evaluate/expression.h | 52 ++++++++++++------ flang/lib/evaluate/fold.cc | 15 +++--- flang/lib/evaluate/type.cc | 61 --------------------- flang/lib/evaluate/type.h | 3 ++ flang/lib/semantics/expression.cc | 25 +++++---- flang/test/semantics/CMakeLists.txt | 10 +++- 10 files changed, 217 insertions(+), 130 deletions(-) diff --git a/flang/documentation/extensions.md b/flang/documentation/extensions.md index f23b34d86026..c4fb289fe360 100644 --- a/flang/documentation/extensions.md +++ b/flang/documentation/extensions.md @@ -1,5 +1,5 @@ As a general principle, this compiler will accept by default and @@ -79,3 +79,4 @@ Extensions and legacy features deliberately not supported * `B` suffix on unquoted octal constants * `Z` prefix on unquoted hexadecimal constants (dangerous) * `T` and `F` as abbreviations for `.TRUE.` and `.FALSE.` (dangerous) +* Use of host FORMAT labels in internal subprograms (PGI-only feature) diff --git a/flang/lib/evaluate/constant.cc b/flang/lib/evaluate/constant.cc index 3772aa76dd15..3da6b7edafd0 100644 --- a/flang/lib/evaluate/constant.cc +++ b/flang/lib/evaluate/constant.cc @@ -19,10 +19,11 @@ namespace Fortran::evaluate { -template ConstantBase::~ConstantBase() {} +template +ConstantBase::~ConstantBase() {} -template -std::ostream &ConstantBase::AsFortran(std::ostream &o) const { +template +std::ostream &ConstantBase::AsFortran(std::ostream &o) const { if (Rank() > 1) { o << "reshape("; } @@ -36,14 +37,14 @@ std::ostream &ConstantBase::AsFortran(std::ostream &o) const { } else { o << ','; } - if constexpr (T::category == TypeCategory::Integer) { - o << value.SignedDecimal() << '_' << T::kind; - } else if constexpr (T::category == TypeCategory::Real || - T::category == TypeCategory::Complex) { - value.AsFortran(o, T::kind); - } else if constexpr (T::category == TypeCategory::Character) { - o << T::kind << '_' << parser::QuoteCharacterLiteral(value); - } else if constexpr (T::category == TypeCategory::Logical) { + if constexpr (Result::category == TypeCategory::Integer) { + o << value.SignedDecimal() << '_' << Result::kind; + } else if constexpr (Result::category == TypeCategory::Real || + Result::category == TypeCategory::Complex) { + value.AsFortran(o, Result::kind); + } else if constexpr (Result::category == TypeCategory::Character) { + o << Result::kind << '_' << parser::QuoteCharacterLiteral(value); + } else if constexpr (Result::category == TypeCategory::Logical) { if (value.IsTrue()) { o << ".true."; } else { @@ -51,7 +52,7 @@ std::ostream &ConstantBase::AsFortran(std::ostream &o) const { } o << '_' << Result::kind; } else { - value.AsFortran(o); + StructureConstructor{AsConstant().derivedTypeSpec(), value}.AsFortran(o); } } if (Rank() > 0) { @@ -69,9 +70,9 @@ std::ostream &ConstantBase::AsFortran(std::ostream &o) const { return o; } -template -auto ConstantBase::At(const std::vector &index) const - -> Value { +template +auto ConstantBase::At( + const std::vector &index) const -> Value { CHECK(index.size() == static_cast(Rank())); std::int64_t stride{1}, offset{0}; int dim{0}; @@ -84,7 +85,8 @@ auto ConstantBase::At(const std::vector &index) const return values_.at(offset); } -template Constant ConstantBase::SHAPE() const { +template +Constant ConstantBase::SHAPE() const { using IntType = Scalar; std::vector result; for (std::int64_t dim : shape_) { @@ -93,10 +95,30 @@ template Constant ConstantBase::SHAPE() const { return {std::move(result), std::vector{Rank()}}; } +Constant::Constant(const StructureConstructor &x) + : Base{x.values()}, derivedTypeSpec_{&x.derivedTypeSpec()} {} + +Constant::Constant(StructureConstructor &&x) + : Base{std::move(x.values())}, derivedTypeSpec_{&x.derivedTypeSpec()} {} + +Constant::Constant(const semantics::DerivedTypeSpec &spec, + std::vector &&x, std::vector &&s) + : Base{std::move(x), std::move(s)}, derivedTypeSpec_{&spec} {} + +static std::vector GetValues( + std::vector &&x) { + std::vector result; + for (auto &&structure : std::move(x)) { + result.emplace_back(std::move(structure.values())); + } + return result; +} + Constant::Constant(const semantics::DerivedTypeSpec &spec, std::vector &&x, std::vector &&s) - : Base{std::move(x), std::move(s)}, spec_{&spec} {} + : Base{GetValues(std::move(x)), std::move(s)}, derivedTypeSpec_{&spec} {} -FOR_EACH_SPECIFIC_TYPE(template class ConstantBase) +FOR_EACH_INTRINSIC_KIND(template class ConstantBase) +template class ConstantBase; FOR_EACH_INTRINSIC_KIND(template class Constant) } diff --git a/flang/lib/evaluate/constant.h b/flang/lib/evaluate/constant.h index a3983c4e11a2..11fad03f24ec 100644 --- a/flang/lib/evaluate/constant.h +++ b/flang/lib/evaluate/constant.h @@ -16,6 +16,7 @@ #define FORTRAN_EVALUATE_CONSTANT_H_ #include "type.h" +#include #include namespace Fortran::evaluate { @@ -27,10 +28,10 @@ namespace Fortran::evaluate { template class Constant; -template class ConstantBase { +template> class ConstantBase { public: using Result = RESULT; - using Value = Scalar; + using Value = VALUE; template ConstantBase(const A &x) : values_{x} {} template @@ -97,30 +98,37 @@ public: // TODO pmk: make CHARACTER values contiguous (they're strings now) }; -template<> class Constant : public ConstantBase { +using StructureConstructorValues = + std::map>>; + +template<> +class Constant + : public ConstantBase { public: using Result = SomeDerived; - using Base = ConstantBase; - template - Constant(const semantics::DerivedTypeSpec &spec, const A &x) - : Base{x}, spec_{&spec} {} - template - Constant(const semantics::DerivedTypeSpec &spec, - std::enable_if_t, A> &&x) - : Base{std::move(x)}, spec_{&spec} {} + using Base = ConstantBase; + Constant(const StructureConstructor &); + Constant(StructureConstructor &&); Constant(const semantics::DerivedTypeSpec &, std::vector &&, std::vector &&); - + Constant(const semantics::DerivedTypeSpec &, + std::vector &&, std::vector &&); CLASS_BOILERPLATE(Constant) + + const semantics::DerivedTypeSpec &derivedTypeSpec() const { + return *derivedTypeSpec_; + } + DynamicType GetType() const { - return DynamicType{TypeCategory::Derived, 0, spec_}; + return DynamicType{TypeCategory::Derived, 0, derivedTypeSpec_}; } private: - const semantics::DerivedTypeSpec *spec_; + const semantics::DerivedTypeSpec *derivedTypeSpec_; }; -FOR_EACH_SPECIFIC_TYPE(extern template class ConstantBase) +FOR_EACH_INTRINSIC_KIND(extern template class ConstantBase) +extern template class ConstantBase; FOR_EACH_INTRINSIC_KIND(extern template class Constant) } #endif // FORTRAN_EVALUATE_CONSTANT_H_ diff --git a/flang/lib/evaluate/expression.cc b/flang/lib/evaluate/expression.cc index 5123bcaef430..e70366adf3f5 100644 --- a/flang/lib/evaluate/expression.cc +++ b/flang/lib/evaluate/expression.cc @@ -130,6 +130,12 @@ std::ostream &ArrayConstructor>::AsFortran( return o << ']'; } +std::ostream &ArrayConstructor::AsFortran(std::ostream &o) const { + o << '[' << GetType().AsFortran() << "::"; + Emit(o, values); + return o << ']'; +} + template std::ostream &ExpressionBase::AsFortran(std::ostream &o) const { std::visit( @@ -234,7 +240,7 @@ bool ArrayConstructorValues::operator==( template bool ArrayConstructor::operator==(const ArrayConstructor &that) const { - return type == that.type && values == that.values; + return values == that.values; } template @@ -243,6 +249,78 @@ bool ArrayConstructor>::operator==( return length == that.length && values == that.values; } +bool ArrayConstructor::operator==( + const ArrayConstructor &that) const { + return derivedTypeSpec_ == that.derivedTypeSpec_ && values == that.values; +} + +StructureConstructor::StructureConstructor( + const semantics::DerivedTypeSpec &spec, + const StructureConstructorValues &values) + : derivedTypeSpec_{&spec}, values_{values} {} +StructureConstructor::StructureConstructor( + const semantics::DerivedTypeSpec &spec, StructureConstructorValues &&values) + : derivedTypeSpec_{&spec}, values_{std::move(values)} {} +StructureConstructor::StructureConstructor(const StructureConstructor &that) + : derivedTypeSpec_{that.derivedTypeSpec_}, values_{that.values_} {} +StructureConstructor::StructureConstructor(StructureConstructor &&that) + : derivedTypeSpec_{that.derivedTypeSpec_}, values_{std::move(that.values_)} {} +StructureConstructor::~StructureConstructor() {} +StructureConstructor &StructureConstructor::operator=( + const StructureConstructor &that) { + derivedTypeSpec_ = that.derivedTypeSpec_; + values_ = that.values_; + return *this; +} +StructureConstructor &StructureConstructor::operator=( + StructureConstructor &&that) { + derivedTypeSpec_ = that.derivedTypeSpec_; + values_ = std::move(that.values_); + return *this; +} + +bool StructureConstructor::operator==(const StructureConstructor &that) const { + return derivedTypeSpec_ == that.derivedTypeSpec_ && values_ == that.values_; +} + +DynamicType StructureConstructor::GetType() const { + return {TypeCategory::Derived, 0, derivedTypeSpec_}; +} + +StructureConstructor &StructureConstructor::Add( + const Symbol &symbol, Expr &&expr) { + values_.emplace(&symbol, std::move(expr)); + return *this; +} + +std::ostream &StructureConstructor::AsFortran(std::ostream &o) const { + DerivedTypeSpecAsFortran(o, *derivedTypeSpec_); + if (values_.empty()) { + o << '('; + } else { + char ch{'('}; + for (const auto &[symbol, value] : values_) { + value->AsFortran(o << ch << symbol->name().ToString() << '='); + ch = ','; + } + } + return o << ')'; +} + +std::ostream &DerivedTypeSpecAsFortran( + std::ostream &o, const semantics::DerivedTypeSpec &spec) { + o << "TYPE("s << spec.typeSymbol().name().ToString(); + if (!spec.parameters().empty()) { + char ch{'('}; + for (const auto &[name, value] : spec.parameters()) { + value.GetExplicit()->AsFortran(o << ch << name.ToString() << '='); + ch = ','; + } + o << ')'; + } + return o; +} + bool GenericExprWrapper::operator==(const GenericExprWrapper &that) const { return v == that.v; } @@ -257,7 +335,7 @@ FOR_EACH_REAL_KIND(template struct Relational) FOR_EACH_CHARACTER_KIND(template struct Relational) template struct Relational; FOR_EACH_TYPE_AND_KIND(template class ExpressionBase) -FOR_EACH_SPECIFIC_TYPE(template struct ArrayConstructor) +FOR_EACH_INTRINSIC_KIND(template struct ArrayConstructor) } // For reclamation of analyzed expressions to which owning pointers have diff --git a/flang/lib/evaluate/expression.h b/flang/lib/evaluate/expression.h index af606e75c092..8c42d04258e5 100644 --- a/flang/lib/evaluate/expression.h +++ b/flang/lib/evaluate/expression.h @@ -425,18 +425,15 @@ template struct ArrayConstructorValues { std::vector> values; }; +// TODO pmk: use a common base class as with Constant template struct ArrayConstructor { using Result = RESULT; CLASS_BOILERPLATE(ArrayConstructor) - ArrayConstructor(Result &&t, ArrayConstructorValues &&v) - : type{std::move(t)}, values{std::move(v)} { - CHECK(type.category != TypeCategory::Character); - } + ArrayConstructor(ArrayConstructorValues &&v) : values{std::move(v)} {} bool operator==(const ArrayConstructor &) const; - DynamicType GetType() const { return type.GetType(); } + static constexpr DynamicType GetType() { return Result::GetType(); } static constexpr int Rank() { return 1; } std::ostream &AsFortran(std::ostream &) const; - Result type; ArrayConstructorValues values; }; @@ -445,8 +442,8 @@ struct ArrayConstructor> { using Result = Type; CLASS_BOILERPLATE(ArrayConstructor) ArrayConstructor( - ArrayConstructorValues &&v, Expr &&len) - : values{std::move(v)}, length{std::move(len)} {} + Expr &&len, ArrayConstructorValues &&v) + : length{std::move(len)}, values{std::move(v)} {} ~ArrayConstructor(); bool operator==(const ArrayConstructor &) const; static constexpr DynamicType GetType() { return Result::GetType(); } @@ -454,8 +451,27 @@ struct ArrayConstructor> { std::ostream &AsFortran(std::ostream &) const; const Expr &LEN() const { return *length; } - ArrayConstructorValues values; CopyableIndirection> length; + ArrayConstructorValues values; +}; + +template<> struct ArrayConstructor { + using Result = SomeDerived; + CLASS_BOILERPLATE(ArrayConstructor) + ArrayConstructor(const semantics::DerivedTypeSpec &spec, + ArrayConstructorValues &&v) + : derivedTypeSpec_{&spec}, values{std::move(v)} {} + bool operator==(const ArrayConstructor &) const; + const semantics::DerivedTypeSpec &derivedTypeSpec() const { + return *derivedTypeSpec_; + } + DynamicType GetType() const { + return DynamicType{TypeCategory::Derived, 0, derivedTypeSpec_}; + } + static constexpr int Rank() { return 1; } + std::ostream &AsFortran(std::ostream &) const; + const semantics::DerivedTypeSpec *derivedTypeSpec_; + ArrayConstructorValues values; }; // Expression representations for each type category. @@ -635,15 +651,16 @@ FOR_EACH_LOGICAL_KIND(extern template class Expr) class StructureConstructor { public: - using Values = std::list>>>; - // N.B. CLASS_BOILERPLATE() can't be used here due to forward reference // to Expr preventing the use of "= default" constructors and // assignment operators. StructureConstructor() = delete; explicit StructureConstructor(const semantics::DerivedTypeSpec &spec) : derivedTypeSpec_{&spec} {} + StructureConstructor( + const semantics::DerivedTypeSpec &, const StructureConstructorValues &); + StructureConstructor( + const semantics::DerivedTypeSpec &, StructureConstructorValues &&); StructureConstructor(const StructureConstructor &); StructureConstructor(StructureConstructor &&); ~StructureConstructor(); @@ -653,8 +670,8 @@ public: const semantics::DerivedTypeSpec &derivedTypeSpec() const { return *derivedTypeSpec_; } - Values &values() { return values_; } - const Values &values() const { return values_; } + StructureConstructorValues &values() { return values_; } + const StructureConstructorValues &values() const { return values_; } bool operator==(const StructureConstructor &) const; StructureConstructor &Add(const semantics::Symbol &, Expr &&); @@ -664,7 +681,7 @@ public: private: const semantics::DerivedTypeSpec *derivedTypeSpec_; - Values values_; + StructureConstructorValues values_; }; // An expression whose result has a derived type. @@ -741,8 +758,11 @@ struct GenericExprWrapper { Expr v; }; +std::ostream &DerivedTypeSpecAsFortran( + std::ostream &, const semantics::DerivedTypeSpec &); + FOR_EACH_CATEGORY_TYPE(extern template class Expr) FOR_EACH_TYPE_AND_KIND(extern template class ExpressionBase) -FOR_EACH_SPECIFIC_TYPE(extern template struct ArrayConstructor) +FOR_EACH_INTRINSIC_KIND(extern template struct ArrayConstructor) } #endif // FORTRAN_EVALUATE_EXPRESSION_H_ diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc index cd5a9baaae86..2827079a6a9e 100644 --- a/flang/lib/evaluate/fold.cc +++ b/flang/lib/evaluate/fold.cc @@ -230,10 +230,10 @@ public: Expr FoldArray(ArrayConstructor &&array) { if (FoldArray(array.values)) { - std::int64_t n = elements_.size(); + auto n{static_cast(elements_.size())}; if constexpr (std::is_same_v) { - return Expr{Constant{array.type.spec(), std::move(elements_), - std::vector{n}}}; + return Expr{Constant{array.derivedTypeSpec(), + std::move(elements_), std::vector{n}}}; } else { return Expr{ Constant{std::move(elements_), std::vector{n}}}; @@ -252,7 +252,11 @@ private: int rank{c->Rank()}; std::vector index(shape.size(), 1); for (std::size_t n{c->size()}; n-- > 0;) { - elements_.push_back(c->At(index)); + if constexpr (std::is_same_v) { + elements_.emplace_back(c->derivedTypeSpec(), c->At(index)); + } else { + elements_.emplace_back(c->At(index)); + } for (int d{0}; d < rank; ++d) { if (++index[d] <= shape[d]) { break; @@ -315,8 +319,7 @@ Expr FoldOperation( for (auto &&[symbol, value] : std::move(structure.values())) { result.Add(*symbol, Fold(context, std::move(*value))); } - return Expr{ - Constant{result.derivedTypeSpec(), result}}; + return Expr{Constant{result}}; } // Substitute a bare type parameter reference with its value if it has one now diff --git a/flang/lib/evaluate/type.cc b/flang/lib/evaluate/type.cc index 1a521d455d4c..1f616db78c75 100644 --- a/flang/lib/evaluate/type.cc +++ b/flang/lib/evaluate/type.cc @@ -21,7 +21,6 @@ #include "../semantics/type.h" #include #include -#include #include #include @@ -185,69 +184,9 @@ bool SomeKind::operator==( return spec_ == that.spec_ && descriptor_ == that.descriptor_; } -static std::ostream &DerivedTypeSpecAsFortran( - std::ostream &o, const semantics::DerivedTypeSpec &spec) { - o << "TYPE("s << spec.typeSymbol().name().ToString(); - if (!spec.parameters().empty()) { - char ch{'('}; - for (const auto &[name, value] : spec.parameters()) { - value.GetExplicit()->AsFortran(o << ch << name.ToString() << '='); - ch = ','; - } - o << ')'; - } - return o; -} - std::string SomeDerived::AsFortran() const { std::stringstream out; DerivedTypeSpecAsFortran(out, spec()); return out.str(); } - -StructureConstructor::StructureConstructor(const StructureConstructor &that) - : derivedTypeSpec_{that.derivedTypeSpec_}, values_{that.values_} {} -StructureConstructor::StructureConstructor(StructureConstructor &&that) - : derivedTypeSpec_{that.derivedTypeSpec_}, values_{std::move(that.values_)} {} -StructureConstructor::~StructureConstructor() {} -StructureConstructor &StructureConstructor::operator=( - const StructureConstructor &that) { - derivedTypeSpec_ = that.derivedTypeSpec_; - values_ = that.values_; - return *this; -} -StructureConstructor &StructureConstructor::operator=( - StructureConstructor &&that) { - derivedTypeSpec_ = that.derivedTypeSpec_; - values_ = std::move(that.values_); - return *this; -} - -bool StructureConstructor::operator==(const StructureConstructor &that) const { - return derivedTypeSpec_ == that.derivedTypeSpec_ && values_ == that.values_; -} - -DynamicType StructureConstructor::GetType() const { - return {TypeCategory::Derived, 0, derivedTypeSpec_}; -} - -StructureConstructor &StructureConstructor::Add( - const Symbol &symbol, Expr &&expr) { - values_.emplace_back(&symbol, std::move(expr)); - return *this; -} - -std::ostream &StructureConstructor::AsFortran(std::ostream &o) const { - DerivedTypeSpecAsFortran(o, *derivedTypeSpec_); - if (values_.empty()) { - o << '('; - } else { - char ch{'('}; - for (const auto &[symbol, value] : values_) { - value->AsFortran(o << ch << symbol->name().ToString() << '='); - ch = ','; - } - } - return o << ')'; -} } diff --git a/flang/lib/evaluate/type.h b/flang/lib/evaluate/type.h index d40a25560a49..bafd930fa03c 100644 --- a/flang/lib/evaluate/type.h +++ b/flang/lib/evaluate/type.h @@ -288,6 +288,9 @@ using SomeDerived = SomeKind; using SomeCategory = std::tuple; +using AllTypes = + common::CombineTuples>; + template using Scalar = typename std::decay_t::Scalar; // When Scalar is S, then TypeOf is T. diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 8e35261c1407..202a816385b1 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -1284,20 +1284,25 @@ ArrayConstructorValues MakeSpecific( struct ArrayConstructorTypeVisitor { using Result = MaybeExpr; - using Types = LengthlessIntrinsicTypes; + using Types = AllTypes; template Result Test() { - if (type.category == T::category && type.kind == T::kind) { - if constexpr (T::category == TypeCategory::Character) { - CHECK(type.length.has_value()); + if (type.category == T::category) { + if constexpr (T::category == TypeCategory::Derived) { + CHECK(type.derived != nullptr); return AsMaybeExpr(ArrayConstructor{ - MakeSpecific(std::move(values)), std::move(*type.length)}); - } else { - return AsMaybeExpr( - ArrayConstructor{T{}, MakeSpecific(std::move(values))}); + *type.derived, MakeSpecific(std::move(values))}); + } else if (type.kind == T::kind) { + if constexpr (T::category == TypeCategory::Character) { + CHECK(type.length.has_value()); + return AsMaybeExpr(ArrayConstructor{ + std::move(*type.length), MakeSpecific(std::move(values))}); + } else { + return AsMaybeExpr( + ArrayConstructor{MakeSpecific(std::move(values))}); + } } - } else { - return std::nullopt; } + return std::nullopt; } DynamicTypeWithLength type; ArrayConstructorValues values; diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index 1ef04faf53a8..7789bc080e72 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -113,7 +113,15 @@ set(MODFILE_TESTS ) set(LABEL_TESTS - label*.[Ff]90 +# label*.[Ff]90 # 01, 05, 06, 07 loop with current master + label02.f90 + label03.f90 + label04.f90 + label08.f90 + label09.f90 + label10.f90 + label11.f90 + label12.f90 ) set(DOCONCURRENT_TESTS