[flang-commits] [flang] fad31d6 - [flang] Implement shape analysis of TRANSFER intrinsic function result

peter klausler via flang-commits flang-commits at lists.llvm.org
Thu Aug 13 09:58:20 PDT 2020


Author: peter klausler
Date: 2020-08-13T09:56:24-07:00
New Revision: fad31d60329b4573a27aaf10cfe3174407d75c3a

URL: https://github.com/llvm/llvm-project/commit/fad31d60329b4573a27aaf10cfe3174407d75c3a
DIFF: https://github.com/llvm/llvm-project/commit/fad31d60329b4573a27aaf10cfe3174407d75c3a.diff

LOG: [flang] Implement shape analysis of TRANSFER intrinsic function result

The shape (esp. the size) of the result of a call to TRANSFER
is implemented according to the definition in the standard.

Differential Revision: https://reviews.llvm.org/D85866

Added: 
    flang/test/Evaluate/folding10.f90

Modified: 
    flang/include/flang/Evaluate/characteristics.h
    flang/include/flang/Evaluate/initial-image.h
    flang/include/flang/Evaluate/type.h
    flang/lib/Evaluate/characteristics.cpp
    flang/lib/Evaluate/fold-designator.cpp
    flang/lib/Evaluate/initial-image.cpp
    flang/lib/Evaluate/shape.cpp
    flang/lib/Evaluate/type.cpp
    flang/lib/Semantics/compute-offsets.cpp
    flang/lib/Semantics/data-to-inits.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index b59640fe8cf8..fe7cc2dac0ca 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -78,6 +78,7 @@ class TypeAndShape {
 
   bool operator==(const TypeAndShape &) const;
   bool operator!=(const TypeAndShape &that) const { return !(*this == that); }
+
   static std::optional<TypeAndShape> Characterize(
       const semantics::Symbol &, FoldingContext &);
   static std::optional<TypeAndShape> Characterize(
@@ -90,6 +91,8 @@ class TypeAndShape {
       const semantics::ProcInterface &);
   static std::optional<TypeAndShape> Characterize(
       const semantics::DeclTypeSpec &);
+  static std::optional<TypeAndShape> Characterize(
+      const ActualArgument &, FoldingContext &);
 
   template <typename A>
   static std::optional<TypeAndShape> Characterize(
@@ -114,6 +117,24 @@ class TypeAndShape {
     }
     return std::nullopt;
   }
+  template <typename A>
+  static std::optional<TypeAndShape> Characterize(
+      const std::optional<A> &x, FoldingContext &context) {
+    if (x) {
+      return Characterize(*x, context);
+    } else {
+      return std::nullopt;
+    }
+  }
+  template <typename A>
+  static std::optional<TypeAndShape> Characterize(
+      const A *x, FoldingContext &context) {
+    if (x) {
+      return Characterize(*x, context);
+    } else {
+      return std::nullopt;
+    }
+  }
 
   DynamicType type() const { return type_; }
   TypeAndShape &set_type(DynamicType t) {

diff  --git a/flang/include/flang/Evaluate/initial-image.h b/flang/include/flang/Evaluate/initial-image.h
index 69cf7ce5d730..eb39e9457528 100644
--- a/flang/include/flang/Evaluate/initial-image.h
+++ b/flang/include/flang/Evaluate/initial-image.h
@@ -42,8 +42,10 @@ class InitialImage {
     if (offset < 0 || offset + bytes > data_.size()) {
       return OutOfRange;
     } else {
-      auto elementBytes{x.GetType().MeasureSizeInBytes()};
-      if (!elementBytes || bytes != x.values().size() * *elementBytes) {
+      auto elementBytes{ToInt64(x.GetType().MeasureSizeInBytes())};
+      if (!elementBytes ||
+          bytes !=
+              x.values().size() * static_cast<std::size_t>(*elementBytes)) {
         return SizeMismatch;
       } else {
         std::memcpy(&data_.at(offset), &x.values().at(0), bytes);

diff  --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index c62d63356343..cf13ba6e27d9 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -138,8 +138,9 @@ class DynamicType {
   constexpr const semantics::ParamValue *charLength() const {
     return charLength_;
   }
-  std::optional<common::ConstantSubscript> GetCharLength() const;
-  std::optional<std::size_t> MeasureSizeInBytes() const;
+  std::optional<Expr<SubscriptInteger>> GetCharLength() const;
+  std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
+      FoldingContext * = nullptr) const;
 
   std::string AsFortran() const;
   std::string AsFortran(std::string &&charLenExpr) const;

diff  --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index dde108a725dc..9d301b6abccc 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -121,6 +121,11 @@ std::optional<TypeAndShape> TypeAndShape::Characterize(
   }
 }
 
+std::optional<TypeAndShape> TypeAndShape::Characterize(
+    const ActualArgument &arg, FoldingContext &context) {
+  return Characterize(arg.UnwrapExpr(), context);
+}
+
 bool TypeAndShape::IsCompatibleWith(parser::ContextualMessages &messages,
     const TypeAndShape &that, const char *thisIs, const char *thatIs,
     bool isElemental) const {
@@ -183,7 +188,7 @@ llvm::raw_ostream &TypeAndShape::Dump(llvm::raw_ostream &o) const {
   o << type_.AsFortran(LEN_ ? LEN_->AsFortran() : "");
   attrs_.Dump(o, EnumToString);
   if (!shape_.empty()) {
-    o << " dimension(";
+    o << " dimension";
     char sep{'('};
     for (const auto &expr : shape_) {
       o << sep;

diff  --git a/flang/lib/Evaluate/fold-designator.cpp b/flang/lib/Evaluate/fold-designator.cpp
index 5c56cd2acf5e..3e84a00fd2ba 100644
--- a/flang/lib/Evaluate/fold-designator.cpp
+++ b/flang/lib/Evaluate/fold-designator.cpp
@@ -27,10 +27,10 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
   } else if (symbol.has<semantics::ObjectEntityDetails>() &&
       !IsNamedConstant(symbol)) {
     if (auto type{DynamicType::From(symbol)}) {
-      if (auto bytes{type->MeasureSizeInBytes()}) {
+      if (auto bytes{ToInt64(type->MeasureSizeInBytes(&context_))}) {
         if (auto extents{GetConstantExtents(context_, symbol)}) {
-          OffsetSymbol result{symbol, *bytes};
-          auto stride{static_cast<ConstantSubscript>(*bytes)};
+          OffsetSymbol result{symbol, static_cast<std::size_t>(*bytes)};
+          auto stride{*bytes};
           for (auto extent : *extents) {
             if (extent == 0) {
               return std::nullopt;
@@ -57,7 +57,7 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
     const ArrayRef &x, ConstantSubscript which) {
   const Symbol &array{x.base().GetLastSymbol()};
   if (auto type{DynamicType::From(array)}) {
-    if (auto bytes{type->MeasureSizeInBytes()}) {
+    if (auto bytes{ToInt64(type->MeasureSizeInBytes(&context_))}) {
       if (auto extents{GetConstantExtents(context_, array)}) {
         Shape lbs{GetLowerBounds(context_, x.base())};
         if (auto lowerBounds{AsConstantExtents(context_, lbs)}) {
@@ -73,7 +73,7 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
           if (!result) {
             return std::nullopt;
           }
-          auto stride{static_cast<ConstantSubscript>(*bytes)};
+          auto stride{*bytes};
           int dim{0};
           for (const Subscript &subscript : x.subscript()) {
             ConstantSubscript lower{lowerBounds->at(dim)};
@@ -217,14 +217,14 @@ static std::optional<ArrayRef> OffsetToArrayRef(FoldingContext &context,
   auto extents{AsConstantExtents(context, shape)};
   Shape lbs{GetLowerBounds(context, entity)};
   auto lower{AsConstantExtents(context, lbs)};
-  auto elementBytes{elementType.MeasureSizeInBytes()};
+  auto elementBytes{ToInt64(elementType.MeasureSizeInBytes(&context))};
   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};
+  auto element{offset / static_cast<std::size_t>(*elementBytes)};
   std::vector<Subscript> subscripts;
   auto at{element};
   for (int dim{0}; dim + 1 < rank; ++dim) {
@@ -239,7 +239,7 @@ static std::optional<ArrayRef> OffsetToArrayRef(FoldingContext &context,
   }
   // This final subscript might be out of range for use in error reporting.
   subscripts.emplace_back(ExtentExpr{(*lower)[rank - 1] + at});
-  offset -= element * *elementBytes;
+  offset -= element * static_cast<std::size_t>(*elementBytes);
   return ArrayRef{std::move(entity), std::move(subscripts)};
 }
 
@@ -315,12 +315,12 @@ std::optional<Expr<SomeType>> OffsetToDesignator(FoldingContext &context,
       if (std::optional<Expr<SomeType>> result{
               TypedWrapper<Designator>(*type, std::move(*dataRef))}) {
         if (IsAllocatableOrPointer(symbol)) {
-        } else if (auto elementBytes{type->MeasureSizeInBytes()}) {
+        } else if (auto elementBytes{
+                       ToInt64(type->MeasureSizeInBytes(&context))}) {
           if (auto *zExpr{std::get_if<Expr<SomeComplex>>(&result->u)}) {
-            if (size * 2 > *elementBytes) {
+            if (size * 2 > static_cast<std::size_t>(*elementBytes)) {
               return result;
-            } else if (offset == 0 ||
-                offset * 2 == static_cast<ConstantSubscript>(*elementBytes)) {
+            } else if (offset == 0 || offset * 2 == *elementBytes) {
               // Pick a COMPLEX component
               auto part{
                   offset == 0 ? ComplexPart::Part::RE : ComplexPart::Part::IM};
@@ -334,7 +334,7 @@ std::optional<Expr<SomeType>> OffsetToDesignator(FoldingContext &context,
             }
           } else if (auto *cExpr{
                          std::get_if<Expr<SomeCharacter>>(&result->u)}) {
-            if (offset > 0 || size != *elementBytes) {
+            if (offset > 0 || size != static_cast<std::size_t>(*elementBytes)) {
               // Select a substring
               return std::visit(
                   [&](const auto &x) -> std::optional<Expr<SomeType>> {

diff  --git a/flang/lib/Evaluate/initial-image.cpp b/flang/lib/Evaluate/initial-image.cpp
index 5d768a89eb6b..d096df9d4d1b 100644
--- a/flang/lib/Evaluate/initial-image.cpp
+++ b/flang/lib/Evaluate/initial-image.cpp
@@ -88,9 +88,10 @@ class AsConstantHelper {
     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());
+    auto elemBytes{ToInt64(type_.MeasureSizeInBytes(&context_))};
+    CHECK(elemBytes && *elemBytes >= 0);
+    std::size_t stride{static_cast<std::size_t>(*elemBytes)};
+    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())) {
@@ -102,7 +103,7 @@ class AsConstantHelper {
           CHECK(componentType);
           auto at{offset_ + component.offset()};
           if (isPointer) {
-            for (std::size_t j{0}; j < elements; ++j, at += *stride) {
+            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));
@@ -110,7 +111,7 @@ class AsConstantHelper {
           } else {
             auto componentExtents{GetConstantExtents(context_, component)};
             CHECK(componentExtents);
-            for (std::size_t j{0}; j < elements; ++j, at += *stride) {
+            for (std::size_t j{0}; j < elements; ++j, at += stride) {
               Result value{image_.AsConstant(
                   context_, *componentType, *componentExtents, at)};
               CHECK(value);
@@ -122,20 +123,20 @@ class AsConstantHelper {
       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};
+      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])};
+            &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);
+      CHECK(sizeof(Scalar) <= stride);
       for (std::size_t j{0}; j < elements; ++j) {
-        std::memcpy(&typedValue[j], &image_.data_[offset_ + j * *stride],
+        std::memcpy(&typedValue[j], &image_.data_[offset_ + j * stride],
             sizeof(Scalar));
       }
       return AsGenericExpr(Const{std::move(typedValue), std::move(extents_)});

diff  --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index 90d864466e2d..a072f5ef3f96 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -626,6 +626,43 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
           }
         }
       }
+    } else if (intrinsic->name == "transfer") {
+      if (call.arguments().size() == 3 && call.arguments().at(2)) {
+        // SIZE= is present; shape is vector [SIZE=]
+        if (const auto *size{
+                UnwrapExpr<Expr<SomeInteger>>(call.arguments().at(2))}) {
+          return Shape{
+              MaybeExtentExpr{ConvertToType<ExtentType>(common::Clone(*size))}};
+        }
+      } else if (auto moldTypeAndShape{
+                     characteristics::TypeAndShape::Characterize(
+                         call.arguments().at(1), context_)}) {
+        if (GetRank(moldTypeAndShape->shape()) == 0) {
+          // SIZE= is absent and MOLD= is scalar: result is scalar
+          return Scalar();
+        } else {
+          // SIZE= is absent and MOLD= is array: result is vector whose
+          // length is determined by sizes of types.  See 16.9.193p4 case(ii).
+          if (auto sourceTypeAndShape{
+                  characteristics::TypeAndShape::Characterize(
+                      call.arguments().at(0), context_)}) {
+            auto sourceElements{
+                GetSize(common::Clone(sourceTypeAndShape->shape()))};
+            auto sourceElementBytes{
+                sourceTypeAndShape->type().MeasureSizeInBytes(&context_)};
+            auto moldElementBytes{
+                moldTypeAndShape->type().MeasureSizeInBytes(&context_)};
+            if (sourceElements && sourceElementBytes && moldElementBytes) {
+              ExtentExpr extent{Fold(context_,
+                  ((std::move(*sourceElements) *
+                       std::move(*sourceElementBytes)) +
+                      common::Clone(*moldElementBytes) - ExtentExpr{1}) /
+                      common::Clone(*moldElementBytes))};
+              return Shape{MaybeExtentExpr{std::move(extent)}};
+            }
+          }
+        }
+      }
     } else if (intrinsic->name == "transpose") {
       if (call.arguments().size() >= 1) {
         if (auto shape{(*this)(call.arguments().at(0))}) {

diff  --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index 293cd1864814..e1eec19e896b 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -103,11 +103,10 @@ bool DynamicType::operator==(const DynamicType &that) const {
       PointeeComparison(derived_, that.derived_);
 }
 
-std::optional<common::ConstantSubscript> DynamicType::GetCharLength() const {
-  if (category_ == TypeCategory::Character && charLength_ &&
-      charLength_->isExplicit()) {
-    if (const auto &len{charLength_->GetExplicit()}) {
-      return ToInt64(len);
+std::optional<Expr<SubscriptInteger>> DynamicType::GetCharLength() const {
+  if (category_ == TypeCategory::Character && charLength_) {
+    if (auto length{charLength_->GetExplicit()}) {
+      return ConvertToType<SubscriptInteger>(std::move(*length));
     }
   }
   return std::nullopt;
@@ -125,24 +124,31 @@ static constexpr int RealKindBytes(int kind) {
   }
 }
 
-std::optional<std::size_t> DynamicType::MeasureSizeInBytes() const {
+std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
+    FoldingContext *context) const {
   switch (category_) {
   case TypeCategory::Integer:
-    return kind_;
+    return Expr<SubscriptInteger>{kind_};
   case TypeCategory::Real:
-    return RealKindBytes(kind_);
+    return Expr<SubscriptInteger>{RealKindBytes(kind_)};
   case TypeCategory::Complex:
-    return 2 * RealKindBytes(kind_);
+    return Expr<SubscriptInteger>{2 * RealKindBytes(kind_)};
   case TypeCategory::Character:
     if (auto len{GetCharLength()}) {
-      return kind_ * *len;
+      auto result{Expr<SubscriptInteger>{kind_} * std::move(*len)};
+      if (context) {
+        return Fold(*context, std::move(result));
+      } else {
+        return std::move(result);
+      }
     }
     break;
   case TypeCategory::Logical:
-    return kind_;
+    return Expr<SubscriptInteger>{kind_};
   case TypeCategory::Derived:
     if (derived_ && derived_->scope()) {
-      return derived_->scope()->size();
+      return Expr<SubscriptInteger>{
+          static_cast<common::ConstantSubscript>(derived_->scope()->size())};
     }
     break;
   }

diff  --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index 27acd18dae3a..8d90bf99fe27 100644
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -396,13 +396,14 @@ auto ComputeOffsetsHelper::GetIntrinsicSizeAndAlignment(
   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());
+  auto bytes{evaluate::ToInt64(
+      evaluate::DynamicType{category, kind}.MeasureSizeInBytes())};
+  CHECK(bytes && *bytes > 0);
+  std::size_t size{static_cast<std::size_t>(*bytes)};
   if (category == TypeCategory::Complex) {
-    return {*size, *size >> 1};
+    return {size, size >> 1};
   } else {
-    return {*size};
+    return {size};
   }
 }
 

diff  --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index a7aaa7a10f6f..64113c78d804 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -229,7 +229,9 @@ DataInitializationCompiler::ConvertElement(
     // (most) other Fortran compilers do.  Pad on the right with spaces
     // when short, truncate the right if long.
     // TODO: big-endian targets
-    std::size_t bytes{type.MeasureSizeInBytes().value()};
+    std::size_t bytes{static_cast<std::size_t>(evaluate::ToInt64(
+        type.MeasureSizeInBytes(&exprAnalyzer_.GetFoldingContext()))
+                                                   .value())};
     evaluate::BOZLiteralConstant bits{0};
     for (std::size_t j{0}; j < bytes; ++j) {
       char ch{j >= chValue->size() ? ' ' : chValue->at(j)};
@@ -425,12 +427,16 @@ static bool CombineSomeEquivalencedInits(
     }
     // Compute the minimum common granularity
     if (auto dyType{evaluate::DynamicType::From(symbol)}) {
-      minElementBytes = dyType->MeasureSizeInBytes().value_or(1);
+      minElementBytes = evaluate::ToInt64(
+          dyType->MeasureSizeInBytes(&exprAnalyzer.GetFoldingContext()))
+                            .value_or(1);
     }
     for (const Symbol *s : conflicts) {
       if (auto dyType{evaluate::DynamicType::From(*s)}) {
-        minElementBytes =
-            std::min(minElementBytes, dyType->MeasureSizeInBytes().value_or(1));
+        minElementBytes = std::min(minElementBytes,
+            static_cast<std::size_t>(evaluate::ToInt64(
+                dyType->MeasureSizeInBytes(&exprAnalyzer.GetFoldingContext()))
+                                         .value_or(1)));
       } else {
         minElementBytes = 1;
       }

diff  --git a/flang/test/Evaluate/folding10.f90 b/flang/test/Evaluate/folding10.f90
new file mode 100644
index 000000000000..077d8d94cc42
--- /dev/null
+++ b/flang/test/Evaluate/folding10.f90
@@ -0,0 +1,13 @@
+! RUN: %S/test_folding.sh %s %t %f18
+! Tests folding of SHAPE(TRANSFER(...))
+
+module m
+  logical, parameter :: test_size_1 = size(shape(transfer(123456789,0_1,size=4))) == 1
+  logical, parameter :: test_size_2 = all(shape(transfer(123456789,0_1,size=4)) == [4])
+  logical, parameter :: test_scalar_1 = size(shape(transfer(123456789, 0_1))) == 0
+  logical, parameter :: test_vector_1 = size(shape(transfer(123456789, [0_1]))) == 1
+  logical, parameter :: test_vector_2 = all(shape(transfer(123456789, [0_1])) == [4])
+  logical, parameter :: test_array_1 = size(shape(transfer(123456789, reshape([0_1],[1,1])))) == 1
+  logical, parameter :: test_array_2 = all(shape(transfer(123456789, reshape([0_1],[1,1]))) == [4])
+  logical, parameter :: test_array_3 = all(shape(transfer([1.,2.,3.], [(0.,0.)])) == [2])
+end module


        


More information about the flang-commits mailing list