From d267f20a0742bfdac248280c2ea33eb999183674 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Tue, 7 Jan 2020 13:39:42 -0800 Subject: [PATCH] [flang] Fold TRIM Accept IS_CONTIGUOUS and fold it test folding is_contiguous Original-commit: flang-compiler/f18@c75a0791b14811477572c6a82a961071ed82c01e Reviewed-on: https://github.com/flang-compiler/f18/pull/911 --- flang/lib/evaluate/call.cc | 15 ++++++++++++++ flang/lib/evaluate/call.h | 2 +- flang/lib/evaluate/character.h | 26 +++++++++++++++--------- flang/lib/evaluate/check-expression.cc | 18 ++++++++--------- flang/lib/evaluate/fold-character.cc | 8 +++++++- flang/lib/evaluate/fold-logical.cc | 12 ++++++++++- flang/lib/evaluate/intrinsics.cc | 4 ++-- flang/test/evaluate/CMakeLists.txt | 1 + flang/test/evaluate/folding05.f90 | Bin 8895 -> 9530 bytes flang/test/evaluate/folding09.f90 | 27 +++++++++++++++++++++++++ flang/test/semantics/modfile32.f90 | 2 +- 11 files changed, 89 insertions(+), 26 deletions(-) create mode 100644 flang/test/evaluate/folding09.f90 diff --git a/flang/lib/evaluate/call.cc b/flang/lib/evaluate/call.cc index 6e8994994ab5..e57ff21abe39 100644 --- a/flang/lib/evaluate/call.cc +++ b/flang/lib/evaluate/call.cc @@ -191,6 +191,21 @@ std::optional> ProcedureRef::LEN() const { return proc_.LEN(); } +int ProcedureRef::Rank() const { + if (IsElemental()) { + for (const auto &arg : arguments_) { + if (arg) { + if (int rank{arg->Rank()}; rank > 0) { + return rank; + } + } + } + return 0; + } else { + return proc_.Rank(); + } +} + ProcedureRef::~ProcedureRef() {} FOR_EACH_SPECIFIC_TYPE(template class FunctionRef, ) diff --git a/flang/lib/evaluate/call.h b/flang/lib/evaluate/call.h index 232297ef3519..c9d6ac73a568 100644 --- a/flang/lib/evaluate/call.h +++ b/flang/lib/evaluate/call.h @@ -197,7 +197,7 @@ public: const ActualArguments &arguments() const { return arguments_; } std::optional> LEN() const; - int Rank() const { return proc_.Rank(); } + int Rank() const; bool IsElemental() const { return proc_.IsElemental(); } bool operator==(const ProcedureRef &) const; std::ostream &AsFortran(std::ostream &) const; diff --git a/flang/lib/evaluate/character.h b/flang/lib/evaluate/character.h index 6d23e733d105..ac8b6fc19c3a 100644 --- a/flang/lib/evaluate/character.h +++ b/flang/lib/evaluate/character.h @@ -64,22 +64,22 @@ public: return str; } - static std::int64_t INDEX( + static ConstantSubscript INDEX( const Character &str, const Character &substr, bool back = false) { auto pos{back ? str.rfind(substr) : str.find(substr)}; - return static_cast(pos == str.npos ? 0 : pos + 1); + return static_cast(pos == str.npos ? 0 : pos + 1); } - static std::int64_t SCAN( + static ConstantSubscript SCAN( const Character &str, const Character &set, bool back = false) { auto pos{back ? str.find_last_of(set) : str.find_first_of(set)}; - return static_cast(pos == str.npos ? 0 : pos + 1); + return static_cast(pos == str.npos ? 0 : pos + 1); } - static std::int64_t VERIFY( + static ConstantSubscript VERIFY( const Character &str, const Character &set, bool back = false) { auto pos{back ? str.find_last_not_of(set) : str.find_first_not_of(set)}; - return static_cast(pos == str.npos ? 0 : pos + 1); + return static_cast(pos == str.npos ? 0 : pos + 1); } // Resize adds spaces on the right if the new size is bigger than the @@ -93,18 +93,24 @@ public: } } - static std::int64_t LEN_TRIM(const Character &str) { + static ConstantSubscript LEN_TRIM(const Character &str) { return VERIFY(str, Character{' '}, true); } - static Character REPEAT(const Character &str, std::int64_t ncopies) { + static Character REPEAT(const Character &str, ConstantSubscript ncopies) { Character result; - while (ncopies-- > 0) { - result += str; + if (!str.empty()) { + while (ncopies-- > 0) { + result += str; + } } return result; } + static Character TRIM(const Character &str) { + return str.substr(0, LEN_TRIM(str)); + } + private: // Following helpers assume that character encodings contain ASCII static constexpr CharT Space() { return 0x20; } diff --git a/flang/lib/evaluate/check-expression.cc b/flang/lib/evaluate/check-expression.cc index 7bfef66782ed..16f2c9d699db 100644 --- a/flang/lib/evaluate/check-expression.cc +++ b/flang/lib/evaluate/check-expression.cc @@ -261,7 +261,8 @@ public: using Base::operator(); Result operator()(const semantics::Symbol &symbol) const { - if (symbol.attrs().test(semantics::Attr::CONTIGUOUS)) { + if (symbol.attrs().test(semantics::Attr::CONTIGUOUS) || + symbol.Rank() == 0) { return true; } else if (semantics::IsPointer(symbol)) { return false; @@ -276,11 +277,8 @@ public: } Result operator()(const ArrayRef &x) const { - if (x.base().Rank() > 0 || !CheckSubscripts(x.subscript())) { - return false; - } else { - return (*this)(x.base()); - } + return (x.base().IsSymbol() || x.base().Rank() == 0) && + CheckSubscripts(x.subscript()) && (*this)(x.base()); } Result operator()(const CoarrayRef &x) const { return CheckSubscripts(x.subscript()); @@ -330,11 +328,11 @@ private: template bool IsSimplyContiguous(const A &x, const IntrinsicProcTable &table) { if (IsVariable(x)) { - if (auto known{IsSimplyContiguousHelper{table}(x)}) { - return *known; - } + auto known{IsSimplyContiguousHelper{table}(x)}; + return known && *known; + } else { + return true; // not a variable } - return false; } template bool IsSimplyContiguous( diff --git a/flang/lib/evaluate/fold-character.cc b/flang/lib/evaluate/fold-character.cc index b05654214f03..a07f752bdecb 100644 --- a/flang/lib/evaluate/fold-character.cc +++ b/flang/lib/evaluate/fold-character.cc @@ -45,9 +45,15 @@ Expr> FoldIntrinsicFunction( CharacterUtils::REPEAT(std::get>(*scalars), std::get>(*scalars).ToInt64())}}; } + } else if (name == "trim") { // not elemental + if (auto scalar{ + GetScalarConstantArguments(context, funcRef.arguments())}) { + return Expr{Constant{ + CharacterUtils::TRIM(std::get>(*scalar))}}; + } } // TODO: cshift, eoshift, maxval, minval, pack, reduce, - // spread, transfer, transpose, trim, unpack + // spread, transfer, transpose, unpack return Expr{std::move(funcRef)}; } diff --git a/flang/lib/evaluate/fold-logical.cc b/flang/lib/evaluate/fold-logical.cc index 0335c0fb9559..fcfbe8dc80a2 100644 --- a/flang/lib/evaluate/fold-logical.cc +++ b/flang/lib/evaluate/fold-logical.cc @@ -6,6 +6,7 @@ // //----------------------------------------------------------------------------// +#include "check-expression.h" #include "fold-implementation.h" namespace Fortran::evaluate { @@ -76,12 +77,21 @@ Expr> FoldIntrinsicFunction( [&fptr](const Scalar &i, const Scalar &j) { return Scalar{std::invoke(fptr, i, j)}; })); + } else if (name == "is_contiguous") { + if (args.at(0)) { + if (auto *expr{args[0]->UnwrapExpr()}) { + if (IsSimplyContiguous(*expr, context.intrinsics())) { + return Expr{true}; + } + } + } } else if (name == "merge") { return FoldMerge(context, std::move(funcRef)); } // TODO: btest, cshift, dot_product, eoshift, is_iostat_end, // is_iostat_eor, lge, lgt, lle, llt, logical, matmul, out_of_range, - // pack, parity, reduce, spread, transfer, transpose, unpack + // pack, parity, reduce, spread, transfer, transpose, unpack, + // extends_type_of, same_type_as return Expr{std::move(funcRef)}; } diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc index 466d37ff0baa..9967ce992692 100644 --- a/flang/lib/evaluate/intrinsics.cc +++ b/flang/lib/evaluate/intrinsics.cc @@ -457,6 +457,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {{"i", SameInt}, {"shift", AnyInt}, {"size", AnyInt, Rank::elemental, Optionality::optional}}, SameInt}, + {"is_contiguous", {{"array", Addressable, Rank::anyOrAssumedRank}}, + DefaultLogical}, {"is_iostat_end", {{"i", AnyInt}}, DefaultLogical}, {"is_iostat_eor", {{"i", AnyInt}}, DefaultLogical}, {"kind", {{"x", AnyIntrinsic}}, DefaultInt}, @@ -704,8 +706,6 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ // LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX, // NUM_IMAGES, STOPPED_IMAGES, TEAM_NUMBER, THIS_IMAGE, // COSHAPE -// TODO: Object characteristic inquiry functions -// IS_CONTIGUOUS // TODO: Non-standard intrinsic functions // AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT, // COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT, diff --git a/flang/test/evaluate/CMakeLists.txt b/flang/test/evaluate/CMakeLists.txt index c8eeedf75826..77e601435dee 100644 --- a/flang/test/evaluate/CMakeLists.txt +++ b/flang/test/evaluate/CMakeLists.txt @@ -142,6 +142,7 @@ set(FOLDING_TESTS folding06.f90 folding07.f90 folding08.f90 + folding09.f90 ) add_test(Expression expression-test) diff --git a/flang/test/evaluate/folding05.f90 b/flang/test/evaluate/folding05.f90 index b3593cd01a737f4bcd75ca28f16dae7298e007f2..d6d8a45673822b31959a962829fd3a147889a315 100644 GIT binary patch delta 373 zcmdn*y31?B7NyAtr4?mLiZXKz6>Jqiw1#?OlDejXUTUG90*DDxAP15#LQWVV6@lFW zcPdyM;SPi{H5BIp#Zes$6;KD62=+YO$zU0nyMP?95)Bk*gG8YL2x4-j=A|g)=BJeA Hq;dfOS>tKW delta 19 acmdnxwcmBa7A5Y~ycC7p{FKt1R4xEh76*X< diff --git a/flang/test/evaluate/folding09.f90 b/flang/test/evaluate/folding09.f90 new file mode 100644 index 000000000000..af89aecf951a --- /dev/null +++ b/flang/test/evaluate/folding09.f90 @@ -0,0 +1,27 @@ +! Test folding of IS_CONTIGUOUS on simply contiguous items (9.5.4) +! When IS_CONTIGUOUS() is constant, it's .TRUE. + +module m + real, target :: hosted(2) + contains + function f() + real, pointer, contiguous :: f(:) + f => hosted + end function + subroutine test(arr1, arr2, arr3, mat) + real, intent(in) :: arr1(:), arr2(10), mat(10, 10) + real, intent(in), contiguous :: arr3(:) + real :: scalar + logical, parameter :: isc01 = is_contiguous(0) + logical, parameter :: isc02 = is_contiguous(scalar) + logical, parameter :: isc03 = is_contiguous(scalar + scalar) + logical, parameter :: isc04 = is_contiguous([0, 1, 2]) + logical, parameter :: isc05 = is_contiguous(arr1 + 1.0) + logical, parameter :: isc06 = is_contiguous(arr2) + logical, parameter :: isc07 = is_contiguous(mat) + logical, parameter :: isc08 = is_contiguous(mat(1:10,1)) + logical, parameter :: isc09 = is_contiguous(arr2(1:10:1)) + logical, parameter :: isc10 = is_contiguous(arr3) + logical, parameter :: isc11 = is_contiguous(f()) + end subroutine +end module diff --git a/flang/test/semantics/modfile32.f90 b/flang/test/semantics/modfile32.f90 index ce43140ddbb8..6db201e852c0 100644 --- a/flang/test/semantics/modfile32.f90 +++ b/flang/test/semantics/modfile32.f90 @@ -216,7 +216,7 @@ end ! end ! subroutine s3(x, y) ! real(4) :: x(1_8:10_8, 1_8:10_8) -! real(4) :: y(1_8:int(ubound(f_elem(x),1_4),kind=8)) +! real(4) :: y(1_8:10_8) ! end !end