[flang-commits] [flang] 460fc79 - [flang] Fold intrinsic inquiry functions SAME_TYPE_AS() and EXTENDS_TYPE_OF()
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon May 9 13:38:31 PDT 2022
Author: Peter Klausler
Date: 2022-05-09T13:38:18-07:00
New Revision: 460fc79a080ba5733c30610cceb6ddced37afdd4
URL: https://github.com/llvm/llvm-project/commit/460fc79a080ba5733c30610cceb6ddced37afdd4
DIFF: https://github.com/llvm/llvm-project/commit/460fc79a080ba5733c30610cceb6ddced37afdd4.diff
LOG: [flang] Fold intrinsic inquiry functions SAME_TYPE_AS() and EXTENDS_TYPE_OF()
When the result can be known at compilation time, fold it.
Success depends on whether the operands are polymorphic.
When neither one is polymorphic, the result is known and can
be either .TRUE. or .FALSE.; when either one is polymorphic,
a .FALSE. result still can be discerned.
Differential Revision: https://reviews.llvm.org/D125062
Added:
flang/test/Evaluate/fold-type.f90
Modified:
flang/include/flang/Evaluate/type.h
flang/lib/Evaluate/fold-logical.cpp
flang/lib/Evaluate/type.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index c413e24cf3190..08c9e94c9d89f 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -186,6 +186,11 @@ class DynamicType {
// relation. Kind type parameters must match.
bool IsTkCompatibleWith(const DynamicType &) const;
+ // EXTENDS_TYPE_OF (16.9.76); ignores type parameter values
+ std::optional<bool> ExtendsTypeOf(const DynamicType &) const;
+ // SAME_TYPE_AS (16.9.165); ignores type parameter values
+ std::optional<bool> SameTypeAs(const DynamicType &) const;
+
// Result will be missing when a symbol is absent or
// has an erroneous type, e.g., REAL(KIND=666).
static std::optional<DynamicType> From(const semantics::DeclTypeSpec &);
diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp
index fe18ae211bd2a..2b25f07bfc01e 100644
--- a/flang/lib/Evaluate/fold-logical.cpp
+++ b/flang/lib/Evaluate/fold-logical.cpp
@@ -109,6 +109,18 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
},
ix->u);
}
+ } else if (name == "extends_type_of") {
+ // Type extension testing with EXTENDS_TYPE_OF() ignores any type
+ // parameters. Returns a constant truth value when the result is known now.
+ if (args[0] && args[1]) {
+ auto t0{args[0]->GetType()};
+ auto t1{args[1]->GetType()};
+ if (t0 && t1) {
+ if (auto result{t0->ExtendsTypeOf(*t1)}) {
+ return Expr<T>{*result};
+ }
+ }
+ }
} else if (name == "isnan" || name == "__builtin_ieee_is_nan") {
// A warning about an invalid argument is discarded from converting
// the argument of isnan() / IEEE_IS_NAN().
@@ -160,6 +172,18 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
}
} else if (name == "merge") {
return FoldMerge<T>(context, std::move(funcRef));
+ } else if (name == "same_type_as") {
+ // Type equality testing with SAME_TYPE_AS() ignores any type parameters.
+ // Returns a constant truth value when the result is known now.
+ if (args[0] && args[1]) {
+ auto t0{args[0]->GetType()};
+ auto t1{args[1]->GetType()};
+ if (t0 && t1) {
+ if (auto result{t0->SameTypeAs(*t1)}) {
+ return Expr<T>{*result};
+ }
+ }
+ }
} else if (name == "__builtin_ieee_support_datatype" ||
name == "__builtin_ieee_support_denormal" ||
name == "__builtin_ieee_support_divide" ||
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index 3ccb25b94010e..626bfaa93cb65 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -334,20 +334,53 @@ static bool AreCompatibleDerivedTypes(const semantics::DerivedTypeSpec *x,
}
}
-// See 7.3.2.3 (5) & 15.5.2.4
-bool DynamicType::IsTkCompatibleWith(const DynamicType &that) const {
- if (IsUnlimitedPolymorphic()) {
+static bool AreCompatibleTypes(const DynamicType &x, const DynamicType &y,
+ bool ignoreTypeParameterValues) {
+ if (x.IsUnlimitedPolymorphic()) {
return true;
- } else if (that.IsUnlimitedPolymorphic()) {
+ } else if (y.IsUnlimitedPolymorphic()) {
return false;
- } else if (category_ != that.category_) {
+ } else if (x.category() != y.category()) {
+ return false;
+ } else if (x.category() != TypeCategory::Derived) {
+ return x.kind() == y.kind();
+ } else {
+ const auto *xdt{GetDerivedTypeSpec(x)};
+ const auto *ydt{GetDerivedTypeSpec(y)};
+ return AreCompatibleDerivedTypes(xdt, ydt, x.IsPolymorphic()) &&
+ (ignoreTypeParameterValues ||
+ (xdt && ydt && AreTypeParamCompatible(*xdt, *ydt)));
+ }
+}
+
+// See 7.3.2.3 (5) & 15.5.2.4
+bool DynamicType::IsTkCompatibleWith(const DynamicType &that) const {
+ return AreCompatibleTypes(*this, that, false);
+}
+
+// 16.9.165
+std::optional<bool> DynamicType::SameTypeAs(const DynamicType &that) const {
+ bool x{AreCompatibleTypes(*this, that, true)};
+ bool y{AreCompatibleTypes(that, *this, true)};
+ if (x == y) {
+ return x;
+ } else {
+ // If either is unlimited polymorphic, the result is unknown.
+ return std::nullopt;
+ }
+}
+
+// 16.9.76
+std::optional<bool> DynamicType::ExtendsTypeOf(const DynamicType &that) const {
+ if (IsUnlimitedPolymorphic() || that.IsUnlimitedPolymorphic()) {
+ return std::nullopt; // unknown
+ } else if (!AreCompatibleDerivedTypes(evaluate::GetDerivedTypeSpec(that),
+ evaluate::GetDerivedTypeSpec(*this), true)) {
return false;
- } else if (derived_) {
- return that.derived_ &&
- AreCompatibleDerivedTypes(derived_, that.derived_, IsPolymorphic()) &&
- AreTypeParamCompatible(*derived_, *that.derived_);
+ } else if (that.IsPolymorphic()) {
+ return std::nullopt; // unknown
} else {
- return kind_ == that.kind_;
+ return true;
}
}
diff --git a/flang/test/Evaluate/fold-type.f90 b/flang/test/Evaluate/fold-type.f90
new file mode 100644
index 0000000000000..3ea59efc0ae49
--- /dev/null
+++ b/flang/test/Evaluate/fold-type.f90
@@ -0,0 +1,43 @@
+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Tests folding of SAME_TYPE_AS() and EXTENDS_TYPE_OF()
+module m
+
+ type :: t1
+ real :: x
+ end type
+ type :: t2(k)
+ integer, kind :: k
+ real(kind=k) :: x
+ end type
+ type :: t3
+ real :: x
+ end type
+ type, extends(t1) :: t4
+ integer :: y
+ end type
+
+ type(t1) :: x1, y1
+ type(t2(4)) :: x24, y24
+ type(t2(8)) :: x28
+ type(t3) :: x3
+ type(t4) :: x4
+ class(t1), allocatable :: a1
+ class(t3), allocatable :: a3
+
+ logical, parameter :: test_1 = same_type_as(x1, x1)
+ logical, parameter :: test_2 = same_type_as(x1, y1)
+ logical, parameter :: test_3 = same_type_as(x24, x24)
+ logical, parameter :: test_4 = same_type_as(x24, y24)
+ logical, parameter :: test_5 = same_type_as(x24, x28) ! ignores parameter
+ logical, parameter :: test_6 = .not. same_type_as(x1, x3)
+ logical, parameter :: test_7 = .not. same_type_as(a1, a3)
+
+ logical, parameter :: test_11 = extends_type_of(x1, y1)
+ logical, parameter :: test_12 = extends_type_of(x24, x24)
+ logical, parameter :: test_13 = extends_type_of(x24, y24)
+ logical, parameter :: test_14 = extends_type_of(x24, x28) ! ignores parameter
+ logical, parameter :: test_15 = .not. extends_type_of(x1, x3)
+ logical, parameter :: test_16 = .not. extends_type_of(a1, a3)
+ logical, parameter :: test_17 = .not. extends_type_of(x1, x4)
+ logical, parameter :: test_18 = extends_type_of(x4, x1)
+end module
More information about the flang-commits
mailing list