[flang] Implement IEEE_SUPPORT_xxx inquiry functions

[klausler]

Summary

Implement IEEE_SUPPORT_DATATYPE() and other inquiry intrinisic
functions from the intrinsic module IEEE_ARITHMETIC, folding all of
their results to .TRUE.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/lib/Evaluate/fold-logical.cpp

if (args.at(0)) {
       if (auto *expr{args[0]->UnwrapExpr()}) {
         if (IsSimplyContiguous(*expr, context)) {
           return Expr<T>{true};
         }
       }
     }
   } 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,
   // pack, parity, reduce, spread, transfer, transpose, unpack,
   // extends_type_of, same_type_as
   return Expr<T>{std::move(funcRef)};
 }
 

flang/lib/Evaluate/intrinsics.cpp

// NULL() is a special case handled in Probe() below
         {{"vector", SameType, Rank::vector}, {"mask", AnyLogical, Rank::array},
             {"field", SameType, Rank::conformable}},
         SameType, Rank::conformable, IntrinsicClass::transformationalFunction},
     {"verify",
         {{"string", SameChar}, {"set", SameChar},
             {"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
 //   LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX,
 //   STOPPED_IMAGES, TEAM_NUMBER, THIS_IMAGE,
 //   COSHAPE
 // TODO: Non-standard intrinsic functions
 //  AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT,

flang/module/__fortran_builtins.f90

type :: __builtin_lock_type
     integer(kind=int64) :: __count
   end type
 
   type :: __builtin_team_type
     integer(kind=int64) :: __id
   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

flang/module/ieee_arithmetic.f90

 !===-- module/ieee_arithmetic.f90 ------------------------------------------===!
 !
 ! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 ! See https://llvm.org/LICENSE.txt for license information.
 ! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 !
 !===------------------------------------------------------------------------===!
 
 ! 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
   end type ieee_class_type
 
   type(ieee_class_type), parameter :: &
     ieee_signaling_nan = ieee_class_type(1), &
     ieee_quiet_nan = ieee_class_type(2), &
interface ieee_copy_sign
     module procedure ieee_copy_sign_a2
     module procedure ieee_copy_sign_a3
     module procedure ieee_copy_sign_a4
     module procedure ieee_copy_sign_a8
     module procedure ieee_copy_sign_a10
     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
 
  contains
 
   elemental logical function class_eq(x,y)
     type(ieee_class_type), intent(in) :: x, y
#define _COPYSIGN(RKIND,IKIND,BITS) \
   _COPYSIGN(2,2,16)
   _COPYSIGN(3,2,16)
   _COPYSIGN(4,4,32)
   _COPYSIGN(8,8,64)
   _COPYSIGN(10,16,80)
   _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

flang/test/Evaluate/folding18.f90

+! 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