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