[flang] DATA statement processing (part 2/4): Initial images

[klausler]

Summary

Defines a representation for the initialized memory image of
a variable. This image is populated by DATA statement
processing as designator elements are put into correspondence
with values, then converted into an initializer in the symbol
table so that lowering can pass the initial image to the
code generator.

flang/include/flang/Evaluate/initial-image.h

+//===-------include/flang/Evaluate/initial-image.h ------------------------===//
+//
+// 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_INITIAL_IMAGE_H_
+#define FORTRAN_EVALUATE_INITIAL_IMAGE_H_
+
+// Represents the initialized storage of an object during DATA statement
+// processing, including the conversion of that image to a constant
+// initializer for a symbol.
+
+#include "expression.h"
+#include <map>
+#include <optional>
+#include <vector>
+
+namespace Fortran::evaluate {
+
+class InitialImage {
+public:
+  explicit InitialImage(std::size_t bytes) : data_(bytes) {}
+
+  std::size_t size() const { return data_.size(); }
+
+  template <typename A> bool Add(ConstantSubscript, std::size_t, const A &) {
+    return false;
+  }
+  template <typename T>
+  bool Add(ConstantSubscript offset, std::size_t bytes, const Constant<T> &x) {
+    CHECK(offset >= 0 && offset + bytes <= data_.size());
+    auto elementBytes{x.GetType().MeasureSizeInBytes()};
+    CHECK(elementBytes && bytes == x.values().size() * *elementBytes);
+    std::memcpy(&data_.at(offset), &x.values().at(0), bytes);
+    return true;
+  }
+  template <int KIND>
+  bool Add(ConstantSubscript offset, std::size_t bytes,
+      const Constant<Type<TypeCategory::Character, KIND>> &x) {
+    CHECK(offset >= 0 && offset + bytes <= data_.size());
+    auto elements{TotalElementCount(x.shape())};
+    auto elementBytes{bytes > 0 ? bytes / elements : 0};
+    CHECK(elements * elementBytes == bytes);
+    for (auto at{x.lbounds()}; elements-- > 0; x.IncrementSubscripts(at)) {
+      auto scalar{x.At(at)}; // this is a std string; size() in chars
+      // Subtle: an initializer for a substring may have been
+      // expanded to the length of the entire string.
+      CHECK(scalar.size() * KIND == elementBytes ||
+          (elements == 0 && scalar.size() * KIND > elementBytes));
+      std::memcpy(&data_[offset], scalar.data(), elementBytes);
+      offset += elementBytes;
+    }
+    return true;
+  }
+  bool Add(ConstantSubscript, std::size_t, const Constant<SomeDerived> &);
+  template <typename T>
+  bool Add(ConstantSubscript offset, std::size_t bytes, const Expr<T> &x) {
+    return std::visit(
+        [&](const auto &y) { return Add(offset, bytes, y); }, x.u);
+  }
+
+  void AddPointer(ConstantSubscript, const Expr<SomeType> &);
+
+  // Conversions to constant initializers
+  std::optional<Expr<SomeType>> AsConstant(FoldingContext &,
+      const DynamicType &, const ConstantSubscripts &,
+      ConstantSubscript offset = 0) const;
+  std::optional<Expr<SomeType>> AsConstantDataPointer(
+      const DynamicType &, ConstantSubscript offset = 0) const;
+  const ProcedureDesignator &AsConstantProcPointer(
+      ConstantSubscript offset = 0) const;
+
+  friend class AsConstantHelper;
+  friend class AsConstantDataPointerHelper;
+
+private:
+  std::vector<char> data_;
+  std::map<ConstantSubscript, Expr<SomeType>> pointers_;
+};
+
+} // namespace Fortran::evaluate
+#endif // FORTRAN_EVALUATE_INITIAL_IMAGE_H_

flang/lib/Evaluate/CMakeLists.txt

add_flang_library(FortranEvaluate
   fold-character.cpp
   fold-complex.cpp
   fold-designator.cpp
   fold-integer.cpp
   fold-logical.cpp
   fold-real.cpp
   formatting.cpp
   host.cpp
+  initial-image.cpp
   integer.cpp
   intrinsics.cpp
   intrinsics-library.cpp
   logical.cpp
   real.cpp
   shape.cpp
   static-data.cpp
   tools.cpp

flang/lib/Evaluate/initial-image.cpp

+//===-- lib/Evaluate/initial-image.cpp ------------------------------------===//
+//
+// 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/initial-image.h"
+#include "flang/Semantics/scope.h"
+#include "flang/Semantics/tools.h"
+
+namespace Fortran::evaluate {
+
+bool InitialImage::Add(ConstantSubscript offset, std::size_t bytes,
+    const Constant<SomeDerived> &x) {
+  CHECK(offset >= 0 && offset + bytes <= data_.size());
+  auto elements{TotalElementCount(x.shape())};
+  auto elementBytes{bytes > 0 ? bytes / elements : 0};
+  CHECK(elements * elementBytes == bytes);
+  auto at{x.lbounds()};
+  for (auto elements{TotalElementCount(x.shape())}; elements-- > 0;
+       x.IncrementSubscripts(at)) {
+    auto scalar{x.At(at)};
+    // TODO: length type parameter values?
+    for (const auto &[symbolRef, indExpr] : scalar) {
+      const Symbol &component{*symbolRef};
+      CHECK(component.offset() + component.size() <= elementBytes);
+      if (IsPointer(component)) {
+        AddPointer(offset + component.offset(), indExpr.value());
+      } else if (!Add(offset + component.offset(), component.size(),
+                     indExpr.value())) {
+        return false;
+      }
+    }
+    offset += elementBytes;
+  }
+  return true;
+}
+
+void InitialImage::AddPointer(
+    ConstantSubscript offset, const Expr<SomeType> &pointer) {
+  pointers_.emplace(offset, pointer);
+}
+
+// Classes used with common::SearchTypes() to (re)construct Constant<> values
+// of the right type to initialize each symbol from the values that have
+// been placed into its initialization image by DATA statements.
+class AsConstantHelper {
+public:
+  using Result = std::optional<Expr<SomeType>>;
+  using Types = AllTypes;
+  AsConstantHelper(FoldingContext &context, const DynamicType &type,
+      const ConstantSubscripts &extents, const InitialImage &image,
+      ConstantSubscript offset = 0)
+      : context_{context}, type_{type}, image_{image}, extents_{extents},
+        offset_{offset} {
+    CHECK(!type.IsPolymorphic());
+  }
+  template <typename T> Result Test() {
+    if (T::category != type_.category()) {
+      return std::nullopt;
+    }
+    if constexpr (T::category != TypeCategory::Derived) {
+      if (T::kind != type_.kind()) {
+        return std::nullopt;
+      }
+    }
+    using Const = Constant<T>;
+    using Scalar = typename Const::Element;
+    std::size_t elements{TotalElementCount(extents_)};
+    std::vector<Scalar> typedValue(elements);
+    auto stride{type_.MeasureSizeInBytes()};
+    CHECK(stride > 0);
+    CHECK(offset_ + elements * *stride <= image_.data_.size());
+    if constexpr (T::category == TypeCategory::Derived) {
+      const semantics::DerivedTypeSpec &derived{type_.GetDerivedTypeSpec()};
+      for (auto iter : DEREF(derived.scope())) {
+        const Symbol &component{*iter.second};
+        bool isPointer{IsPointer(component)};
+        if (component.has<semantics::ObjectEntityDetails>() ||
+            component.has<semantics::ProcEntityDetails>()) {
+          auto componentType{DynamicType::From(component)};
+          CHECK(componentType);
+          auto at{offset_ + component.offset()};
+          if (isPointer) {
+            for (std::size_t j{0}; j < elements; ++j, at += *stride) {
+              Result value{image_.AsConstantDataPointer(*componentType, at)};
+              CHECK(value);
+              typedValue[j].emplace(component, std::move(*value));
+            }
+          } else {
+            auto componentExtents{GetConstantExtents(context_, component)};
+            CHECK(componentExtents);
+            for (std::size_t j{0}; j < elements; ++j, at += *stride) {
+              Result value{image_.AsConstant(
+                  context_, *componentType, *componentExtents, at)};
+              CHECK(value);
+              typedValue[j].emplace(component, std::move(*value));
+            }
+          }
+        }
+      }
+      return AsGenericExpr(
+          Const{derived, std::move(typedValue), std::move(extents_)});
+    } else if constexpr (T::category == TypeCategory::Character) {
+      auto length{static_cast<ConstantSubscript>(*stride) / T::kind};
+      for (std::size_t j{0}; j < elements; ++j) {
+        using Char = typename Scalar::value_type;
+        const Char *data{reinterpret_cast<const Char *>(
+            &image_.data_[offset_ + j * *stride])};
+        typedValue[j].assign(data, length);
+      }
+      return AsGenericExpr(
+          Const{length, std::move(typedValue), std::move(extents_)});
+    } else {
+      // Lengthless intrinsic type
+      CHECK(sizeof(Scalar) <= *stride);
+      for (std::size_t j{0}; j < elements; ++j) {
+        std::memcpy(&typedValue[j], &image_.data_[offset_ + j * *stride],
+            sizeof(Scalar));
+      }
+      return AsGenericExpr(Const{std::move(typedValue), std::move(extents_)});
+    }
+  }
+
+private:
+  FoldingContext &context_;
+  const DynamicType &type_;
+  const InitialImage &image_;
+  ConstantSubscripts extents_; // a copy
+  ConstantSubscript offset_;
+};
+
+std::optional<Expr<SomeType>> InitialImage::AsConstant(FoldingContext &context,
+    const DynamicType &type, const ConstantSubscripts &extents,
+    ConstantSubscript offset) const {
+  return common::SearchTypes(
+      AsConstantHelper{context, type, extents, *this, offset});
+}
+
+class AsConstantDataPointerHelper {
+public:
+  using Result = std::optional<Expr<SomeType>>;
+  using Types = AllTypes;
+  AsConstantDataPointerHelper(const DynamicType &type,
+      const InitialImage &image, ConstantSubscript offset = 0)
+      : type_{type}, image_{image}, offset_{offset} {}
+  template <typename T> Result Test() {
+    if (T::category != type_.category()) {
+      return std::nullopt;
+    }
+    if constexpr (T::category != TypeCategory::Derived) {
+      if (T::kind != type_.kind()) {
+        return std::nullopt;
+      }
+    }
+    auto iter{image_.pointers_.find(offset_)};
+    if (iter == image_.pointers_.end()) {
+      return AsGenericExpr(NullPointer{});
+    }
+    return iter->second;
+  }
+
+private:
+  const DynamicType &type_;
+  const InitialImage &image_;
+  ConstantSubscript offset_;
+};
+
+std::optional<Expr<SomeType>> InitialImage::AsConstantDataPointer(
+    const DynamicType &type, ConstantSubscript offset) const {
+  return common::SearchTypes(AsConstantDataPointerHelper{type, *this, offset});
+}
+
+const ProcedureDesignator &InitialImage::AsConstantProcPointer(
+    ConstantSubscript offset) const {
+  auto iter{pointers_.find(0)};
+  CHECK(iter != pointers_.end());
+  return DEREF(std::get_if<ProcedureDesignator>(&iter->second.u));
+}
+
+} // namespace Fortran::evaluate