[flang-commits] [flang] 6965a77 - [flang] Fold LGE/LGT/LLE/LLT intrinsic functions
peter klausler via flang-commits
flang-commits at lists.llvm.org
Thu Oct 14 15:24:11 PDT 2021
Author: peter klausler
Date: 2021-10-14T15:24:03-07:00
New Revision: 6965a776ee192cb4c1a2618c270254fbf70879df
URL: https://github.com/llvm/llvm-project/commit/6965a776ee192cb4c1a2618c270254fbf70879df
DIFF: https://github.com/llvm/llvm-project/commit/6965a776ee192cb4c1a2618c270254fbf70879df.diff
LOG: [flang] Fold LGE/LGT/LLE/LLT intrinsic functions
Fold the legacy intrinsic functions LGE, LGT, LLE, & LLT
by rewriting them into character relational expressions and
then folding those. Also fix folding of comparisons of
character values of distinct lengths: the shorter value must
be padded with blanks. (This fix exposed some bad test cases,
which are also fixed.)
Differential Revision: https://reviews.llvm.org/D111843
Added:
flang/test/Evaluate/fold-char-cmp.f90
Modified:
flang/include/flang/Evaluate/common.h
flang/include/flang/Evaluate/type.h
flang/lib/Evaluate/fold-logical.cpp
flang/lib/Semantics/check-io.h
flang/lib/Semantics/data-to-inits.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/runtime-type-info.cpp
flang/test/Evaluate/folding01.f90
flang/test/Evaluate/folding05.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/common.h b/flang/include/flang/Evaluate/common.h
index dd7cb96eb5696..e0e5caceadc7d 100644
--- a/flang/include/flang/Evaluate/common.h
+++ b/flang/include/flang/Evaluate/common.h
@@ -19,6 +19,7 @@
#include "flang/Parser/message.h"
#include <cinttypes>
#include <map>
+#include <string>
namespace Fortran::semantics {
class DerivedTypeSpec;
@@ -45,6 +46,26 @@ static constexpr Ordering Compare(const A &x, const A &y) {
}
}
+template <typename CH>
+static constexpr Ordering Compare(
+ const std::basic_string<CH> &x, const std::basic_string<CH> &y) {
+ std::size_t xLen{x.size()}, yLen{y.size()};
+ using String = std::basic_string<CH>;
+ // Fortran CHARACTER comparison is defined with blank padding
+ // to extend a shorter operand.
+ if (xLen < yLen) {
+ return Compare(String{x}.append(yLen - xLen, CH{' '}), y);
+ } else if (xLen > yLen) {
+ return Compare(x, String{y}.append(xLen - yLen, CH{' '}));
+ } else if (x < y) {
+ return Ordering::Less;
+ } else if (x > y) {
+ return Ordering::Greater;
+ } else {
+ return Ordering::Equal;
+ }
+}
+
static constexpr Ordering Reverse(Ordering ordering) {
if (ordering == Ordering::Less) {
return Ordering::Greater;
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index 23fc6cab809d8..dcc052769b786 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -52,6 +52,7 @@ using SubscriptInteger = Type<TypeCategory::Integer, 8>;
using CInteger = Type<TypeCategory::Integer, 4>;
using LogicalResult = Type<TypeCategory::Logical, 4>;
using LargestReal = Type<TypeCategory::Real, 16>;
+using Ascii = Type<TypeCategory::Character, 1>;
// A predicate that is true when a kind value is a kind that could possibly
// be supported for an intrinsic type category on some target instruction
diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp
index 1e11fec256405..586909d3ecf83 100644
--- a/flang/lib/Evaluate/fold-logical.cpp
+++ b/flang/lib/Evaluate/fold-logical.cpp
@@ -106,6 +106,20 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
}
}
}
+ } else if (name == "lge" || name == "lgt" || name == "lle" || name == "llt") {
+ // Rewrite LGE/LGT/LLE/LLT into ASCII character relations
+ auto *cx0{UnwrapExpr<Expr<SomeCharacter>>(args[0])};
+ auto *cx1{UnwrapExpr<Expr<SomeCharacter>>(args[1])};
+ if (cx0 && cx1) {
+ return Fold(context,
+ ConvertToType<T>(
+ PackageRelation(name == "lge" ? RelationalOperator::GE
+ : name == "lgt" ? RelationalOperator::GT
+ : name == "lle" ? RelationalOperator::LE
+ : RelationalOperator::LT,
+ ConvertToType<Ascii>(std::move(*cx0)),
+ ConvertToType<Ascii>(std::move(*cx1)))));
+ }
} else if (name == "logical") {
if (auto *expr{UnwrapExpr<Expr<SomeLogical>>(args[0])}) {
return Fold(context, ConvertToType<T>(std::move(*expr)));
@@ -126,7 +140,7 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
return Expr<T>{true};
}
// TODO: btest, dot_product, is_iostat_end,
- // is_iostat_eor, lge, lgt, lle, llt, logical, matmul, out_of_range,
+ // is_iostat_eor, logical, matmul, out_of_range,
// parity, transfer
return Expr<T>{std::move(funcRef)};
}
diff --git a/flang/lib/Semantics/check-io.h b/flang/lib/Semantics/check-io.h
index 01bbcd9ba24ff..44c01e85ffdcf 100644
--- a/flang/lib/Semantics/check-io.h
+++ b/flang/lib/Semantics/check-io.h
@@ -86,8 +86,7 @@ class IoChecker : public virtual BaseChecker {
StatusReplace, StatusScratch, DataList)
template <typename R, typename T> std::optional<R> GetConstExpr(const T &x) {
- using DefaultCharConstantType =
- evaluate::Type<common::TypeCategory::Character, 1>;
+ using DefaultCharConstantType = evaluate::Ascii;
if (const SomeExpr * expr{GetExpr(x)}) {
const auto foldExpr{
evaluate::Fold(context_.foldingContext(), common::Clone(*expr))};
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index 8fba39f825345..958184ca2b6af 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -234,8 +234,8 @@ DataInitializationCompiler::ConvertElement(
if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) {
return {std::make_pair(std::move(*converted), false)};
}
- if (std::optional<std::string> chValue{evaluate::GetScalarConstantValue<
- evaluate::Type<TypeCategory::Character, 1>>(expr)}) {
+ if (std::optional<std::string> chValue{
+ evaluate::GetScalarConstantValue<evaluate::Ascii>(expr)}) {
// Allow DATA initialization with Hollerith and kind=1 CHARACTER like
// (most) other Fortran compilers do. Pad on the right with spaces
// when short, truncate the right if long.
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 21f0b4fb46ec1..8ad0f5ab27d8b 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1576,8 +1576,8 @@ void AttrsVisitor::SetBindNameOn(Symbol &symbol) {
if (!attrs_ || !attrs_->test(Attr::BIND_C)) {
return;
}
- std::optional<std::string> label{evaluate::GetScalarConstantValue<
- evaluate::Type<TypeCategory::Character, 1>>(bindName_)};
+ std::optional<std::string> label{
+ evaluate::GetScalarConstantValue<evaluate::Ascii>(bindName_)};
// 18.9.2(2): discard leading and trailing blanks, ignore if all blank
if (label) {
auto first{label->find_first_not_of(" ")};
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index ddda7d1e7a8eb..bc6a889fa9d86 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -637,7 +637,7 @@ SomeExpr RuntimeTableBuilder::SaveNameAsPointerTarget(
object.set_type(scope.MakeCharacterType(
ParamValue{len, common::TypeParamAttr::Len}, KindExpr{1}));
}
- using Ascii = evaluate::Type<TypeCategory::Character, 1>;
+ using evaluate::Ascii;
using AsciiExpr = evaluate::Expr<Ascii>;
object.set_init(evaluate::AsGenericExpr(AsciiExpr{name}));
Symbol &symbol{*scope
diff --git a/flang/test/Evaluate/fold-char-cmp.f90 b/flang/test/Evaluate/fold-char-cmp.f90
new file mode 100644
index 0000000000000..6fe5c7033621d
--- /dev/null
+++ b/flang/test/Evaluate/fold-char-cmp.f90
@@ -0,0 +1,17 @@
+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Tests folding of character comparisons
+module m1
+ logical, parameter :: cases(*) = &
+ [ "" == "", "" == " " &
+ , "aaa" == "aaa", "aaa" == "aaa ", "aaa" /= "aab" &
+ , "aaa" <= "aaa", .not. "aaa" < "aaa", "aaa" < "aab", "aaa" >= "aaa" &
+ , .not. "aaa" > "aaa", .not. "aaa" >= "aab" &
+ , 4_"aaa" == 4_"aaa", 4_"aaa" == 4_"aaa ", 4_"aaa" /= 4_"aab" &
+ , 4_"aaa" <= 4_"aaa", .not. 4_"aaa" < 4_"aaa", 4_"aaa" < 4_"aab", 4_"aaa" >= 4_"aaa" &
+ , .not. 4_"aaa" > 4_"aaa", .not. 4_"aaa" >= 4_"aab" &
+ , lle("aaa", "aaa"), .not. llt("aaa", "aaa"), llt("aaa", "aab"), lge("aaa", "aaa") &
+ , .not. lgt("aaa", "aaa"), .not. lge("aaa", "aab") &
+ , lle("", ""), .not. llt("", ""), lge("", ""), .not. lgt("", "") &
+ ]
+ logical, parameter :: test_cases = all(cases)
+end module
diff --git a/flang/test/Evaluate/folding01.f90 b/flang/test/Evaluate/folding01.f90
index cb7a9eb5309fd..cc3b17e4c2c43 100644
--- a/flang/test/Evaluate/folding01.f90
+++ b/flang/test/Evaluate/folding01.f90
@@ -123,9 +123,7 @@ module m
character(len(c3)), parameter :: exp_min = c1
character(len(c3)), parameter :: exp_max = c4
logical, parameter :: test_max_c_1 = res_max_c.EQ.exp_max
- logical, parameter :: test_max_c_2 = res_max_c.NE.c4
logical, parameter :: test_max_c_3 = len(res_max_c).EQ.len(c3)
- logical, parameter :: test_min_c_1 = res_min_c.NE.c1
logical, parameter :: test_min_c_2 = res_min_c.EQ.exp_min
logical, parameter :: test_min_c_3 = len(res_min_c).EQ.len(c3)
@@ -137,5 +135,5 @@ module m
logical, parameter :: test_not_zero = not(0).EQ.-1
logical, parameter :: test_not_neg_one = not(-1).EQ.0
logical, parameter :: test_not_array = all(not([5, 6, 7]).EQ.[-6, -7, -8])
-
+
end module
diff --git a/flang/test/Evaluate/folding05.f90 b/flang/test/Evaluate/folding05.f90
index 22c029030632b..4ace088ec551d 100644
Binary files a/flang/test/Evaluate/folding05.f90 and b/flang/test/Evaluate/folding05.f90
diff er
More information about the flang-commits
mailing list