1 //===-- runtime/reduction.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 ALL, ANY, COUNT, IALL, IANY, IPARITY, & PARITY for all required
10 // operand types and shapes.
11 //
12 // DOT_PRODUCT, FINDLOC, MATMUL, SUM, and PRODUCT are in their own eponymous
13 // source files.
14 // NORM2, MAXLOC, MINLOC, MAXVAL, and MINVAL are in extrema.cpp.
15 
16 #include "flang/Runtime/reduction.h"
17 #include "reduction-templates.h"
18 #include <cinttypes>
19 
20 namespace Fortran::runtime {
21 
22 // IALL, IANY, IPARITY
23 
24 template <typename INTERMEDIATE> class IntegerAndAccumulator {
25 public:
26   explicit IntegerAndAccumulator(const Descriptor &array) : array_{array} {}
27   void Reinitialize() { and_ = ~INTERMEDIATE{0}; }
28   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
29     *p = static_cast<A>(and_);
30   }
31   template <typename A> bool AccumulateAt(const SubscriptValue at[]) {
32     and_ &= *array_.Element<A>(at);
33     return true;
34   }
35 
36 private:
37   const Descriptor &array_;
38   INTERMEDIATE and_{~INTERMEDIATE{0}};
39 };
40 
41 template <typename INTERMEDIATE> class IntegerOrAccumulator {
42 public:
43   explicit IntegerOrAccumulator(const Descriptor &array) : array_{array} {}
44   void Reinitialize() { or_ = 0; }
45   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
46     *p = static_cast<A>(or_);
47   }
48   template <typename A> bool AccumulateAt(const SubscriptValue at[]) {
49     or_ |= *array_.Element<A>(at);
50     return true;
51   }
52 
53 private:
54   const Descriptor &array_;
55   INTERMEDIATE or_{0};
56 };
57 
58 template <typename INTERMEDIATE> class IntegerXorAccumulator {
59 public:
60   explicit IntegerXorAccumulator(const Descriptor &array) : array_{array} {}
61   void Reinitialize() { xor_ = 0; }
62   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
63     *p = static_cast<A>(xor_);
64   }
65   template <typename A> bool AccumulateAt(const SubscriptValue at[]) {
66     xor_ ^= *array_.Element<A>(at);
67     return true;
68   }
69 
70 private:
71   const Descriptor &array_;
72   INTERMEDIATE xor_{0};
73 };
74 
75 extern "C" {
76 CppTypeFor<TypeCategory::Integer, 1> RTNAME(IAll1)(const Descriptor &x,
77     const char *source, int line, int dim, const Descriptor *mask) {
78   return GetTotalReduction<TypeCategory::Integer, 1>(x, source, line, dim, mask,
79       IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IALL");
80 }
81 CppTypeFor<TypeCategory::Integer, 2> RTNAME(IAll2)(const Descriptor &x,
82     const char *source, int line, int dim, const Descriptor *mask) {
83   return GetTotalReduction<TypeCategory::Integer, 2>(x, source, line, dim, mask,
84       IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IALL");
85 }
86 CppTypeFor<TypeCategory::Integer, 4> RTNAME(IAll4)(const Descriptor &x,
87     const char *source, int line, int dim, const Descriptor *mask) {
88   return GetTotalReduction<TypeCategory::Integer, 4>(x, source, line, dim, mask,
89       IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IALL");
90 }
91 CppTypeFor<TypeCategory::Integer, 8> RTNAME(IAll8)(const Descriptor &x,
92     const char *source, int line, int dim, const Descriptor *mask) {
93   return GetTotalReduction<TypeCategory::Integer, 8>(x, source, line, dim, mask,
94       IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x}, "IALL");
95 }
96 #ifdef __SIZEOF_INT128__
97 CppTypeFor<TypeCategory::Integer, 16> RTNAME(IAll16)(const Descriptor &x,
98     const char *source, int line, int dim, const Descriptor *mask) {
99   return GetTotalReduction<TypeCategory::Integer, 16>(x, source, line, dim,
100       mask, IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 16>>{x},
101       "IALL");
102 }
103 #endif
104 void RTNAME(IAllDim)(Descriptor &result, const Descriptor &x, int dim,
105     const char *source, int line, const Descriptor *mask) {
106   Terminator terminator{source, line};
107   auto catKind{x.type().GetCategoryAndKind()};
108   RUNTIME_CHECK(terminator,
109       catKind.has_value() && catKind->first == TypeCategory::Integer);
110   PartialIntegerReduction<IntegerAndAccumulator>(
111       result, x, dim, catKind->second, mask, "IALL", terminator);
112 }
113 
114 CppTypeFor<TypeCategory::Integer, 1> RTNAME(IAny1)(const Descriptor &x,
115     const char *source, int line, int dim, const Descriptor *mask) {
116   return GetTotalReduction<TypeCategory::Integer, 1>(x, source, line, dim, mask,
117       IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IANY");
118 }
119 CppTypeFor<TypeCategory::Integer, 2> RTNAME(IAny2)(const Descriptor &x,
120     const char *source, int line, int dim, const Descriptor *mask) {
121   return GetTotalReduction<TypeCategory::Integer, 2>(x, source, line, dim, mask,
122       IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IANY");
123 }
124 CppTypeFor<TypeCategory::Integer, 4> RTNAME(IAny4)(const Descriptor &x,
125     const char *source, int line, int dim, const Descriptor *mask) {
126   return GetTotalReduction<TypeCategory::Integer, 4>(x, source, line, dim, mask,
127       IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IANY");
128 }
129 CppTypeFor<TypeCategory::Integer, 8> RTNAME(IAny8)(const Descriptor &x,
130     const char *source, int line, int dim, const Descriptor *mask) {
131   return GetTotalReduction<TypeCategory::Integer, 8>(x, source, line, dim, mask,
132       IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x}, "IANY");
133 }
134 #ifdef __SIZEOF_INT128__
135 CppTypeFor<TypeCategory::Integer, 16> RTNAME(IAny16)(const Descriptor &x,
136     const char *source, int line, int dim, const Descriptor *mask) {
137   return GetTotalReduction<TypeCategory::Integer, 16>(x, source, line, dim,
138       mask, IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 16>>{x},
139       "IANY");
140 }
141 #endif
142 void RTNAME(IAnyDim)(Descriptor &result, const Descriptor &x, int dim,
143     const char *source, int line, const Descriptor *mask) {
144   Terminator terminator{source, line};
145   auto catKind{x.type().GetCategoryAndKind()};
146   RUNTIME_CHECK(terminator,
147       catKind.has_value() && catKind->first == TypeCategory::Integer);
148   PartialIntegerReduction<IntegerOrAccumulator>(
149       result, x, dim, catKind->second, mask, "IANY", terminator);
150 }
151 
152 CppTypeFor<TypeCategory::Integer, 1> RTNAME(IParity1)(const Descriptor &x,
153     const char *source, int line, int dim, const Descriptor *mask) {
154   return GetTotalReduction<TypeCategory::Integer, 1>(x, source, line, dim, mask,
155       IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
156       "IPARITY");
157 }
158 CppTypeFor<TypeCategory::Integer, 2> RTNAME(IParity2)(const Descriptor &x,
159     const char *source, int line, int dim, const Descriptor *mask) {
160   return GetTotalReduction<TypeCategory::Integer, 2>(x, source, line, dim, mask,
161       IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
162       "IPARITY");
163 }
164 CppTypeFor<TypeCategory::Integer, 4> RTNAME(IParity4)(const Descriptor &x,
165     const char *source, int line, int dim, const Descriptor *mask) {
166   return GetTotalReduction<TypeCategory::Integer, 4>(x, source, line, dim, mask,
167       IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
168       "IPARITY");
169 }
170 CppTypeFor<TypeCategory::Integer, 8> RTNAME(IParity8)(const Descriptor &x,
171     const char *source, int line, int dim, const Descriptor *mask) {
172   return GetTotalReduction<TypeCategory::Integer, 8>(x, source, line, dim, mask,
173       IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x},
174       "IPARITY");
175 }
176 #ifdef __SIZEOF_INT128__
177 CppTypeFor<TypeCategory::Integer, 16> RTNAME(IParity16)(const Descriptor &x,
178     const char *source, int line, int dim, const Descriptor *mask) {
179   return GetTotalReduction<TypeCategory::Integer, 16>(x, source, line, dim,
180       mask, IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 16>>{x},
181       "IPARITY");
182 }
183 #endif
184 void RTNAME(IParityDim)(Descriptor &result, const Descriptor &x, int dim,
185     const char *source, int line, const Descriptor *mask) {
186   Terminator terminator{source, line};
187   auto catKind{x.type().GetCategoryAndKind()};
188   RUNTIME_CHECK(terminator,
189       catKind.has_value() && catKind->first == TypeCategory::Integer);
190   PartialIntegerReduction<IntegerXorAccumulator>(
191       result, x, dim, catKind->second, mask, "IPARITY", terminator);
192 }
193 }
194 
195 // ALL, ANY, COUNT, & PARITY
196 
197 enum class LogicalReduction { All, Any, Parity };
198 
199 template <LogicalReduction REDUCTION> class LogicalAccumulator {
200 public:
201   using Type = bool;
202   explicit LogicalAccumulator(const Descriptor &array) : array_{array} {}
203   void Reinitialize() { result_ = REDUCTION == LogicalReduction::All; }
204   bool Result() const { return result_; }
205   bool Accumulate(bool x) {
206     if constexpr (REDUCTION == LogicalReduction::Parity) {
207       result_ = result_ != x;
208     } else if (x != (REDUCTION == LogicalReduction::All)) {
209       result_ = x;
210       return false;
211     }
212     return true;
213   }
214   template <typename IGNORED = void>
215   bool AccumulateAt(const SubscriptValue at[]) {
216     return Accumulate(IsLogicalElementTrue(array_, at));
217   }
218 
219 private:
220   const Descriptor &array_;
221   bool result_{REDUCTION == LogicalReduction::All};
222 };
223 
224 template <typename ACCUMULATOR>
225 inline auto GetTotalLogicalReduction(const Descriptor &x, const char *source,
226     int line, int dim, ACCUMULATOR &&accumulator, const char *intrinsic) ->
227     typename ACCUMULATOR::Type {
228   Terminator terminator{source, line};
229   if (dim < 0 || dim > 1) {
230     terminator.Crash("%s: bad DIM=%d", intrinsic, dim);
231   }
232   SubscriptValue xAt[maxRank];
233   x.GetLowerBounds(xAt);
234   for (auto elements{x.Elements()}; elements--; x.IncrementSubscripts(xAt)) {
235     if (!accumulator.AccumulateAt(xAt)) {
236       break; // cut short, result is known
237     }
238   }
239   return accumulator.Result();
240 }
241 
242 template <typename ACCUMULATOR>
243 inline auto ReduceLogicalDimToScalar(const Descriptor &x, int zeroBasedDim,
244     SubscriptValue subscripts[]) -> typename ACCUMULATOR::Type {
245   ACCUMULATOR accumulator{x};
246   SubscriptValue xAt[maxRank];
247   GetExpandedSubscripts(xAt, x, zeroBasedDim, subscripts);
248   const auto &dim{x.GetDimension(zeroBasedDim)};
249   SubscriptValue at{dim.LowerBound()};
250   for (auto n{dim.Extent()}; n-- > 0; ++at) {
251     xAt[zeroBasedDim] = at;
252     if (!accumulator.AccumulateAt(xAt)) {
253       break;
254     }
255   }
256   return accumulator.Result();
257 }
258 
259 template <LogicalReduction REDUCTION> struct LogicalReduceHelper {
260   template <int KIND> struct Functor {
261     void operator()(Descriptor &result, const Descriptor &x, int dim,
262         Terminator &terminator, const char *intrinsic) const {
263       // Standard requires result to have same LOGICAL kind as argument.
264       CreatePartialReductionResult(
265           result, x, dim, terminator, intrinsic, x.type());
266       SubscriptValue at[maxRank];
267       result.GetLowerBounds(at);
268       INTERNAL_CHECK(result.rank() == 0 || at[0] == 1);
269       using CppType = CppTypeFor<TypeCategory::Logical, KIND>;
270       for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
271         *result.Element<CppType>(at) =
272             ReduceLogicalDimToScalar<LogicalAccumulator<REDUCTION>>(
273                 x, dim - 1, at);
274       }
275     }
276   };
277 };
278 
279 template <LogicalReduction REDUCTION>
280 inline void DoReduceLogicalDimension(Descriptor &result, const Descriptor &x,
281     int dim, Terminator &terminator, const char *intrinsic) {
282   auto catKind{x.type().GetCategoryAndKind()};
283   RUNTIME_CHECK(terminator, catKind && catKind->first == TypeCategory::Logical);
284   ApplyLogicalKind<LogicalReduceHelper<REDUCTION>::template Functor, void>(
285       catKind->second, terminator, result, x, dim, terminator, intrinsic);
286 }
287 
288 // COUNT
289 
290 class CountAccumulator {
291 public:
292   using Type = std::int64_t;
293   explicit CountAccumulator(const Descriptor &array) : array_{array} {}
294   void Reinitialize() { result_ = 0; }
295   Type Result() const { return result_; }
296   template <typename IGNORED = void>
297   bool AccumulateAt(const SubscriptValue at[]) {
298     if (IsLogicalElementTrue(array_, at)) {
299       ++result_;
300     }
301     return true;
302   }
303 
304 private:
305   const Descriptor &array_;
306   Type result_{0};
307 };
308 
309 template <int KIND> struct CountDimension {
310   void operator()(Descriptor &result, const Descriptor &x, int dim,
311       Terminator &terminator) const {
312     CreatePartialReductionResult(result, x, dim, terminator, "COUNT",
313         TypeCode{TypeCategory::Integer, KIND});
314     SubscriptValue at[maxRank];
315     result.GetLowerBounds(at);
316     INTERNAL_CHECK(result.rank() == 0 || at[0] == 1);
317     using CppType = CppTypeFor<TypeCategory::Integer, KIND>;
318     for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
319       *result.Element<CppType>(at) =
320           ReduceLogicalDimToScalar<CountAccumulator>(x, dim - 1, at);
321     }
322   }
323 };
324 
325 extern "C" {
326 
327 bool RTNAME(All)(const Descriptor &x, const char *source, int line, int dim) {
328   return GetTotalLogicalReduction(x, source, line, dim,
329       LogicalAccumulator<LogicalReduction::All>{x}, "ALL");
330 }
331 void RTNAME(AllDim)(Descriptor &result, const Descriptor &x, int dim,
332     const char *source, int line) {
333   Terminator terminator{source, line};
334   DoReduceLogicalDimension<LogicalReduction::All>(
335       result, x, dim, terminator, "ALL");
336 }
337 
338 bool RTNAME(Any)(const Descriptor &x, const char *source, int line, int dim) {
339   return GetTotalLogicalReduction(x, source, line, dim,
340       LogicalAccumulator<LogicalReduction::Any>{x}, "ANY");
341 }
342 void RTNAME(AnyDim)(Descriptor &result, const Descriptor &x, int dim,
343     const char *source, int line) {
344   Terminator terminator{source, line};
345   DoReduceLogicalDimension<LogicalReduction::Any>(
346       result, x, dim, terminator, "ANY");
347 }
348 
349 std::int64_t RTNAME(Count)(
350     const Descriptor &x, const char *source, int line, int dim) {
351   return GetTotalLogicalReduction(
352       x, source, line, dim, CountAccumulator{x}, "COUNT");
353 }
354 
355 void RTNAME(CountDim)(Descriptor &result, const Descriptor &x, int dim,
356     int kind, const char *source, int line) {
357   Terminator terminator{source, line};
358   ApplyIntegerKind<CountDimension, void>(
359       kind, terminator, result, x, dim, terminator);
360 }
361 
362 bool RTNAME(Parity)(
363     const Descriptor &x, const char *source, int line, int dim) {
364   return GetTotalLogicalReduction(x, source, line, dim,
365       LogicalAccumulator<LogicalReduction::Parity>{x}, "PARITY");
366 }
367 void RTNAME(ParityDim)(Descriptor &result, const Descriptor &x, int dim,
368     const char *source, int line) {
369   Terminator terminator{source, line};
370   DoReduceLogicalDimension<LogicalReduction::Parity>(
371       result, x, dim, terminator, "PARITY");
372 }
373 
374 } // extern "C"
375 } // namespace Fortran::runtime
376