1//===-- lib/Evaluate/fold-logical.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#include "fold-implementation.h"
10#include "fold-matmul.h"
11#include "fold-reduction.h"
12#include "flang/Evaluate/check-expression.h"
13#include "flang/Runtime/magic-numbers.h"
14
15namespace Fortran::evaluate {
16
17template <typename T>
18static std::optional<Expr<SomeType>> ZeroExtend(const Constant<T> &c) {
19 std::vector<Scalar<LargestInt>> exts;
20 for (const auto &v : c.values()) {
21 exts.push_back(Scalar<LargestInt>::ConvertUnsigned(v).value);
22 }
23 return AsGenericExpr(
24 Constant<LargestInt>(std::move(exts), ConstantSubscripts(c.shape())));
25}
26
27// for ALL, ANY & PARITY
28template <typename T>
29static Expr<T> FoldAllAnyParity(FoldingContext &context, FunctionRef<T> &&ref,
30 Scalar<T> (Scalar<T>::*operation)(const Scalar<T> &) const,
31 Scalar<T> identity) {
32 static_assert(T::category == TypeCategory::Logical);
33 std::optional<int> dim;
34 if (std::optional<ArrayAndMask<T>> arrayAndMask{
35 ProcessReductionArgs<T>(context, ref.arguments(), dim,
36 /*ARRAY(MASK)=*/0, /*DIM=*/1)}) {
37 OperationAccumulator accumulator{arrayAndMask->array, operation};
38 return Expr<T>{DoReduction<T>(
39 arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)};
40 }
41 return Expr<T>{std::move(ref)};
42}
43
44// OUT_OF_RANGE(x,mold[,round]) references are entirely rewritten here into
45// expressions, which are then folded into constants when 'x' and 'round'
46// are constant. It is guaranteed that 'x' is evaluated at most once.
47
48template <int X_RKIND, int MOLD_IKIND>
49Expr<SomeReal> RealToIntBoundHelper(bool round, bool negate) {
50 using RType = Type<TypeCategory::Real, X_RKIND>;
51 using RealType = Scalar<RType>;
52 using IntType = Scalar<Type<TypeCategory::Integer, MOLD_IKIND>>;
53 RealType result{}; // 0.
54 common::RoundingMode roundingMode{round
55 ? common::RoundingMode::TiesAwayFromZero
56 : common::RoundingMode::ToZero};
57 // Add decreasing powers of two to the result to find the largest magnitude
58 // value that can be converted to the integer type without overflow.
59 RealType at{RealType::FromInteger(IntType{negate ? -1 : 1}).value};
60 bool decrement{true};
61 while (!at.template ToInteger<IntType>(roundingMode)
62 .flags.test(RealFlag::Overflow)) {
63 auto tmp{at.SCALE(IntType{1})};
64 if (tmp.flags.test(RealFlag::Overflow)) {
65 decrement = false;
66 break;
67 }
68 at = tmp.value;
69 }
70 while (true) {
71 if (decrement) {
72 at = at.SCALE(IntType{-1}).value;
73 } else {
74 decrement = true;
75 }
76 auto tmp{at.Add(result)};
77 if (tmp.flags.test(RealFlag::Inexact)) {
78 break;
79 } else if (!tmp.value.template ToInteger<IntType>(roundingMode)
80 .flags.test(RealFlag::Overflow)) {
81 result = tmp.value;
82 }
83 }
84 return AsCategoryExpr(Constant<RType>{std::move(result)});
85}
86
87static Expr<SomeReal> RealToIntBound(
88 int xRKind, int moldIKind, bool round, bool negate) {
89 switch (xRKind) {
90#define ICASES(RK) \
91 switch (moldIKind) { \
92 case 1: \
93 return RealToIntBoundHelper<RK, 1>(round, negate); \
94 break; \
95 case 2: \
96 return RealToIntBoundHelper<RK, 2>(round, negate); \
97 break; \
98 case 4: \
99 return RealToIntBoundHelper<RK, 4>(round, negate); \
100 break; \
101 case 8: \
102 return RealToIntBoundHelper<RK, 8>(round, negate); \
103 break; \
104 case 16: \
105 return RealToIntBoundHelper<RK, 16>(round, negate); \
106 break; \
107 } \
108 break
109 case 2:
110 ICASES(2);
111 break;
112 case 3:
113 ICASES(3);
114 break;
115 case 4:
116 ICASES(4);
117 break;
118 case 8:
119 ICASES(8);
120 break;
121 case 10:
122 ICASES(10);
123 break;
124 case 16:
125 ICASES(16);
126 break;
127 }
128 DIE("RealToIntBound: no case");
129#undef ICASES
130}
131
132class RealToIntLimitHelper {
133public:
134 using Result = std::optional<Expr<SomeReal>>;
135 using Types = RealTypes;
136 RealToIntLimitHelper(
137 FoldingContext &context, Expr<SomeReal> &&hi, Expr<SomeReal> &lo)
138 : context_{context}, hi_{std::move(hi)}, lo_{lo} {}
139 template <typename T> Result Test() {
140 if (UnwrapExpr<Expr<T>>(hi_)) {
141 bool promote{T::kind < 16};
142 Result constResult;
143 if (auto hiV{GetScalarConstantValue<T>(hi_)}) {
144 auto loV{GetScalarConstantValue<T>(lo_)};
145 CHECK(loV.has_value());
146 auto diff{hiV->Subtract(*loV, Rounding{common::RoundingMode::ToZero})};
147 promote = promote &&
148 (diff.flags.test(RealFlag::Overflow) ||
149 diff.flags.test(RealFlag::Inexact));
150 constResult = AsCategoryExpr(Constant<T>{std::move(diff.value)});
151 }
152 if (promote) {
153 constexpr int nextKind{T::kind < 4 ? 4 : T::kind == 4 ? 8 : 16};
154 using T2 = Type<TypeCategory::Real, nextKind>;
155 hi_ = Expr<SomeReal>{Fold(context_, ConvertToType<T2>(std::move(hi_)))};
156 lo_ = Expr<SomeReal>{Fold(context_, ConvertToType<T2>(std::move(lo_)))};
157 if (constResult) {
158 // Use promoted constants on next iteration of SearchTypes
159 return std::nullopt;
160 }
161 }
162 if (constResult) {
163 return constResult;
164 } else {
165 return AsCategoryExpr(std::move(hi_) - Expr<SomeReal>{lo_});
166 }
167 } else {
168 return std::nullopt;
169 }
170 }
171
172private:
173 FoldingContext &context_;
174 Expr<SomeReal> hi_;
175 Expr<SomeReal> &lo_;
176};
177
178static std::optional<Expr<SomeReal>> RealToIntLimit(
179 FoldingContext &context, Expr<SomeReal> &&hi, Expr<SomeReal> &lo) {
180 return common::SearchTypes(RealToIntLimitHelper{context, std::move(hi), lo});
181}
182
183// RealToRealBounds() returns a pair (HUGE(x),REAL(HUGE(mold),KIND(x)))
184// when REAL(HUGE(x),KIND(mold)) overflows, and std::nullopt otherwise.
185template <int X_RKIND, int MOLD_RKIND>
186std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>>
187RealToRealBoundsHelper() {
188 using RType = Type<TypeCategory::Real, X_RKIND>;
189 using RealType = Scalar<RType>;
190 using MoldRealType = Scalar<Type<TypeCategory::Real, MOLD_RKIND>>;
191 if (!MoldRealType::Convert(RealType::HUGE()).flags.test(RealFlag::Overflow)) {
192 return std::nullopt;
193 } else {
194 return std::make_pair(AsCategoryExpr(Constant<RType>{
195 RealType::Convert(MoldRealType::HUGE()).value}),
196 AsCategoryExpr(Constant<RType>{RealType::HUGE()}));
197 }
198}
199
200static std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>>
201RealToRealBounds(int xRKind, int moldRKind) {
202 switch (xRKind) {
203#define RCASES(RK) \
204 switch (moldRKind) { \
205 case 2: \
206 return RealToRealBoundsHelper<RK, 2>(); \
207 break; \
208 case 3: \
209 return RealToRealBoundsHelper<RK, 3>(); \
210 break; \
211 case 4: \
212 return RealToRealBoundsHelper<RK, 4>(); \
213 break; \
214 case 8: \
215 return RealToRealBoundsHelper<RK, 8>(); \
216 break; \
217 case 10: \
218 return RealToRealBoundsHelper<RK, 10>(); \
219 break; \
220 case 16: \
221 return RealToRealBoundsHelper<RK, 16>(); \
222 break; \
223 } \
224 break
225 case 2:
226 RCASES(2);
227 break;
228 case 3:
229 RCASES(3);
230 break;
231 case 4:
232 RCASES(4);
233 break;
234 case 8:
235 RCASES(8);
236 break;
237 case 10:
238 RCASES(10);
239 break;
240 case 16:
241 RCASES(16);
242 break;
243 }
244 DIE("RealToRealBounds: no case");
245#undef RCASES
246}
247
248template <int X_IKIND, int MOLD_RKIND>
249std::optional<Expr<SomeInteger>> IntToRealBoundHelper(bool negate) {
250 using IType = Type<TypeCategory::Integer, X_IKIND>;
251 using IntType = Scalar<IType>;
252 using RealType = Scalar<Type<TypeCategory::Real, MOLD_RKIND>>;
253 IntType result{}; // 0
254 while (true) {
255 std::optional<IntType> next;
256 for (int bit{0}; bit < IntType::bits; ++bit) {
257 IntType power{IntType{}.IBSET(bit)};
258 if (power.IsNegative()) {
259 if (!negate) {
260 break;
261 }
262 } else if (negate) {
263 power = power.Negate().value;
264 }
265 auto tmp{power.AddSigned(result)};
266 if (tmp.overflow ||
267 RealType::FromInteger(tmp.value).flags.test(RealFlag::Overflow)) {
268 break;
269 }
270 next = tmp.value;
271 }
272 if (next) {
273 CHECK(result.CompareSigned(*next) != Ordering::Equal);
274 result = *next;
275 } else {
276 break;
277 }
278 }
279 if (result.CompareSigned(IntType::HUGE()) == Ordering::Equal) {
280 return std::nullopt;
281 } else {
282 return AsCategoryExpr(Constant<IType>{std::move(result)});
283 }
284}
285
286static std::optional<Expr<SomeInteger>> IntToRealBound(
287 int xIKind, int moldRKind, bool negate) {
288 switch (xIKind) {
289#define RCASES(IK) \
290 switch (moldRKind) { \
291 case 2: \
292 return IntToRealBoundHelper<IK, 2>(negate); \
293 break; \
294 case 3: \
295 return IntToRealBoundHelper<IK, 3>(negate); \
296 break; \
297 case 4: \
298 return IntToRealBoundHelper<IK, 4>(negate); \
299 break; \
300 case 8: \
301 return IntToRealBoundHelper<IK, 8>(negate); \
302 break; \
303 case 10: \
304 return IntToRealBoundHelper<IK, 10>(negate); \
305 break; \
306 case 16: \
307 return IntToRealBoundHelper<IK, 16>(negate); \
308 break; \
309 } \
310 break
311 case 1:
312 RCASES(1);
313 break;
314 case 2:
315 RCASES(2);
316 break;
317 case 4:
318 RCASES(4);
319 break;
320 case 8:
321 RCASES(8);
322 break;
323 case 16:
324 RCASES(16);
325 break;
326 }
327 DIE("IntToRealBound: no case");
328#undef RCASES
329}
330
331template <int X_IKIND, int MOLD_IKIND>
332std::optional<Expr<SomeInteger>> IntToIntBoundHelper() {
333 if constexpr (X_IKIND <= MOLD_IKIND) {
334 return std::nullopt;
335 } else {
336 using XIType = Type<TypeCategory::Integer, X_IKIND>;
337 using IntegerType = Scalar<XIType>;
338 using MoldIType = Type<TypeCategory::Integer, MOLD_IKIND>;
339 using MoldIntegerType = Scalar<MoldIType>;
340 return AsCategoryExpr(Constant<XIType>{
341 IntegerType::ConvertSigned(MoldIntegerType::HUGE()).value});
342 }
343}
344
345static std::optional<Expr<SomeInteger>> IntToIntBound(
346 int xIKind, int moldIKind) {
347 switch (xIKind) {
348#define ICASES(IK) \
349 switch (moldIKind) { \
350 case 1: \
351 return IntToIntBoundHelper<IK, 1>(); \
352 break; \
353 case 2: \
354 return IntToIntBoundHelper<IK, 2>(); \
355 break; \
356 case 4: \
357 return IntToIntBoundHelper<IK, 4>(); \
358 break; \
359 case 8: \
360 return IntToIntBoundHelper<IK, 8>(); \
361 break; \
362 case 16: \
363 return IntToIntBoundHelper<IK, 16>(); \
364 break; \
365 } \
366 break
367 case 1:
368 ICASES(1);
369 break;
370 case 2:
371 ICASES(2);
372 break;
373 case 4:
374 ICASES(4);
375 break;
376 case 8:
377 ICASES(8);
378 break;
379 case 16:
380 ICASES(16);
381 break;
382 }
383 DIE("IntToIntBound: no case");
384#undef ICASES
385}
386
387// ApplyIntrinsic() constructs the typed expression representation
388// for a specific intrinsic function reference.
389// TODO: maybe move into tools.h?
390class IntrinsicCallHelper {
391public:
392 explicit IntrinsicCallHelper(SpecificCall &&call) : call_{call} {
393 CHECK(proc_.IsFunction());
394 typeAndShape_ = proc_.functionResult->GetTypeAndShape();
395 CHECK(typeAndShape_ != nullptr);
396 }
397 using Result = std::optional<Expr<SomeType>>;
398 using Types = LengthlessIntrinsicTypes;
399 template <typename T> Result Test() {
400 if (T::category == typeAndShape_->type().category() &&
401 T::kind == typeAndShape_->type().kind()) {
402 return AsGenericExpr(FunctionRef<T>{
403 ProcedureDesignator{std::move(call_.specificIntrinsic)},
404 std::move(call_.arguments)});
405 } else {
406 return std::nullopt;
407 }
408 }
409
410private:
411 SpecificCall call_;
412 const characteristics::Procedure &proc_{
413 call_.specificIntrinsic.characteristics.value()};
414 const characteristics::TypeAndShape *typeAndShape_{nullptr};
415};
416
417static Expr<SomeType> ApplyIntrinsic(
418 FoldingContext &context, const std::string &func, ActualArguments &&args) {
419 auto found{
420 context.intrinsics().Probe(CallCharacteristics{func}, args, context)};
421 CHECK(found.has_value());
422 auto result{common::SearchTypes(IntrinsicCallHelper{std::move(*found)})};
423 CHECK(result.has_value());
424 return *result;
425}
426
427static Expr<LogicalResult> CompareUnsigned(FoldingContext &context,
428 const char *intrin, Expr<SomeType> &&x, Expr<SomeType> &&y) {
429 Expr<SomeType> result{ApplyIntrinsic(context, intrin,
430 ActualArguments{
431 ActualArgument{std::move(x)}, ActualArgument{std::move(y)}})};
432 return DEREF(UnwrapExpr<Expr<LogicalResult>>(result));
433}
434
435// Determines the right kind of INTEGER to hold the bits of a REAL type.
436static Expr<SomeType> IntTransferMold(
437 const TargetCharacteristics &target, DynamicType realType, bool asVector) {
438 CHECK(realType.category() == TypeCategory::Real);
439 int rKind{realType.kind()};
440 int iKind{std::max<int>(target.GetAlignment(TypeCategory::Real, rKind),
441 target.GetByteSize(TypeCategory::Real, rKind))};
442 CHECK(target.CanSupportType(TypeCategory::Integer, iKind));
443 DynamicType iType{TypeCategory::Integer, iKind};
444 ConstantSubscripts shape;
445 if (asVector) {
446 shape = ConstantSubscripts{1};
447 }
448 Constant<SubscriptInteger> value{
449 std::vector<Scalar<SubscriptInteger>>{0}, std::move(shape)};
450 auto expr{ConvertToType(iType, AsGenericExpr(std::move(value)))};
451 CHECK(expr.has_value());
452 return std::move(*expr);
453}
454
455static Expr<SomeType> GetRealBits(FoldingContext &context, Expr<SomeReal> &&x) {
456 auto xType{x.GetType()};
457 CHECK(xType.has_value());
458 bool asVector{x.Rank() > 0};
459 return ApplyIntrinsic(context, "transfer",
460 ActualArguments{ActualArgument{AsGenericExpr(std::move(x))},
461 ActualArgument{IntTransferMold(
462 context.targetCharacteristics(), *xType, asVector)}});
463}
464
465template <int KIND>
466static Expr<Type<TypeCategory::Logical, KIND>> RewriteOutOfRange(
467 FoldingContext &context,
468 FunctionRef<Type<TypeCategory::Logical, KIND>> &&funcRef) {
469 using ResultType = Type<TypeCategory::Logical, KIND>;
470 ActualArguments &args{funcRef.arguments()};
471 // Fold x= and round= unconditionally
472 if (auto *x{UnwrapExpr<Expr<SomeType>>(args[0])}) {
473 *args[0] = Fold(context, std::move(*x));
474 }
475 if (args.size() >= 3) {
476 if (auto *round{UnwrapExpr<Expr<SomeType>>(args[2])}) {
477 *args[2] = Fold(context, std::move(*round));
478 }
479 }
480 if (auto *x{UnwrapExpr<Expr<SomeType>>(args[0])}) {
481 x = UnwrapExpr<Expr<SomeType>>(args[0]);
482 CHECK(x != nullptr);
483 if (const auto *mold{UnwrapExpr<Expr<SomeType>>(args[1])}) {
484 DynamicType xType{x->GetType().value()};
485 std::optional<Expr<LogicalResult>> result;
486 bool alwaysFalse{false};
487 if (auto *iXExpr{UnwrapExpr<Expr<SomeInteger>>(*x)}) {
488 int iXKind{iXExpr->GetType().value().kind()};
489 if (auto *iMoldExpr{UnwrapExpr<Expr<SomeInteger>>(*mold)}) {
490 // INTEGER -> INTEGER
491 int iMoldKind{iMoldExpr->GetType().value().kind()};
492 if (auto hi{IntToIntBound(iXKind, iMoldKind)}) {
493 // 'hi' is INT(HUGE(mold), KIND(x))
494 // OUT_OF_RANGE(x,mold) = (x + (hi + 1)) .UGT. (2*hi + 1)
495 auto one{DEREF(UnwrapExpr<Expr<SomeInteger>>(ConvertToType(
496 xType, AsGenericExpr(Constant<SubscriptInteger>{1}))))};
497 auto lhs{std::move(*iXExpr) +
498 (Expr<SomeInteger>{*hi} + Expr<SomeInteger>{one})};
499 auto two{DEREF(UnwrapExpr<Expr<SomeInteger>>(ConvertToType(
500 xType, AsGenericExpr(Constant<SubscriptInteger>{2}))))};
501 auto rhs{std::move(two) * std::move(*hi) + std::move(one)};
502 result = CompareUnsigned(context, "bgt",
503 Expr<SomeType>{std::move(lhs)}, Expr<SomeType>{std::move(rhs)});
504 } else {
505 alwaysFalse = true;
506 }
507 } else if (auto *rMoldExpr{UnwrapExpr<Expr<SomeReal>>(*mold)}) {
508 // INTEGER -> REAL
509 int rMoldKind{rMoldExpr->GetType().value().kind()};
510 if (auto hi{IntToRealBound(iXKind, rMoldKind, /*negate=*/false)}) {
511 // OUT_OF_RANGE(x,mold) = (x - lo) .UGT. (hi - lo)
512 auto lo{IntToRealBound(iXKind, rMoldKind, /*negate=*/true)};
513 CHECK(lo.has_value());
514 auto lhs{std::move(*iXExpr) - Expr<SomeInteger>{*lo}};
515 auto rhs{std::move(*hi) - std::move(*lo)};
516 result = CompareUnsigned(context, "bgt",
517 Expr<SomeType>{std::move(lhs)}, Expr<SomeType>{std::move(rhs)});
518 } else {
519 alwaysFalse = true;
520 }
521 }
522 } else if (auto *rXExpr{UnwrapExpr<Expr<SomeReal>>(*x)}) {
523 int rXKind{rXExpr->GetType().value().kind()};
524 if (auto *iMoldExpr{UnwrapExpr<Expr<SomeInteger>>(*mold)}) {
525 // REAL -> INTEGER
526 int iMoldKind{iMoldExpr->GetType().value().kind()};
527 auto hi{RealToIntBound(rXKind, iMoldKind, false, false)};
528 auto lo{RealToIntBound(rXKind, iMoldKind, false, true)};
529 if (args.size() >= 3) {
530 // Bounds depend on round= value
531 if (auto *round{UnwrapExpr<Expr<SomeType>>(args[2])}) {
532 if (const Symbol * whole{UnwrapWholeSymbolDataRef(*round)};
533 whole && semantics::IsOptional(whole->GetUltimate())) {
534 if (auto source{args[2]->sourceLocation()}) {
535 context.messages().Say(*source,
536 "ROUND= argument to OUT_OF_RANGE() is an optional dummy argument that must be present at execution"_warn_en_US);
537 }
538 }
539 auto rlo{RealToIntBound(rXKind, iMoldKind, true, true)};
540 auto rhi{RealToIntBound(rXKind, iMoldKind, true, false)};
541 auto mlo{Fold(context,
542 ApplyIntrinsic(context, "merge",
543 ActualArguments{
544 ActualArgument{Expr<SomeType>{std::move(rlo)}},
545 ActualArgument{Expr<SomeType>{std::move(lo)}},
546 ActualArgument{Expr<SomeType>{*round}}}))};
547 auto mhi{Fold(context,
548 ApplyIntrinsic(context, "merge",
549 ActualArguments{
550 ActualArgument{Expr<SomeType>{std::move(rhi)}},
551 ActualArgument{Expr<SomeType>{std::move(hi)}},
552 ActualArgument{std::move(*round)}}))};
553 lo = std::move(DEREF(UnwrapExpr<Expr<SomeReal>>(mlo)));
554 hi = std::move(DEREF(UnwrapExpr<Expr<SomeReal>>(mhi)));
555 }
556 }
557 // OUT_OF_RANGE(x,mold[,round]) =
558 // TRANSFER(x - lo, int) .UGT. TRANSFER(hi - lo, int)
559 hi = Fold(context, std::move(hi));
560 lo = Fold(context, std::move(lo));
561 if (auto rhs{RealToIntLimit(context, std::move(hi), lo)}) {
562 Expr<SomeReal> lhs{std::move(*rXExpr) - std::move(lo)};
563 result = CompareUnsigned(context, "bgt",
564 GetRealBits(context, std::move(lhs)),
565 GetRealBits(context, std::move(*rhs)));
566 }
567 } else if (auto *rMoldExpr{UnwrapExpr<Expr<SomeReal>>(*mold)}) {
568 // REAL -> REAL
569 // Only finite arguments with ABS(x) > HUGE(mold) are .TRUE.
570 // OUT_OF_RANGE(x,mold) =
571 // TRANSFER(ABS(x) - HUGE(mold), int) - 1 .ULT.
572 // TRANSFER(HUGE(mold), int)
573 // Note that OUT_OF_RANGE(+/-Inf or NaN,mold) =
574 // TRANSFER(+Inf or Nan, int) - 1 .ULT. TRANSFER(HUGE(mold), int)
575 int rMoldKind{rMoldExpr->GetType().value().kind()};
576 if (auto bounds{RealToRealBounds(rXKind, rMoldKind)}) {
577 auto &[moldHuge, xHuge]{*bounds};
578 Expr<SomeType> abs{ApplyIntrinsic(context, "abs",
579 ActualArguments{
580 ActualArgument{Expr<SomeType>{std::move(*rXExpr)}}})};
581 auto &absR{DEREF(UnwrapExpr<Expr<SomeReal>>(abs))};
582 Expr<SomeType> diffBits{
583 GetRealBits(context, std::move(absR) - std::move(moldHuge))};
584 auto &diffBitsI{DEREF(UnwrapExpr<Expr<SomeInteger>>(diffBits))};
585 Expr<SomeType> decr{std::move(diffBitsI) -
586 Expr<SomeInteger>{Expr<SubscriptInteger>{1}}};
587 result = CompareUnsigned(context, "blt", std::move(decr),
588 GetRealBits(context, std::move(xHuge)));
589 } else {
590 alwaysFalse = true;
591 }
592 }
593 }
594 if (alwaysFalse) {
595 // xType can never overflow moldType, so
596 // OUT_OF_RANGE(x) = (x /= 0) .AND. .FALSE.
597 // which has the same shape as x.
598 Expr<LogicalResult> scalarFalse{
599 Constant<LogicalResult>{Scalar<LogicalResult>{false}}};
600 if (x->Rank() > 0) {
601 if (auto nez{Relate(context.messages(), RelationalOperator::NE,
602 std::move(*x),
603 AsGenericExpr(Constant<SubscriptInteger>{0}))}) {
604 result = Expr<LogicalResult>{LogicalOperation<LogicalResult::kind>{
605 LogicalOperator::And, std::move(*nez), std::move(scalarFalse)}};
606 }
607 } else {
608 result = std::move(scalarFalse);
609 }
610 }
611 if (result) {
612 auto restorer{context.messages().DiscardMessages()};
613 return Fold(
614 context, AsExpr(ConvertToType<ResultType>(std::move(*result))));
615 }
616 }
617 }
618 return AsExpr(std::move(funcRef));
619}
620
621template <int KIND>
622Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
623 FoldingContext &context,
624 FunctionRef<Type<TypeCategory::Logical, KIND>> &&funcRef) {
625 using T = Type<TypeCategory::Logical, KIND>;
626 ActualArguments &args{funcRef.arguments()};
627 auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
628 CHECK(intrinsic);
629 std::string name{intrinsic->name};
630 using SameInt = Type<TypeCategory::Integer, KIND>;
631 if (name == "all") {
632 return FoldAllAnyParity(
633 context, std::move(funcRef), &Scalar<T>::AND, Scalar<T>{true});
634 } else if (name == "any") {
635 return FoldAllAnyParity(
636 context, std::move(funcRef), &Scalar<T>::OR, Scalar<T>{false});
637 } else if (name == "associated") {
638 bool gotConstant{true};
639 const Expr<SomeType> *firstArgExpr{args[0]->UnwrapExpr()};
640 if (!firstArgExpr || !IsNullPointer(*firstArgExpr)) {
641 gotConstant = false;
642 } else if (args[1]) { // There's a second argument
643 const Expr<SomeType> *secondArgExpr{args[1]->UnwrapExpr()};
644 if (!secondArgExpr || !IsNullPointer(*secondArgExpr)) {
645 gotConstant = false;
646 }
647 }
648 return gotConstant ? Expr<T>{false} : Expr<T>{std::move(funcRef)};
649 } else if (name == "bge" || name == "bgt" || name == "ble" || name == "blt") {
650 static_assert(std::is_same_v<Scalar<LargestInt>, BOZLiteralConstant>);
651
652 // The arguments to these intrinsics can be of different types. In that
653 // case, the shorter of the two would need to be zero-extended to match
654 // the size of the other. If at least one of the operands is not a constant,
655 // the zero-extending will be done during lowering. Otherwise, the folding
656 // must be done here.
657 std::optional<Expr<SomeType>> constArgs[2];
658 for (int i{0}; i <= 1; i++) {
659 if (BOZLiteralConstant * x{UnwrapExpr<BOZLiteralConstant>(args[i])}) {
660 constArgs[i] = AsGenericExpr(Constant<LargestInt>{std::move(*x)});
661 } else if (auto *x{UnwrapExpr<Expr<SomeInteger>>(args[i])}) {
662 common::visit(
663 [&](const auto &ix) {
664 using IntT = typename std::decay_t<decltype(ix)>::Result;
665 if (auto *c{UnwrapConstantValue<IntT>(ix)}) {
666 constArgs[i] = ZeroExtend(*c);
667 }
668 },
669 x->u);
670 }
671 }
672
673 if (constArgs[0] && constArgs[1]) {
674 auto fptr{&Scalar<LargestInt>::BGE};
675 if (name == "bge") { // done in fptr declaration
676 } else if (name == "bgt") {
677 fptr = &Scalar<LargestInt>::BGT;
678 } else if (name == "ble") {
679 fptr = &Scalar<LargestInt>::BLE;
680 } else if (name == "blt") {
681 fptr = &Scalar<LargestInt>::BLT;
682 } else {
683 common::die("missing case to fold intrinsic function %s", name.c_str());
684 }
685
686 for (int i{0}; i <= 1; i++) {
687 *args[i] = std::move(constArgs[i].value());
688 }
689
690 return FoldElementalIntrinsic<T, LargestInt, LargestInt>(context,
691 std::move(funcRef),
692 ScalarFunc<T, LargestInt, LargestInt>(
693 [&fptr](
694 const Scalar<LargestInt> &i, const Scalar<LargestInt> &j) {
695 return Scalar<T>{std::invoke(fptr, i, j)};
696 }));
697 } else {
698 return Expr<T>{std::move(funcRef)};
699 }
700 } else if (name == "btest") {
701 if (const auto *ix{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
702 return common::visit(
703 [&](const auto &x) {
704 using IT = ResultType<decltype(x)>;
705 return FoldElementalIntrinsic<T, IT, SameInt>(context,
706 std::move(funcRef),
707 ScalarFunc<T, IT, SameInt>(
708 [&](const Scalar<IT> &x, const Scalar<SameInt> &pos) {
709 auto posVal{pos.ToInt64()};
710 if (posVal < 0 || posVal >= x.bits) {
711 context.messages().Say(
712 "POS=%jd out of range for BTEST"_err_en_US,
713 static_cast<std::intmax_t>(posVal));
714 }
715 return Scalar<T>{x.BTEST(posVal)};
716 }));
717 },
718 ix->u);
719 }
720 } else if (name == "dot_product") {
721 return FoldDotProduct<T>(context, std::move(funcRef));
722 } else if (name == "extends_type_of") {
723 // Type extension testing with EXTENDS_TYPE_OF() ignores any type
724 // parameters. Returns a constant truth value when the result is known now.
725 if (args[0] && args[1]) {
726 auto t0{args[0]->GetType()};
727 auto t1{args[1]->GetType()};
728 if (t0 && t1) {
729 if (auto result{t0->ExtendsTypeOf(*t1)}) {
730 return Expr<T>{*result};
731 }
732 }
733 }
734 } else if (name == "isnan" || name == "__builtin_ieee_is_nan") {
735 // Only replace the type of the function if we can do the fold
736 if (args[0] && args[0]->UnwrapExpr() &&
737 IsActuallyConstant(*args[0]->UnwrapExpr())) {
738 auto restorer{context.messages().DiscardMessages()};
739 using DefaultReal = Type<TypeCategory::Real, 4>;
740 return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
741 ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
742 return Scalar<T>{x.IsNotANumber()};
743 }));
744 }
745 } else if (name == "__builtin_ieee_is_negative") {
746 auto restorer{context.messages().DiscardMessages()};
747 using DefaultReal = Type<TypeCategory::Real, 4>;
748 if (args[0] && args[0]->UnwrapExpr() &&
749 IsActuallyConstant(*args[0]->UnwrapExpr())) {
750 return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
751 ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
752 return Scalar<T>{x.IsNegative()};
753 }));
754 }
755 } else if (name == "__builtin_ieee_is_normal") {
756 auto restorer{context.messages().DiscardMessages()};
757 using DefaultReal = Type<TypeCategory::Real, 4>;
758 if (args[0] && args[0]->UnwrapExpr() &&
759 IsActuallyConstant(*args[0]->UnwrapExpr())) {
760 return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
761 ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
762 return Scalar<T>{x.IsNormal()};
763 }));
764 }
765 } else if (name == "is_contiguous") {
766 if (args.at(0)) {
767 if (auto *expr{args[0]->UnwrapExpr()}) {
768 if (auto contiguous{IsContiguous(*expr, context)}) {
769 return Expr<T>{*contiguous};
770 }
771 } else if (auto *assumedType{args[0]->GetAssumedTypeDummy()}) {
772 if (auto contiguous{IsContiguous(*assumedType, context)}) {
773 return Expr<T>{*contiguous};
774 }
775 }
776 }
777 } else if (name == "is_iostat_end") {
778 if (args[0] && args[0]->UnwrapExpr() &&
779 IsActuallyConstant(*args[0]->UnwrapExpr())) {
780 using Int64 = Type<TypeCategory::Integer, 8>;
781 return FoldElementalIntrinsic<T, Int64>(context, std::move(funcRef),
782 ScalarFunc<T, Int64>([](const Scalar<Int64> &x) {
783 return Scalar<T>{x.ToInt64() == FORTRAN_RUNTIME_IOSTAT_END};
784 }));
785 }
786 } else if (name == "is_iostat_eor") {
787 if (args[0] && args[0]->UnwrapExpr() &&
788 IsActuallyConstant(*args[0]->UnwrapExpr())) {
789 using Int64 = Type<TypeCategory::Integer, 8>;
790 return FoldElementalIntrinsic<T, Int64>(context, std::move(funcRef),
791 ScalarFunc<T, Int64>([](const Scalar<Int64> &x) {
792 return Scalar<T>{x.ToInt64() == FORTRAN_RUNTIME_IOSTAT_EOR};
793 }));
794 }
795 } else if (name == "lge" || name == "lgt" || name == "lle" || name == "llt") {
796 // Rewrite LGE/LGT/LLE/LLT into ASCII character relations
797 auto *cx0{UnwrapExpr<Expr<SomeCharacter>>(args[0])};
798 auto *cx1{UnwrapExpr<Expr<SomeCharacter>>(args[1])};
799 if (cx0 && cx1) {
800 return Fold(context,
801 ConvertToType<T>(
802 PackageRelation(name == "lge" ? RelationalOperator::GE
803 : name == "lgt" ? RelationalOperator::GT
804 : name == "lle" ? RelationalOperator::LE
805 : RelationalOperator::LT,
806 ConvertToType<Ascii>(std::move(*cx0)),
807 ConvertToType<Ascii>(std::move(*cx1)))));
808 }
809 } else if (name == "logical") {
810 if (auto *expr{UnwrapExpr<Expr<SomeLogical>>(args[0])}) {
811 return Fold(context, ConvertToType<T>(std::move(*expr)));
812 }
813 } else if (name == "matmul") {
814 return FoldMatmul(context, std::move(funcRef));
815 } else if (name == "out_of_range") {
816 return RewriteOutOfRange<KIND>(context, std::move(funcRef));
817 } else if (name == "parity") {
818 return FoldAllAnyParity(
819 context, std::move(funcRef), &Scalar<T>::NEQV, Scalar<T>{false});
820 } else if (name == "same_type_as") {
821 // Type equality testing with SAME_TYPE_AS() ignores any type parameters.
822 // Returns a constant truth value when the result is known now.
823 if (args[0] && args[1]) {
824 auto t0{args[0]->GetType()};
825 auto t1{args[1]->GetType()};
826 if (t0 && t1) {
827 if (auto result{t0->SameTypeAs(*t1)}) {
828 return Expr<T>{*result};
829 }
830 }
831 }
832 } else if (name == "__builtin_ieee_support_datatype" ||
833 name == "__builtin_ieee_support_denormal" ||
834 name == "__builtin_ieee_support_divide" ||
835 name == "__builtin_ieee_support_inf" ||
836 name == "__builtin_ieee_support_io" ||
837 name == "__builtin_ieee_support_nan" ||
838 name == "__builtin_ieee_support_sqrt" ||
839 name == "__builtin_ieee_support_standard" ||
840 name == "__builtin_ieee_support_subnormal" ||
841 name == "__builtin_ieee_support_underflow_control") {
842 return Expr<T>{true};
843 }
844 return Expr<T>{std::move(funcRef)};
845}
846
847template <typename T>
848Expr<LogicalResult> FoldOperation(
849 FoldingContext &context, Relational<T> &&relation) {
850 if (auto array{ApplyElementwise(context, relation,
851 std::function<Expr<LogicalResult>(Expr<T> &&, Expr<T> &&)>{
852 [=](Expr<T> &&x, Expr<T> &&y) {
853 return Expr<LogicalResult>{Relational<SomeType>{
854 Relational<T>{relation.opr, std::move(x), std::move(y)}}};
855 }})}) {
856 return *array;
857 }
858 if (auto folded{OperandsAreConstants(relation)}) {
859 bool result{};
860 if constexpr (T::category == TypeCategory::Integer) {
861 result =
862 Satisfies(relation.opr, folded->first.CompareSigned(folded->second));
863 } else if constexpr (T::category == TypeCategory::Real) {
864 result = Satisfies(relation.opr, folded->first.Compare(folded->second));
865 } else if constexpr (T::category == TypeCategory::Complex) {
866 result = (relation.opr == RelationalOperator::EQ) ==
867 folded->first.Equals(folded->second);
868 } else if constexpr (T::category == TypeCategory::Character) {
869 result = Satisfies(relation.opr, Compare(folded->first, folded->second));
870 } else {
871 static_assert(T::category != TypeCategory::Logical);
872 }
873 return Expr<LogicalResult>{Constant<LogicalResult>{result}};
874 }
875 return Expr<LogicalResult>{Relational<SomeType>{std::move(relation)}};
876}
877
878Expr<LogicalResult> FoldOperation(
879 FoldingContext &context, Relational<SomeType> &&relation) {
880 return common::visit(
881 [&](auto &&x) {
882 return Expr<LogicalResult>{FoldOperation(context, std::move(x))};
883 },
884 std::move(relation.u));
885}
886
887template <int KIND>
888Expr<Type<TypeCategory::Logical, KIND>> FoldOperation(
889 FoldingContext &context, Not<KIND> &&x) {
890 if (auto array{ApplyElementwise(context, x)}) {
891 return *array;
892 }
893 using Ty = Type<TypeCategory::Logical, KIND>;
894 auto &operand{x.left()};
895 if (auto value{GetScalarConstantValue<Ty>(operand)}) {
896 return Expr<Ty>{Constant<Ty>{!value->IsTrue()}};
897 }
898 return Expr<Ty>{x};
899}
900
901template <int KIND>
902Expr<Type<TypeCategory::Logical, KIND>> FoldOperation(
903 FoldingContext &context, LogicalOperation<KIND> &&operation) {
904 using LOGICAL = Type<TypeCategory::Logical, KIND>;
905 if (auto array{ApplyElementwise(context, operation,
906 std::function<Expr<LOGICAL>(Expr<LOGICAL> &&, Expr<LOGICAL> &&)>{
907 [=](Expr<LOGICAL> &&x, Expr<LOGICAL> &&y) {
908 return Expr<LOGICAL>{LogicalOperation<KIND>{
909 operation.logicalOperator, std::move(x), std::move(y)}};
910 }})}) {
911 return *array;
912 }
913 if (auto folded{OperandsAreConstants(operation)}) {
914 bool xt{folded->first.IsTrue()}, yt{folded->second.IsTrue()}, result{};
915 switch (operation.logicalOperator) {
916 case LogicalOperator::And:
917 result = xt && yt;
918 break;
919 case LogicalOperator::Or:
920 result = xt || yt;
921 break;
922 case LogicalOperator::Eqv:
923 result = xt == yt;
924 break;
925 case LogicalOperator::Neqv:
926 result = xt != yt;
927 break;
928 case LogicalOperator::Not:
929 DIE("not a binary operator");
930 }
931 return Expr<LOGICAL>{Constant<LOGICAL>{result}};
932 }
933 return Expr<LOGICAL>{std::move(operation)};
934}
935
936#ifdef _MSC_VER // disable bogus warning about missing definitions
937#pragma warning(disable : 4661)
938#endif
939FOR_EACH_LOGICAL_KIND(template class ExpressionBase, )
940template class ExpressionBase<SomeLogical>;
941} // namespace Fortran::evaluate
942

source code of flang/lib/Evaluate/fold-logical.cpp