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