From 0ae3d43d76bdb1b1a1bcb8efc27abde6860f40c4 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Tue, 22 Jan 2019 16:30:32 -0800 Subject: [PATCH] [flang] Run expression semantic analysis with rest of semantics. checkpoint array constructor semantics work checkpoint array constructors of lengthless intrinsic types checkpoint Correct ambiguous substring refs misparsed as array elements Original-commit: flang-compiler/f18@2232549efe42a2ef97725a131ac642b9be9274f4 Reviewed-on: https://github.com/flang-compiler/f18/pull/271 Tree-same-pre-rewrite: false --- flang/lib/common/fortran.h | 7 +- flang/lib/common/template.h | 28 +-- flang/lib/evaluate/expression.cc | 54 +++-- flang/lib/evaluate/expression.h | 91 +++++--- flang/lib/evaluate/fold.cc | 15 +- flang/lib/evaluate/tools.cc | 62 ++++++ flang/lib/evaluate/tools.h | 83 ++++---- flang/lib/evaluate/type.cc | 14 +- flang/lib/evaluate/type.h | 28 +-- flang/lib/evaluate/variable.cc | 45 ++-- flang/lib/evaluate/variable.h | 10 +- flang/lib/parser/parse-tree.h | 6 +- flang/lib/semantics/expression.cc | 396 ++++++++++++++++++++++++++++++++--- flang/lib/semantics/expression.h | 8 + flang/lib/semantics/resolve-names.cc | 122 +++++++++-- flang/lib/semantics/scope.h | 2 +- flang/lib/semantics/semantics.cc | 9 +- flang/lib/semantics/semantics.h | 6 - flang/lib/semantics/type.cc | 4 - flang/lib/semantics/type.h | 7 +- flang/test/semantics/resolve30.f90 | 13 -- flang/test/semantics/resolve35.f90 | 11 +- flang/tools/f18/f18.cc | 8 +- 23 files changed, 775 insertions(+), 254 deletions(-) diff --git a/flang/lib/common/fortran.h b/flang/lib/common/fortran.h index 1bc9679..5dc8d77 100644 --- a/flang/lib/common/fortran.h +++ b/flang/lib/common/fortran.h @@ -23,9 +23,14 @@ namespace Fortran::common { -// Fortran has five kinds of intrinsic data, and the derived types. +// Fortran has five kinds of intrinsic data types, plus the derived types. ENUM_CLASS(TypeCategory, Integer, Real, Complex, Character, Logical, Derived) +constexpr bool IsNumericTypeCategory(TypeCategory category) { + return category == TypeCategory::Integer || category == TypeCategory::Real || + category == TypeCategory::Complex; +} + // Kinds of IMPORT statements. Default means IMPORT or IMPORT :: names. ENUM_CLASS(ImportKind, Default, Only, None, All) diff --git a/flang/lib/common/template.h b/flang/lib/common/template.h index 7f3f4d6..aaa7721 100644 --- a/flang/lib/common/template.h +++ b/flang/lib/common/template.h @@ -29,8 +29,7 @@ namespace Fortran::common { // SearchTypeList scans a list of types. The zero-based // index of the first type T in the list for which PREDICATE::value() is // true is returned, or -1 if the predicate is false for every type in the list. -// This is a compile-time operation; see SearchDynamicTypes below for a -// run-time form. +// This is a compile-time operation; see SearchTypes below for a run-time form. template class PREDICATE, typename TUPLE> struct SearchTypeListHelper { static constexpr int value() { @@ -245,28 +244,29 @@ std::optional MapOptional( // Given a VISITOR class of the general form // struct VISITOR { // using Result = ...; -// static constexpr std::size_t Types{...}; -// template static Result Test(); +// using Types = std::tuple<...>; +// template Result Test() { ... } // }; -// SearchDynamicTypes will traverse the indices 0 .. (Types-1) and -// invoke VISITOR::Test() until it returns a value that casts -// to true. If no invocation of Test succeeds, it returns a -// default-constructed Result. +// SearchTypes will traverse the element types in the tuple in order +// and invoke VISITOR::Test() on each until it returns a value that +// casts to true. If no invocation of Test succeeds, SearchTypes will +// return a default-constructed value VISITOR::Result{}. template -typename VISITOR::Result SearchDynamicTypesHelper(VISITOR &&visitor) { - if constexpr (J < VISITOR::Types) { - if (auto result{visitor.template Test()}) { +typename VISITOR::Result SearchTypesHelper(VISITOR &&visitor) { + using Tuple = typename VISITOR::Types; + if constexpr (J < std::tuple_size_v) { + if (auto result{visitor.template Test>()}) { return result; } - return SearchDynamicTypesHelper(std::move(visitor)); + return SearchTypesHelper(std::move(visitor)); } else { return typename VISITOR::Result{}; } } template -typename VISITOR::Result SearchDynamicTypes(VISITOR &&visitor) { - return SearchDynamicTypesHelper<0, VISITOR>(std::move(visitor)); +typename VISITOR::Result SearchTypes(VISITOR &&visitor) { + return SearchTypesHelper<0, VISITOR>(std::move(visitor)); } } #endif // FORTRAN_COMMON_TEMPLATE_H_ diff --git a/flang/lib/evaluate/expression.cc b/flang/lib/evaluate/expression.cc index ef78008..f4e4ff9 100644 --- a/flang/lib/evaluate/expression.cc +++ b/flang/lib/evaluate/expression.cc @@ -21,6 +21,7 @@ #include "../parser/characters.h" #include "../parser/message.h" #include +#include #include #include @@ -107,15 +108,15 @@ template std::ostream &Emit(std::ostream &o, const CopyableIndirection> &expr) { return expr->AsFortran(o); } + template std::ostream &Emit(std::ostream &, const ArrayConstructorValues &); -template -std::ostream &Emit(std::ostream &o, const ImpliedDo &implDo) { +template +std::ostream &Emit(std::ostream &o, const ImpliedDo &implDo) { o << '('; Emit(o, *implDo.values); - o << ',' << INT::AsFortran() << "::"; - o << implDo.controlVariableName.ToString(); + o << ',' << ImpliedDoIndex::Result::AsFortran() << "::"; o << '='; implDo.lower->AsFortran(o) << ','; implDo.upper->AsFortran(o) << ','; @@ -136,8 +137,18 @@ std::ostream &Emit(std::ostream &o, const ArrayConstructorValues &values) { template std::ostream &ArrayConstructor::AsFortran(std::ostream &o) const { - o << '[' << result.AsFortran() << "::"; - Emit(o, *this); + o << '[' << GetType().AsFortran() << "::"; + Emit(o, values); + return o << ']'; +} + +template +std::ostream &ArrayConstructor>::AsFortran( + std::ostream &o) const { + std::stringstream len; + length->AsFortran(len); + o << '[' << GetType().AsFortran(len.str()) << "::"; + Emit(o, values); return o << ']'; } @@ -149,17 +160,13 @@ std::ostream &ExpressionBase::AsFortran(std::ostream &o) const { o << "z'" << x.Hexadecimal() << "'"; }, [&](const CopyableIndirection &s) { s->AsFortran(o); }, + [&](const ImpliedDoIndex &i) { o << i.name.ToString(); }, [&](const auto &x) { x.AsFortran(o); }, }, derived().u); return o; } -template Expr ArrayConstructor::LEN() const { - // TODO pmk: extract from type spec in array constructor - return AsExpr(Constant{0}); // TODO placeholder -} - template Expr Expr>::LEN() const { return std::visit( @@ -184,11 +191,6 @@ Expr Expr>::LEN() const { Expr::~Expr() {} -template DynamicType ArrayConstructor::GetType() const { - // TODO: pmk: parameterized derived types, CHARACTER length - return result.GetType(); -} - #if defined(__APPLE__) && defined(__GNUC__) template typename ExpressionBase::Derived &ExpressionBase::derived() { @@ -231,10 +233,17 @@ template int ExpressionBase::Rank() const { derived().u); } +template +ArrayConstructor>::~ArrayConstructor() {} + // Equality testing for classes without EVALUATE_UNION_CLASS_BOILERPLATE() -template -bool ImpliedDo::operator==(const ImpliedDo &that) const { +bool ImpliedDoIndex::operator==(const ImpliedDoIndex &that) const { + return name == that.name; +} + +template +bool ImpliedDo::operator==(const ImpliedDo &that) const { return controlVariableName == that.controlVariableName && lower == that.lower && upper == that.upper && stride == that.stride && values == that.values; @@ -248,8 +257,13 @@ bool ArrayConstructorValues::operator==( template bool ArrayConstructor::operator==(const ArrayConstructor &that) const { - return *static_cast *>(this) == that && - result == that.result && typeParameterValues == that.typeParameterValues; + return type == that.type && values == that.values; +} + +template +bool ArrayConstructor>::operator==( + const ArrayConstructor> &that) const { + return length == that.length && values == that.values; } bool GenericExprWrapper::operator==(const GenericExprWrapper &that) const { diff --git a/flang/lib/evaluate/expression.h b/flang/lib/evaluate/expression.h index 59e1566..a4071ac 100644 --- a/flang/lib/evaluate/expression.h +++ b/flang/lib/evaluate/expression.h @@ -31,6 +31,7 @@ #include "../lib/parser/char-block.h" #include "../lib/parser/message.h" #include +#include #include #include #include @@ -58,7 +59,7 @@ using common::RelationalOperator; // Everything that can appear in, or as, a valid Fortran expression must be // represented with an instance of some class containing a Result typedef that // maps to some instantiation of Type, SomeKind, -// or SomeType. +// or SomeType. (Exception: BOZ literal constants in generic Expr.) template using ResultType = typename std::decay_t::Result; // Common Expr<> behaviors: every Expr derives from ExpressionBase. @@ -212,7 +213,8 @@ private: // dynamic kind. template struct Convert : public Operation, TO, SomeKind> { - // Fortran doesn't have conversions between kinds of CHARACTER. + // Fortran doesn't have conversions between kinds of CHARACTER apart from + // assignments, and in those the data must be convertible to/from 7-bit ASCII. // Conversions between kinds of COMPLEX are represented piecewise. static_assert(((TO::category == TypeCategory::Integer || TO::category == TypeCategory::Real) && @@ -392,47 +394,67 @@ struct LogicalOperation template struct ArrayConstructorValues; -template struct ImpliedDo { - using Values = VALUES; - using Operand = OPERAND; - using Result = ResultType; - static_assert(Operand::category == TypeCategory::Integer); +struct ImpliedDoIndex { + using Result = SubscriptInteger; + bool operator==(const ImpliedDoIndex &) const; + static constexpr int Rank() { return 0; } + parser::CharBlock name; // nested implied DOs must use distinct names +}; + +template struct ImpliedDo { + using Result = RESULT; bool operator==(const ImpliedDo &) const; parser::CharBlock controlVariableName; - CopyableIndirection> lower, upper, stride; - CopyableIndirection values; + CopyableIndirection>> lower, upper, stride; + CopyableIndirection> values; }; template struct ArrayConstructorValue { using Result = RESULT; EVALUATE_UNION_CLASS_BOILERPLATE(ArrayConstructorValue) - template - using ImpliedDo = ImpliedDo, INT>; - common::CombineVariants>>, - common::MapTemplate> - u; + std::variant>, ImpliedDo> u; }; template struct ArrayConstructorValues { using Result = RESULT; - CLASS_BOILERPLATE(ArrayConstructorValues) - template void Push(A &&x) { values.emplace_back(std::move(x)); } + DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(ArrayConstructorValues) + ArrayConstructorValues() {} bool operator==(const ArrayConstructorValues &) const; + template void Push(A &&x) { values.emplace_back(std::move(x)); } std::vector> values; }; -template -struct ArrayConstructor : public ArrayConstructorValues { +template struct ArrayConstructor { using Result = RESULT; - using ArrayConstructorValues::ArrayConstructorValues; - DynamicType GetType() const; + CLASS_BOILERPLATE(ArrayConstructor) + ArrayConstructor(Result &&t, ArrayConstructorValues &&v) + : type{std::move(t)}, values{std::move(v)} { + CHECK(type.category != TypeCategory::Character); + } + bool operator==(const ArrayConstructor &) const; + DynamicType GetType() const { return type.GetType(); } + static constexpr int Rank() { return 1; } + std::ostream &AsFortran(std::ostream &) const; + Result type; + ArrayConstructorValues values; +}; + +template +struct ArrayConstructor> { + using Result = Type; + CLASS_BOILERPLATE(ArrayConstructor) + ArrayConstructor( + ArrayConstructorValues &&v, Expr &&len) + : values{std::move(v)}, length{std::move(len)} {} + ~ArrayConstructor(); + bool operator==(const ArrayConstructor &) const; + static constexpr DynamicType GetType() { return Result::GetType(); } static constexpr int Rank() { return 1; } - Expr LEN() const; - bool operator==(const ArrayConstructor &) const; std::ostream &AsFortran(std::ostream &) const; + const Expr &LEN() const { return *length; } - Result result; - std::vector> typeParameterValues; + ArrayConstructorValues values; + CopyableIndirection> length; }; // Expression representations for each type category. @@ -450,16 +472,20 @@ public: : u{Constant{n}} {} private: - using Conversions = std::variant, + using Conversions = std::tuple, Convert>; - using Operations = std::variant, Negate, + using Operations = std::tuple, Negate, Add, Subtract, Multiply, Divide, Power, Extremum>; - using Others = std::variant, ArrayConstructor, + using Indices = std::conditional_t, std::tuple<>>; + using Others = std::tuple, ArrayConstructor, TypeParamInquiry, Designator, FunctionRef>; public: - common::CombineVariants u; + common::TupleToVariant< + common::CombineTuples> + u; }; template @@ -592,15 +618,16 @@ public: explicit Expr(bool x) : u{Constant{x}} {} private: - using Operations = std::variant, + using Operations = std::tuple, Parentheses, Not, LogicalOperation>; using Relations = std::conditional_t>, std::variant<>>; - using Others = std::variant, ArrayConstructor, + std::tuple>, std::tuple<>>; + using Others = std::tuple, ArrayConstructor, Designator, FunctionRef>; public: - common::CombineVariants u; + common::TupleToVariant> + u; }; FOR_EACH_LOGICAL_KIND(extern template class Expr) diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc index c9b4c2f..32e9fe8 100644 --- a/flang/lib/evaluate/fold.cc +++ b/flang/lib/evaluate/fold.cc @@ -68,7 +68,7 @@ Component FoldOperation(FoldingContext &context, Component &&component) { Triplet FoldOperation(FoldingContext &context, Triplet &&triplet) { return {Fold(context, triplet.lower()), Fold(context, triplet.upper()), - Fold(context, triplet.stride())}; + Fold(context, Expr{triplet.stride()})}; } Subscript FoldOperation(FoldingContext &context, Subscript &&subscript) { @@ -660,14 +660,16 @@ bool IsConstExpr(ConstExprContext &, const Symbol *symbol) { return symbol->attrs().test(semantics::Attr::PARAMETER); } bool IsConstExpr(ConstExprContext &, const CoarrayRef &) { return false; } +bool IsConstExpr(ConstExprContext &, const ImpliedDoIndex &) { + return true; // only tested when bounds are constant +} // Prototypes for mutual recursion template bool IsConstExpr(ConstExprContext &, const Operation &); template bool IsConstExpr(ConstExprContext &, const Operation &); -template -bool IsConstExpr(ConstExprContext &, const ImpliedDo &); +template bool IsConstExpr(ConstExprContext &, const ImpliedDo &); template bool IsConstExpr(ConstExprContext &, const ArrayConstructorValue &); template @@ -709,8 +711,8 @@ bool IsConstExpr( return IsConstExpr(context, operation.left()) && IsConstExpr(context, operation.right()); } -template -bool IsConstExpr(ConstExprContext &context, const ImpliedDo &impliedDo) { +template +bool IsConstExpr(ConstExprContext &context, const ImpliedDo &impliedDo) { if (!IsConstExpr(context, impliedDo.lower) || !IsConstExpr(context, impliedDo.upper) || !IsConstExpr(context, impliedDo.stride)) { @@ -732,8 +734,7 @@ bool IsConstExpr( } template bool IsConstExpr(ConstExprContext &context, const ArrayConstructor &array) { - return IsConstExpr(context, array.values) && - IsConstExpr(context, array.typeParameterValues); + return IsConstExpr(context, array.values); } bool IsConstExpr(ConstExprContext &context, const BaseObject &base) { return IsConstExpr(context, base.u); diff --git a/flang/lib/evaluate/tools.cc b/flang/lib/evaluate/tools.cc index c511750..abb2061 100644 --- a/flang/lib/evaluate/tools.cc +++ b/flang/lib/evaluate/tools.cc @@ -494,4 +494,66 @@ Expr BinaryLogicalOperation( }, AsSameKindExprs(std::move(x), std::move(y))); } + +template +std::optional> ConvertToNumeric(int kind, Expr &&x) { + static_assert(common::IsNumericTypeCategory(TO)); + return std::visit( + [=](auto &&cx) -> std::optional> { + using cxType = std::decay_t; + if constexpr (!std::is_same_v) { + if constexpr (IsNumericTypeCategory(ResultType::category)) { + return std::make_optional( + Expr{ConvertToKind(kind, std::move(cx))}); + } + } + return std::nullopt; + }, + std::move(x.u)); +} + +std::optional> ConvertToType( + const DynamicType &type, Expr &&x) { + switch (type.category) { + case TypeCategory::Integer: + return ConvertToNumeric(type.kind, std::move(x)); + case TypeCategory::Real: + return ConvertToNumeric(type.kind, std::move(x)); + case TypeCategory::Complex: + return ConvertToNumeric(type.kind, std::move(x)); + case TypeCategory::Character: + if (auto fromType{x.GetType()}) { + if (fromType->category == TypeCategory::Character && + fromType->kind == type.kind) { + // TODO pmk: adjusting CHARACTER length via conversion + return std::move(x); + } + } + break; + case TypeCategory::Logical: + if (auto *cx{UnwrapExpr>(x)}) { + return Expr{ + ConvertToKind(type.kind, std::move(*cx))}; + } + break; + case TypeCategory::Derived: + if (auto fromType{x.GetType()}) { + if (type == fromType) { + return std::move(x); + } + } + break; + default: CRASH_NO_CASE; + } + return std::nullopt; +} + +std::optional> ConvertToType( + const DynamicType &type, std::optional> &&x) { + if (x.has_value()) { + return ConvertToType(type, std::move(*x)); + } else { + return std::nullopt; + } +} } diff --git a/flang/lib/evaluate/tools.h b/flang/lib/evaluate/tools.h index de924ed..67cde04 100644 --- a/flang/lib/evaluate/tools.h +++ b/flang/lib/evaluate/tools.h @@ -164,6 +164,16 @@ Expr ConvertToType(Expr> &&x) { Scalar zero; return Expr{ComplexConstructor{ ConvertToType(std::move(x)), Expr{Constant{zero}}}}; + } else if constexpr (FROMCAT == TypeCategory::Complex) { + // Extract and convert the real component of a complex value + return std::visit( + [&](auto &&z) { + using ZType = ResultType; + using Part = typename ZType::Part; + return ConvertToType(Expr{ + Expr{ComplexComponent{false, std::move(z)}}}); + }, + std::move(x.u)); } else { return Expr{Convert{std::move(x)}}; } @@ -194,6 +204,11 @@ Expr ConvertToType(Expr> &&x) { } } +template +Expr ConvertToType(Expr> &&x) { + return ConvertToType(Expr>{std::move(x)}); +} + template Expr ConvertToType(BOZLiteralConstant &&x) { static_assert(IsSpecificIntrinsicType); using Value = typename Constant::Value; @@ -206,21 +221,20 @@ template Expr ConvertToType(BOZLiteralConstant &&x) { } } -template -Expr> ConvertTo( - const Expr> &, Expr> &&x) { - return ConvertToType>(std::move(x)); -} +// Conversions to dynamic types +std::optional> ConvertToType( + const DynamicType &, Expr &&); +std::optional> ConvertToType( + const DynamicType &, std::optional> &&); -template -Expr> ConvertTo( - const Expr> &, Expr> &&x) { - return AsExpr(ConvertToType>(AsCategoryExpr(std::move(x)))); +// Conversions to the type of another expression +template +Expr> ConvertTo(const Expr> &, FROM &&x) { + return ConvertToType>(std::move(x)); } -template -Expr> ConvertTo( - const Expr> &to, Expr> &&from) { +template +Expr> ConvertTo(const Expr> &to, FROM &&from) { return std::visit( [&](const auto &toKindExpr) { using KindExpr = std::decay_t; @@ -230,14 +244,8 @@ Expr> ConvertTo( to.u); } -template -Expr> ConvertTo( - const Expr> &to, Expr> &&from) { - return ConvertTo(to, AsCategoryExpr(std::move(from))); -} - -template -Expr ConvertTo(const Expr &to, Expr &&from) { +template +Expr ConvertTo(const Expr &to, FROM &&from) { return std::visit( [&](const auto &toCatExpr) { return AsGenericExpr(ConvertTo(toCatExpr, std::move(from))); @@ -245,28 +253,16 @@ Expr ConvertTo(const Expr &to, Expr &&from) { to.u); } -template -Expr> ConvertTo( - const Expr> &to, BOZLiteralConstant &&from) { - return std::visit( - [&](const auto &tok) { - using Ty = ResultType; - return AsCategoryExpr(ConvertToType(std::move(from))); - }, - to.u); -} - // Convert an expression of some known category to a dynamically chosen // kind of some category (usually but not necessarily distinct). template struct ConvertToKindHelper { using Result = std::optional>>; - static constexpr std::size_t Types{std::tuple_size_v>}; + using Types = CategoryTypes; ConvertToKindHelper(int k, VALUE &&x) : kind{k}, value{std::move(x)} {} - template Result Test() { - using Ty = std::tuple_element_t>; - if (kind == Ty::kind) { + template Result Test() { + if (kind == T::kind) { return std::make_optional( - AsCategoryExpr(ConvertToType(std::move(value)))); + AsCategoryExpr(ConvertToType(std::move(value)))); } return std::nullopt; } @@ -276,7 +272,7 @@ template struct ConvertToKindHelper { template Expr> ConvertToKind(int kind, VALUE &&x) { - return common::SearchDynamicTypes( + return common::SearchTypes( ConvertToKindHelper{kind, std::move(x)}) .value(); } @@ -501,21 +497,20 @@ Expr> operator/( return PromoteAndCombine(std::move(x), std::move(y)); } -// A utility for use with common::SearchDynamicTypes to create generic -// expressions when an intrinsic type category for (say) a variable is known +// A utility for use with common::SearchTypes to create generic expressions +// when an intrinsic type category for (say) a variable is known // but the kind parameter value is not. template class TEMPLATE, typename VALUE> struct TypeKindVisitor { using Result = std::optional>; - static constexpr std::size_t Types{std::tuple_size_v>}; + using Types = CategoryTypes; TypeKindVisitor(int k, VALUE &&x) : kind{k}, value{std::move(x)} {} TypeKindVisitor(int k, const VALUE &x) : kind{k}, value{x} {} - template Result Test() { - using Ty = std::tuple_element_t>; - if (kind == Ty::kind) { - return AsGenericExpr(TEMPLATE{std::move(value)}); + template Result Test() { + if (kind == T::kind) { + return AsGenericExpr(TEMPLATE{std::move(value)}); } return std::nullopt; } diff --git a/flang/lib/evaluate/type.cc b/flang/lib/evaluate/type.cc index 79ba99430..ee45eb1 100644 --- a/flang/lib/evaluate/type.cc +++ b/flang/lib/evaluate/type.cc @@ -118,15 +118,23 @@ std::optional GetSymbolType(const semantics::Symbol *symbol) { } std::string DynamicType::AsFortran() const { - if (category == TypeCategory::Derived) { - // TODO: derived type parameters + if (derived != nullptr) { + CHECK(category == TypeCategory::Derived); return "TYPE("s + derived->typeSymbol().name().ToString() + ')'; } else { - // TODO: CHARACTER length return EnumToString(category) + '(' + std::to_string(kind) + ')'; } } +std::string DynamicType::AsFortran(std::string &&charLenExpr) const { + if (!charLenExpr.empty() && category == TypeCategory::Character) { + return "CHARACTER(KIND=" + std::to_string(kind) + + ",len=" + std::move(charLenExpr) + ')'; + } else { + return AsFortran(); + } +} + DynamicType DynamicType::ResultTypeForMultiply(const DynamicType &that) const { switch (category) { case TypeCategory::Integer: diff --git a/flang/lib/evaluate/type.h b/flang/lib/evaluate/type.h index c2fbaad..678618a 100644 --- a/flang/lib/evaluate/type.h +++ b/flang/lib/evaluate/type.h @@ -44,27 +44,35 @@ namespace Fortran::evaluate { using common::TypeCategory; +// Specific intrinsic types are represented by specializations of +// this class template Type. +template class Type; + +using SubscriptInteger = Type; +using LogicalResult = Type; +using LargestReal = Type; + // DynamicType is suitable for use as the result type for -// GetType() functions and member functions. +// GetType() functions and member functions. It does *not* +// hold CHARACTER length type parameter expressions -- those +// must be derived via LEN() member functions or packaged +// elsewhere (e.g. as in ArrayConstructor). struct DynamicType { - bool operator==(const DynamicType &that) const; + bool operator==(const DynamicType &) const; std::string AsFortran() const; + std::string AsFortran(std::string &&charLenExpr) const; DynamicType ResultTypeForMultiply(const DynamicType &) const; TypeCategory category; int kind{0}; // set only for intrinsic types - const semantics::DerivedTypeSpec *derived{nullptr}; - const semantics::Symbol *descriptor{nullptr}; + const semantics::DerivedTypeSpec *derived{nullptr}; // TYPE(T), CLASS(T) + const semantics::Symbol *descriptor{nullptr}; // CHARACTER, CLASS(T/*) }; // Result will be missing when a symbol is absent or // has an erroneous type, e.g., REAL(KIND=666). std::optional GetSymbolType(const semantics::Symbol *); -// Specific intrinsic types are represented by specializations of -// this class template Type. -template class Type; - template struct TypeBase { static constexpr TypeCategory category{CATEGORY}; static constexpr int kind{KIND}; @@ -172,10 +180,6 @@ template using Scalar = typename std::decay_t::Scalar; template using SameKind = Type::kind>; -using SubscriptInteger = Type; -using LogicalResult = Type; -using LargestReal = Type; - // Many expressions, including subscripts, CHARACTER lengths, array bounds, // and effective type parameter values, are of a maximal kind of INTEGER. using IndirectSubscriptIntegerExpr = diff --git a/flang/lib/evaluate/variable.cc b/flang/lib/evaluate/variable.cc index ac95368..b6af28c 100644 --- a/flang/lib/evaluate/variable.cc +++ b/flang/lib/evaluate/variable.cc @@ -29,17 +29,17 @@ namespace Fortran::evaluate { // Constructors, accessors, mutators +Triplet::Triplet() : stride_{Expr{1}} {} + Triplet::Triplet(std::optional> &&l, std::optional> &&u, - std::optional> &&s) { + std::optional> &&s) + : stride_{s.has_value() ? std::move(*s) : Expr{1}} { if (l.has_value()) { - lower_ = IndirectSubscriptIntegerExpr::Make(std::move(*l)); + lower_.emplace(std::move(*l)); } if (u.has_value()) { - upper_ = IndirectSubscriptIntegerExpr::Make(std::move(*u)); - } - if (s.has_value()) { - stride_ = IndirectSubscriptIntegerExpr::Make(std::move(*s)); + upper_.emplace(std::move(*u)); } } @@ -57,11 +57,14 @@ std::optional> Triplet::upper() const { return std::nullopt; } -std::optional> Triplet::stride() const { - if (stride_) { - return {**stride_}; +const Expr &Triplet::stride() const { return *stride_; } + +bool Triplet::IsStrideOne() const { + if (auto stride{ToInt64(*stride_)}) { + return stride == 1; + } else { + return false; } - return std::nullopt; } CoarrayRef::CoarrayRef(std::vector &&c, @@ -90,13 +93,13 @@ std::optional> CoarrayRef::team() const { CoarrayRef &CoarrayRef::set_stat(Expr &&v) { CHECK(IsVariable(v)); - stat_ = CopyableIndirection>::Make(std::move(v)); + stat_.emplace(std::move(v)); return *this; } CoarrayRef &CoarrayRef::set_team(Expr &&v, bool isTeamNumber) { CHECK(IsVariable(v)); - team_ = CopyableIndirection>::Make(std::move(v)); + team_.emplace(std::move(v)); teamIsTeamNumber_ = isTeamNumber; return *this; } @@ -104,10 +107,10 @@ CoarrayRef &CoarrayRef::set_team(Expr &&v, bool isTeamNumber) { void Substring::SetBounds(std::optional> &lower, std::optional> &upper) { if (lower.has_value()) { - lower_ = IndirectSubscriptIntegerExpr::Make(std::move(*lower)); + lower_.emplace(std::move(*lower)); } if (upper.has_value()) { - upper_ = IndirectSubscriptIntegerExpr::Make(std::move(*upper)); + upper_.emplace(std::move(*upper)); } } @@ -156,8 +159,12 @@ std::optional> Substring::Fold(FoldingContext &context) { std::optional length; if (literal != nullptr) { length = (*literal)->data().size(); - } else { - // TODO pmk: get max character length from symbol + } else if (const Symbol * symbol{GetLastSymbol()}) { + if (const semantics::DeclTypeSpec * type{symbol->GetType()}) { + if (type->category() == semantics::DeclTypeSpec::Character) { + length = ToInt64(type->characterTypeSpec().length().GetExplicit()); + } + } } if (*ubi < 1 || (lbi.has_value() && *ubi < *lbi)) { // Zero-length string: canonicalize @@ -298,9 +305,7 @@ std::ostream &Component::AsFortran(std::ostream &o) const { std::ostream &Triplet::AsFortran(std::ostream &o) const { Emit(o, lower_) << ':'; Emit(o, upper_); - if (stride_) { - Emit(o << ':', stride_); - } + Emit(o << ':', *stride_); return o; } @@ -657,7 +662,7 @@ bool TypeParamInquiry::operator==( } bool Triplet::operator==(const Triplet &that) const { return lower_ == that.lower_ && upper_ == that.upper_ && - stride_ == that.stride_; + *stride_ == *that.stride_; } bool ArrayRef::operator==(const ArrayRef &that) const { return u == that.u && subscript == that.subscript; diff --git a/flang/lib/evaluate/variable.h b/flang/lib/evaluate/variable.h index 81463e7..1da5df0 100644 --- a/flang/lib/evaluate/variable.h +++ b/flang/lib/evaluate/variable.h @@ -21,6 +21,8 @@ // Fortran 2018 language standard (q.v.) and uses strong typing to ensure // that only admissable combinations can be constructed. +// TODO pmk: convert remaining structs to classes + #include "call.h" #include "common.h" #include "static-data.h" @@ -120,19 +122,21 @@ EXPAND_FOR_EACH_INTEGER_KIND( // R921 subscript-triplet class Triplet { public: - Triplet() {} + Triplet(); DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(Triplet) Triplet(std::optional> &&, std::optional> &&, std::optional> &&); std::optional> lower() const; std::optional> upper() const; - std::optional> stride() const; + const Expr &stride() const; bool operator==(const Triplet &) const; + bool IsStrideOne() const; std::ostream &AsFortran(std::ostream &) const; private: - std::optional lower_, upper_, stride_; + std::optional lower_, upper_; + IndirectSubscriptIntegerExpr stride_; }; // R919 subscript when rank 0, R923 vector-subscript when rank 1 diff --git a/flang/lib/parser/parse-tree.h b/flang/lib/parser/parse-tree.h index d94f2da..e3e409b 100644 --- a/flang/lib/parser/parse-tree.h +++ b/flang/lib/parser/parse-tree.h @@ -60,6 +60,7 @@ CLASS_TRAIT(TupleTrait) // here. namespace Fortran::semantics { class Symbol; +class DeclTypeSpec; } // Expressions in the parse tree have owning pointers that can be set to @@ -700,6 +701,7 @@ struct DerivedTypeSpec { // R702 type-spec -> intrinsic-type-spec | derived-type-spec struct TypeSpec { UNION_CLASS_BOILERPLATE(TypeSpec); + mutable const semantics::DeclTypeSpec *declTypeSpec{nullptr}; std::variant u; }; @@ -1693,9 +1695,9 @@ struct Expr { explicit Expr(Designator &&); explicit Expr(FunctionReference &&); - // Filled in later during semantic analysis of the expression. - // TODO: May be temporary; remove if caching no longer required. + // Filled in after successful semantic analysis of the expression. mutable common::OwningPointer typedExpr; + CharBlock source; std::variant, diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 9d70913..f43be6e 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -13,7 +13,6 @@ // limitations under the License. #include "expression.h" -#include "dump-parse-tree.h" // TODO pmk temporary #include "scope.h" #include "semantics.h" #include "symbol.h" @@ -27,7 +26,12 @@ #include #include -#include // TODO pmk rm +// TODO pmk remove when scaffolding is obsolete +#define PMKDEBUG 1 +#if PMKDEBUG +#include "dump-parse-tree.h" +#include +#endif // Typedef for optional generic expressions (ubiquitous in this file) using MaybeExpr = @@ -109,9 +113,50 @@ struct CallAndArguments { ActualArguments arguments; }; +struct DynamicTypeWithLength : public DynamicType { + std::optional> length; +}; + +std::optional AnalyzeTypeSpec( + ExpressionAnalysisContext &context, + const std::optional &spec) { + if (spec.has_value()) { + if (const semantics::DeclTypeSpec * typeSpec{spec->declTypeSpec}) { + // Name resolution sets TypeSpec::declTypeSpec only when it's valid + // (viz., an intrinsic type with valid known kind or a non-polymorphic + // & non-ABSTRACT derived type). + if (const semantics::IntrinsicTypeSpec * + intrinsic{typeSpec->AsIntrinsic()}) { + TypeCategory category{intrinsic->category()}; + if (auto kind{ToInt64(intrinsic->kind())}) { + DynamicTypeWithLength result{category, static_cast(*kind)}; + if (category == TypeCategory::Character) { + const semantics::CharacterTypeSpec &cts{ + typeSpec->characterTypeSpec()}; + const semantics::ParamValue len{cts.length()}; + // N.B. CHARACTER(LEN=*) is allowed in type-specs in ALLOCATE() & + // type guards, but not in array constructors. + if (len.GetExplicit().has_value()) { + Expr copy{*len.GetExplicit()}; + result.length = ConvertToType(std::move(copy)); + } + } + return result; + } + } else if (const semantics::DerivedTypeSpec * + derived{typeSpec->AsDerived()}) { + return DynamicTypeWithLength{TypeCategory::Derived, 0, derived}; + } + } + } + return std::nullopt; +} + // Forward declarations of additional AnalyzeExpr specializations and overloads template MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &, const std::variant &); +template +MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &, const std::optional &); static MaybeExpr AnalyzeExpr( ExpressionAnalysisContext &, const parser::Designator &); static MaybeExpr AnalyzeExpr( @@ -217,12 +262,21 @@ MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context, const A &x) { // Definitions of AnalyzeExpr() specializations follow. // Helper subroutines are intermixed. -// Variants are silently traversed by AnalyzeExpr(). +// Variants and optionals are silently traversed by AnalyzeExpr(). template MaybeExpr AnalyzeExpr( ExpressionAnalysisContext &context, const std::variant &u) { return std::visit([&](const auto &x) { return AnalyzeExpr(context, x); }, u); } +template +MaybeExpr AnalyzeExpr( + ExpressionAnalysisContext &context, const std::optional &x) { + if (x.has_value()) { + return AnalyzeExpr(context, *x); + } else { + return std::nullopt; + } +} // Wraps a object in an explicitly typed representation (e.g., Designator<> // or FunctionRef<>) that has been instantiated on a dynamically chosen type. @@ -230,7 +284,7 @@ MaybeExpr AnalyzeExpr( template typename WRAPPER, typename WRAPPED> MaybeExpr WrapperHelper(int kind, WRAPPED &&x) { - return common::SearchDynamicTypes( + return common::SearchTypes( TypeKindVisitor{kind, std::move(x)}); } @@ -269,8 +323,44 @@ static MaybeExpr Designate(DataRef &&dataRef) { return std::nullopt; } +// Catch and resolve the ambiguous parse of a substring reference +// that looks like a 1-D array element or section. +static MaybeExpr ResolveAmbiguousSubstring( + ExpressionAnalysisContext &context, ArrayRef &&ref) { + const Symbol &symbol{ref.GetLastSymbol()}; + if (std::optional dyType{GetSymbolType(&symbol)}) { + if (dyType->category == TypeCategory::Character && + ref.subscript.size() == 1) { + DataRef base{std::visit( + [](auto &&y) { return DataRef{std::move(y)}; }, std::move(ref.u))}; + std::optional> lower, upper; + if (std::visit( + common::visitors{ + [&](IndirectSubscriptIntegerExpr &&x) { + lower = std::move(*x); + return true; + }, + [&](Triplet &&triplet) { + lower = triplet.lower(); + upper = triplet.upper(); + return triplet.IsStrideOne(); + }, + }, + std::move(ref.subscript[0].u))) { + return WrapperHelper( + dyType->kind, + Substring{std::move(base), std::move(lower), std::move(upper)}); + } + } + } + + return std::nullopt; +} + // Some subscript semantic checks must be deferred until all of the -// subscripts are in hand. +// subscripts are in hand. This is also where we can catch the +// ambiguous parse of a substring reference that looks like a 1-D array +// element or section. static MaybeExpr CompleteSubscripts( ExpressionAnalysisContext &context, ArrayRef &&ref) { const Symbol &symbol{ref.GetLastSymbol()}; @@ -283,7 +373,11 @@ static MaybeExpr CompleteSubscripts( } int subscripts = ref.subscript.size(); if (subscripts != symbolRank) { - context.Say("reference to rank-%d object '%s' has %d subscripts"_err_en_US, + if (MaybeExpr substring{ + ResolveAmbiguousSubstring(context, std::move(ref))}) { + return substring; + } + context.Say("Reference to rank-%d object '%s' has %d subscripts"_err_en_US, symbolRank, symbol.name().ToString().data(), subscripts); } else if (subscripts == 0) { // nothing to check @@ -292,8 +386,8 @@ static MaybeExpr CompleteSubscripts( if (baseRank > 0) { int rank{ref.Rank()}; if (rank > 0) { - context.Say( - "subscripts of rank-%d component reference have rank %d, but must all be scalar"_err_en_US, + context.Say("Subscripts of rank-%d component reference have rank %d, " + "but must all be scalar"_err_en_US, baseRank, rank); } } @@ -302,8 +396,8 @@ static MaybeExpr CompleteSubscripts( // C928 & C1002 if (Triplet * last{std::get_if(&ref.subscript.back().u)}) { if (!last->upper().has_value() && details->IsAssumedSize()) { - context.Say( - "assumed-size array '%s' must have explicit final subscript upper bound value"_err_en_US, + context.Say("Assumed-size array '%s' must have explicit final " + "subscript upper bound value"_err_en_US, symbol.name().ToString().data()); } } @@ -433,7 +527,7 @@ MaybeExpr IntLiteralConstant( AnalyzeKindParam(context, std::get>(x.t), context.GetDefaultKind(TypeCategory::Integer))}; auto value{std::get<0>(x.t)}; // std::(u)int64_t - auto result{common::SearchDynamicTypes( + auto result{common::SearchTypes( TypeKindVisitor{ kind, static_cast(value)})}; if (!result.has_value()) { @@ -468,15 +562,14 @@ Constant ReadRealLiteral( struct RealTypeVisitor { using Result = std::optional>; - static constexpr std::size_t Types{std::tuple_size_v}; + using Types = RealTypes; RealTypeVisitor(int k, parser::CharBlock lit, FoldingContext &ctx) : kind{k}, literal{lit}, context{ctx} {} - template Result Test() { - using Ty = std::tuple_element_t; - if (kind == Ty::kind) { - return {AsCategoryExpr(ReadRealLiteral(literal, context))}; + template Result Test() { + if (kind == T::kind) { + return {AsCategoryExpr(ReadRealLiteral(literal, context))}; } return std::nullopt; } @@ -520,7 +613,7 @@ static MaybeExpr AnalyzeExpr( context.Say( "explicit kind parameter on real constant disagrees with exponent letter"_en_US); } - auto result{common::SearchDynamicTypes( + auto result{common::SearchTypes( RealTypeVisitor{kind, x.real.source, context.GetFoldingContext()})}; if (!result.has_value()) { context.Say("unsupported REAL(KIND=%d)"_err_en_US, kind); @@ -610,7 +703,7 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context, AnalyzeKindParam(context, std::get>(x.t), context.GetDefaultKind(TypeCategory::Logical))}; bool value{std::get(x.t)}; - auto result{common::SearchDynamicTypes( + auto result{common::SearchTypes( TypeKindVisitor{ kind, std::move(value)})}; if (!result.has_value()) { @@ -645,19 +738,17 @@ static MaybeExpr AnalyzeExpr( return {AsGenericExpr(std::move(value.value))}; } -// For use with SearchDynamicTypes to create a TypeParamInquiry with the +// For use with SearchTypes to create a TypeParamInquiry with the // right integer kind. struct TypeParamInquiryVisitor { using Result = std::optional>; - static constexpr std::size_t Types{ - std::tuple_size_v>}; + using Types = IntegerTypes; TypeParamInquiryVisitor(int k, SymbolOrComponent &&b, const Symbol ¶m) : kind{k}, base{std::move(b)}, parameter{param} {} - template Result Test() { - using Ty = std::tuple_element_t>; - if (kind == Ty::kind) { + template Result Test() { + if (kind == T::kind) { return Expr{ - Expr{TypeParamInquiry{std::move(base), parameter}}}; + Expr{TypeParamInquiry{std::move(base), parameter}}}; } return std::nullopt; } @@ -670,7 +761,7 @@ static std::optional> MakeTypeParamInquiry( const Symbol *symbol) { if (std::optional dyType{GetSymbolType(symbol)}) { if (dyType->category == TypeCategory::Integer) { - return common::SearchDynamicTypes(TypeParamInquiryVisitor{ + return common::SearchTypes(TypeParamInquiryVisitor{ dyType->kind, SymbolOrComponent{nullptr}, *symbol}); } } @@ -680,7 +771,10 @@ static std::optional> MakeTypeParamInquiry( // Names and named constants static MaybeExpr AnalyzeExpr( ExpressionAnalysisContext &context, const parser::Name &n) { - if (n.symbol == nullptr) { + if (std::optional kind{context.IsAcImpliedDo(n.source)}) { + return AsMaybeExpr(ConvertToKind( + *kind, AsExpr(ImpliedDoIndex{n.source}))); + } else if (n.symbol == nullptr) { context.Say( n.source, "TODO INTERNAL: name was not resolved to a symbol"_err_en_US); } else if (n.symbol->attrs().test(semantics::Attr::PARAMETER)) { @@ -944,7 +1038,7 @@ static MaybeExpr AnalyzeExpr( CHECK(dyType.has_value()); CHECK(dyType->category == TypeCategory::Integer); return AsMaybeExpr( - common::SearchDynamicTypes(TypeParamInquiryVisitor{dyType->kind, + common::SearchTypes(TypeParamInquiryVisitor{dyType->kind, IgnoreAnySubscripts(std::move(*designator)), *sym})); } else { context.Say(name, @@ -1015,9 +1109,221 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context, return std::nullopt; } -static MaybeExpr AnalyzeExpr( - ExpressionAnalysisContext &context, const parser::ArrayConstructor &) { - context.Say("TODO: ArrayConstructor unimplemented"_en_US); +static int IntegerTypeSpecKind( + ExpressionAnalysisContext &context, const parser::IntegerTypeSpec &spec) { + Expr value{context.Analyze(TypeCategory::Integer, spec.v)}; + if (auto kind{ToInt64(value)}) { + return static_cast(*kind); + } + context.SayAt(spec, "Constant INTEGER kind value required here"_err_en_US); + return context.GetDefaultKind(TypeCategory::Integer); +} + +template +std::optional>> GetSpecificIntExpr( + ExpressionAnalysisContext &context, const A &x) { + if (MaybeExpr y{AnalyzeExpr(context, x)}) { + Expr *intExpr{UnwrapExpr>(*y)}; + CHECK(intExpr != nullptr); + return ConvertToType>( + std::move(*intExpr)); + } + return std::nullopt; +} + +// Array constructors + +struct ArrayConstructorContext { + void Push(MaybeExpr &&); + void Add(const parser::AcValue &); + ExpressionAnalysisContext &exprContext; + std::optional &type; + bool typesMustMatch{false}; + ArrayConstructorValues values; +}; + +void ArrayConstructorContext::Push(MaybeExpr &&x) { + if (x.has_value()) { + DynamicTypeWithLength xType; + if (auto dyType{x->GetType()}) { + *static_cast(&xType) = *dyType; + } + if (Expr * charExpr{UnwrapExpr>(*x)}) { + CHECK(xType.category == TypeCategory::Character); + xType.length = + std::visit([](const auto &kc) { return kc.LEN(); }, charExpr->u); + } + if (!type.has_value()) { + // If there is no explicit type-spec in an array constructor, the type + // of the array is the declared type of all of the elements, which must + // be well-defined. + // TODO: Possible language extension: use the most general type of + // the values as the type of a numeric constructed array, convert all + // of the other values to that type. Alternative: let the first value + // determine the type, and convert the others to that type. + type = std::move(xType); + values.Push(std::move(*x)); + } else if (typesMustMatch) { + if (static_cast(*type) == + static_cast(xType)) { + values.Push(std::move(*x)); + } else { + exprContext.Say( + "Values in array constructor must have the same declared type when no explicit type appears"_err_en_US); + } + } else { + if (auto cast{ConvertToType(*type, std::move(*x))}) { + values.Push(std::move(*cast)); + } else { + exprContext.Say( + "Value in array constructor could not be converted to the type of the array"_err_en_US); + } + } + } +} + +void ArrayConstructorContext::Add(const parser::AcValue &x) { + using IntType = ResultType; + std::visit( + common::visitors{ + [&](const parser::AcValue::Triplet &triplet) { + // Transform l:u(:s) into (_,_=l,u(,s)) with an anonymous index '_' + std::optional> lower{ + GetSpecificIntExpr( + exprContext, std::get<0>(triplet.t))}; + std::optional> upper{ + GetSpecificIntExpr( + exprContext, std::get<1>(triplet.t))}; + std::optional> stride{ + GetSpecificIntExpr( + exprContext, std::get<2>(triplet.t))}; + if (lower.has_value() && upper.has_value()) { + if (!stride.has_value()) { + stride = Expr{1}; + } + if (!type.has_value()) { + type = DynamicTypeWithLength{IntType::GetType()}; + } + ArrayConstructorContext nested{exprContext, type, typesMustMatch}; + parser::CharBlock name; + nested.Push(Expr{ + Expr{Expr{ImpliedDoIndex{name}}}}); + values.Push(ImpliedDo{name, std::move(*lower), + std::move(*upper), std::move(*stride), + std::move(nested.values)}); + } + }, + [&](const common::Indirection &expr) { + if (MaybeExpr v{exprContext.Analyze(*expr)}) { + Push(std::move(*v)); + } + }, + [&](const common::Indirection &impliedDo) { + const auto &control{ + std::get(impliedDo->t)}; + const auto &bounds{ + std::get>(control.t)}; + parser::CharBlock name{bounds.name.thing.thing.source}; + int kind{IntType::kind}; + if (auto &its{std::get>( + control.t)}) { + kind = IntegerTypeSpecKind(exprContext, *its); + } + bool inserted{exprContext.AddAcImpliedDo(name, kind)}; + if (!inserted) { + exprContext.SayAt(name, + "Implied DO index is active in surrounding implied DO loop and cannot have the same name"_err_en_US); + } + std::optional> lower{ + GetSpecificIntExpr(exprContext, bounds.lower)}; + std::optional> upper{ + GetSpecificIntExpr(exprContext, bounds.upper)}; + std::optional> stride{ + GetSpecificIntExpr(exprContext, bounds.step)}; + ArrayConstructorContext nested{exprContext, type, typesMustMatch}; + for (const auto &value : + std::get>(impliedDo->t)) { + nested.Add(value); + } + if (lower.has_value() && upper.has_value()) { + if (!stride.has_value()) { + stride = Expr{1}; + } + values.Push(ImpliedDo{name, std::move(*lower), + std::move(*upper), std::move(*stride), + std::move(nested.values)}); + } + if (inserted) { + exprContext.RemoveAcImpliedDo(name); + } + }, + }, + x.u); +} + +// Inverts a collection of generic ArrayConstructorValues that +// all happen to have or be convertible to the same actual type T into +// one ArrayConstructor. +template +ArrayConstructorValues MakeSpecific( + ArrayConstructorValues &&from) { + ArrayConstructorValues to; + for (ArrayConstructorValue &x : from.values) { + std::visit( + common::visitors{ + [&](CopyableIndirection> &&expr) { + auto *typed{UnwrapExpr>(*expr)}; + CHECK(typed != nullptr); + to.Push(std::move(*typed)); + }, + [&](ImpliedDo &&impliedDo) { + to.Push(ImpliedDo{impliedDo.controlVariableName, + std::move(*impliedDo.lower), std::move(*impliedDo.upper), + std::move(*impliedDo.stride), + MakeSpecific(std::move(*impliedDo.values))}); + }, + }, + std::move(x.u)); + } + return to; +} + +struct ArrayConstructorTypeVisitor { + using Result = MaybeExpr; + using Types = LengthlessIntrinsicTypes; + template Result Test() { + if (type.category == T::category && type.kind == T::kind) { + if constexpr (T::category == TypeCategory::Character) { + CHECK(type.length.has_value()); + return AsMaybeExpr(ArrayConstructor{ + MakeSpecific(std::move(values)), std::move(*type.length)}); + } else { + return AsMaybeExpr( + ArrayConstructor{T{}, MakeSpecific(std::move(values))}); + } + } else { + return std::nullopt; + } + } + DynamicTypeWithLength type; + ArrayConstructorValues values; +}; + +static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &exprContext, + const parser::ArrayConstructor &array) { + const parser::AcSpec &acSpec{array.v}; + std::optional type{ + AnalyzeTypeSpec(exprContext, acSpec.type)}; + bool typesMustMatch{!type.has_value()}; + ArrayConstructorContext context{exprContext, type, typesMustMatch}; + for (const parser::AcValue &value : acSpec.values) { + context.Add(value); + } + if (type.has_value()) { + ArrayConstructorTypeVisitor visitor{ + std::move(*type), std::move(context.values)}; + return common::SearchTypes(std::move(visitor)); + } return std::nullopt; } @@ -1502,6 +1808,28 @@ DynamicType ExpressionAnalysisContext::GetDefaultKindOfType( common::TypeCategory category) { return {category, GetDefaultKind(category)}; } + +bool ExpressionAnalysisContext::AddAcImpliedDo( + parser::CharBlock name, int kind) { + return acImpliedDos_.insert(std::make_pair(name, kind)).second; +} + +void ExpressionAnalysisContext::RemoveAcImpliedDo(parser::CharBlock name) { + auto iter{acImpliedDos_.find(name)}; + if (iter != acImpliedDos_.end()) { + acImpliedDos_.erase(iter); + } +} + +std::optional ExpressionAnalysisContext::IsAcImpliedDo( + parser::CharBlock name) const { + auto iter{acImpliedDos_.find(name)}; + if (iter != acImpliedDos_.cend()) { + return {iter->second}; + } else { + return std::nullopt; + } +} } namespace Fortran::semantics { @@ -1517,12 +1845,16 @@ public: bool Pre(const parser::Expr &expr) { if (expr.typedExpr.get() == nullptr) { if (MaybeExpr checked{AnalyzeExpr(context_, expr)}) { - // checked->AsFortran(std::cout << "pmk: checked expression: ") << '\n'; +#if PMKDEBUG +// checked->AsFortran(std::cout << "checked expression: ") << '\n'; +#endif expr.typedExpr.reset( new evaluate::GenericExprWrapper{std::move(*checked)}); } else { +#if PMKDEBUG std::cout << "TODO: expression analysis failed for this expression: "; DumpTree(std::cout, expr); +#endif } } return false; diff --git a/flang/lib/semantics/expression.h b/flang/lib/semantics/expression.h index d7e3a56..9a55bf7 100644 --- a/flang/lib/semantics/expression.h +++ b/flang/lib/semantics/expression.h @@ -21,8 +21,10 @@ #include "../evaluate/expression.h" #include "../evaluate/tools.h" #include "../evaluate/type.h" +#include "../parser/char-block.h" #include "../parser/parse-tree-visitor.h" #include "../parser/parse-tree.h" +#include #include #include @@ -98,8 +100,14 @@ public: int GetDefaultKind(common::TypeCategory); DynamicType GetDefaultKindOfType(common::TypeCategory); + // Manage a set of active array constructor implied DO loops. + bool AddAcImpliedDo(parser::CharBlock, int); + void RemoveAcImpliedDo(parser::CharBlock); + std::optional IsAcImpliedDo(parser::CharBlock) const; + private: semantics::SemanticsContext &context_; + std::map acImpliedDos_; // values are INTEGER kinds }; template diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index db91b48..4cd025c 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -267,7 +267,7 @@ public: void Post(const parser::DeclarationTypeSpec::TypeStar &); bool Pre(const parser::TypeGuardStmt &); void Post(const parser::TypeGuardStmt &); - bool Pre(const parser::AcSpec &); + void Post(const parser::TypeSpec &); protected: struct State { @@ -687,10 +687,14 @@ public: protected: bool BeginDecl(); void EndDecl(); - // Declare a construct or statement entity. If there isn't a type specified + // Declare a construct entity. If there isn't a type specified // it comes from the entity in the containing scope, or implicit rules. // Return pointer to the new symbol, or nullptr on error. Symbol *DeclareConstructEntity(const parser::Name &); + // Declare a statement entity (e.g., an implied DO loop index). + // If there isn't a type specified, implicit rules apply. + // Return pointer to the new symbol, or nullptr on error. + Symbol *DeclareStatementEntity(const parser::Name &); bool CheckUseError(const parser::Name &); void CheckAccessibility(const parser::Name &, bool, const Symbol &); @@ -774,9 +778,11 @@ public: bool Pre(const parser::LocalitySpec::Local &); bool Pre(const parser::LocalitySpec::LocalInit &); bool Pre(const parser::LocalitySpec::Shared &); + bool Pre(const parser::AcSpec &); + bool Pre(const parser::AcImpliedDo &); bool Pre(const parser::DataImpliedDo &); - bool Pre(const parser::DataStmt &); - void Post(const parser::DataStmt &); + bool Pre(const parser::DataStmtSet &); + void Post(const parser::DataStmtSet &); bool Pre(const parser::DoConstruct &); void Post(const parser::DoConstruct &); void Post(const parser::ConcurrentControl &); @@ -846,7 +852,7 @@ private: } bool CheckDef(const std::optional &); void CheckRef(const std::optional &); - void CheckIntegerType(const Symbol &); + void CheckScalarIntegerType(const Symbol &); const DeclTypeSpec &ToDeclTypeSpec(evaluate::DynamicType &&); const DeclTypeSpec &ToDeclTypeSpec( evaluate::DynamicType &&, SubscriptIntExpr &&length); @@ -1150,15 +1156,27 @@ void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) { EndDeclTypeSpec(); } -bool DeclTypeSpecVisitor::Pre(const parser::AcSpec &x) { - // AcSpec can occur within a TypeDeclarationStmt: save and restore state - auto savedState{SetDeclTypeSpecState({})}; - BeginDeclTypeSpec(); - Walk(x.type); - Walk(x.values); - EndDeclTypeSpec(); - SetDeclTypeSpecState(savedState); - return false; +void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) { + // Record the resolved DeclTypeSpec in the parse tree for use by + // expression semantics if the DeclTypeSpec is a valid TypeSpec. + // The grammar ensures that it's an intrinsic or derived type spec, + // not TYPE(*) or CLASS(*) or CLASS(T). + if (const DeclTypeSpec * spec{state_.declTypeSpec}) { + switch (spec->category()) { + case DeclTypeSpec::Numeric: + case DeclTypeSpec::Logical: + case DeclTypeSpec::Character: typeSpec.declTypeSpec = spec; break; + case DeclTypeSpec::TypeDerived: + if (const DerivedTypeSpec * derived{spec->AsDerived()}) { + if (derived->typeSymbol().attrs().test(Attr::ABSTRACT)) { + Say("ABSTRACT derived type may not be used here"_err_en_US); + } + typeSpec.declTypeSpec = spec; + } + break; + default: CRASH_NO_CASE; + } + } } void DeclTypeSpecVisitor::Post( @@ -2985,6 +3003,26 @@ Symbol *DeclarationVisitor::DeclareConstructEntity(const parser::Name &name) { return &symbol; } +Symbol *DeclarationVisitor::DeclareStatementEntity(const parser::Name &name) { + if (auto *prev{FindSymbol(name)}) { + if (prev->owner() == currScope()) { + SayAlreadyDeclared(name, *prev); + return nullptr; + } + name.symbol = nullptr; + } + Symbol &symbol{DeclareEntity(name, {})}; + if (symbol.has()) { + if (auto *type{GetDeclTypeSpec()}) { + SetType(name, *type); + } else { + ApplyImplicitRules(symbol); + } + return Resolve(name, &symbol); + } + return nullptr; +} + // Set the type of an entity or report an error. void DeclarationVisitor::SetType( const parser::Name &name, const DeclTypeSpec &type) { @@ -3173,6 +3211,39 @@ bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) { return false; } +bool ConstructVisitor::Pre(const parser::AcSpec &x) { + // AcSpec can occur within a TypeDeclarationStmt: save and restore state + auto savedState{SetDeclTypeSpecState({})}; + BeginDeclTypeSpec(); + Walk(x.type); + EndDeclTypeSpec(); + SetDeclTypeSpecState(savedState); + PushScope(Scope::Kind::ImpliedDos, nullptr); + Walk(x.values); + PopScope(); + return false; +} + +bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) { + auto &values{std::get>(x.t)}; + auto &control{std::get(x.t)}; + auto &type{std::get>(control.t)}; + auto &bounds{std::get>(control.t)}; + if (type) { + BeginDeclTypeSpec(); + DeclarationVisitor::Post(*type); + } + if (auto *symbol{DeclareStatementEntity(bounds.name.thing.thing)}) { + CheckScalarIntegerType(*symbol); + } + if (type) { + EndDeclTypeSpec(); + } + Walk(bounds); + Walk(values); + return false; +} + bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) { auto &objects{std::get>(x.t)}; auto &type{std::get>(x.t)}; @@ -3182,8 +3253,8 @@ bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) { BeginDeclTypeSpec(); DeclarationVisitor::Post(*type); } - if (auto *symbol{DeclareConstructEntity(bounds.name.thing.thing)}) { - CheckIntegerType(*symbol); + if (auto *symbol{DeclareStatementEntity(bounds.name.thing.thing)}) { + CheckScalarIntegerType(*symbol); } if (type) { EndDeclTypeSpec(); @@ -3193,11 +3264,11 @@ bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) { return false; } -bool ConstructVisitor::Pre(const parser::DataStmt &) { - PushScope(Scope::Kind::Block, nullptr); +bool ConstructVisitor::Pre(const parser::DataStmtSet &) { + PushScope(Scope::Kind::ImpliedDos, nullptr); return true; } -void ConstructVisitor::Post(const parser::DataStmt &) { PopScope(); } +void ConstructVisitor::Post(const parser::DataStmtSet &) { PopScope(); } bool ConstructVisitor::Pre(const parser::DoConstruct &x) { if (x.IsDoConcurrent()) { @@ -3214,7 +3285,7 @@ void ConstructVisitor::Post(const parser::DoConstruct &x) { void ConstructVisitor::Post(const parser::ConcurrentControl &x) { auto &name{std::get(x.t)}; if (auto *symbol{DeclareConstructEntity(name)}) { - CheckIntegerType(*symbol); + CheckScalarIntegerType(*symbol); } } @@ -3334,10 +3405,17 @@ void ConstructVisitor::CheckRef(const std::optional &x) { } } -void ConstructVisitor::CheckIntegerType(const Symbol &symbol) { +void ConstructVisitor::CheckScalarIntegerType(const Symbol &symbol) { + if (const auto *details{symbol.detailsIf()}) { + if (details->IsArray()) { + Say(symbol.name(), "Variable '%s' is not scalar"_err_en_US); + return; + } + } if (auto *type{symbol.GetType()}) { if (!type->IsNumeric(TypeCategory::Integer)) { - Say(symbol.name(), "Variable '%s' is not scalar integer"_err_en_US); + Say(symbol.name(), "Variable '%s' is not integer"_err_en_US); + return; } } } diff --git a/flang/lib/semantics/scope.h b/flang/lib/semantics/scope.h index 8a80773..63f3c47 100644 --- a/flang/lib/semantics/scope.h +++ b/flang/lib/semantics/scope.h @@ -38,7 +38,7 @@ class Scope { public: ENUM_CLASS(Kind, System, Global, Module, MainProgram, Subprogram, DerivedType, - Block, Forall) + Block, Forall, ImpliedDos) using ImportKind = common::ImportKind; // Create the Global scope -- the root of the scope tree diff --git a/flang/lib/semantics/semantics.cc b/flang/lib/semantics/semantics.cc index 7f72ad6..9af2cbc 100644 --- a/flang/lib/semantics/semantics.cc +++ b/flang/lib/semantics/semantics.cc @@ -71,9 +71,6 @@ bool Semantics::Perform() { if (AnyFatalError()) { return false; } - if (AnyFatalError()) { - return false; - } CheckDoConcurrentConstraints(context_.messages(), program_); if (AnyFatalError()) { return false; @@ -83,10 +80,8 @@ bool Semantics::Perform() { if (AnyFatalError()) { return false; } - if (context_.debugExpressions()) { - AnalyzeExpressions(program_, context_); - AnalyzeAssignments(program_, context_); - } + AnalyzeExpressions(program_, context_); + AnalyzeAssignments(program_, context_); return !AnyFatalError(); } diff --git a/flang/lib/semantics/semantics.h b/flang/lib/semantics/semantics.h index de974b5..994ddd7 100644 --- a/flang/lib/semantics/semantics.h +++ b/flang/lib/semantics/semantics.h @@ -46,7 +46,6 @@ public: } const std::string &moduleDirectory() const { return moduleDirectory_; } const bool warningsAreErrors() const { return warningsAreErrors_; } - const bool debugExpressions() const { return debugExpressions_; } const evaluate::IntrinsicProcTable &intrinsics() const { return intrinsics_; } Scope &globalScope() { return globalScope_; } parser::Messages &messages() { return messages_; } @@ -64,10 +63,6 @@ public: warningsAreErrors_ = x; return *this; } - SemanticsContext &set_debugExpressions(bool x) { - debugExpressions_ = x; - return *this; - } const DeclTypeSpec &MakeNumericType(TypeCategory, int kind = 0); const DeclTypeSpec &MakeLogicalType(int kind = 0); @@ -82,7 +77,6 @@ private: std::vector searchDirectories_; std::string moduleDirectory_{"."s}; bool warningsAreErrors_{false}; - bool debugExpressions_{false}; const evaluate::IntrinsicProcTable intrinsics_; Scope globalScope_; parser::Messages messages_; diff --git a/flang/lib/semantics/type.cc b/flang/lib/semantics/type.cc index ce34065..655448c 100644 --- a/flang/lib/semantics/type.cc +++ b/flang/lib/semantics/type.cc @@ -276,10 +276,6 @@ const LogicalTypeSpec &DeclTypeSpec::logicalTypeSpec() const { CHECK(category_ == Logical); return std::get(typeSpec_); } -const CharacterTypeSpec &DeclTypeSpec::characterTypeSpec() const { - CHECK(category_ == Character); - return std::get(typeSpec_); -} const DerivedTypeSpec &DeclTypeSpec::derivedTypeSpec() const { CHECK(category_ == TypeDerived || category_ == ClassDerived); return std::get(typeSpec_); diff --git a/flang/lib/semantics/type.h b/flang/lib/semantics/type.h index 5223408..d81a6e6 100644 --- a/flang/lib/semantics/type.h +++ b/flang/lib/semantics/type.h @@ -149,7 +149,7 @@ public: CharacterTypeSpec(ParamValue &&length, KindExpr &&kind) : IntrinsicTypeSpec(TypeCategory::Character, std::move(kind)), length_{std::move(length)} {} - const ParamValue length() const { return length_; } + const ParamValue &length() const { return length_; } private: ParamValue length_; @@ -280,7 +280,10 @@ public: bool IsNumeric(TypeCategory) const; const NumericTypeSpec &numericTypeSpec() const; const LogicalTypeSpec &logicalTypeSpec() const; - const CharacterTypeSpec &characterTypeSpec() const; + const CharacterTypeSpec &characterTypeSpec() const { + CHECK(category_ == Character); + return std::get(typeSpec_); + } const DerivedTypeSpec &derivedTypeSpec() const; DerivedTypeSpec &derivedTypeSpec(); diff --git a/flang/test/semantics/resolve30.f90 b/flang/test/semantics/resolve30.f90 index 00fe442..b6cc7aa 100644 --- a/flang/test/semantics/resolve30.f90 +++ b/flang/test/semantics/resolve30.f90 @@ -28,16 +28,3 @@ subroutine s2 y = 1 end block end - -subroutine s3 - integer j - block - import, only: j - type t - !ERROR: 'i' from host scoping unit is not accessible due to IMPORT - real :: x(10) = [(i, & - !ERROR: 'i' from host scoping unit is not accessible due to IMPORT - i=1,10)] - end type - end block -end subroutine diff --git a/flang/test/semantics/resolve35.f90 b/flang/test/semantics/resolve35.f90 index 9832676..db12a9b 100644 --- a/flang/test/semantics/resolve35.f90 +++ b/flang/test/semantics/resolve35.f90 @@ -45,14 +45,19 @@ end subroutine s4 real :: a(10), b(10) complex :: x - !ERROR: Variable 'x' is not scalar integer + integer :: i(2) + !ERROR: Variable 'x' is not integer forall(x=1:10) a(x) = b(x) end forall - !ERROR: Variable 'y' is not scalar integer + !ERROR: Variable 'y' is not integer forall(y=1:10) a(y) = b(y) end forall + !ERROR: Variable 'i' is not scalar + forall(i=1:10) + a(i) = b(i) + end forall end subroutine s5 @@ -68,7 +73,7 @@ subroutine s6 real, dimension(n) :: x data(x(i), i=1, n) / n * 0.0 / !ERROR: Index name 't' conflicts with existing identifier - data(x(t), t=1, n) / n * 0.0 / + forall(t=1:n) x(t) = 0.0 contains subroutine t end diff --git a/flang/tools/f18/f18.cc b/flang/tools/f18/f18.cc index b095989..29dbcc0 100644 --- a/flang/tools/f18/f18.cc +++ b/flang/tools/f18/f18.cc @@ -92,7 +92,6 @@ struct DriverOptions { bool dumpUnparseWithSymbols{false}; bool dumpParseTree{false}; bool dumpSymbols{false}; - bool debugExpressions{false}; bool debugResolveNames{false}; bool debugSemantics{false}; bool measureTree{false}; @@ -213,7 +212,7 @@ std::string CompileFortran(std::string path, Fortran::parser::Options options, } // TODO: Change this predicate to just "if (!driver.debugNoSemantics)" if (driver.debugSemantics || driver.debugResolveNames || driver.dumpSymbols || - driver.dumpUnparseWithSymbols || driver.debugExpressions) { + driver.dumpUnparseWithSymbols) { Fortran::semantics::Semantics semantics{ semanticsContext, parseTree, parsing.cooked()}; semantics.Perform(); @@ -392,8 +391,6 @@ int main(int argc, char *const argv[]) { driver.dumpParseTree = true; } else if (arg == "-fdebug-dump-symbols") { driver.dumpSymbols = true; - } else if (arg == "-fdebug-expressions") { - driver.debugExpressions = true; } else if (arg == "-fdebug-resolve-names") { driver.debugResolveNames = true; } else if (arg == "-fdebug-measure-parse-tree") { @@ -494,8 +491,7 @@ int main(int argc, char *const argv[]) { Fortran::semantics::SemanticsContext semanticsContext{defaultKinds}; semanticsContext.set_moduleDirectory(driver.moduleDirectory) .set_searchDirectories(driver.searchDirectories) - .set_warningsAreErrors(driver.warningsAreErrors) - .set_debugExpressions(driver.debugExpressions); + .set_warningsAreErrors(driver.warningsAreErrors); if (!anyFiles) { driver.measureTree = true; -- 2.7.4