[flang] Implement IEEE_SUPPORT_xxx inquiry functions
Implement IEEE_SUPPORT_DATATYPE() and other inquiry intrinisic
functions from the intrinsic module IEEE_ARITHMETIC, folding all of
their results to .TRUE.
Differential Revision: https://reviews.llvm.org/D95830
GitOrigin-RevId: aa39ddd0a320c1d615171fef98694e5726c3fa4f
diff --git a/lib/Evaluate/fold-logical.cpp b/lib/Evaluate/fold-logical.cpp
index 827127f..64e4bd8 100644
--- a/lib/Evaluate/fold-logical.cpp
+++ b/lib/Evaluate/fold-logical.cpp
@@ -108,6 +108,18 @@
}
} else if (name == "merge") {
return FoldMerge<T>(context, std::move(funcRef));
+ } else if (name == "__builtin_ieee_support_datatype" ||
+ name == "__builtin_ieee_support_denormal" ||
+ name == "__builtin_ieee_support_divide" ||
+ name == "__builtin_ieee_support_divide" ||
+ name == "__builtin_ieee_support_inf" ||
+ name == "__builtin_ieee_support_io" ||
+ name == "__builtin_ieee_support_nan" ||
+ name == "__builtin_ieee_support_sqrt" ||
+ name == "__builtin_ieee_support_standard" ||
+ name == "__builtin_ieee_support_subnormal" ||
+ name == "__builtin_ieee_support_underflow_control") {
+ return Expr<T>{true};
}
// TODO: btest, cshift, dot_product, eoshift, is_iostat_end,
// is_iostat_eor, lge, lgt, lle, llt, logical, matmul, out_of_range,
diff --git a/lib/Evaluate/intrinsics.cpp b/lib/Evaluate/intrinsics.cpp
index 98fbe92..b54ff78 100644
--- a/lib/Evaluate/intrinsics.cpp
+++ b/lib/Evaluate/intrinsics.cpp
@@ -772,6 +772,36 @@
{"back", AnyLogical, Rank::elemental, Optionality::optional},
DefaultingKIND},
KINDInt},
+ {"__builtin_ieee_support_datatype",
+ {{"x", AnyReal, Rank::elemental, Optionality::optional}},
+ DefaultLogical},
+ {"__builtin_ieee_support_denormal",
+ {{"x", AnyReal, Rank::elemental, Optionality::optional}},
+ DefaultLogical},
+ {"__builtin_ieee_support_divide",
+ {{"x", AnyReal, Rank::elemental, Optionality::optional}},
+ DefaultLogical},
+ {"__builtin_ieee_support_inf",
+ {{"x", AnyReal, Rank::elemental, Optionality::optional}},
+ DefaultLogical},
+ {"__builtin_ieee_support_io",
+ {{"x", AnyReal, Rank::elemental, Optionality::optional}},
+ DefaultLogical},
+ {"__builtin_ieee_support_nan",
+ {{"x", AnyReal, Rank::elemental, Optionality::optional}},
+ DefaultLogical},
+ {"__builtin_ieee_support_sqrt",
+ {{"x", AnyReal, Rank::elemental, Optionality::optional}},
+ DefaultLogical},
+ {"__builtin_ieee_support_standard",
+ {{"x", AnyReal, Rank::elemental, Optionality::optional}},
+ DefaultLogical},
+ {"__builtin_ieee_support_subnormal",
+ {{"x", AnyReal, Rank::elemental, Optionality::optional}},
+ DefaultLogical},
+ {"__builtin_ieee_support_underflow_control",
+ {{"x", AnyReal, Rank::elemental, Optionality::optional}},
+ DefaultLogical},
};
// TODO: Coarray intrinsic functions
diff --git a/module/__fortran_builtins.f90 b/module/__fortran_builtins.f90
index 852a7a9..c9cf111 100644
--- a/module/__fortran_builtins.f90
+++ b/module/__fortran_builtins.f90
@@ -31,4 +31,11 @@
end type
procedure(type(__builtin_c_ptr)) :: __builtin_c_loc
+
+ intrinsic :: __builtin_ieee_support_datatype, &
+ __builtin_ieee_support_denormal, __builtin_ieee_support_divide, &
+ __builtin_ieee_support_inf, __builtin_ieee_support_io, &
+ __builtin_ieee_support_nan, __builtin_ieee_support_sqrt, &
+ __builtin_ieee_support_standard, __builtin_ieee_support_subnormal, &
+ __builtin_ieee_support_underflow_control
end module
diff --git a/module/ieee_arithmetic.f90 b/module/ieee_arithmetic.f90
index 3e0ad85..488a950 100644
--- a/module/ieee_arithmetic.f90
+++ b/module/ieee_arithmetic.f90
@@ -9,6 +9,18 @@
! See Fortran 2018, clause 17.2
module ieee_arithmetic
+ use __Fortran_builtins, only: &
+ ieee_support_datatype => __builtin_ieee_support_datatype, &
+ ieee_support_denormal => __builtin_ieee_support_denormal, &
+ ieee_support_divide => __builtin_ieee_support_divide, &
+ ieee_support_inf => __builtin_ieee_support_inf, &
+ ieee_support_io => __builtin_ieee_support_io, &
+ ieee_support_nan => __builtin_ieee_support_nan, &
+ ieee_support_sqrt => __builtin_ieee_support_sqrt, &
+ ieee_support_standard => __builtin_ieee_support_standard, &
+ ieee_support_subnormal => __builtin_ieee_support_subnormal, &
+ ieee_support_underflow_control => __builtin_ieee_support_underflow_control
+
type :: ieee_class_type
private
integer(kind=1) :: which = 0
@@ -72,6 +84,15 @@
module procedure ieee_copy_sign_a16
end interface ieee_copy_sign
+ generic :: ieee_support_rounding => ieee_support_rounding_, &
+ ieee_support_rounding_2, ieee_support_rounding_3, &
+ ieee_support_rounding_4, ieee_support_rounding_8, &
+ ieee_support_rounding_10, ieee_support_rounding_16
+ private :: ieee_support_rounding_, &
+ ieee_support_rounding_2, ieee_support_rounding_3, &
+ ieee_support_rounding_4, ieee_support_rounding_8, &
+ ieee_support_rounding_10, ieee_support_rounding_16
+
! TODO: more interfaces (_fma, &c.)
private :: classify
@@ -181,4 +202,39 @@
_COPYSIGN(16,16,128)
#undef _COPYSIGN
+ pure logical function ieee_support_rounding_(round_type)
+ type(ieee_round_type), intent(in) :: round_type
+ ieee_support_rounding_ = .true.
+ end function
+ pure logical function ieee_support_rounding_2(round_type,x)
+ type(ieee_round_type), intent(in) :: round_type
+ real(kind=2), intent(in) :: x
+ ieee_support_rounding_2 = .true.
+ end function
+ pure logical function ieee_support_rounding_3(round_type,x)
+ type(ieee_round_type), intent(in) :: round_type
+ real(kind=3), intent(in) :: x
+ ieee_support_rounding_3 = .true.
+ end function
+ pure logical function ieee_support_rounding_4(round_type,x)
+ type(ieee_round_type), intent(in) :: round_type
+ real(kind=4), intent(in) :: x
+ ieee_support_rounding_4 = .true.
+ end function
+ pure logical function ieee_support_rounding_8(round_type,x)
+ type(ieee_round_type), intent(in) :: round_type
+ real(kind=8), intent(in) :: x
+ ieee_support_rounding_8 = .true.
+ end function
+ pure logical function ieee_support_rounding_10(round_type,x)
+ type(ieee_round_type), intent(in) :: round_type
+ real(kind=10), intent(in) :: x
+ ieee_support_rounding_10 = .true.
+ end function
+ pure logical function ieee_support_rounding_16(round_type,x)
+ type(ieee_round_type), intent(in) :: round_type
+ real(kind=16), intent(in) :: x
+ ieee_support_rounding_16 = .true.
+ end function
+
end module ieee_arithmetic
diff --git a/test/Evaluate/folding18.f90 b/test/Evaluate/folding18.f90
new file mode 100644
index 0000000..613e57a
--- /dev/null
+++ b/test/Evaluate/folding18.f90
@@ -0,0 +1,75 @@
+! RUN: %S/test_folding.sh %s %t %f18
+! Test implementations of IEEE inquiry functions
+module m
+ use ieee_arithmetic
+ logical, parameter :: test_ieee_support_datatype = ieee_support_datatype() &
+ .and. ieee_support_datatype(1.0_2) &
+ .and. ieee_support_datatype(1.0_3) &
+ .and. ieee_support_datatype(1.0_4) &
+ .and. ieee_support_datatype(1.0_8) &
+ .and. ieee_support_datatype(1.0_10) &
+ .and. ieee_support_datatype(1.0_16)
+ logical, parameter :: test_ieee_support_denormal = ieee_support_denormal() &
+ .and. ieee_support_denormal(1.0_2) &
+ .and. ieee_support_denormal(1.0_3) &
+ .and. ieee_support_denormal(1.0_4) &
+ .and. ieee_support_denormal(1.0_8) &
+ .and. ieee_support_denormal(1.0_10) &
+ .and. ieee_support_denormal(1.0_16)
+ logical, parameter :: test_ieee_support_divide = ieee_support_divide() &
+ .and. ieee_support_divide(1.0_2) &
+ .and. ieee_support_divide(1.0_3) &
+ .and. ieee_support_divide(1.0_4) &
+ .and. ieee_support_divide(1.0_8) &
+ .and. ieee_support_divide(1.0_10) &
+ .and. ieee_support_divide(1.0_16)
+ logical, parameter :: test_ieee_support_inf = ieee_support_inf() &
+ .and. ieee_support_inf(1.0_2) &
+ .and. ieee_support_inf(1.0_3) &
+ .and. ieee_support_inf(1.0_4) &
+ .and. ieee_support_inf(1.0_8) &
+ .and. ieee_support_inf(1.0_10) &
+ .and. ieee_support_inf(1.0_16)
+ logical, parameter :: test_ieee_support_io = ieee_support_io() &
+ .and. ieee_support_io(1.0_2) &
+ .and. ieee_support_io(1.0_3) &
+ .and. ieee_support_io(1.0_4) &
+ .and. ieee_support_io(1.0_8) &
+ .and. ieee_support_io(1.0_10) &
+ .and. ieee_support_io(1.0_16)
+ logical, parameter :: test_ieee_support_nan = ieee_support_nan() &
+ .and. ieee_support_nan(1.0_2) &
+ .and. ieee_support_nan(1.0_3) &
+ .and. ieee_support_nan(1.0_4) &
+ .and. ieee_support_nan(1.0_8) &
+ .and. ieee_support_nan(1.0_10) &
+ .and. ieee_support_nan(1.0_16)
+ logical, parameter :: test_ieee_support_sqrt = ieee_support_sqrt() &
+ .and. ieee_support_sqrt(1.0_2) &
+ .and. ieee_support_sqrt(1.0_3) &
+ .and. ieee_support_sqrt(1.0_4) &
+ .and. ieee_support_sqrt(1.0_8) &
+ .and. ieee_support_sqrt(1.0_10) &
+ .and. ieee_support_sqrt(1.0_16)
+ logical, parameter :: test_ieee_support_standard = ieee_support_standard() &
+ .and. ieee_support_standard(1.0_2) &
+ .and. ieee_support_standard(1.0_3) &
+ .and. ieee_support_standard(1.0_4) &
+ .and. ieee_support_standard(1.0_8) &
+ .and. ieee_support_standard(1.0_10) &
+ .and. ieee_support_standard(1.0_16)
+ logical, parameter :: test_ieee_support_subnormal = ieee_support_subnormal() &
+ .and. ieee_support_subnormal(1.0_2) &
+ .and. ieee_support_subnormal(1.0_3) &
+ .and. ieee_support_subnormal(1.0_4) &
+ .and. ieee_support_subnormal(1.0_8) &
+ .and. ieee_support_subnormal(1.0_10) &
+ .and. ieee_support_subnormal(1.0_16)
+ logical, parameter :: test_ieee_support_underflow_control = ieee_support_underflow_control() &
+ .and. ieee_support_underflow_control(1.0_2) &
+ .and. ieee_support_underflow_control(1.0_3) &
+ .and. ieee_support_underflow_control(1.0_4) &
+ .and. ieee_support_underflow_control(1.0_8) &
+ .and. ieee_support_underflow_control(1.0_10) &
+ .and. ieee_support_underflow_control(1.0_16)
+end module
