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 NonComplexProductAccumulator(const Descriptor &array)
  22       : array_{array} {}
  23   void Reinitialize() { product_ = 1; }
  24   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
  25     *p = static_cast<A>(product_);
  26   }
  27   template <typename A> bool AccumulateAt(const SubscriptValue at[]) {
  28     product_ *= *array_.Element<A>(at);
  29     return product_ != 0;
  30   }
  31
  32 private:
  33   const Descriptor &array_;
  34   INTERMEDIATE product_{1};
  35 };
  36
  37 template <typename PART> class ComplexProductAccumulator {
  38 public:
  39   explicit ComplexProductAccumulator(const Descriptor &array) : array_{array} {}
  40   void Reinitialize() { product_ = std::complex<PART>{1, 0}; }
  41   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
  42     using ResultPart = typename A::value_type;
  43     *p = {static_cast<ResultPart>(product_.real()),
  44         static_cast<ResultPart>(product_.imag())};
  45   }
  46   template <typename A> bool AccumulateAt(const SubscriptValue at[]) {
  47     product_ *= *array_.Element<A>(at);
  48     return true;
  49   }
  50
  51 private:
  52   const Descriptor &array_;
  53   std::complex<PART> product_{1, 0};
  54 };
  55
  56 extern "C" {
  57 CppTypeFor<TypeCategory::Integer, 1> RTNAME(ProductInteger1)(
  58     const Descriptor &x, const char *source, int line, int dim,
  59     const Descriptor *mask) {
  60   return GetTotalReduction<TypeCategory::Integer, 1>(x, source, line, dim, mask,
  61       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
  62       "PRODUCT");
  63 }
  64 CppTypeFor<TypeCategory::Integer, 2> RTNAME(ProductInteger2)(
  65     const Descriptor &x, const char *source, int line, int dim,
  66     const Descriptor *mask) {
  67   return GetTotalReduction<TypeCategory::Integer, 2>(x, source, line, dim, mask,
  68       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
  69       "PRODUCT");
  70 }
  71 CppTypeFor<TypeCategory::Integer, 4> RTNAME(ProductInteger4)(
  72     const Descriptor &x, const char *source, int line, int dim,
  73     const Descriptor *mask) {
  74   return GetTotalReduction<TypeCategory::Integer, 4>(x, source, line, dim, mask,
  75       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
  76       "PRODUCT");
  77 }
  78 CppTypeFor<TypeCategory::Integer, 8> RTNAME(ProductInteger8)(
  79     const Descriptor &x, const char *source, int line, int dim,
  80     const Descriptor *mask) {
  81   return GetTotalReduction<TypeCategory::Integer, 8>(x, source, line, dim, mask,
  82       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x},
  83       "PRODUCT");
  84 }
  85 #ifdef __SIZEOF_INT128__
  86 CppTypeFor<TypeCategory::Integer, 16> RTNAME(ProductInteger16)(
  87     const Descriptor &x, const char *source, int line, int dim,
  88     const Descriptor *mask) {
  89   return GetTotalReduction<TypeCategory::Integer, 16>(x, source, line, dim,
  90       mask,
  91       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Integer, 16>>{x},
  92       "PRODUCT");
  93 }
  94 #endif
  95
  96 // TODO: real/complex(2 & 3)
  97 CppTypeFor<TypeCategory::Real, 4> RTNAME(ProductReal4)(const Descriptor &x,
  98     const char *source, int line, int dim, const Descriptor *mask) {
  99   return GetTotalReduction<TypeCategory::Real, 4>(x, source, line, dim, mask,
 100       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 8>>{x},
 101       "PRODUCT");
 102 }
 103 CppTypeFor<TypeCategory::Real, 8> RTNAME(ProductReal8)(const Descriptor &x,
 104     const char *source, int line, int dim, const Descriptor *mask) {
 105   return GetTotalReduction<TypeCategory::Real, 8>(x, source, line, dim, mask,
 106       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 8>>{x},
 107       "PRODUCT");
 108 }
 109 #if LDBL_MANT_DIG == 64
 110 CppTypeFor<TypeCategory::Real, 10> RTNAME(ProductReal10)(const Descriptor &x,
 111     const char *source, int line, int dim, const Descriptor *mask) {
 112   return GetTotalReduction<TypeCategory::Real, 10>(x, source, line, dim, mask,
 113       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 10>>{x},
 114       "PRODUCT");
 115 }
 116 #elif LDBL_MANT_DIG == 113
 117 CppTypeFor<TypeCategory::Real, 16> RTNAME(ProductReal16)(const Descriptor &x,
 118     const char *source, int line, int dim, const Descriptor *mask) {
 119   return GetTotalReduction<TypeCategory::Real, 16>(x, source, line, dim, mask,
 120       NonComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 16>>{x},
 121       "PRODUCT");
 122 }
 123 #endif
 124
 125 void RTNAME(CppProductComplex4)(CppTypeFor<TypeCategory::Complex, 4> &result,
 126     const Descriptor &x, const char *source, int line, int dim,
 127     const Descriptor *mask) {
 128   result = GetTotalReduction<TypeCategory::Complex, 4>(x, source, line, dim,
 129       mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 8>>{x},
 130       "PRODUCT");
 131 }
 132 void RTNAME(CppProductComplex8)(CppTypeFor<TypeCategory::Complex, 8> &result,
 133     const Descriptor &x, const char *source, int line, int dim,
 134     const Descriptor *mask) {
 135   result = GetTotalReduction<TypeCategory::Complex, 8>(x, source, line, dim,
 136       mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 8>>{x},
 137       "PRODUCT");
 138 }
 139 #if LDBL_MANT_DIG == 64
 140 void RTNAME(CppProductComplex10)(CppTypeFor<TypeCategory::Complex, 10> &result,
 141     const Descriptor &x, const char *source, int line, int dim,
 142     const Descriptor *mask) {
 143   result = GetTotalReduction<TypeCategory::Complex, 10>(x, source, line, dim,
 144       mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 10>>{x},
 145       "PRODUCT");
 146 }
 147 #elif LDBL_MANT_DIG == 113
 148 void RTNAME(CppProductComplex16)(CppTypeFor<TypeCategory::Complex, 16> &result,
 149     const Descriptor &x, const char *source, int line, int dim,
 150     const Descriptor *mask) {
 151   result = GetTotalReduction<TypeCategory::Complex, 16>(x, source, line, dim,
 152       mask, ComplexProductAccumulator<CppTypeFor<TypeCategory::Real, 16>>{x},
 153       "PRODUCT");
 154 }
 155 #endif
 156
 157 void RTNAME(ProductDim)(Descriptor &result, const Descriptor &x, int dim,
 158     const char *source, int line, const Descriptor *mask) {
 159   TypedPartialNumericReduction<NonComplexProductAccumulator,
 160       NonComplexProductAccumulator, ComplexProductAccumulator>(
 161       result, x, dim, source, line, mask, "PRODUCT");
 162 }
 163 } // extern "C"
 164 } // namespace Fortran::runtime