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