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

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