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, IPARITY, & PARITY for all required operand
10 // types and shapes.
11 //
12 // DOT_PRODUCT, FINDLOC, SUM, and PRODUCT are in their own eponymous source
13 // files; NORM2, MAXLOC, MINLOC, MAXVAL, and MINVAL are in extrema.cpp.
14 
15 #include "reduction.h"
16 #include "reduction-templates.h"
17 #include <cinttypes>
18 
19 namespace Fortran::runtime {
20 
21 // IPARITY()
22 
23 template <typename INTERMEDIATE> class IntegerXorAccumulator {
24 public:
25   explicit IntegerXorAccumulator(const Descriptor &array) : array_{array} {}
26   void Reinitialize() { xor_ = 0; }
27   template <typename A> void GetResult(A *p, int /*zeroBasedDim*/ = -1) const {
28     *p = static_cast<A>(xor_);
29   }
30   template <typename A> bool AccumulateAt(const SubscriptValue at[]) {
31     xor_ ^= *array_.Element<A>(at);
32     return true;
33   }
34 
35 private:
36   const Descriptor &array_;
37   INTERMEDIATE xor_{0};
38 };
39 
40 extern "C" {
41 CppTypeFor<TypeCategory::Integer, 1> RTNAME(IParity1)(const Descriptor &x,
42     const char *source, int line, int dim, const Descriptor *mask) {
43   return GetTotalReduction<TypeCategory::Integer, 1>(x, source, line, dim, mask,
44       IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
45       "IPARITY");
46 }
47 CppTypeFor<TypeCategory::Integer, 2> RTNAME(IParity2)(const Descriptor &x,
48     const char *source, int line, int dim, const Descriptor *mask) {
49   return GetTotalReduction<TypeCategory::Integer, 2>(x, source, line, dim, mask,
50       IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
51       "IPARITY");
52 }
53 CppTypeFor<TypeCategory::Integer, 4> RTNAME(IParity4)(const Descriptor &x,
54     const char *source, int line, int dim, const Descriptor *mask) {
55   return GetTotalReduction<TypeCategory::Integer, 4>(x, source, line, dim, mask,
56       IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
57       "IPARITY");
58 }
59 CppTypeFor<TypeCategory::Integer, 8> RTNAME(IParity8)(const Descriptor &x,
60     const char *source, int line, int dim, const Descriptor *mask) {
61   return GetTotalReduction<TypeCategory::Integer, 8>(x, source, line, dim, mask,
62       IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x},
63       "IPARITY");
64 }
65 #ifdef __SIZEOF_INT128__
66 CppTypeFor<TypeCategory::Integer, 16> RTNAME(IParity16)(const Descriptor &x,
67     const char *source, int line, int dim, const Descriptor *mask) {
68   return GetTotalReduction<TypeCategory::Integer, 16>(x, source, line, dim,
69       mask, IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 16>>{x},
70       "IPARITY");
71 }
72 #endif
73 void RTNAME(IParityDim)(Descriptor &result, const Descriptor &x, int dim,
74     const char *source, int line, const Descriptor *mask) {
75   Terminator terminator{source, line};
76   auto catKind{x.type().GetCategoryAndKind()};
77   RUNTIME_CHECK(terminator,
78       catKind.has_value() && catKind->first == TypeCategory::Integer);
79   PartialIntegerReduction<IntegerXorAccumulator>(
80       result, x, dim, catKind->second, mask, "IPARITY", terminator);
81 }
82 }
83 
84 // ALL, ANY, COUNT, & PARITY
85 
86 enum class LogicalReduction { All, Any, Parity };
87 
88 template <LogicalReduction REDUCTION> class LogicalAccumulator {
89 public:
90   using Type = bool;
91   explicit LogicalAccumulator(const Descriptor &array) : array_{array} {}
92   void Reinitialize() { result_ = REDUCTION == LogicalReduction::All; }
93   bool Result() const { return result_; }
94   bool Accumulate(bool x) {
95     if constexpr (REDUCTION == LogicalReduction::Parity) {
96       result_ = result_ != x;
97     } else if (x != (REDUCTION == LogicalReduction::All)) {
98       result_ = x;
99       return false;
100     }
101     return true;
102   }
103   template <typename IGNORED = void>
104   bool AccumulateAt(const SubscriptValue at[]) {
105     return Accumulate(IsLogicalElementTrue(array_, at));
106   }
107 
108 private:
109   const Descriptor &array_;
110   bool result_{REDUCTION == LogicalReduction::All};
111 };
112 
113 template <typename ACCUMULATOR>
114 inline auto GetTotalLogicalReduction(const Descriptor &x, const char *source,
115     int line, int dim, ACCUMULATOR &&accumulator, const char *intrinsic) ->
116     typename ACCUMULATOR::Type {
117   Terminator terminator{source, line};
118   if (dim < 0 || dim > 1) {
119     terminator.Crash("%s: bad DIM=%d", intrinsic, dim);
120   }
121   SubscriptValue xAt[maxRank];
122   x.GetLowerBounds(xAt);
123   for (auto elements{x.Elements()}; elements--; x.IncrementSubscripts(xAt)) {
124     if (!accumulator.AccumulateAt(xAt)) {
125       break; // cut short, result is known
126     }
127   }
128   return accumulator.Result();
129 }
130 
131 template <typename ACCUMULATOR>
132 inline auto ReduceLogicalDimToScalar(const Descriptor &x, int zeroBasedDim,
133     SubscriptValue subscripts[]) -> typename ACCUMULATOR::Type {
134   ACCUMULATOR accumulator{x};
135   SubscriptValue xAt[maxRank];
136   GetExpandedSubscripts(xAt, x, zeroBasedDim, subscripts);
137   const auto &dim{x.GetDimension(zeroBasedDim)};
138   SubscriptValue at{dim.LowerBound()};
139   for (auto n{dim.Extent()}; n-- > 0; ++at) {
140     xAt[zeroBasedDim] = at;
141     if (!accumulator.AccumulateAt(xAt)) {
142       break;
143     }
144   }
145   return accumulator.Result();
146 }
147 
148 template <LogicalReduction REDUCTION> struct LogicalReduceHelper {
149   template <int KIND> struct Functor {
150     void operator()(Descriptor &result, const Descriptor &x, int dim,
151         Terminator &terminator, const char *intrinsic) const {
152       // Standard requires result to have same LOGICAL kind as argument.
153       CreatePartialReductionResult(
154           result, x, dim, terminator, intrinsic, x.type());
155       SubscriptValue at[maxRank];
156       result.GetLowerBounds(at);
157       INTERNAL_CHECK(at[0] == 1);
158       using CppType = CppTypeFor<TypeCategory::Logical, KIND>;
159       for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
160         *result.Element<CppType>(at) =
161             ReduceLogicalDimToScalar<LogicalAccumulator<REDUCTION>>(
162                 x, dim - 1, at);
163       }
164     }
165   };
166 };
167 
168 template <LogicalReduction REDUCTION>
169 inline void DoReduceLogicalDimension(Descriptor &result, const Descriptor &x,
170     int dim, Terminator &terminator, const char *intrinsic) {
171   auto catKind{x.type().GetCategoryAndKind()};
172   RUNTIME_CHECK(terminator, catKind && catKind->first == TypeCategory::Logical);
173   ApplyLogicalKind<LogicalReduceHelper<REDUCTION>::template Functor, void>(
174       catKind->second, terminator, result, x, dim, terminator, intrinsic);
175 }
176 
177 // COUNT
178 
179 class CountAccumulator {
180 public:
181   using Type = std::int64_t;
182   explicit CountAccumulator(const Descriptor &array) : array_{array} {}
183   void Reinitialize() { result_ = 0; }
184   Type Result() const { return result_; }
185   template <typename IGNORED = void>
186   bool AccumulateAt(const SubscriptValue at[]) {
187     if (IsLogicalElementTrue(array_, at)) {
188       ++result_;
189     }
190     return true;
191   }
192 
193 private:
194   const Descriptor &array_;
195   Type result_{0};
196 };
197 
198 template <int KIND> struct CountDimension {
199   void operator()(Descriptor &result, const Descriptor &x, int dim,
200       Terminator &terminator) const {
201     CreatePartialReductionResult(result, x, dim, terminator, "COUNT",
202         TypeCode{TypeCategory::Integer, KIND});
203     SubscriptValue at[maxRank];
204     result.GetLowerBounds(at);
205     INTERNAL_CHECK(at[0] == 1);
206     using CppType = CppTypeFor<TypeCategory::Integer, KIND>;
207     for (auto n{result.Elements()}; n-- > 0; result.IncrementSubscripts(at)) {
208       *result.Element<CppType>(at) =
209           ReduceLogicalDimToScalar<CountAccumulator>(x, dim - 1, at);
210     }
211   }
212 };
213 
214 extern "C" {
215 
216 bool RTNAME(All)(const Descriptor &x, const char *source, int line, int dim) {
217   return GetTotalLogicalReduction(x, source, line, dim,
218       LogicalAccumulator<LogicalReduction::All>{x}, "ALL");
219 }
220 void RTNAME(AllDim)(Descriptor &result, const Descriptor &x, int dim,
221     const char *source, int line) {
222   Terminator terminator{source, line};
223   DoReduceLogicalDimension<LogicalReduction::All>(
224       result, x, dim, terminator, "ALL");
225 }
226 
227 bool RTNAME(Any)(const Descriptor &x, const char *source, int line, int dim) {
228   return GetTotalLogicalReduction(x, source, line, dim,
229       LogicalAccumulator<LogicalReduction::Any>{x}, "ANY");
230 }
231 void RTNAME(AnyDim)(Descriptor &result, const Descriptor &x, int dim,
232     const char *source, int line) {
233   Terminator terminator{source, line};
234   DoReduceLogicalDimension<LogicalReduction::Any>(
235       result, x, dim, terminator, "ANY");
236 }
237 
238 std::int64_t RTNAME(Count)(
239     const Descriptor &x, const char *source, int line, int dim) {
240   return GetTotalLogicalReduction(
241       x, source, line, dim, CountAccumulator{x}, "COUNT");
242 }
243 
244 void RTNAME(CountDim)(Descriptor &result, const Descriptor &x, int dim,
245     int kind, const char *source, int line) {
246   Terminator terminator{source, line};
247   ApplyIntegerKind<CountDimension, void>(
248       kind, terminator, result, x, dim, terminator);
249 }
250 
251 bool RTNAME(Parity)(
252     const Descriptor &x, const char *source, int line, int dim) {
253   return GetTotalLogicalReduction(x, source, line, dim,
254       LogicalAccumulator<LogicalReduction::Parity>{x}, "PARITY");
255 }
256 void RTNAME(ParityDim)(Descriptor &result, const Descriptor &x, int dim,
257     const char *source, int line) {
258   Terminator terminator{source, line};
259   DoReduceLogicalDimension<LogicalReduction::Parity>(
260       result, x, dim, terminator, "PARITY");
261 }
262 
263 } // extern "C"
264 } // namespace Fortran::runtime
265