flang/lib/Evaluate/variable.cpp

   1 //===-- lib/Evaluate/variable.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 "flang/Evaluate/variable.h"
  10 #include "flang/Common/idioms.h"
  11 #include "flang/Evaluate/check-expression.h"
  12 #include "flang/Evaluate/fold.h"
  13 #include "flang/Evaluate/tools.h"
  14 #include "flang/Parser/char-block.h"
  15 #include "flang/Parser/characters.h"
  16 #include "flang/Parser/message.h"
  17 #include "flang/Semantics/scope.h"
  18 #include "flang/Semantics/symbol.h"
  19 #include <type_traits>
  20
  21 using namespace Fortran::parser::literals;
  22
  23 namespace Fortran::evaluate {
  24
  25 // Constructors, accessors, mutators
  26
  27 Triplet::Triplet() : stride_{Expr<SubscriptInteger>{1}} {}
  28
  29 Triplet::Triplet(std::optional<Expr<SubscriptInteger>> &&l,
  30     std::optional<Expr<SubscriptInteger>> &&u,
  31     std::optional<Expr<SubscriptInteger>> &&s)
  32     : stride_{s ? std::move(*s) : Expr<SubscriptInteger>{1}} {
  33   if (l) {
  34     lower_.emplace(std::move(*l));
  35   }
  36   if (u) {
  37     upper_.emplace(std::move(*u));
  38   }
  39 }
  40
  41 std::optional<Expr<SubscriptInteger>> Triplet::lower() const {
  42   if (lower_) {
  43     return {lower_.value().value()};
  44   }
  45   return std::nullopt;
  46 }
  47
  48 Triplet &Triplet::set_lower(Expr<SubscriptInteger> &&expr) {
  49   lower_.emplace(std::move(expr));
  50   return *this;
  51 }
  52
  53 std::optional<Expr<SubscriptInteger>> Triplet::upper() const {
  54   if (upper_) {
  55     return {upper_.value().value()};
  56   }
  57   return std::nullopt;
  58 }
  59
  60 Triplet &Triplet::set_upper(Expr<SubscriptInteger> &&expr) {
  61   upper_.emplace(std::move(expr));
  62   return *this;
  63 }
  64
  65 Expr<SubscriptInteger> Triplet::stride() const { return stride_.value(); }
  66
  67 Triplet &Triplet::set_stride(Expr<SubscriptInteger> &&expr) {
  68   stride_.value() = std::move(expr);
  69   return *this;
  70 }
  71
  72 CoarrayRef::CoarrayRef(SymbolVector &&base, std::vector<Subscript> &&ss,
  73     std::vector<Expr<SubscriptInteger>> &&css)
  74     : base_{std::move(base)}, subscript_(std::move(ss)),
  75       cosubscript_(std::move(css)) {
  76   CHECK(!base_.empty());
  77   CHECK(!cosubscript_.empty());
  78 }
  79
  80 std::optional<Expr<SomeInteger>> CoarrayRef::stat() const {
  81   if (stat_) {
  82     return stat_.value().value();
  83   } else {
  84     return std::nullopt;
  85   }
  86 }
  87
  88 std::optional<Expr<SomeInteger>> CoarrayRef::team() const {
  89   if (team_) {
  90     return team_.value().value();
  91   } else {
  92     return std::nullopt;
  93   }
  94 }
  95
  96 CoarrayRef &CoarrayRef::set_stat(Expr<SomeInteger> &&v) {
  97   CHECK(IsVariable(v));
  98   stat_.emplace(std::move(v));
  99   return *this;
 100 }
 101
 102 CoarrayRef &CoarrayRef::set_team(Expr<SomeInteger> &&v, bool isTeamNumber) {
 103   CHECK(IsVariable(v));
 104   team_.emplace(std::move(v));
 105   teamIsTeamNumber_ = isTeamNumber;
 106   return *this;
 107 }
 108
 109 const Symbol &CoarrayRef::GetFirstSymbol() const { return base_.front(); }
 110
 111 const Symbol &CoarrayRef::GetLastSymbol() const { return base_.back(); }
 112
 113 void Substring::SetBounds(std::optional<Expr<SubscriptInteger>> &lower,
 114     std::optional<Expr<SubscriptInteger>> &upper) {
 115   if (lower) {
 116     set_lower(std::move(lower.value()));
 117   }
 118   if (upper) {
 119     set_upper(std::move(upper.value()));
 120   }
 121 }
 122
 123 Expr<SubscriptInteger> Substring::lower() const {
 124   if (lower_) {
 125     return lower_.value().value();
 126   } else {
 127     return AsExpr(Constant<SubscriptInteger>{1});
 128   }
 129 }
 130
 131 Substring &Substring::set_lower(Expr<SubscriptInteger> &&expr) {
 132   lower_.emplace(std::move(expr));
 133   return *this;
 134 }
 135
 136 std::optional<Expr<SubscriptInteger>> Substring::upper() const {
 137   if (upper_) {
 138     return upper_.value().value();
 139   } else {
 140     return common::visit(
 141         common::visitors{
 142             [](const DataRef &dataRef) { return dataRef.LEN(); },
 143             [](const StaticDataObject::Pointer &object)
 144                 -> std::optional<Expr<SubscriptInteger>> {
 145               return AsExpr(Constant<SubscriptInteger>{object->data().size()});
 146             },
 147         },
 148         parent_);
 149   }
 150 }
 151
 152 Substring &Substring::set_upper(Expr<SubscriptInteger> &&expr) {
 153   upper_.emplace(std::move(expr));
 154   return *this;
 155 }
 156
 157 std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
 158   if (!upper_) {
 159     upper_ = upper();
 160     if (!upper_) {
 161       return std::nullopt;
 162     }
 163   }
 164   upper_.value() = evaluate::Fold(context, std::move(upper_.value().value()));
 165   std::optional<ConstantSubscript> ubi{ToInt64(upper_.value().value())};
 166   if (!ubi) {
 167     return std::nullopt;
 168   }
 169   if (!lower_) {
 170     lower_ = AsExpr(Constant<SubscriptInteger>{1});
 171   }
 172   lower_.value() = evaluate::Fold(context, std::move(lower_.value().value()));
 173   std::optional<ConstantSubscript> lbi{ToInt64(lower_.value().value())};
 174   if (!lbi) {
 175     return std::nullopt;
 176   }
 177   if (*lbi > *ubi) { // empty result; canonicalize
 178     *lbi = 1;
 179     *ubi = 0;
 180     lower_ = AsExpr(Constant<SubscriptInteger>{*lbi});
 181     upper_ = AsExpr(Constant<SubscriptInteger>{*ubi});
 182   }
 183   std::optional<ConstantSubscript> length;
 184   std::optional<Expr<SomeCharacter>> strings; // a Constant<Character>
 185   if (const auto *literal{std::get_if<StaticDataObject::Pointer>(&parent_)}) {
 186     length = (*literal)->data().size();
 187     if (auto str{(*literal)->AsString()}) {
 188       strings =
 189           Expr<SomeCharacter>(Expr<Ascii>(Constant<Ascii>{std::move(*str)}));
 190     }
 191   } else if (const auto *dataRef{std::get_if<DataRef>(&parent_)}) {
 192     if (auto expr{AsGenericExpr(DataRef{*dataRef})}) {
 193       auto folded{evaluate::Fold(context, std::move(*expr))};
 194       if (IsActuallyConstant(folded)) {
 195         if (const auto *value{UnwrapExpr<Expr<SomeCharacter>>(folded)}) {
 196           strings = *value;
 197         }
 198       }
 199     }
 200   }
 201   std::optional<Expr<SomeCharacter>> result;
 202   if (strings) {
 203     result = common::visit(
 204         [&](const auto &expr) -> std::optional<Expr<SomeCharacter>> {
 205           using Type = typename std::decay_t<decltype(expr)>::Result;
 206           if (const auto *cc{std::get_if<Constant<Type>>(&expr.u)}) {
 207             if (auto substr{cc->Substring(*lbi, *ubi)}) {
 208               return Expr<SomeCharacter>{Expr<Type>{*substr}};
 209             }
 210           }
 211           return std::nullopt;
 212         },
 213         strings->u);
 214   }
 215   if (!result) { // error cases
 216     if (*lbi < 1) {
 217       if (context.languageFeatures().ShouldWarn(common::UsageWarning::Bounds)) {
 218         context.messages().Say(common::UsageWarning::Bounds,
 219             "Lower bound (%jd) on substring is less than one"_warn_en_US,
 220             static_cast<std::intmax_t>(*lbi));
 221       }
 222       *lbi = 1;
 223       lower_ = AsExpr(Constant<SubscriptInteger>{1});
 224     }
 225     if (length && *ubi > *length) {
 226       if (context.languageFeatures().ShouldWarn(common::UsageWarning::Bounds)) {
 227         context.messages().Say(common::UsageWarning::Bounds,
 228             "Upper bound (%jd) on substring is greater than character length (%jd)"_warn_en_US,
 229             static_cast<std::intmax_t>(*ubi),
 230             static_cast<std::intmax_t>(*length));
 231       }
 232       *ubi = *length;
 233       upper_ = AsExpr(Constant<SubscriptInteger>{*ubi});
 234     }
 235   }
 236   return result;
 237 }
 238
 239 DescriptorInquiry::DescriptorInquiry(
 240     const NamedEntity &base, Field field, int dim)
 241     : base_{base}, field_{field}, dimension_{dim} {
 242   const Symbol &last{base_.GetLastSymbol()};
 243   CHECK(IsDescriptor(last));
 244   CHECK(((field == Field::Len || field == Field::Rank) && dim == 0) ||
 245       (field != Field::Len && dim >= 0 && dim < last.Rank()));
 246 }
 247
 248 DescriptorInquiry::DescriptorInquiry(NamedEntity &&base, Field field, int dim)
 249     : base_{std::move(base)}, field_{field}, dimension_{dim} {
 250   const Symbol &last{base_.GetLastSymbol()};
 251   CHECK(IsDescriptor(last));
 252   CHECK((field == Field::Len && dim == 0) ||
 253       (field != Field::Len && dim >= 0 &&
 254           (dim < last.Rank() || IsAssumedRank(last))));
 255 }
 256
 257 // LEN()
 258 static std::optional<Expr<SubscriptInteger>> SymbolLEN(const Symbol &symbol) {
 259   const Symbol &ultimate{symbol.GetUltimate()};
 260   if (const auto *assoc{ultimate.detailsIf<semantics::AssocEntityDetails>()}) {
 261     if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(assoc->expr())}) {
 262       return chExpr->LEN();
 263     }
 264   }
 265   if (auto dyType{DynamicType::From(ultimate)}) {
 266     auto len{dyType->GetCharLength()};
 267     if (!len && ultimate.attrs().test(semantics::Attr::PARAMETER)) {
 268       // Its initializer determines the length of an implied-length named
 269       // constant.
 270       if (const auto *object{
 271               ultimate.detailsIf<semantics::ObjectEntityDetails>()}) {
 272         if (object->init()) {
 273           if (auto dyType2{DynamicType::From(*object->init())}) {
 274             len = dyType2->GetCharLength();
 275           }
 276         }
 277       }
 278     }
 279     if (len) {
 280       if (auto constLen{ToInt64(*len)}) {
 281         return Expr<SubscriptInteger>{std::max<std::int64_t>(*constLen, 0)};
 282       } else if (ultimate.owner().IsDerivedType() ||
 283           IsScopeInvariantExpr(*len)) {
 284         return AsExpr(Extremum<SubscriptInteger>{
 285             Ordering::Greater, Expr<SubscriptInteger>{0}, std::move(*len)});
 286       }
 287     }
 288   }
 289   if (IsDescriptor(ultimate) && !ultimate.owner().IsDerivedType()) {
 290     return Expr<SubscriptInteger>{
 291         DescriptorInquiry{NamedEntity{symbol}, DescriptorInquiry::Field::Len}};
 292   }
 293   return std::nullopt;
 294 }
 295
 296 std::optional<Expr<SubscriptInteger>> BaseObject::LEN() const {
 297   return common::visit(
 298       common::visitors{
 299           [](const Symbol &symbol) { return SymbolLEN(symbol); },
 300           [](const StaticDataObject::Pointer &object)
 301               -> std::optional<Expr<SubscriptInteger>> {
 302             return AsExpr(Constant<SubscriptInteger>{object->data().size()});
 303           },
 304       },
 305       u);
 306 }
 307
 308 std::optional<Expr<SubscriptInteger>> Component::LEN() const {
 309   return SymbolLEN(GetLastSymbol());
 310 }
 311
 312 std::optional<Expr<SubscriptInteger>> NamedEntity::LEN() const {
 313   return SymbolLEN(GetLastSymbol());
 314 }
 315
 316 std::optional<Expr<SubscriptInteger>> ArrayRef::LEN() const {
 317   return base_.LEN();
 318 }
 319
 320 std::optional<Expr<SubscriptInteger>> CoarrayRef::LEN() const {
 321   return SymbolLEN(GetLastSymbol());
 322 }
 323
 324 std::optional<Expr<SubscriptInteger>> DataRef::LEN() const {
 325   return common::visit(common::visitors{
 326                            [](SymbolRef symbol) { return SymbolLEN(symbol); },
 327                            [](const auto &x) { return x.LEN(); },
 328                        },
 329       u);
 330 }
 331
 332 std::optional<Expr<SubscriptInteger>> Substring::LEN() const {
 333   if (auto top{upper()}) {
 334     return AsExpr(Extremum<SubscriptInteger>{Ordering::Greater,
 335         AsExpr(Constant<SubscriptInteger>{0}),
 336         *std::move(top) - lower() + AsExpr(Constant<SubscriptInteger>{1})});
 337   } else {
 338     return std::nullopt;
 339   }
 340 }
 341
 342 template <typename T>
 343 std::optional<Expr<SubscriptInteger>> Designator<T>::LEN() const {
 344   if constexpr (T::category == TypeCategory::Character) {
 345     return common::visit(common::visitors{
 346                              [](SymbolRef symbol) { return SymbolLEN(symbol); },
 347                              [](const auto &x) { return x.LEN(); },
 348                          },
 349         u);
 350   } else {
 351     common::die("Designator<non-char>::LEN() called");
 352     return std::nullopt;
 353   }
 354 }
 355
 356 std::optional<Expr<SubscriptInteger>> ProcedureDesignator::LEN() const {
 357   using T = std::optional<Expr<SubscriptInteger>>;
 358   return common::visit(
 359       common::visitors{
 360           [](SymbolRef symbol) -> T { return SymbolLEN(symbol); },
 361           [](const common::CopyableIndirection<Component> &c) -> T {
 362             return c.value().LEN();
 363           },
 364           [](const SpecificIntrinsic &i) -> T {
 365             // Some cases whose results' lengths can be determined
 366             // from the lengths of their arguments are handled in
 367             // ProcedureRef::LEN() before coming here.
 368             if (const auto &result{i.characteristics.value().functionResult}) {
 369               if (const auto *type{result->GetTypeAndShape()}) {
 370                 if (auto length{type->type().GetCharLength()}) {
 371                   return std::move(*length);
 372                 }
 373               }
 374             }
 375             return std::nullopt;
 376           },
 377       },
 378       u);
 379 }
 380
 381 // Rank()
 382 int BaseObject::Rank() const {
 383   return common::visit(common::visitors{
 384                            [](SymbolRef symbol) { return symbol->Rank(); },
 385                            [](const StaticDataObject::Pointer &) { return 0; },
 386                        },
 387       u);
 388 }
 389
 390 int Component::Rank() const {
 391   if (int rank{symbol_->Rank()}; rank > 0) {
 392     return rank;
 393   }
 394   return base().Rank();
 395 }
 396
 397 int NamedEntity::Rank() const {
 398   return common::visit(common::visitors{
 399                            [](const SymbolRef s) { return s->Rank(); },
 400                            [](const Component &c) { return c.Rank(); },
 401                        },
 402       u_);
 403 }
 404
 405 int Subscript::Rank() const {
 406   return common::visit(common::visitors{
 407                            [](const IndirectSubscriptIntegerExpr &x) {
 408                              return x.value().Rank();
 409                            },
 410                            [](const Triplet &) { return 1; },
 411                        },
 412       u);
 413 }
 414
 415 int ArrayRef::Rank() const {
 416   int rank{0};
 417   for (const auto &expr : subscript_) {
 418     rank += expr.Rank();
 419   }
 420   if (rank > 0) {
 421     return rank;
 422   } else if (const Component * component{base_.UnwrapComponent()}) {
 423     return component->base().Rank();
 424   } else {
 425     return 0;
 426   }
 427 }
 428
 429 int CoarrayRef::Rank() const {
 430   if (!subscript_.empty()) {
 431     int rank{0};
 432     for (const auto &expr : subscript_) {
 433       rank += expr.Rank();
 434     }
 435     return rank;
 436   } else {
 437     return base_.back()->Rank();
 438   }
 439 }
 440
 441 int DataRef::Rank() const {
 442   return common::visit(common::visitors{
 443                            [](SymbolRef symbol) { return symbol->Rank(); },
 444                            [](const auto &x) { return x.Rank(); },
 445                        },
 446       u);
 447 }
 448
 449 int Substring::Rank() const {
 450   return common::visit(
 451       common::visitors{
 452           [](const DataRef &dataRef) { return dataRef.Rank(); },
 453           [](const StaticDataObject::Pointer &) { return 0; },
 454       },
 455       parent_);
 456 }
 457
 458 int ComplexPart::Rank() const { return complex_.Rank(); }
 459
 460 template <typename T> int Designator<T>::Rank() const {
 461   return common::visit(common::visitors{
 462                            [](SymbolRef symbol) { return symbol->Rank(); },
 463                            [](const auto &x) { return x.Rank(); },
 464                        },
 465       u);
 466 }
 467
 468 // Corank()
 469 int BaseObject::Corank() const {
 470   return common::visit(common::visitors{
 471                            [](SymbolRef symbol) { return symbol->Corank(); },
 472                            [](const StaticDataObject::Pointer &) { return 0; },
 473                        },
 474       u);
 475 }
 476
 477 int Component::Corank() const {
 478   if (int corank{symbol_->Corank()}; corank > 0) {
 479     return corank;
 480   }
 481   return base().Corank();
 482 }
 483
 484 int NamedEntity::Corank() const {
 485   return common::visit(common::visitors{
 486                            [](const SymbolRef s) { return s->Corank(); },
 487                            [](const Component &c) { return c.Corank(); },
 488                        },
 489       u_);
 490 }
 491
 492 int ArrayRef::Corank() const { return base().Corank(); }
 493
 494 int DataRef::Corank() const {
 495   return common::visit(common::visitors{
 496                            [](SymbolRef symbol) { return symbol->Corank(); },
 497                            [](const auto &x) { return x.Corank(); },
 498                        },
 499       u);
 500 }
 501
 502 int Substring::Corank() const {
 503   return common::visit(
 504       common::visitors{
 505           [](const DataRef &dataRef) { return dataRef.Corank(); },
 506           [](const StaticDataObject::Pointer &) { return 0; },
 507       },
 508       parent_);
 509 }
 510
 511 int ComplexPart::Corank() const { return complex_.Corank(); }
 512
 513 template <typename T> int Designator<T>::Corank() const {
 514   return common::visit(common::visitors{
 515                            [](SymbolRef symbol) { return symbol->Corank(); },
 516                            [](const auto &x) { return x.Corank(); },
 517                        },
 518       u);
 519 }
 520
 521 // GetBaseObject(), GetFirstSymbol(), GetLastSymbol(), &c.
 522 const Symbol &Component::GetFirstSymbol() const {
 523   return base_.value().GetFirstSymbol();
 524 }
 525
 526 const Symbol &NamedEntity::GetFirstSymbol() const {
 527   return common::visit(common::visitors{
 528                            [](SymbolRef s) -> const Symbol & { return s; },
 529                            [](const Component &c) -> const Symbol & {
 530                              return c.GetFirstSymbol();
 531                            },
 532                        },
 533       u_);
 534 }
 535
 536 const Symbol &NamedEntity::GetLastSymbol() const {
 537   return common::visit(common::visitors{
 538                            [](SymbolRef s) -> const Symbol & { return s; },
 539                            [](const Component &c) -> const Symbol & {
 540                              return c.GetLastSymbol();
 541                            },
 542                        },
 543       u_);
 544 }
 545
 546 const SymbolRef *NamedEntity::UnwrapSymbolRef() const {
 547   return common::visit(
 548       common::visitors{
 549           [](const SymbolRef &s) { return &s; },
 550           [](const Component &) -> const SymbolRef * { return nullptr; },
 551       },
 552       u_);
 553 }
 554
 555 SymbolRef *NamedEntity::UnwrapSymbolRef() {
 556   return common::visit(common::visitors{
 557                            [](SymbolRef &s) { return &s; },
 558                            [](Component &) -> SymbolRef * { return nullptr; },
 559                        },
 560       u_);
 561 }
 562
 563 const Component *NamedEntity::UnwrapComponent() const {
 564   return common::visit(
 565       common::visitors{
 566           [](SymbolRef) -> const Component * { return nullptr; },
 567           [](const Component &c) { return &c; },
 568       },
 569       u_);
 570 }
 571
 572 Component *NamedEntity::UnwrapComponent() {
 573   return common::visit(common::visitors{
 574                            [](SymbolRef &) -> Component * { return nullptr; },
 575                            [](Component &c) { return &c; },
 576                        },
 577       u_);
 578 }
 579
 580 const Symbol &ArrayRef::GetFirstSymbol() const {
 581   return base_.GetFirstSymbol();
 582 }
 583
 584 const Symbol &ArrayRef::GetLastSymbol() const { return base_.GetLastSymbol(); }
 585
 586 const Symbol &DataRef::GetFirstSymbol() const {
 587   return *common::visit(common::visitors{
 588                             [](SymbolRef symbol) { return &*symbol; },
 589                             [](const auto &x) { return &x.GetFirstSymbol(); },
 590                         },
 591       u);
 592 }
 593
 594 const Symbol &DataRef::GetLastSymbol() const {
 595   return *common::visit(common::visitors{
 596                             [](SymbolRef symbol) { return &*symbol; },
 597                             [](const auto &x) { return &x.GetLastSymbol(); },
 598                         },
 599       u);
 600 }
 601
 602 BaseObject Substring::GetBaseObject() const {
 603   return common::visit(common::visitors{
 604                            [](const DataRef &dataRef) {
 605                              return BaseObject{dataRef.GetFirstSymbol()};
 606                            },
 607                            [](StaticDataObject::Pointer pointer) {
 608                              return BaseObject{std::move(pointer)};
 609                            },
 610                        },
 611       parent_);
 612 }
 613
 614 const Symbol *Substring::GetLastSymbol() const {
 615   return common::visit(
 616       common::visitors{
 617           [](const DataRef &dataRef) { return &dataRef.GetLastSymbol(); },
 618           [](const auto &) -> const Symbol * { return nullptr; },
 619       },
 620       parent_);
 621 }
 622
 623 template <typename T> BaseObject Designator<T>::GetBaseObject() const {
 624   return common::visit(
 625       common::visitors{
 626           [](SymbolRef symbol) { return BaseObject{symbol}; },
 627           [](const Substring &sstring) { return sstring.GetBaseObject(); },
 628           [](const auto &x) { return BaseObject{x.GetFirstSymbol()}; },
 629       },
 630       u);
 631 }
 632
 633 template <typename T> const Symbol *Designator<T>::GetLastSymbol() const {
 634   return common::visit(
 635       common::visitors{
 636           [](SymbolRef symbol) { return &*symbol; },
 637           [](const Substring &sstring) { return sstring.GetLastSymbol(); },
 638           [](const auto &x) { return &x.GetLastSymbol(); },
 639       },
 640       u);
 641 }
 642
 643 template <typename T>
 644 std::optional<DynamicType> Designator<T>::GetType() const {
 645   if constexpr (IsLengthlessIntrinsicType<Result>) {
 646     return Result::GetType();
 647   }
 648   if constexpr (Result::category == TypeCategory::Character) {
 649     if (std::holds_alternative<Substring>(u)) {
 650       if (auto len{LEN()}) {
 651         if (auto n{ToInt64(*len)}) {
 652           return DynamicType{T::kind, *n};
 653         }
 654       }
 655       return DynamicType{TypeCategory::Character, T::kind};
 656     }
 657   }
 658   if (const Symbol * symbol{GetLastSymbol()}) {
 659     return DynamicType::From(*symbol);
 660   }
 661   return std::nullopt;
 662 }
 663
 664 static NamedEntity AsNamedEntity(const SymbolVector &x) {
 665   CHECK(!x.empty());
 666   NamedEntity result{x.front()};
 667   int j{0};
 668   for (const Symbol &symbol : x) {
 669     if (j++ != 0) {
 670       DataRef base{result.IsSymbol() ? DataRef{result.GetLastSymbol()}
 671                                      : DataRef{result.GetComponent()}};
 672       result = NamedEntity{Component{std::move(base), symbol}};
 673     }
 674   }
 675   return result;
 676 }
 677
 678 NamedEntity CoarrayRef::GetBase() const { return AsNamedEntity(base_); }
 679
 680 // Equality testing
 681
 682 // For the purposes of comparing type parameter expressions while
 683 // testing the compatibility of procedure characteristics, two
 684 // dummy arguments with the same position are considered equal.
 685 static std::optional<int> GetDummyArgPosition(const Symbol &original) {
 686   const Symbol &symbol(original.GetUltimate());
 687   if (IsDummy(symbol)) {
 688     if (const Symbol * proc{symbol.owner().symbol()}) {
 689       if (const auto *subp{proc->detailsIf<semantics::SubprogramDetails>()}) {
 690         int j{0};
 691         for (const Symbol *arg : subp->dummyArgs()) {
 692           if (arg == &symbol) {
 693             return j;
 694           }
 695           ++j;
 696         }
 697       }
 698     }
 699   }
 700   return std::nullopt;
 701 }
 702
 703 static bool AreSameSymbol(const Symbol &x, const Symbol &y) {
 704   if (&x == &y) {
 705     return true;
 706   }
 707   if (auto xPos{GetDummyArgPosition(x)}) {
 708     if (auto yPos{GetDummyArgPosition(y)}) {
 709       return *xPos == *yPos;
 710     }
 711   }
 712   return false;
 713 }
 714
 715 // Implements operator==() for a union type, using special case handling
 716 // for Symbol references.
 717 template <typename A> static bool TestVariableEquality(const A &x, const A &y) {
 718   const SymbolRef *xSymbol{std::get_if<SymbolRef>(&x.u)};
 719   if (const SymbolRef * ySymbol{std::get_if<SymbolRef>(&y.u)}) {
 720     return xSymbol && AreSameSymbol(*xSymbol, *ySymbol);
 721   } else {
 722     return x.u == y.u;
 723   }
 724 }
 725
 726 bool BaseObject::operator==(const BaseObject &that) const {
 727   return TestVariableEquality(*this, that);
 728 }
 729 bool Component::operator==(const Component &that) const {
 730   return base_ == that.base_ && &*symbol_ == &*that.symbol_;
 731 }
 732 bool NamedEntity::operator==(const NamedEntity &that) const {
 733   if (IsSymbol()) {
 734     return that.IsSymbol() &&
 735         AreSameSymbol(GetFirstSymbol(), that.GetFirstSymbol());
 736   } else {
 737     return !that.IsSymbol() && GetComponent() == that.GetComponent();
 738   }
 739 }
 740 bool TypeParamInquiry::operator==(const TypeParamInquiry &that) const {
 741   return &*parameter_ == &*that.parameter_ && base_ == that.base_;
 742 }
 743 bool Triplet::operator==(const Triplet &that) const {
 744   return lower_ == that.lower_ && upper_ == that.upper_ &&
 745       stride_ == that.stride_;
 746 }
 747 bool Subscript::operator==(const Subscript &that) const { return u == that.u; }
 748 bool ArrayRef::operator==(const ArrayRef &that) const {
 749   return base_ == that.base_ && subscript_ == that.subscript_;
 750 }
 751 bool CoarrayRef::operator==(const CoarrayRef &that) const {
 752   return base_ == that.base_ && subscript_ == that.subscript_ &&
 753       cosubscript_ == that.cosubscript_ && stat_ == that.stat_ &&
 754       team_ == that.team_ && teamIsTeamNumber_ == that.teamIsTeamNumber_;
 755 }
 756 bool DataRef::operator==(const DataRef &that) const {
 757   return TestVariableEquality(*this, that);
 758 }
 759 bool Substring::operator==(const Substring &that) const {
 760   return parent_ == that.parent_ && lower_ == that.lower_ &&
 761       upper_ == that.upper_;
 762 }
 763 bool ComplexPart::operator==(const ComplexPart &that) const {
 764   return part_ == that.part_ && complex_ == that.complex_;
 765 }
 766 bool ProcedureRef::operator==(const ProcedureRef &that) const {
 767   return proc_ == that.proc_ && arguments_ == that.arguments_;
 768 }
 769 template <typename T>
 770 bool Designator<T>::operator==(const Designator<T> &that) const {
 771   return TestVariableEquality(*this, that);
 772 }
 773 bool DescriptorInquiry::operator==(const DescriptorInquiry &that) const {
 774   return field_ == that.field_ && base_ == that.base_ &&
 775       dimension_ == that.dimension_;
 776 }
 777
 778 #ifdef _MSC_VER // disable bogus warning about missing definitions
 779 #pragma warning(disable : 4661)
 780 #endif
 781 INSTANTIATE_VARIABLE_TEMPLATES
 782 } // namespace Fortran::evaluate
 783
 784 template class Fortran::common::Indirection<Fortran::evaluate::Component, true>;