[flang] DATA stmt processing (part 1/4): designator folding

[klausler]

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.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/include/flang/Evaluate/fold-designator.h

+//===-- 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_

flang/include/flang/Evaluate/shape.h

private:
   FoldingContext &context_;
 };
 
 template <typename A>
 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_

flang/include/flang/Evaluate/tools.h

template <typename T> Result Test() {
     }
     return std::nullopt;
   }
 
   int kind;
   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.
 struct GetLastSymbolHelper
     : public AnyTraverse<GetLastSymbolHelper, std::optional<const Symbol *>> {
   using Result = std::optional<const Symbol *>;
   using Base = AnyTraverse<GetLastSymbolHelper, Result>;
   GetLastSymbolHelper() : Base{*this} {}

 
 // Check for references to impure procedures; returns the name
 // of one to complain about, if any exist.
 std::optional<std::string> FindImpureCall(
     const IntrinsicProcTable &, const Expr<SomeType> &);
 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 {
 
 class Scope;
 
 // These functions are used in Evaluate so they are defined here rather than in
 // Semantics to avoid a link-time dependency on Semantics.

flang/include/flang/Evaluate/type.h

public:
   constexpr int kind() const {
     CHECK(kind_ > 0);
     return kind_;
   }
   constexpr const semantics::ParamValue *charLength() const {
     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;
   DynamicType ResultTypeForMultiply(const DynamicType &) const;
 
   bool IsAssumedLengthCharacter() const;
   bool IsUnknownLengthCharacter() const;
   bool IsTypelessIntrinsicArgument() const;

flang/lib/Evaluate/CMakeLists.txt

 
 add_flang_library(FortranEvaluate
   call.cpp
   characteristics.cpp
   check-expression.cpp
   common.cpp
   complex.cpp
   constant.cpp
   expression.cpp
   fold.cpp
   fold-character.cpp
   fold-complex.cpp
+  fold-designator.cpp
   fold-integer.cpp
   fold-logical.cpp
   fold-real.cpp
   formatting.cpp
   host.cpp
   integer.cpp
   intrinsics.cpp
   intrinsics-library.cpp

flang/lib/Evaluate/fold-designator.cpp

+//===-- 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

flang/lib/Evaluate/fold-implementation.h

auto ApplyElementwise(
     -> std::optional<Expr<RESULT>> {
   return ApplyElementwise(context, operation,
       std::function<Expr<RESULT>(Expr<OPERAND> &&)>{
           [](Expr<OPERAND> &&operand) {
             return Expr<RESULT>{DERIVED{std::move(operand)}};
           }});
 }
 
-// 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,
     std::function<Expr<RESULT>(Expr<LEFT> &&, Expr<RIGHT> &&)> &&f)
     -> std::optional<Expr<RESULT>> {
   auto &leftExpr{operation.left()};
   leftExpr = Fold(context, std::move(leftExpr));
   auto &rightExpr{operation.right()};

flang/lib/Evaluate/type.cpp

 #include "flang/Semantics/scope.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
 #include "flang/Semantics/type.h"
 #include <algorithm>
 #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 {
 
 static bool IsDescriptor(const ObjectEntityDetails &details) {
   if (const auto *type{details.type()}) {
     if (auto dynamicType{evaluate::DynamicType::From(*type)}) {
       if (dynamicType->RequiresDescriptor()) {
         return true;
if (category_ == TypeCategory::Character && charLength_ &&
       charLength_->isExplicit()) {
     if (const auto &len{charLength_->GetExplicit()}) {
       return ToInt64(len);
     }
   }
   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();
 }
 
 bool DynamicType::IsUnknownLengthCharacter() const {
   if (category_ != TypeCategory::Character) {
     return false;

flang/lib/Semantics/compute-offsets.cpp

-//===----------------------------------------------------------------------===//
+//===-- 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.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "compute-offsets.h"

 #include <algorithm>
 #include <vector>
 
 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()); }
 
 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};
   };
   struct SymbolAndOffset {
     Symbol *symbol{nullptr};
     std::size_t offset{0};
   };
 

 }
 
 auto ComputeOffsetsHelper::GetElementSize(
     const Symbol &symbol, bool isSubstring) -> SizeAndAlignment {
   const DeclTypeSpec *type{symbol.GetType()};
   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()}) {
       lenParams = CountLenParameters(*derived);
     }
     std::size_t size{
         runtime::Descriptor::SizeInBytes(symbol.Rank(), false, lenParams)};
     return {size, maxAlignment};
std::size_t ComputeOffsetsHelper::Align(std::size_t x, std::size_t alignment) {
   if (alignment > maxAlignment) {
     alignment = maxAlignment;
   }
   return (x + alignment - 1) & -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};
   }
 }
 
 void ComputeOffsets(SemanticsContext &context) {
   ComputeOffsetsHelper{context}.Compute();
 }
 
 } // namespace Fortran::semantics

flang/lib/Semantics/expression.cpp

if (const semantics::DeclTypeSpec * typeSpec{spec->declTypeSpec}) {
           derived{typeSpec->AsDerived()}) {
         return DynamicTypeWithLength{DynamicType{*derived}};
       }
     }
   }
   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)
       : context_{context}, allowAssumedType_{false} {}
   ArgumentAnalyzer(ExpressionAnalyzer &context, parser::CharBlock source,
       bool allowAssumedType = false)
       : context_{context}, source_{source}, allowAssumedType_{
                                                 allowAssumedType} {}