flang/runtime/product.cpp

   1 //===-- runtime/product.cpp -----------------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 // Implements PRODUCT for all required operand types and shapes.
  10
  11 #include "reduction-templates.h"
  12 #include "flang/Common/float128.h"
  13 #include "flang/Runtime/reduction.h"
  14 #include <cfloat>
  15 #include <cinttypes>
  16 #include <complex>
  17
  18 namespace Fortran::runtime {
  19 template <typename INTERMEDIATE> class NonComplexProductAccumulator {
  20 public:
  21   explicit RT_API_ATTRS NonComplexProductAccumulator(const Descriptor &array)
  22       : array_{array} {}
  23   RT_API_ATTRS void Reinitialize() { product_ = 1; }
  24   template <typename A>
  25   RT_API_ATTRS void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
  26     *p = static_cast<A>(product_);
  27   }
  28   template <typename A>
  29   RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) {
  30     product_ *= *array_.Element<A>(at);
  31     return product_ != 0;
  32   }
  33
  34 private:
  35   const Descriptor &array_;
  36   INTERMEDIATE product_{1};
  37 };
  38
  39 template <typename PART> class ComplexProductAccumulator {
  40 public:
  41   explicit RT_API_ATTRS ComplexProductAccumulator(const Descriptor &array)
  42       : array_{array} {}
  43   RT_API_ATTRS void Reinitialize() { product_ = rtcmplx::complex<PART>{1, 0}; }
  44   template <typename A>
  45   RT_API_ATTRS void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
  46     using ResultPart = typename A::value_type;
  47     *p = {static_cast<ResultPart>(product_.real()),
  48         static_cast<ResultPart>(product_.imag())};
  49   }
  50   template <typename A>
  51   RT_API_ATTRS bool AccumulateAt(const SubscriptValue at[]) {
  52     product_ *= *array_.Element<A>(at);
  53     return true;
  54   }
  55
  56 private:
  57   const Descriptor &array_;
  58   rtcmplx::complex<PART> product_{1, 0};
  59 };
  60
  61 extern "C" {
  62 RT_EXT_API_GROUP_BEGIN
  63
  64 CppTypeFor<TypeCategory::Integer, 1> RTDEF(ProductInteger1)(const Descriptor &x,
  65     const char *source, int line, int dim, const Descriptor *mask) {
  66   return GetTotalReduction<TypeCategory::Integer, 1>(x, source, line, dim, mask,
  67       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
  68       "PRODUCT");
  69 }
  70 CppTypeFor<TypeCategory::Integer, 2> RTDEF(ProductInteger2)(const Descriptor &x,
  71     const char *source, int line, int dim, const Descriptor *mask) {
  72   return GetTotalReduction<TypeCategory::Integer, 2>(x, source, line, dim, mask,
  73       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
  74       "PRODUCT");
  75 }
  76 CppTypeFor<TypeCategory::Integer, 4> RTDEF(ProductInteger4)(const Descriptor &x,
  77     const char *source, int line, int dim, const Descriptor *mask) {
  78   return GetTotalReduction<TypeCategory::Integer, 4>(x, source, line, dim, mask,
  79       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
  80       "PRODUCT");
  81 }
  82 CppTypeFor<TypeCategory::Integer, 8> RTDEF(ProductInteger8)(const Descriptor &x,
  83     const char *source, int line, int dim, const Descriptor *mask) {
  84   return GetTotalReduction<TypeCategory::Integer, 8>(x, source, line, dim, mask,
  85       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x},
  86       "PRODUCT");
  87 }
  88 #ifdef __SIZEOF_INT128__
  89 CppTypeFor<TypeCategory::Integer, 16> RTDEF(ProductInteger16)(
  90     const Descriptor &x, const char *source, int line, int dim,
  91     const Descriptor *mask) {
  92   return GetTotalReduction<TypeCategory::Integer, 16>(x, source, line, dim,
  93       mask,
  94       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 16>>{x},
  95       "PRODUCT");
  96 }
  97 #endif
  98
  99 // TODO: real/complex(2 & 3)
 100 CppTypeFor<TypeCategory::Real, 4> RTDEF(ProductReal4)(const Descriptor &x,
 101     const char *source, int line, int dim, const Descriptor *mask) {
 102   return GetTotalReduction<TypeCategory::Real, 4>(x, source, line, dim, mask,
 103       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 4>>{x},
 104       "PRODUCT");
 105 }
 106 CppTypeFor<TypeCategory::Real, 8> RTDEF(ProductReal8)(const Descriptor &x,
 107     const char *source, int line, int dim, const Descriptor *mask) {
 108   return GetTotalReduction<TypeCategory::Real, 8>(x, source, line, dim, mask,
 109       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 8>>{x},
 110       "PRODUCT");
 111 }
 112 #if HAS_FLOAT80
 113 CppTypeFor<TypeCategory::Real, 10> RTDEF(ProductReal10)(const Descriptor &x,
 114     const char *source, int line, int dim, const Descriptor *mask) {
 115   return GetTotalReduction<TypeCategory::Real, 10>(x, source, line, dim, mask,
 116       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 10>>{x},
 117       "PRODUCT");
 118 }
 119 #endif
 120 #if HAS_LDBL128 || HAS_FLOAT128
 121 CppTypeFor<TypeCategory::Real, 16> RTDEF(ProductReal16)(const Descriptor &x,
 122     const char *source, int line, int dim, const Descriptor *mask) {
 123   return GetTotalReduction<TypeCategory::Real, 16>(x, source, line, dim, mask,
 124       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 16>>{x},
 125       "PRODUCT");
 126 }
 127 #endif
 128
 129 void RTDEF(CppProductComplex4)(CppTypeFor<TypeCategory::Complex, 4> &result,
 130     const Descriptor &x, const char *source, int line, int dim,
 131     const Descriptor *mask) {
 132   result = GetTotalReduction<TypeCategory::Complex, 4>(x, source, line, dim,
 133       mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 4>>{x},
 134       "PRODUCT");
 135 }
 136 void RTDEF(CppProductComplex8)(CppTypeFor<TypeCategory::Complex, 8> &result,
 137     const Descriptor &x, const char *source, int line, int dim,
 138     const Descriptor *mask) {
 139   result = GetTotalReduction<TypeCategory::Complex, 8>(x, source, line, dim,
 140       mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 8>>{x},
 141       "PRODUCT");
 142 }
 143 #if HAS_FLOAT80
 144 void RTDEF(CppProductComplex10)(CppTypeFor<TypeCategory::Complex, 10> &result,
 145     const Descriptor &x, const char *source, int line, int dim,
 146     const Descriptor *mask) {
 147   result = GetTotalReduction<TypeCategory::Complex, 10>(x, source, line, dim,
 148       mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 10>>{x},
 149       "PRODUCT");
 150 }
 151 #endif
 152 #if HAS_LDBL128 || HAS_FLOAT128
 153 void RTDEF(CppProductComplex16)(CppTypeFor<TypeCategory::Complex, 16> &result,
 154     const Descriptor &x, const char *source, int line, int dim,
 155     const Descriptor *mask) {
 156   result = GetTotalReduction<TypeCategory::Complex, 16>(x, source, line, dim,
 157       mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 16>>{x},
 158       "PRODUCT");
 159 }
 160 #endif
 161
 162 void RTDEF(ProductDim)(Descriptor &result, const Descriptor &x, int dim,
 163     const char *source, int line, const Descriptor *mask) {
 164   TypedPartialNumericReduction<NonComplexProductAccumulator,
 165       NonComplexProductAccumulator, ComplexProductAccumulator,
 166       /*MIN_REAL_KIND=*/4>(result, x, dim, source, line, mask, "PRODUCT");
 167 }
 168
 169 RT_EXT_API_GROUP_END
 170 } // extern "C"
 171 } // namespace Fortran::runtime