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 15 namespace Fortran::evaluate { 16 17 template <typename T> 18 static 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 28 template <typename T> 29 static 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 49 template <int X_RKIND, int MOLD_IKIND> 50 Expr<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 88 static 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 133 class RealToIntLimitHelper { 134 public: 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 173 private: 174 FoldingContext &context_; 175 Expr<SomeReal> hi_; 176 Expr<SomeReal> &lo_; 177 }; 178 179 static 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. 186 template <int X_RKIND, int MOLD_RKIND> 187 std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>> 188 RealToRealBoundsHelper() { 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 201 static std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>> 202 RealToRealBounds(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 249 template <int X_IKIND, int MOLD_RKIND> 250 std::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 287 static 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 332 template <int X_IKIND, int MOLD_IKIND> 333 std::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 346 static 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? 391 class IntrinsicCallHelper { 392 public: 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 411 private: 412 SpecificCall call_; 413 const characteristics::Procedure &proc_{ 414 call_.specificIntrinsic.characteristics.value()}; 415 const characteristics::TypeAndShape *typeAndShape_{nullptr}; 416 }; 417 418 static 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 428 static 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. 437 static 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 456 static 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 466 template <int KIND> 467 static 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 625 static 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 643 template <int KIND> 644 Expr<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 == "any") { 656 return FoldAllAnyParity( 657 context, std::move(funcRef), &Scalar<T>::OR, Scalar<T>{false}); 658 } else if (name == "associated") { 659 bool gotConstant{true}; 660 const Expr<SomeType> *firstArgExpr{args[0]->UnwrapExpr()}; 661 if (!firstArgExpr || !IsNullPointer(*firstArgExpr)) { 662 gotConstant = false; 663 } else if (args[1]) { // There's a second argument 664 const Expr<SomeType> *secondArgExpr{args[1]->UnwrapExpr()}; 665 if (!secondArgExpr || !IsNullPointer(*secondArgExpr)) { 666 gotConstant = false; 667 } 668 } 669 return gotConstant ? Expr<T>{false} : Expr<T>{std::move(funcRef)}; 670 } else if (name == "bge" || name == "bgt" || name == "ble" || name == "blt") { 671 static_assert(std::is_same_v<Scalar<LargestInt>, BOZLiteralConstant>); 672 673 // The arguments to these intrinsics can be of different types. In that 674 // case, the shorter of the two would need to be zero-extended to match 675 // the size of the other. If at least one of the operands is not a constant, 676 // the zero-extending will be done during lowering. Otherwise, the folding 677 // must be done here. 678 std::optional<Expr<SomeType>> constArgs[2]; 679 for (int i{0}; i <= 1; i++) { 680 if (BOZLiteralConstant * x{UnwrapExpr<BOZLiteralConstant>(args[i])}) { 681 constArgs[i] = AsGenericExpr(Constant<LargestInt>{std::move(*x)}); 682 } else if (auto *x{UnwrapExpr<Expr<SomeInteger>>(args[i])}) { 683 common::visit( 684 [&](const auto &ix) { 685 using IntT = typename std::decay_t<decltype(ix)>::Result; 686 if (auto *c{UnwrapConstantValue<IntT>(ix)}) { 687 constArgs[i] = ZeroExtend(*c); 688 } 689 }, 690 x->u); 691 } 692 } 693 694 if (constArgs[0] && constArgs[1]) { 695 auto fptr{&Scalar<LargestInt>::BGE}; 696 if (name == "bge") { // done in fptr declaration 697 } else if (name == "bgt") { 698 fptr = &Scalar<LargestInt>::BGT; 699 } else if (name == "ble") { 700 fptr = &Scalar<LargestInt>::BLE; 701 } else if (name == "blt") { 702 fptr = &Scalar<LargestInt>::BLT; 703 } else { 704 common::die("missing case to fold intrinsic function %s", name.c_str()); 705 } 706 707 for (int i{0}; i <= 1; i++) { 708 *args[i] = std::move(constArgs[i].value()); 709 } 710 711 return FoldElementalIntrinsic<T, LargestInt, LargestInt>(context, 712 std::move(funcRef), 713 ScalarFunc<T, LargestInt, LargestInt>( 714 [&fptr]( 715 const Scalar<LargestInt> &i, const Scalar<LargestInt> &j) { 716 return Scalar<T>{std::invoke(fptr, i, j)}; 717 })); 718 } else { 719 return Expr<T>{std::move(funcRef)}; 720 } 721 } else if (name == "btest") { 722 using SameInt = Type<TypeCategory::Integer, KIND>; 723 if (const auto *ix{UnwrapExpr<Expr<SomeInteger>>(args[0])}) { 724 return common::visit( 725 [&](const auto &x) { 726 using IT = ResultType<decltype(x)>; 727 return FoldElementalIntrinsic<T, IT, SameInt>(context, 728 std::move(funcRef), 729 ScalarFunc<T, IT, SameInt>( 730 [&](const Scalar<IT> &x, const Scalar<SameInt> &pos) { 731 auto posVal{pos.ToInt64()}; 732 if (posVal < 0 || posVal >= x.bits) { 733 context.messages().Say( 734 "POS=%jd out of range for BTEST"_err_en_US, 735 static_cast<std::intmax_t>(posVal)); 736 } 737 return Scalar<T>{x.BTEST(posVal)}; 738 })); 739 }, 740 ix->u); 741 } else if (const auto *ux{UnwrapExpr<Expr<SomeUnsigned>>(args[0])}) { 742 return common::visit( 743 [&](const auto &x) { 744 using UT = ResultType<decltype(x)>; 745 return FoldElementalIntrinsic<T, UT, SameInt>(context, 746 std::move(funcRef), 747 ScalarFunc<T, UT, SameInt>( 748 [&](const Scalar<UT> &x, const Scalar<SameInt> &pos) { 749 auto posVal{pos.ToInt64()}; 750 if (posVal < 0 || posVal >= x.bits) { 751 context.messages().Say( 752 "POS=%jd out of range for BTEST"_err_en_US, 753 static_cast<std::intmax_t>(posVal)); 754 } 755 return Scalar<T>{x.BTEST(posVal)}; 756 })); 757 }, 758 ux->u); 759 } 760 } else if (name == "dot_product") { 761 return FoldDotProduct<T>(context, std::move(funcRef)); 762 } else if (name == "extends_type_of") { 763 // Type extension testing with EXTENDS_TYPE_OF() ignores any type 764 // parameters. Returns a constant truth value when the result is known now. 765 if (args[0] && args[1]) { 766 auto t0{args[0]->GetType()}; 767 auto t1{args[1]->GetType()}; 768 if (t0 && t1) { 769 if (auto result{t0->ExtendsTypeOf(*t1)}) { 770 return Expr<T>{*result}; 771 } 772 } 773 } 774 } else if (name == "isnan" || name == "__builtin_ieee_is_nan") { 775 // Only replace the type of the function if we can do the fold 776 if (args[0] && args[0]->UnwrapExpr() && 777 IsActuallyConstant(*args[0]->UnwrapExpr())) { 778 auto restorer{context.messages().DiscardMessages()}; 779 using DefaultReal = Type<TypeCategory::Real, 4>; 780 return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef), 781 ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) { 782 return Scalar<T>{x.IsNotANumber()}; 783 })); 784 } 785 } else if (name == "__builtin_ieee_is_negative") { 786 auto restorer{context.messages().DiscardMessages()}; 787 using DefaultReal = Type<TypeCategory::Real, 4>; 788 if (args[0] && args[0]->UnwrapExpr() && 789 IsActuallyConstant(*args[0]->UnwrapExpr())) { 790 return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef), 791 ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) { 792 return Scalar<T>{x.IsNegative()}; 793 })); 794 } 795 } else if (name == "__builtin_ieee_is_normal") { 796 auto restorer{context.messages().DiscardMessages()}; 797 using DefaultReal = Type<TypeCategory::Real, 4>; 798 if (args[0] && args[0]->UnwrapExpr() && 799 IsActuallyConstant(*args[0]->UnwrapExpr())) { 800 return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef), 801 ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) { 802 return Scalar<T>{x.IsNormal()}; 803 })); 804 } 805 } else if (name == "is_contiguous") { 806 if (args.at(0)) { 807 if (auto *expr{args[0]->UnwrapExpr()}) { 808 if (auto contiguous{IsContiguous(*expr, context)}) { 809 return Expr<T>{*contiguous}; 810 } 811 } else if (auto *assumedType{args[0]->GetAssumedTypeDummy()}) { 812 if (auto contiguous{IsContiguous(*assumedType, context)}) { 813 return Expr<T>{*contiguous}; 814 } 815 } 816 } 817 } else if (name == "is_iostat_end") { 818 if (args[0] && args[0]->UnwrapExpr() && 819 IsActuallyConstant(*args[0]->UnwrapExpr())) { 820 using Int64 = Type<TypeCategory::Integer, 8>; 821 return FoldElementalIntrinsic<T, Int64>(context, std::move(funcRef), 822 ScalarFunc<T, Int64>([](const Scalar<Int64> &x) { 823 return Scalar<T>{x.ToInt64() == FORTRAN_RUNTIME_IOSTAT_END}; 824 })); 825 } 826 } else if (name == "is_iostat_eor") { 827 if (args[0] && args[0]->UnwrapExpr() && 828 IsActuallyConstant(*args[0]->UnwrapExpr())) { 829 using Int64 = Type<TypeCategory::Integer, 8>; 830 return FoldElementalIntrinsic<T, Int64>(context, std::move(funcRef), 831 ScalarFunc<T, Int64>([](const Scalar<Int64> &x) { 832 return Scalar<T>{x.ToInt64() == FORTRAN_RUNTIME_IOSTAT_EOR}; 833 })); 834 } 835 } else if (name == "lge" || name == "lgt" || name == "lle" || name == "llt") { 836 // Rewrite LGE/LGT/LLE/LLT into ASCII character relations 837 auto *cx0{UnwrapExpr<Expr<SomeCharacter>>(args[0])}; 838 auto *cx1{UnwrapExpr<Expr<SomeCharacter>>(args[1])}; 839 if (cx0 && cx1) { 840 return Fold(context, 841 ConvertToType<T>( 842 PackageRelation(name == "lge" ? RelationalOperator::GE 843 : name == "lgt" ? RelationalOperator::GT 844 : name == "lle" ? RelationalOperator::LE 845 : RelationalOperator::LT, 846 ConvertToType<Ascii>(std::move(*cx0)), 847 ConvertToType<Ascii>(std::move(*cx1))))); 848 } 849 } else if (name == "logical") { 850 if (auto *expr{UnwrapExpr<Expr<SomeLogical>>(args[0])}) { 851 return Fold(context, ConvertToType<T>(std::move(*expr))); 852 } 853 } else if (name == "matmul") { 854 return FoldMatmul(context, std::move(funcRef)); 855 } else if (name == "out_of_range") { 856 return RewriteOutOfRange<KIND>(context, std::move(funcRef)); 857 } else if (name == "parity") { 858 return FoldAllAnyParity( 859 context, std::move(funcRef), &Scalar<T>::NEQV, Scalar<T>{false}); 860 } else if (name == "same_type_as") { 861 // Type equality testing with SAME_TYPE_AS() ignores any type parameters. 862 // Returns a constant truth value when the result is known now. 863 if (args[0] && args[1]) { 864 auto t0{args[0]->GetType()}; 865 auto t1{args[1]->GetType()}; 866 if (t0 && t1) { 867 if (auto result{t0->SameTypeAs(*t1)}) { 868 return Expr<T>{*result}; 869 } 870 } 871 } 872 } else if (name == "__builtin_ieee_support_datatype") { 873 return Expr<T>{true}; 874 } else if (name == "__builtin_ieee_support_denormal") { 875 return Expr<T>{context.targetCharacteristics().ieeeFeatures().test( 876 IeeeFeature::Denormal)}; 877 } else if (name == "__builtin_ieee_support_divide") { 878 return Expr<T>{context.targetCharacteristics().ieeeFeatures().test( 879 IeeeFeature::Divide)}; 880 } else if (name == "__builtin_ieee_support_flag") { 881 return Expr<T>{context.targetCharacteristics().ieeeFeatures().test( 882 IeeeFeature::Flags)}; 883 } else if (name == "__builtin_ieee_support_halting") { 884 if (!context.targetCharacteristics() 885 .haltingSupportIsUnknownAtCompileTime()) { 886 return Expr<T>{context.targetCharacteristics().ieeeFeatures().test( 887 IeeeFeature::Halting)}; 888 } 889 } else if (name == "__builtin_ieee_support_inf") { 890 return Expr<T>{ 891 context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::Inf)}; 892 } else if (name == "__builtin_ieee_support_io") { 893 return Expr<T>{ 894 context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::Io)}; 895 } else if (name == "__builtin_ieee_support_nan") { 896 return Expr<T>{ 897 context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::NaN)}; 898 } else if (name == "__builtin_ieee_support_rounding") { 899 if (context.targetCharacteristics().ieeeFeatures().test( 900 IeeeFeature::Rounding)) { 901 if (auto mode{GetRoundingMode(args[0])}) { 902 return Expr<T>{mode != common::RoundingMode::TiesAwayFromZero}; 903 } 904 } 905 } else if (name == "__builtin_ieee_support_sqrt") { 906 return Expr<T>{ 907 context.targetCharacteristics().ieeeFeatures().test(IeeeFeature::Sqrt)}; 908 } else if (name == "__builtin_ieee_support_standard") { 909 return Expr<T>{context.targetCharacteristics().ieeeFeatures().test( 910 IeeeFeature::Standard)}; 911 } else if (name == "__builtin_ieee_support_subnormal") { 912 return Expr<T>{context.targetCharacteristics().ieeeFeatures().test( 913 IeeeFeature::Subnormal)}; 914 } else if (name == "__builtin_ieee_support_underflow_control") { 915 // Setting kind=0 checks subnormal flushing control across all type kinds. 916 if (args[0]) { 917 return Expr<T>{ 918 context.targetCharacteristics().hasSubnormalFlushingControl( 919 args[0]->GetType().value().kind())}; 920 } else { 921 return Expr<T>{ 922 context.targetCharacteristics().hasSubnormalFlushingControl( 923 /*any=*/false)}; 924 } 925 } 926 return Expr<T>{std::move(funcRef)}; 927 } 928 929 template <typename T> 930 Expr<LogicalResult> FoldOperation( 931 FoldingContext &context, Relational<T> &&relation) { 932 if (auto array{ApplyElementwise(context, relation, 933 std::function<Expr<LogicalResult>(Expr<T> &&, Expr<T> &&)>{ 934 [=](Expr<T> &&x, Expr<T> &&y) { 935 return Expr<LogicalResult>{Relational<SomeType>{ 936 Relational<T>{relation.opr, std::move(x), std::move(y)}}}; 937 }})}) { 938 return *array; 939 } 940 if (auto folded{OperandsAreConstants(relation)}) { 941 bool result{}; 942 if constexpr (T::category == TypeCategory::Integer) { 943 result = 944 Satisfies(relation.opr, folded->first.CompareSigned(folded->second)); 945 } else if constexpr (T::category == TypeCategory::Unsigned) { 946 result = Satisfies( 947 relation.opr, folded->first.CompareUnsigned(folded->second)); 948 } else if constexpr (T::category == TypeCategory::Real) { 949 result = Satisfies(relation.opr, folded->first.Compare(folded->second)); 950 } else if constexpr (T::category == TypeCategory::Complex) { 951 result = (relation.opr == RelationalOperator::EQ) == 952 folded->first.Equals(folded->second); 953 } else if constexpr (T::category == TypeCategory::Character) { 954 result = Satisfies(relation.opr, Compare(folded->first, folded->second)); 955 } else { 956 static_assert(T::category != TypeCategory::Logical); 957 } 958 return Expr<LogicalResult>{Constant<LogicalResult>{result}}; 959 } 960 return Expr<LogicalResult>{Relational<SomeType>{std::move(relation)}}; 961 } 962 963 Expr<LogicalResult> FoldOperation( 964 FoldingContext &context, Relational<SomeType> &&relation) { 965 return common::visit( 966 [&](auto &&x) { 967 return Expr<LogicalResult>{FoldOperation(context, std::move(x))}; 968 }, 969 std::move(relation.u)); 970 } 971 972 template <int KIND> 973 Expr<Type<TypeCategory::Logical, KIND>> FoldOperation( 974 FoldingContext &context, Not<KIND> &&x) { 975 if (auto array{ApplyElementwise(context, x)}) { 976 return *array; 977 } 978 using Ty = Type<TypeCategory::Logical, KIND>; 979 auto &operand{x.left()}; 980 if (auto value{GetScalarConstantValue<Ty>(operand)}) { 981 return Expr<Ty>{Constant<Ty>{!value->IsTrue()}}; 982 } 983 return Expr<Ty>{x}; 984 } 985 986 template <int KIND> 987 Expr<Type<TypeCategory::Logical, KIND>> FoldOperation( 988 FoldingContext &context, LogicalOperation<KIND> &&operation) { 989 using LOGICAL = Type<TypeCategory::Logical, KIND>; 990 if (auto array{ApplyElementwise(context, operation, 991 std::function<Expr<LOGICAL>(Expr<LOGICAL> &&, Expr<LOGICAL> &&)>{ 992 [=](Expr<LOGICAL> &&x, Expr<LOGICAL> &&y) { 993 return Expr<LOGICAL>{LogicalOperation<KIND>{ 994 operation.logicalOperator, std::move(x), std::move(y)}}; 995 }})}) { 996 return *array; 997 } 998 if (auto folded{OperandsAreConstants(operation)}) { 999 bool xt{folded->first.IsTrue()}, yt{folded->second.IsTrue()}, result{}; 1000 switch (operation.logicalOperator) { 1001 case LogicalOperator::And: 1002 result = xt && yt; 1003 break; 1004 case LogicalOperator::Or: 1005 result = xt || yt; 1006 break; 1007 case LogicalOperator::Eqv: 1008 result = xt == yt; 1009 break; 1010 case LogicalOperator::Neqv: 1011 result = xt != yt; 1012 break; 1013 case LogicalOperator::Not: 1014 DIE("not a binary operator"); 1015 } 1016 return Expr<LOGICAL>{Constant<LOGICAL>{result}}; 1017 } 1018 return Expr<LOGICAL>{std::move(operation)}; 1019 } 1020 1021 #ifdef _MSC_VER // disable bogus warning about missing definitions 1022 #pragma warning(disable : 4661) 1023 #endif 1024 FOR_EACH_LOGICAL_KIND(template class ExpressionBase, ) 1025 template class ExpressionBase<SomeLogical>; 1026 } // namespace Fortran::evaluate 1027