[flang-commits] [flang] d1862eb - [flang] DATA stmt processing (part 1/4): designator folding
peter klausler via flang-commits
flang-commits at lists.llvm.org
Thu Jun 18 15:27:02 PDT 2020
Author: peter klausler
Date: 2020-06-18T15:25:21-07:00
New Revision: d1862eb8457f517ef5f4c5667bbf15053ab933f8
URL: https://github.com/llvm/llvm-project/commit/d1862eb8457f517ef5f4c5667bbf15053ab933f8
DIFF: https://github.com/llvm/llvm-project/commit/d1862eb8457f517ef5f4c5667bbf15053ab933f8.diff
LOG: [flang] DATA stmt processing (part 1/4): designator folding
Summary:
Add code to resolve constant Designators at compilation time
into a base Symbol, byte offset, and field size. This is used in
later DATA statement processing to identify the static storage being
initialized by each object in a DATA statement. Also implement
the reverse mapping so that Designators can be reconstructed for
use in error messages about (e.g.) duplicate initializers.
Reviewers: tskeith, PeteSteinfeld, sscalpone, jdoerfert, DavidTruby
Reviewed By: PeteSteinfeld
Subscribers: mgorny, llvm-commits, flang-commits
Tags: #flang, #llvm
Differential Revision: https://reviews.llvm.org/D82125
Added:
flang/include/flang/Evaluate/fold-designator.h
flang/lib/Evaluate/fold-designator.cpp
Modified:
flang/include/flang/Evaluate/shape.h
flang/include/flang/Evaluate/tools.h
flang/include/flang/Evaluate/type.h
flang/lib/Evaluate/CMakeLists.txt
flang/lib/Evaluate/fold-implementation.h
flang/lib/Evaluate/type.cpp
flang/lib/Semantics/compute-offsets.cpp
flang/lib/Semantics/expression.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/fold-designator.h b/flang/include/flang/Evaluate/fold-designator.h
new file mode 100644
index 000000000000..c6b6cfe70fe0
--- /dev/null
+++ b/flang/include/flang/Evaluate/fold-designator.h
@@ -0,0 +1,183 @@
+//===-- include/flang/Evaluate/fold-designator.h ----------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_EVALUATE_FOLD_DESIGNATOR_H_
+#define FORTRAN_EVALUATE_FOLD_DESIGNATOR_H_
+
+// Resolves a designator at compilation time to a base symbol, a byte offset
+// from that symbol, and a byte size. Also resolves in the reverse direction,
+// reconstructing a designator from a symbol, byte offset, and size.
+// Used for resolving variables in DATA statements to ranges in their
+// initial images.
+// Some designators can also be folded into constant pointer descriptors,
+// which also have per-dimension extent and stride information suitable
+// for initializing a descriptor.
+// (The designators that cannot be folded are those with vector-valued
+// subscripts; they are allowed as DATA statement objects, but are not valid
+// initial pointer targets.)
+
+#include "common.h"
+#include "expression.h"
+#include "fold.h"
+#include "shape.h"
+#include "type.h"
+#include "variable.h"
+#include <optional>
+#include <variant>
+
+namespace Fortran::evaluate {
+
+using common::ConstantSubscript;
+
+// Identifies a single contiguous interval of bytes at a fixed offset
+// from a known symbol.
+class OffsetSymbol {
+public:
+ OffsetSymbol(const Symbol &symbol, std::size_t bytes)
+ : symbol_{symbol}, size_{bytes} {}
+ DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(OffsetSymbol)
+
+ const Symbol &symbol() const { return *symbol_; }
+ void set_symbol(const Symbol &symbol) { symbol_ = symbol; };
+ ConstantSubscript offset() const { return offset_; }
+ void Augment(ConstantSubscript n) { offset_ += n; }
+ std::size_t size() const { return size_; }
+ void set_size(std::size_t bytes) { size_ = bytes; }
+
+private:
+ SymbolRef symbol_;
+ ConstantSubscript offset_{0};
+ std::size_t size_;
+};
+
+// Folds a Designator<T> into a sequence of OffsetSymbols, if it can
+// be so folded. Array sections yield multiple results, each
+// corresponding to an element in array element order.
+class DesignatorFolder {
+public:
+ explicit DesignatorFolder(FoldingContext &c) : context_{c} {}
+
+ DesignatorFolder &Reset() {
+ elementNumber_ = 0;
+ return *this;
+ }
+
+ template <typename T>
+ std::optional<OffsetSymbol> FoldDesignator(const Expr<T> &expr) {
+ return std::visit(
+ [&](const auto &x) { return FoldDesignator(x, elementNumber_++); },
+ expr.u);
+ }
+
+private:
+ std::optional<OffsetSymbol> FoldDesignator(
+ const Symbol &, ConstantSubscript) const;
+ std::optional<OffsetSymbol> FoldDesignator(
+ const SymbolRef &x, ConstantSubscript which) const {
+ return FoldDesignator(*x, which);
+ }
+ std::optional<OffsetSymbol> FoldDesignator(
+ const ArrayRef &, ConstantSubscript) const;
+ std::optional<OffsetSymbol> FoldDesignator(
+ const Component &, ConstantSubscript) const;
+ std::optional<OffsetSymbol> FoldDesignator(
+ const ComplexPart &, ConstantSubscript) const;
+ std::optional<OffsetSymbol> FoldDesignator(
+ const Substring &, ConstantSubscript) const;
+ std::optional<OffsetSymbol> FoldDesignator(
+ const DataRef &, ConstantSubscript) const;
+ std::optional<OffsetSymbol> FoldDesignator(
+ const NamedEntity &, ConstantSubscript) const;
+ std::optional<OffsetSymbol> FoldDesignator(
+ const CoarrayRef &, ConstantSubscript) const;
+ std::optional<OffsetSymbol> FoldDesignator(
+ const ProcedureDesignator &, ConstantSubscript) const;
+
+ template <typename T>
+ std::optional<OffsetSymbol> FoldDesignator(
+ const Expr<T> &expr, ConstantSubscript which) const {
+ return std::visit(
+ [&](const auto &x) { return FoldDesignator(x, which); }, expr.u);
+ }
+
+ template <typename A>
+ std::optional<OffsetSymbol> FoldDesignator(
+ const A &x, ConstantSubscript) const {
+ DIE("DesignatorFolder::FoldDesignator(): unexpected object in designator");
+ }
+
+ template <typename T>
+ std::optional<OffsetSymbol> FoldDesignator(
+ const Designator<T> &designator, ConstantSubscript which) const {
+ return std::visit(
+ [&](const auto &x) { return FoldDesignator(x, which); }, designator.u);
+ }
+ template <int KIND>
+ std::optional<OffsetSymbol> FoldDesignator(
+ const Designator<Type<TypeCategory::Character, KIND>> &designator,
+ ConstantSubscript which) const {
+ return std::visit(
+ common::visitors{
+ [&](const Substring &ss) {
+ if (const auto *dataRef{ss.GetParentIf<DataRef>()}) {
+ if (auto result{FoldDesignator(*dataRef, which)}) {
+ if (auto start{ToInt64(ss.lower())}) {
+ std::optional<ConstantSubscript> end;
+ if (ss.upper()) {
+ end = ToInt64(*ss.upper());
+ } else if (auto len{dataRef->LEN()}) {
+ end = ToInt64(*len);
+ }
+ if (end) {
+ result->Augment(KIND * (*start - 1));
+ result->set_size(
+ *end >= *start ? KIND * (*end - *start + 1) : 0);
+ return result;
+ }
+ }
+ }
+ }
+ return std::optional<OffsetSymbol>{};
+ },
+ [&](const auto &x) { return FoldDesignator(x, which); },
+ },
+ designator.u);
+ }
+
+ FoldingContext &context_;
+ ConstantSubscript elementNumber_{0}; // zero-based
+};
+
+// Reconstructs a Designator<> from a symbol and an offset.
+std::optional<Expr<SomeType>> OffsetToDesignator(
+ FoldingContext &, const Symbol &, ConstantSubscript offset, std::size_t);
+std::optional<Expr<SomeType>> OffsetToDesignator(
+ FoldingContext &, const OffsetSymbol &);
+
+// Represents a compile-time constant Descriptor suitable for use
+// as a pointer initializer. Lower bounds are always 1.
+struct ConstantObjectPointer : public OffsetSymbol {
+ struct Dimension {
+ ConstantSubscript byteStride;
+ ConstantSubscript extent;
+ };
+ using Dimensions = std::vector<Dimension>;
+
+ ConstantObjectPointer(
+ const Symbol &symbol, std::size_t size, Dimensions &&dims)
+ : OffsetSymbol{symbol, size}, dimensions{std::move(dims)} {}
+
+ // Folds a designator to a constant pointer. Crashes on failure.
+ // Use IsInitialDataTarget() to validate the expression beforehand.
+ static ConstantObjectPointer From(FoldingContext &, const Expr<SomeType> &);
+
+ Dimensions dimensions;
+};
+
+} // namespace Fortran::evaluate
+#endif // FORTRAN_EVALUATE_FOLD_DESIGNATOR_H_
diff --git a/flang/include/flang/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h
index 053164ba7a9b..d8a1a6f8daff 100644
--- a/flang/include/flang/Evaluate/shape.h
+++ b/flang/include/flang/Evaluate/shape.h
@@ -188,11 +188,38 @@ std::optional<Shape> GetShape(FoldingContext &context, const A &x) {
return GetShapeHelper{context}(x);
}
+template <typename A>
+std::optional<Constant<ExtentType>> GetConstantShape(
+ FoldingContext &context, const A &x) {
+ if (auto shape{GetShape(context, x)}) {
+ return AsConstantShape(context, *shape);
+ } else {
+ return std::nullopt;
+ }
+}
+
+template <typename A>
+std::optional<ConstantSubscripts> GetConstantExtents(
+ FoldingContext &context, const A &x) {
+ if (auto shape{GetShape(context, x)}) {
+ return AsConstantExtents(context, *shape);
+ } else {
+ return std::nullopt;
+ }
+}
+
// Compilation-time shape conformance checking, when corresponding extents
// are known.
bool CheckConformance(parser::ContextualMessages &, const Shape &left,
const Shape &right, const char *leftIs = "left operand",
const char *rightIs = "right operand");
+// Increments one-based subscripts in element order (first varies fastest)
+// and returns true when they remain in range; resets them all to one and
+// return false otherwise (including the case where one or more of the
+// extents are zero).
+bool IncrementSubscripts(
+ ConstantSubscripts &, const ConstantSubscripts &extents);
+
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_SHAPE_H_
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index c8d6da3dbf28..1fc80e590360 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -700,6 +700,42 @@ struct TypeKindVisitor {
VALUE value;
};
+// TypedWrapper() wraps a object in an explicitly typed representation
+// (e.g., Designator<> or FunctionRef<>) that has been instantiated on
+// a dynamically chosen Fortran type.
+template <TypeCategory CATEGORY, template <typename> typename WRAPPER,
+ typename WRAPPED>
+common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> WrapperHelper(
+ int kind, WRAPPED &&x) {
+ return common::SearchTypes(
+ TypeKindVisitor<CATEGORY, WRAPPER, WRAPPED>{kind, std::move(x)});
+}
+
+template <template <typename> typename WRAPPER, typename WRAPPED>
+common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> TypedWrapper(
+ const DynamicType &dyType, WRAPPED &&x) {
+ switch (dyType.category()) {
+ SWITCH_COVERS_ALL_CASES
+ case TypeCategory::Integer:
+ return WrapperHelper<TypeCategory::Integer, WRAPPER, WRAPPED>(
+ dyType.kind(), std::move(x));
+ case TypeCategory::Real:
+ return WrapperHelper<TypeCategory::Real, WRAPPER, WRAPPED>(
+ dyType.kind(), std::move(x));
+ case TypeCategory::Complex:
+ return WrapperHelper<TypeCategory::Complex, WRAPPER, WRAPPED>(
+ dyType.kind(), std::move(x));
+ case TypeCategory::Character:
+ return WrapperHelper<TypeCategory::Character, WRAPPER, WRAPPED>(
+ dyType.kind(), std::move(x));
+ case TypeCategory::Logical:
+ return WrapperHelper<TypeCategory::Logical, WRAPPER, WRAPPED>(
+ dyType.kind(), std::move(x));
+ case TypeCategory::Derived:
+ return AsGenericExpr(Expr<SomeDerived>{WRAPPER<SomeDerived>{std::move(x)}});
+ }
+}
+
// GetLastSymbol() returns the rightmost symbol in an object or procedure
// designator (which has perhaps been wrapped in an Expr<>), or a null pointer
// when none is found.
@@ -839,6 +875,22 @@ std::optional<std::string> FindImpureCall(
std::optional<std::string> FindImpureCall(
const IntrinsicProcTable &, const ProcedureRef &);
+// Predicate: is a scalar expression suitable for naive scalar expansion
+// in the flattening of an array expression?
+// TODO: capture such scalar expansions in temporaries, flatten everything
+struct UnexpandabilityFindingVisitor
+ : public AnyTraverse<UnexpandabilityFindingVisitor> {
+ using Base = AnyTraverse<UnexpandabilityFindingVisitor>;
+ using Base::operator();
+ UnexpandabilityFindingVisitor() : Base{*this} {}
+ template <typename T> bool operator()(const FunctionRef<T> &) { return true; }
+ bool operator()(const CoarrayRef &) { return true; }
+};
+
+template <typename T> bool IsExpandableScalar(const Expr<T> &expr) {
+ return !UnexpandabilityFindingVisitor{}(expr);
+}
+
} // namespace Fortran::evaluate
namespace Fortran::semantics {
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index 93de6242aa30..197fb3291dd4 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -139,6 +139,7 @@ class DynamicType {
return charLength_;
}
std::optional<common::ConstantSubscript> GetCharLength() const;
+ std::optional<std::size_t> MeasureSizeInBytes() const;
std::string AsFortran() const;
std::string AsFortran(std::string &&charLenExpr) const;
diff --git a/flang/lib/Evaluate/CMakeLists.txt b/flang/lib/Evaluate/CMakeLists.txt
index 0e5dc4d2c5ff..7911b50e13db 100644
--- a/flang/lib/Evaluate/CMakeLists.txt
+++ b/flang/lib/Evaluate/CMakeLists.txt
@@ -10,6 +10,7 @@ add_flang_library(FortranEvaluate
fold.cpp
fold-character.cpp
fold-complex.cpp
+ fold-designator.cpp
fold-integer.cpp
fold-logical.cpp
fold-real.cpp
diff --git a/flang/lib/Evaluate/fold-designator.cpp b/flang/lib/Evaluate/fold-designator.cpp
new file mode 100644
index 000000000000..b33436296e95
--- /dev/null
+++ b/flang/lib/Evaluate/fold-designator.cpp
@@ -0,0 +1,408 @@
+//===-- lib/Evaluate/designate.cpp ------------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Evaluate/fold-designator.h"
+#include "flang/Semantics/tools.h"
+
+namespace Fortran::evaluate {
+
+DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(OffsetSymbol)
+
+std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
+ const Symbol &symbol, ConstantSubscript which) const {
+ if (semantics::IsPointer(symbol) || semantics::IsAllocatable(symbol)) {
+ // A pointer may appear as a DATA statement object if it is the
+ // rightmost symbol in a designator and has no subscripts.
+ // An allocatable may appear if its initializer is NULL().
+ if (which == 0) {
+ return OffsetSymbol{symbol, symbol.size()};
+ }
+ } else if (symbol.has<semantics::ObjectEntityDetails>()) {
+ if (auto type{DynamicType::From(symbol)}) {
+ if (auto bytes{type->MeasureSizeInBytes()}) {
+ if (auto extents{GetConstantExtents(context_, symbol)}) {
+ OffsetSymbol result{symbol, *bytes};
+ auto stride{static_cast<ConstantSubscript>(*bytes)};
+ for (auto extent : *extents) {
+ if (extent == 0) {
+ return std::nullopt;
+ }
+ auto quotient{which / extent};
+ auto remainder{which - extent * quotient};
+ result.Augment(stride * remainder);
+ which = quotient;
+ stride *= extent;
+ }
+ if (which == 0) {
+ return std::move(result);
+ }
+ }
+ }
+ }
+ }
+ return std::nullopt;
+}
+
+std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
+ const ArrayRef &x, ConstantSubscript which) const {
+ const Symbol &array{x.base().GetLastSymbol()};
+ if (auto type{DynamicType::From(array)}) {
+ if (auto bytes{type->MeasureSizeInBytes()}) {
+ if (auto extents{GetConstantExtents(context_, array)}) {
+ Shape lbs{GetLowerBounds(context_, x.base())};
+ if (auto lowerBounds{AsConstantExtents(context_, lbs)}) {
+ std::optional<OffsetSymbol> result;
+ if (!x.base().IsSymbol() &&
+ x.base().GetComponent().base().Rank() > 0) {
+ // A(:)%B(1) - apply elementNumber_ to base
+ result = FoldDesignator(x.base(), which);
+ which = 0;
+ } else { // A(1)%B(:) - apply elementNumber_ to subscripts
+ result = FoldDesignator(x.base(), 0);
+ }
+ if (!result) {
+ return std::nullopt;
+ }
+ auto stride{static_cast<ConstantSubscript>(*bytes)};
+ int dim{0};
+ for (const Subscript &subscript : x.subscript()) {
+ ConstantSubscript lower{lowerBounds->at(dim)};
+ ConstantSubscript extent{extents->at(dim)};
+ ConstantSubscript upper{lower + extent - 1};
+ if (!std::visit(
+ common::visitors{
+ [&](const IndirectSubscriptIntegerExpr &expr) {
+ auto folded{
+ Fold(context_, common::Clone(expr.value()))};
+ if (auto value{UnwrapConstantValue<SubscriptInteger>(
+ folded)}) {
+ CHECK(value->Rank() <= 1);
+ if (value->size() != 0) {
+ // Apply subscript, possibly vector-valued
+ auto quotient{which / value->size()};
+ auto remainder{which - value->size() * quotient};
+ ConstantSubscript at{
+ value->values().at(remainder).ToInt64()};
+ if (at >= lower && at <= upper) {
+ result->Augment((at - lower) * stride);
+ which = quotient;
+ return true;
+ }
+ }
+ }
+ return false;
+ },
+ [&](const Triplet &triplet) {
+ auto start{ToInt64(Fold(context_,
+ triplet.lower().value_or(ExtentExpr{lower})))};
+ auto end{ToInt64(Fold(context_,
+ triplet.upper().value_or(ExtentExpr{upper})))};
+ auto step{ToInt64(Fold(context_, triplet.stride()))};
+ if (start && end && step && *step != 0) {
+ ConstantSubscript range{
+ (*end - *start + *step) / *step};
+ if (range > 0) {
+ auto quotient{which / range};
+ auto remainder{which - range * quotient};
+ auto j{*start + remainder * *step};
+ result->Augment((j - lower) * stride);
+ which = quotient;
+ return true;
+ }
+ }
+ return false;
+ },
+ },
+ subscript.u)) {
+ return std::nullopt;
+ }
+ ++dim;
+ stride *= extent;
+ }
+ if (which == 0) {
+ return result;
+ }
+ }
+ }
+ }
+ }
+ return std::nullopt;
+}
+
+std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
+ const Component &component, ConstantSubscript which) const {
+ const Symbol &comp{component.GetLastSymbol()};
+ const DataRef &base{component.base()};
+ std::optional<OffsetSymbol> result, baseResult;
+ if (base.Rank() == 0) { // A%X(:) - apply "which" to component
+ baseResult = FoldDesignator(base, 0);
+ result = FoldDesignator(comp, which);
+ } else { // A(:)%X - apply "which" to base
+ baseResult = FoldDesignator(base, which);
+ result = FoldDesignator(comp, 0);
+ }
+ if (result && baseResult) {
+ result->set_symbol(baseResult->symbol());
+ result->Augment(baseResult->offset() + comp.offset());
+ return result;
+ } else {
+ return std::nullopt;
+ }
+}
+
+std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
+ const ComplexPart &z, ConstantSubscript which) const {
+ if (auto result{FoldDesignator(z.complex(), which)}) {
+ result->set_size(result->size() >> 1);
+ if (z.part() == ComplexPart::Part::IM) {
+ result->Augment(result->size());
+ }
+ return result;
+ } else {
+ return std::nullopt;
+ }
+}
+
+std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
+ const DataRef &dataRef, ConstantSubscript which) const {
+ return std::visit(
+ [&](const auto &x) { return FoldDesignator(x, which); }, dataRef.u);
+}
+
+std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
+ const NamedEntity &entity, ConstantSubscript which) const {
+ return entity.IsSymbol() ? FoldDesignator(entity.GetLastSymbol(), which)
+ : FoldDesignator(entity.GetComponent(), which);
+}
+
+std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
+ const CoarrayRef &, ConstantSubscript) const {
+ return std::nullopt;
+}
+
+std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
+ const ProcedureDesignator &proc, ConstantSubscript which) const {
+ if (const Symbol * symbol{proc.GetSymbol()}) {
+ if (const Component * component{proc.GetComponent()}) {
+ return FoldDesignator(*component, which);
+ } else if (which == 0) {
+ return FoldDesignator(*symbol, 0);
+ }
+ }
+ return std::nullopt;
+}
+
+// Conversions of offset symbols (back) to Designators
+
+// Reconstructs subscripts.
+// "offset" is decremented in place to hold remaining component offset.
+static std::optional<ArrayRef> OffsetToArrayRef(FoldingContext &context,
+ NamedEntity &&entity, const Shape &shape, const DynamicType &elementType,
+ ConstantSubscript &offset) {
+ auto extents{AsConstantExtents(context, shape)};
+ Shape lbs{GetLowerBounds(context, entity)};
+ auto lower{AsConstantExtents(context, lbs)};
+ auto elementBytes{elementType.MeasureSizeInBytes()};
+ if (!extents || !lower || !elementBytes || *elementBytes <= 0) {
+ return std::nullopt;
+ }
+ int rank{GetRank(shape)};
+ CHECK(extents->size() == static_cast<std::size_t>(rank) &&
+ lower->size() == extents->size());
+ auto element{offset / *elementBytes};
+ std::vector<Subscript> subscripts;
+ auto at{element};
+ for (int dim{0}; dim < rank; ++dim) {
+ auto extent{(*extents)[dim]};
+ if (extent <= 0) {
+ return std::nullopt;
+ }
+ auto quotient{at / extent};
+ auto remainder{at - quotient * extent};
+ subscripts.emplace_back(ExtentExpr{(*lower)[dim] + remainder});
+ at = quotient;
+ }
+ if (at == 0) {
+ offset -= element * *elementBytes;
+ return ArrayRef{std::move(entity), std::move(subscripts)};
+ }
+ return std::nullopt;
+}
+
+// Maps an offset back to a component, when unambiguous.
+static const Symbol *OffsetToUniqueComponent(
+ const semantics::DerivedTypeSpec &spec, ConstantSubscript offset) {
+ const Symbol *result{nullptr};
+ if (const semantics::Scope * scope{spec.scope()}) {
+ for (const auto &pair : *scope) {
+ const Symbol &component{*pair.second};
+ if (offset >= static_cast<ConstantSubscript>(component.offset()) &&
+ offset < static_cast<ConstantSubscript>(
+ component.offset() + component.size())) {
+ if (result) {
+ return nullptr; // MAP overlap or error recovery
+ }
+ result = &component;
+ }
+ }
+ }
+ return result;
+}
+
+// Converts an offset into subscripts &/or component references. Recursive.
+static std::optional<DataRef> OffsetToDataRef(FoldingContext &context,
+ NamedEntity &&entity, ConstantSubscript &offset, std::size_t size) {
+ const Symbol &symbol{entity.GetLastSymbol()};
+ if (IsAllocatableOrPointer(symbol)) {
+ return entity.IsSymbol() ? DataRef{symbol}
+ : DataRef{std::move(entity.GetComponent())};
+ }
+ std::optional<DataRef> result;
+ if (std::optional<DynamicType> type{DynamicType::From(symbol)}) {
+ if (!type->IsUnlimitedPolymorphic()) {
+ if (std::optional<Shape> shape{GetShape(context, symbol)}) {
+ if (GetRank(*shape) > 0) {
+ if (auto aref{OffsetToArrayRef(
+ context, std::move(entity), *shape, *type, offset)}) {
+ result = DataRef{std::move(*aref)};
+ }
+ } else {
+ result = entity.IsSymbol()
+ ? DataRef{symbol}
+ : DataRef{std::move(entity.GetComponent())};
+ }
+ if (result && type->category() == TypeCategory::Derived &&
+ size < result->GetLastSymbol().size()) {
+ if (const Symbol *
+ component{OffsetToUniqueComponent(
+ type->GetDerivedTypeSpec(), offset)}) {
+ offset -= component->offset();
+ return OffsetToDataRef(context,
+ NamedEntity{Component{std::move(*result), *component}}, offset,
+ size);
+ }
+ result.reset();
+ }
+ }
+ }
+ }
+ return result;
+}
+
+// Reconstructs a Designator from a symbol, an offset, and a size.
+std::optional<Expr<SomeType>> OffsetToDesignator(FoldingContext &context,
+ const Symbol &baseSymbol, ConstantSubscript offset, std::size_t size) {
+ CHECK(offset >= 0);
+ if (std::optional<DataRef> dataRef{
+ OffsetToDataRef(context, NamedEntity{baseSymbol}, offset, size)}) {
+ const Symbol &symbol{dataRef->GetLastSymbol()};
+ if (auto type{DynamicType::From(symbol)}) {
+ if (std::optional<Expr<SomeType>> result{
+ TypedWrapper<Designator>(*type, std::move(*dataRef))}) {
+ if (IsAllocatableOrPointer(symbol)) {
+ } else if (auto elementBytes{type->MeasureSizeInBytes()}) {
+ if (auto *zExpr{std::get_if<Expr<SomeComplex>>(&result->u)}) {
+ if (size * 2 > *elementBytes) {
+ return result;
+ } else if (offset == 0 ||
+ offset * 2 == static_cast<ConstantSubscript>(*elementBytes)) {
+ // Pick a COMPLEX component
+ auto part{
+ offset == 0 ? ComplexPart::Part::RE : ComplexPart::Part::IM};
+ return std::visit(
+ [&](const auto &z) -> std::optional<Expr<SomeType>> {
+ using PartType = typename ResultType<decltype(z)>::Part;
+ return AsGenericExpr(Designator<PartType>{ComplexPart{
+ ExtractDataRef(std::move(*zExpr)).value(), part}});
+ },
+ zExpr->u);
+ }
+ } else if (auto *cExpr{
+ std::get_if<Expr<SomeCharacter>>(&result->u)}) {
+ if (offset > 0 || size != *elementBytes) {
+ // Select a substring
+ return std::visit(
+ [&](const auto &x) -> std::optional<Expr<SomeType>> {
+ using T = typename std::decay_t<decltype(x)>::Result;
+ return AsGenericExpr(Designator<T>{
+ Substring{ExtractDataRef(std::move(*cExpr)).value(),
+ std::optional<Expr<SubscriptInteger>>{
+ 1 + (offset / T::kind)},
+ std::optional<Expr<SubscriptInteger>>{
+ 1 + ((offset + size - 1) / T::kind)}}});
+ },
+ cExpr->u);
+ }
+ }
+ }
+ if (offset == 0) {
+ return result;
+ }
+ }
+ }
+ }
+ return std::nullopt;
+}
+
+std::optional<Expr<SomeType>> OffsetToDesignator(
+ FoldingContext &context, const OffsetSymbol &offsetSymbol) {
+ return OffsetToDesignator(context, offsetSymbol.symbol(),
+ offsetSymbol.offset(), offsetSymbol.size());
+}
+
+ConstantObjectPointer ConstantObjectPointer::From(
+ FoldingContext &context, const Expr<SomeType> &expr) {
+ auto extents{GetConstantExtents(context, expr)};
+ CHECK(extents);
+ std::size_t elements{TotalElementCount(*extents)};
+ CHECK(elements > 0);
+ int rank{GetRank(*extents)};
+ ConstantSubscripts at(rank, 1);
+ ConstantObjectPointer::Dimensions dimensions(rank);
+ for (int j{0}; j < rank; ++j) {
+ dimensions[j].extent = (*extents)[j];
+ }
+ DesignatorFolder designatorFolder{context};
+ const Symbol *symbol{nullptr};
+ ConstantSubscript baseOffset{0};
+ std::size_t elementSize{0};
+ for (std::size_t j{0}; j < elements; ++j) {
+ auto folded{designatorFolder.FoldDesignator(expr)};
+ CHECK(folded);
+ if (j == 0) {
+ symbol = &folded->symbol();
+ baseOffset = folded->offset();
+ elementSize = folded->size();
+ } else {
+ CHECK(symbol == &folded->symbol());
+ CHECK(elementSize == folded->size());
+ }
+ int twoDim{-1};
+ for (int k{0}; k < rank; ++k) {
+ if (at[k] == 2 && twoDim == -1) {
+ twoDim = k;
+ } else if (at[k] != 1) {
+ twoDim = -2;
+ }
+ }
+ if (twoDim >= 0) {
+ // Exactly one subscript is a 2 and the rest are 1.
+ dimensions[twoDim].byteStride = folded->offset() - baseOffset;
+ }
+ ConstantSubscript checkOffset{baseOffset};
+ for (int k{0}; k < rank; ++k) {
+ checkOffset += (at[k] - 1) * dimensions[twoDim].byteStride;
+ }
+ CHECK(checkOffset == folded->offset());
+ CHECK(IncrementSubscripts(at, *extents) == (j + 1 < elements));
+ }
+ CHECK(!designatorFolder.FoldDesignator(expr));
+ return ConstantObjectPointer{
+ DEREF(symbol), elementSize, std::move(dimensions)};
+}
+} // namespace Fortran::evaluate
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index 4454aca96f2a..05068a2d143a 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -1076,22 +1076,6 @@ auto ApplyElementwise(
}});
}
-// Predicate: is a scalar expression suitable for naive scalar expansion
-// in the flattening of an array expression?
-// TODO: capture such scalar expansions in temporaries, flatten everything
-struct UnexpandabilityFindingVisitor
- : public AnyTraverse<UnexpandabilityFindingVisitor> {
- using Base = AnyTraverse<UnexpandabilityFindingVisitor>;
- using Base::operator();
- UnexpandabilityFindingVisitor() : Base{*this} {}
- template <typename T> bool operator()(const FunctionRef<T> &) { return true; }
- bool operator()(const CoarrayRef &) { return true; }
-};
-
-template <typename T> bool IsExpandableScalar(const Expr<T> &expr) {
- return !UnexpandabilityFindingVisitor{}(expr);
-}
-
template <typename DERIVED, typename RESULT, typename LEFT, typename RIGHT>
auto ApplyElementwise(FoldingContext &context,
Operation<DERIVED, RESULT, LEFT, RIGHT> &operation,
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index 6988a1b2e3d6..7d23b9273330 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -20,7 +20,8 @@
#include <optional>
#include <string>
-// IsDescriptor() predicate
+// IsDescriptor() predicate: true when a symbol is implemented
+// at runtime with a descriptor.
// TODO there's probably a better place for this predicate than here
namespace Fortran::semantics {
@@ -107,6 +108,42 @@ std::optional<common::ConstantSubscript> DynamicType::GetCharLength() const {
return std::nullopt;
}
+static constexpr int RealKindBytes(int kind) {
+ switch (kind) {
+ case 3: // non-IEEE 16-bit format (truncated 32-bit)
+ return 2;
+ case 10: // 80387 80-bit extended precision
+ case 12: // possible variant spelling
+ return 16;
+ default:
+ return kind;
+ }
+}
+
+std::optional<std::size_t> DynamicType::MeasureSizeInBytes() const {
+ switch (category_) {
+ case TypeCategory::Integer:
+ return kind_;
+ case TypeCategory::Real:
+ return RealKindBytes(kind_);
+ case TypeCategory::Complex:
+ return 2 * RealKindBytes(kind_);
+ case TypeCategory::Character:
+ if (auto len{GetCharLength()}) {
+ return kind_ * *len;
+ }
+ break;
+ case TypeCategory::Logical:
+ return kind_;
+ case TypeCategory::Derived:
+ if (derived_ && derived_->scope()) {
+ return derived_->scope()->size();
+ }
+ break;
+ }
+ return std::nullopt;
+}
+
bool DynamicType::IsAssumedLengthCharacter() const {
return category_ == TypeCategory::Character && charLength_ &&
charLength_->isAssumed();
diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index 6c2573d790a1..1a03c6ee47f9 100644
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -1,4 +1,4 @@
-//===----------------------------------------------------------------------===//
+//===-- lib/Semantics/compute-offsets.cpp -----------------------*- C++ -*-===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
@@ -24,7 +24,7 @@ namespace Fortran::semantics {
class ComputeOffsetsHelper {
public:
// TODO: configure based on target
- static constexpr int maxAlignment{8};
+ static constexpr std::size_t maxAlignment{8};
ComputeOffsetsHelper(SemanticsContext &context) : context_{context} {}
void Compute() { Compute(context_.globalScope()); }
@@ -32,9 +32,9 @@ class ComputeOffsetsHelper {
private:
struct SizeAndAlignment {
SizeAndAlignment() {}
- SizeAndAlignment(std::size_t size) : size{size}, alignment{size} {}
- SizeAndAlignment(std::size_t size, std::size_t alignment)
- : size{size}, alignment{alignment} {}
+ SizeAndAlignment(std::size_t bytes) : size{bytes}, alignment{bytes} {}
+ SizeAndAlignment(std::size_t bytes, std::size_t align)
+ : size{bytes}, alignment{align} {}
std::size_t size{0};
std::size_t alignment{0};
};
@@ -209,6 +209,9 @@ auto ComputeOffsetsHelper::GetElementSize(
if (!type) {
return {};
}
+ // TODO: The size of procedure pointers is not yet known
+ // and is independent of rank (and probably also the number
+ // of length type parameters).
if (IsDescriptor(symbol) || IsProcedure(symbol)) {
int lenParams{0};
if (const DerivedTypeSpec * derived{type->AsDerived()}) {
@@ -264,12 +267,16 @@ std::size_t ComputeOffsetsHelper::Align(std::size_t x, std::size_t alignment) {
auto ComputeOffsetsHelper::GetIntrinsicSizeAndAlignment(
TypeCategory category, int kind) -> SizeAndAlignment {
- // TODO: does kind==10 need special handling?
- std::size_t size{kind == 3 ? 2 : static_cast<std::size_t>(kind)};
+ if (category == TypeCategory::Character) {
+ return {static_cast<std::size_t>(kind)};
+ }
+ std::optional<std::size_t> size{
+ evaluate::DynamicType{category, kind}.MeasureSizeInBytes()};
+ CHECK(size.has_value());
if (category == TypeCategory::Complex) {
- return {2 * size, size};
+ return {*size, *size >> 1};
} else {
- return {size};
+ return {*size};
}
}
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index cc7faef24640..76d0ffe32d6c 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -95,40 +95,6 @@ static std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
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.
-template <TypeCategory CATEGORY, template <typename> typename WRAPPER,
- typename WRAPPED>
-common::IfNoLvalue<MaybeExpr, WRAPPED> WrapperHelper(int kind, WRAPPED &&x) {
- return common::SearchTypes(
- TypeKindVisitor<CATEGORY, WRAPPER, WRAPPED>{kind, std::move(x)});
-}
-
-template <template <typename> typename WRAPPER, typename WRAPPED>
-common::IfNoLvalue<MaybeExpr, WRAPPED> TypedWrapper(
- const DynamicType &dyType, WRAPPED &&x) {
- switch (dyType.category()) {
- SWITCH_COVERS_ALL_CASES
- case TypeCategory::Integer:
- return WrapperHelper<TypeCategory::Integer, WRAPPER, WRAPPED>(
- dyType.kind(), std::move(x));
- case TypeCategory::Real:
- return WrapperHelper<TypeCategory::Real, WRAPPER, WRAPPED>(
- dyType.kind(), std::move(x));
- case TypeCategory::Complex:
- return WrapperHelper<TypeCategory::Complex, WRAPPER, WRAPPED>(
- dyType.kind(), std::move(x));
- case TypeCategory::Character:
- return WrapperHelper<TypeCategory::Character, WRAPPER, WRAPPED>(
- dyType.kind(), std::move(x));
- case TypeCategory::Logical:
- return WrapperHelper<TypeCategory::Logical, WRAPPER, WRAPPED>(
- dyType.kind(), std::move(x));
- case TypeCategory::Derived:
- return AsGenericExpr(Expr<SomeDerived>{WRAPPER<SomeDerived>{std::move(x)}});
- }
-}
-
class ArgumentAnalyzer {
public:
explicit ArgumentAnalyzer(ExpressionAnalyzer &context)
More information about the flang-commits
mailing list