[flang] Fold TRANSFER()

Fold usage of the raw data reinterpretation intrinsic function TRANSFER().

Differential Revision: https://reviews.llvm.org/D129671
This commit is contained in:
Peter Klausler 2022-07-05 16:32:59 -07:00
parent 5acd471698
commit ae93d8ea42
17 changed files with 161 additions and 31 deletions

View File

@ -189,9 +189,7 @@ public:
Constant Reshape(ConstantSubscripts &&) const;
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
static constexpr DynamicType GetType() {
return {TypeCategory::Character, KIND};
}
DynamicType GetType() const { return {KIND, length_}; }
std::size_t CopyFrom(const Constant &source, std::size_t count,
ConstantSubscripts &resultSubscripts, const std::vector<int> *dimOrder);

View File

@ -52,6 +52,7 @@ public:
} else if (bytes == 0) {
return Ok;
} else {
// TODO endianness
std::memcpy(&data_.at(offset), &x.values().at(0), bytes);
return Ok;
}
@ -80,6 +81,7 @@ public:
(scalarBytes > elementBytes && elements != 0)) {
return SizeMismatch;
}
// TODO endianness
std::memcpy(&data_.at(offset), scalar.data(), elementBytes);
offset += elementBytes;
}
@ -103,7 +105,7 @@ public:
// Conversions to constant initializers
std::optional<Expr<SomeType>> AsConstant(FoldingContext &,
const DynamicType &, const ConstantSubscripts &,
const DynamicType &, const ConstantSubscripts &, bool padWithZero = false,
ConstantSubscript offset = 0) const;
std::optional<Expr<SomeType>> AsConstantPointer(
ConstantSubscript offset = 0) const;

View File

@ -102,7 +102,6 @@ Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction(
CharacterUtils<KIND>::TRIM(std::get<Scalar<T>>(*scalar))}};
}
}
// TODO: transfer
return Expr<T>{std::move(funcRef)};
}

View File

@ -70,7 +70,7 @@ Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction(
} else if (name == "sum") {
return FoldSum<T>(context, std::move(funcRef));
}
// TODO: dot_product, matmul, transfer
// TODO: dot_product, matmul
return Expr<T>{std::move(funcRef)};
}

View File

@ -70,6 +70,8 @@ public:
Expr<T> TRANSPOSE(FunctionRef<T> &&);
Expr<T> UNPACK(FunctionRef<T> &&);
Expr<T> TRANSFER(FunctionRef<T> &&);
private:
FoldingContext &context_;
};
@ -1013,6 +1015,17 @@ template <typename T> Expr<T> Folder<T>::UNPACK(FunctionRef<T> &&funcRef) {
PackageConstant<T>(std::move(resultElements), *vector, mask->shape())};
}
std::optional<Expr<SomeType>> FoldTransfer(
FoldingContext &, const ActualArguments &);
template <typename T> Expr<T> Folder<T>::TRANSFER(FunctionRef<T> &&funcRef) {
if (auto folded{FoldTransfer(context_, funcRef.arguments())}) {
return DEREF(UnwrapExpr<Expr<T>>(*folded));
} else {
return Expr<T>{std::move(funcRef)};
}
}
template <typename T>
Expr<T> FoldMINorMAX(
FoldingContext &context, FunctionRef<T> &&funcRef, Ordering order) {
@ -1119,6 +1132,8 @@ Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) {
return Folder<T>{context}.RESHAPE(std::move(funcRef));
} else if (name == "spread") {
return Folder<T>{context}.SPREAD(std::move(funcRef));
} else if (name == "transfer") {
return Folder<T>{context}.TRANSFER(std::move(funcRef));
} else if (name == "transpose") {
return Folder<T>{context}.TRANSPOSE(std::move(funcRef));
} else if (name == "unpack") {

View File

@ -1053,7 +1053,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
} else if (name == "ubound") {
return UBOUND(context, std::move(funcRef));
}
// TODO: dot_product, ishftc, matmul, sign, transfer
// TODO: dot_product, ishftc, matmul, sign
return Expr<T>{std::move(funcRef)};
}

View File

@ -199,7 +199,7 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
}
// TODO: dot_product, is_iostat_end,
// is_iostat_eor, logical, matmul, out_of_range,
// parity, transfer
// parity
return Expr<T>{std::move(funcRef)};
}

View File

@ -315,7 +315,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
return result.value;
}));
}
// TODO: dot_product, fraction, matmul, norm2, set_exponent, transfer
// TODO: dot_product, fraction, matmul, norm2, set_exponent
return Expr<T>{std::move(funcRef)};
}

View File

@ -9,6 +9,7 @@
#include "flang/Evaluate/fold.h"
#include "fold-implementation.h"
#include "flang/Evaluate/characteristics.h"
#include "flang/Evaluate/initial-image.h"
namespace Fortran::evaluate {
@ -220,6 +221,58 @@ Expr<ImpliedDoIndex::Result> FoldOperation(
}
}
// TRANSFER (F'2018 16.9.193)
std::optional<Expr<SomeType>> FoldTransfer(
FoldingContext &context, const ActualArguments &arguments) {
CHECK(arguments.size() == 2 || arguments.size() == 3);
const auto *source{UnwrapExpr<Expr<SomeType>>(arguments[0])};
std::optional<std::size_t> sourceBytes;
if (source) {
if (auto sourceTypeAndShape{
characteristics::TypeAndShape::Characterize(*source, context)}) {
if (auto sourceBytesExpr{
sourceTypeAndShape->MeasureSizeInBytes(context)}) {
sourceBytes = ToInt64(*sourceBytesExpr);
}
}
}
std::optional<DynamicType> moldType;
if (arguments[1]) {
moldType = arguments[1]->GetType();
}
std::optional<ConstantSubscripts> extents;
if (arguments.size() == 2) { // no SIZE=
if (moldType && sourceBytes) {
if (arguments[1]->Rank() == 0) { // scalar MOLD=
extents = ConstantSubscripts{}; // empty extents (scalar result)
} else if (auto moldBytesExpr{
moldType->MeasureSizeInBytes(context, true)}) {
if (auto moldBytes{ToInt64(Fold(context, std::move(*moldBytesExpr)))};
*moldBytes > 0) {
extents = ConstantSubscripts{
static_cast<ConstantSubscript>((*sourceBytes) + *moldBytes - 1) /
*moldBytes};
}
}
}
} else if (arguments[2]) { // SIZE= is present
if (const auto *sizeExpr{arguments[2]->UnwrapExpr()}) {
if (auto sizeValue{ToInt64(*sizeExpr)}) {
extents = ConstantSubscripts{*sizeValue};
}
}
}
if (sourceBytes && IsActuallyConstant(*source) && moldType && extents) {
InitialImage image{*sourceBytes};
InitialImage::Result imageResult{
image.Add(0, *sourceBytes, *source, context)};
CHECK(imageResult == InitialImage::Ok);
return image.AsConstant(context, *moldType, *extents, true /*pad with 0*/);
} else {
return std::nullopt;
}
}
template class ExpressionBase<SomeDerived>;
template class ExpressionBase<SomeType>;

View File

@ -72,9 +72,9 @@ public:
using Types = AllTypes;
AsConstantHelper(FoldingContext &context, const DynamicType &type,
const ConstantSubscripts &extents, const InitialImage &image,
ConstantSubscript offset = 0)
bool padWithZero = false, ConstantSubscript offset = 0)
: context_{context}, type_{type}, image_{image}, extents_{extents},
offset_{offset} {
padWithZero_{padWithZero}, offset_{offset} {
CHECK(!type.IsPolymorphic());
}
template <typename T> Result Test() {
@ -94,7 +94,7 @@ public:
ToInt64(type_.MeasureSizeInBytes(context_, GetRank(extents_) > 0))};
CHECK(elemBytes && *elemBytes >= 0);
std::size_t stride{static_cast<std::size_t>(*elemBytes)};
CHECK(offset_ + elements * stride <= image_.data_.size());
CHECK(offset_ + elements * stride <= image_.data_.size() || padWithZero_);
if constexpr (T::category == TypeCategory::Derived) {
const semantics::DerivedTypeSpec &derived{type_.GetDerivedTypeSpec()};
for (auto iter : DEREF(derived.scope())) {
@ -120,8 +120,8 @@ public:
auto componentExtents{GetConstantExtents(context_, component)};
CHECK(componentExtents.has_value());
for (std::size_t j{0}; j < elements; ++j, at += stride) {
if (Result value{image_.AsConstant(
context_, *componentType, *componentExtents, at)}) {
if (Result value{image_.AsConstant(context_, *componentType,
*componentExtents, padWithZero_, at)}) {
typedValue[j].emplace(component, std::move(*value));
}
}
@ -134,8 +134,12 @@ public:
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])};
auto at{static_cast<std::size_t>(offset_ + j * stride)};
if (at + length > image_.data_.size()) {
CHECK(padWithZero_);
break;
}
const Char *data{reinterpret_cast<const Char *>(&image_.data_[at])};
typedValue[j].assign(data, length);
}
return AsGenericExpr(
@ -144,8 +148,17 @@ public:
// 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));
auto at{static_cast<std::size_t>(offset_ + j * stride)};
std::size_t chunk{sizeof(Scalar)};
if (at + chunk > image_.data_.size()) {
CHECK(padWithZero_);
if (at >= image_.data_.size()) {
break;
}
chunk = image_.data_.size() - at;
}
// TODO endianness
std::memcpy(&typedValue[j], &image_.data_[at], chunk);
}
return AsGenericExpr(Const{std::move(typedValue), std::move(extents_)});
}
@ -156,14 +169,15 @@ private:
const DynamicType &type_;
const InitialImage &image_;
ConstantSubscripts extents_; // a copy
bool padWithZero_;
ConstantSubscript offset_;
};
std::optional<Expr<SomeType>> InitialImage::AsConstant(FoldingContext &context,
const DynamicType &type, const ConstantSubscripts &extents,
ConstantSubscript offset) const {
bool padWithZero, ConstantSubscript offset) const {
return common::SearchTypes(
AsConstantHelper{context, type, extents, *this, offset});
AsConstantHelper{context, type, extents, *this, padWithZero, offset});
}
std::optional<Expr<SomeType>> InitialImage::AsConstantPointer(

View File

@ -541,8 +541,8 @@ static void PopulateWithComponentDefaults(SymbolDataInitialization &init,
if (auto dyType{evaluate::DynamicType::From(component)}) {
if (auto extents{evaluate::GetConstantExtents(
foldingContext, component)}) {
if (auto extant{init.image.AsConstant(
foldingContext, *dyType, *extents, componentOffset)}) {
if (auto extant{init.image.AsConstant(foldingContext, *dyType,
*extents, false /*don't pad*/, componentOffset)}) {
initialized = !(*extant == *object->init());
}
}

View File

@ -0,0 +1,37 @@
! RUN: %python %S/test_folding.py %s %flang_fc1
! Tests folding of TRANSFER(...)
module m
logical, parameter :: test_r2i_s_1 = transfer(1., 0) == int(z'3f800000')
logical, parameter :: test_r2i_v_1 = all(transfer(1., [integer::]) == [int(z'3f800000')])
logical, parameter :: test_r2i_v_2 = all(transfer([1., 2.], [integer::]) == [int(z'3f800000'), int(z'40000000')])
logical, parameter :: test_r2i_vs_1 = all(transfer([1., 2.], [integer::], 1) == [int(z'3f800000')])
type :: t
real :: x = 0.
end type t
logical, parameter :: test_t2i_s_1 = transfer(t(1.), 0) == int(z'3f800000')
logical, parameter :: test_t2i_v_1 = all(transfer(t(1.), [integer::]) == [int(z'3f800000')])
logical, parameter :: test_t2i_v_2 = all(transfer([t(1.), t(2.)], [integer::]) == [int(z'3f800000'), int(z'40000000')])
logical, parameter :: test_t2i_vs_1 = all(transfer([t(1.), t(2.)], [integer::], 1) == [int(z'3f800000')])
type(t), parameter :: t1 = transfer(1., t())
logical, parameter :: test_r2t_s_1 = t1%x == 1.
type(t), parameter :: t2(*) = transfer(1., [t::])
logical, parameter :: test_r2t_v_1 = all(t2%x == [1.])
type(t), parameter :: t3(*) = transfer([1., 2.], [t::])
logical, parameter :: test_r2t_v_2 = all(t3%x == [1., 2.])
type(t), parameter :: t4(*) = transfer([1., 2.], t(), 1)
logical, parameter :: test_r2t_vs_1 = all(t4%x == [1.])
logical, parameter :: test_nan = transfer(int(z'7ff8000000000000', 8), 0._8) /= transfer(int(z'7ff8000000000000', 8), 0._8)
integer, parameter :: jc1 = transfer("abcd", 0)
logical, parameter :: test_c2i_s_1 = jc1 == int(z'61626364') .or. jc1 == int(z'64636261')
integer, parameter :: jc2(*) = transfer("abcd", [integer::])
logical, parameter :: test_c2i_v_1 = all(jc2 == int(z'61626364') .or. jc1 == int(z'64636261'))
integer, parameter :: jc3(*) = transfer(["abcd", "efgh"], [integer::])
logical, parameter :: test_c2i_v_2 = all(jc3 == [int(z'61626364'), int(z'65666768')]) .or. all(jc3 == [int(z'64636261'), int(z'68676665')])
integer, parameter :: jc4(*) = transfer(["abcd", "efgh"], 0, 1)
logical, parameter :: test_c2i_vs_1 = all(jc4 == [int(z'61626364')]) .or. all(jc4 == [int(z'64636261')])
end module

View File

@ -1,7 +1,19 @@
! RUN: %python %S/test_folding.py %s %flang_fc1
! Tests folding of SHAPE(TRANSFER(...))
! Adjusted to allow for folding (or not) of TRANSFER().
module m
integer :: j
real :: a(3)
logical, parameter :: test_size_v1 = size(shape(transfer(j, 0_1,size=4))) == 1
logical, parameter :: test_size_v2 = all(shape(transfer(j, 0_1,size=4)) == [4])
logical, parameter :: test_scalar_v1 = size(shape(transfer(j, 0_1))) == 0
logical, parameter :: test_vector_v1 = size(shape(transfer(j, [0_1]))) == 1
logical, parameter :: test_vector_v2 = all(shape(transfer(j, [0_1])) == [4])
logical, parameter :: test_array_v1 = size(shape(transfer(j, reshape([0_1],[1,1])))) == 1
logical, parameter :: test_array_v2 = all(shape(transfer(j, reshape([0_1],[1,1]))) == [4])
logical, parameter :: test_array_v3 = all(shape(transfer(a, [(0.,0.)])) == [2])
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

View File

@ -29,7 +29,7 @@ subroutine arrayconstructorvalues()
! C7111
!ERROR: Value in array constructor of type 'LOGICAL(4)' could not be converted to the type of the array 'INTEGER(4)'
intarray = [integer:: .true., 2, 3, 4, 5]
!ERROR: Value in array constructor of type 'CHARACTER(1)' could not be converted to the type of the array 'INTEGER(4)'
!ERROR: Value in array constructor of type 'CHARACTER(KIND=1,LEN=22_8)' could not be converted to the type of the array 'INTEGER(4)'
intarray = [integer:: "RAM stores information", 2, 3, 4, 5]
!ERROR: Value in array constructor of type 'employee' could not be converted to the type of the array 'INTEGER(4)'
intarray = [integer:: EMPLOYEE (19, "Jack"), 2, 3, 4, 5]

View File

@ -69,7 +69,7 @@ program selectCaseProg
! C1147
select case (grade2)
!ERROR: CASE value has type 'CHARACTER(1)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
!ERROR: CASE value has type 'CHARACTER(KIND=1,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
case (:'Z')
case default
end select
@ -94,19 +94,19 @@ program selectCaseProg
case (.true. :)
!ERROR: CASE value has type 'REAL(4)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
case (1.0)
!ERROR: CASE value has type 'CHARACTER(1)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
!ERROR: CASE value has type 'CHARACTER(KIND=1,LEN=3_8)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
case ('wow')
end select
select case (ASCII_parm1)
case (ASCII_parm2)
!ERROR: CASE value has type 'CHARACTER(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
!ERROR: CASE value has type 'CHARACTER(KIND=4,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'
case (UCS32_parm)
!ERROR: CASE value has type 'CHARACTER(2)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
!ERROR: CASE value has type 'CHARACTER(KIND=2,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'
case (UCS16_parm)
!ERROR: CASE value has type 'CHARACTER(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
!ERROR: CASE value has type 'CHARACTER(KIND=4,LEN=6_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'
case (4_"ucs-32")
!ERROR: CASE value has type 'CHARACTER(2)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
!ERROR: CASE value has type 'CHARACTER(KIND=2,LEN=6_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'
case (2_"ucs-16")
case default
end select

View File

@ -239,7 +239,7 @@ contains
RANK(1.0)
!ERROR: Must be a constant value
RANK(RANK(x))
!ERROR: Must have INTEGER type, but is CHARACTER(1)
!ERROR: Must have INTEGER type, but is CHARACTER(KIND=1,LEN=6_8)
RANK("STRING")
END SELECT
end subroutine

View File

@ -36,7 +36,7 @@ module module1
! call scalararg(scalar(4)(5.,6,(7._8,8._2),4_'b',.true._4))
call scalararg(scalar(4)(ix=5.,rx=6,zx=(7._8,8._2),cx=4_'b',lx=.true.))
call scalararg(scalar(4)(5.,6,(7._8,8._2),4_'b',.true.))
!ERROR: Value in structure constructor of type 'CHARACTER(1)' is incompatible with component 'ix' of type 'INTEGER(4)'
!ERROR: Value in structure constructor of type 'CHARACTER(KIND=1,LEN=1_8)' is incompatible with component 'ix' of type 'INTEGER(4)'
call scalararg(scalar(4)(ix='a'))
!ERROR: Value in structure constructor of type 'LOGICAL(4)' is incompatible with component 'ix' of type 'INTEGER(4)'
call scalararg(scalar(4)(ix=.false.))