flang/lib/Semantics/semantics.cpp

   1 //===-- lib/Semantics/semantics.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/Semantics/semantics.h"
  10 #include "assignment.h"
  11 #include "canonicalize-acc.h"
  12 #include "canonicalize-directives.h"
  13 #include "canonicalize-do.h"
  14 #include "canonicalize-omp.h"
  15 #include "check-acc-structure.h"
  16 #include "check-allocate.h"
  17 #include "check-arithmeticif.h"
  18 #include "check-case.h"
  19 #include "check-coarray.h"
  20 #include "check-cuda.h"
  21 #include "check-data.h"
  22 #include "check-deallocate.h"
  23 #include "check-declarations.h"
  24 #include "check-do-forall.h"
  25 #include "check-if-stmt.h"
  26 #include "check-io.h"
  27 #include "check-namelist.h"
  28 #include "check-nullify.h"
  29 #include "check-omp-structure.h"
  30 #include "check-purity.h"
  31 #include "check-return.h"
  32 #include "check-select-rank.h"
  33 #include "check-select-type.h"
  34 #include "check-stop.h"
  35 #include "compute-offsets.h"
  36 #include "mod-file.h"
  37 #include "resolve-labels.h"
  38 #include "resolve-names.h"
  39 #include "rewrite-parse-tree.h"
  40 #include "flang/Common/default-kinds.h"
  41 #include "flang/Parser/parse-tree-visitor.h"
  42 #include "flang/Parser/tools.h"
  43 #include "flang/Semantics/expression.h"
  44 #include "flang/Semantics/scope.h"
  45 #include "flang/Semantics/symbol.h"
  46 #include "llvm/Support/raw_ostream.h"
  47 #include "llvm/TargetParser/Host.h"
  48 #include "llvm/TargetParser/Triple.h"
  49
  50 namespace Fortran::semantics {
  51
  52 using NameToSymbolMap = std::multimap<parser::CharBlock, SymbolRef>;
  53 static void DoDumpSymbols(llvm::raw_ostream &, const Scope &, int indent = 0);
  54 static void PutIndent(llvm::raw_ostream &, int indent);
  55
  56 static void GetSymbolNames(const Scope &scope, NameToSymbolMap &symbols) {
  57   // Finds all symbol names in the scope without collecting duplicates.
  58   for (const auto &pair : scope) {
  59     symbols.emplace(pair.second->name(), *pair.second);
  60   }
  61   for (const auto &pair : scope.commonBlocks()) {
  62     symbols.emplace(pair.second->name(), *pair.second);
  63   }
  64   for (const auto &child : scope.children()) {
  65     GetSymbolNames(child, symbols);
  66   }
  67 }
  68
  69 // A parse tree visitor that calls Enter/Leave functions from each checker
  70 // class C supplied as template parameters. Enter is called before the node's
  71 // children are visited, Leave is called after. No two checkers may have the
  72 // same Enter or Leave function. Each checker must be constructible from
  73 // SemanticsContext and have BaseChecker as a virtual base class.
  74 template <typename... C>
  75 class SemanticsVisitor : public virtual BaseChecker, public virtual C... {
  76 public:
  77   using BaseChecker::Enter;
  78   using BaseChecker::Leave;
  79   using C::Enter...;
  80   using C::Leave...;
  81   SemanticsVisitor(SemanticsContext &context)
  82       : C{context}..., context_{context} {}
  83
  84   template <typename N> bool Pre(const N &node) {
  85     if constexpr (common::HasMember<const N *, ConstructNode>) {
  86       context_.PushConstruct(node);
  87     }
  88     Enter(node);
  89     return true;
  90   }
  91   template <typename N> void Post(const N &node) {
  92     Leave(node);
  93     if constexpr (common::HasMember<const N *, ConstructNode>) {
  94       context_.PopConstruct();
  95     }
  96   }
  97
  98   template <typename T> bool Pre(const parser::Statement<T> &node) {
  99     context_.set_location(node.source);
 100     Enter(node);
 101     return true;
 102   }
 103   template <typename T> bool Pre(const parser::UnlabeledStatement<T> &node) {
 104     context_.set_location(node.source);
 105     Enter(node);
 106     return true;
 107   }
 108   template <typename T> void Post(const parser::Statement<T> &node) {
 109     Leave(node);
 110     context_.set_location(std::nullopt);
 111   }
 112   template <typename T> void Post(const parser::UnlabeledStatement<T> &node) {
 113     Leave(node);
 114     context_.set_location(std::nullopt);
 115   }
 116
 117   bool Walk(const parser::Program &program) {
 118     parser::Walk(program, *this);
 119     return !context_.AnyFatalError();
 120   }
 121
 122 private:
 123   SemanticsContext &context_;
 124 };
 125
 126 class MiscChecker : public virtual BaseChecker {
 127 public:
 128   explicit MiscChecker(SemanticsContext &context) : context_{context} {}
 129   void Leave(const parser::EntryStmt &) {
 130     if (!context_.constructStack().empty()) { // C1571
 131       context_.Say("ENTRY may not appear in an executable construct"_err_en_US);
 132     }
 133   }
 134   void Leave(const parser::AssignStmt &stmt) {
 135     CheckAssignGotoName(std::get<parser::Name>(stmt.t));
 136   }
 137   void Leave(const parser::AssignedGotoStmt &stmt) {
 138     CheckAssignGotoName(std::get<parser::Name>(stmt.t));
 139   }
 140
 141 private:
 142   void CheckAssignGotoName(const parser::Name &name) {
 143     if (context_.HasError(name.symbol)) {
 144       return;
 145     }
 146     const Symbol &symbol{DEREF(name.symbol)};
 147     auto type{evaluate::DynamicType::From(symbol)};
 148     if (!IsVariableName(symbol) || symbol.Rank() != 0 || !type ||
 149         type->category() != TypeCategory::Integer ||
 150         type->kind() !=
 151             context_.defaultKinds().GetDefaultKind(TypeCategory::Integer)) {
 152       context_
 153           .Say(name.source,
 154               "'%s' must be a default integer scalar variable"_err_en_US,
 155               name.source)
 156           .Attach(symbol.name(), "Declaration of '%s'"_en_US, symbol.name());
 157     }
 158   }
 159
 160   SemanticsContext &context_;
 161 };
 162
 163 static void WarnUndefinedFunctionResult(
 164     SemanticsContext &context, const Scope &scope) {
 165   auto WasDefined{[&context](const Symbol &symbol) {
 166     return context.IsSymbolDefined(symbol) ||
 167         IsInitialized(symbol, /*ignoreDataStatements=*/true,
 168             /*ignoreAllocatable=*/true, /*ignorePointer=*/true);
 169   }};
 170   if (const Symbol * symbol{scope.symbol()}) {
 171     if (const auto *subp{symbol->detailsIf<SubprogramDetails>()}) {
 172       if (subp->isFunction() && !subp->isInterface() && !subp->stmtFunction()) {
 173         bool wasDefined{WasDefined(subp->result())};
 174         if (!wasDefined) {
 175           // Definitions of ENTRY result variables also count.
 176           for (const auto &pair : scope) {
 177             const Symbol &local{*pair.second};
 178             if (IsFunctionResult(local) && WasDefined(local)) {
 179               wasDefined = true;
 180               break;
 181             }
 182           }
 183           if (!wasDefined) {
 184             context.Warn(common::UsageWarning::UndefinedFunctionResult,
 185                 symbol->name(), "Function result is never defined"_warn_en_US);
 186           }
 187         }
 188       }
 189     }
 190   }
 191   if (!scope.IsModuleFile()) {
 192     for (const Scope &child : scope.children()) {
 193       WarnUndefinedFunctionResult(context, child);
 194     }
 195   }
 196 }
 197
 198 using StatementSemanticsPass1 = ExprChecker;
 199 using StatementSemanticsPass2 = SemanticsVisitor<AllocateChecker,
 200     ArithmeticIfStmtChecker, AssignmentChecker, CaseChecker, CoarrayChecker,
 201     DataChecker, DeallocateChecker, DoForallChecker, IfStmtChecker, IoChecker,
 202     MiscChecker, NamelistChecker, NullifyChecker, PurityChecker,
 203     ReturnStmtChecker, SelectRankConstructChecker, SelectTypeChecker,
 204     StopChecker>;
 205
 206 static bool PerformStatementSemantics(
 207     SemanticsContext &context, parser::Program &program) {
 208   ResolveNames(context, program, context.globalScope());
 209   RewriteParseTree(context, program);
 210   ComputeOffsets(context, context.globalScope());
 211   CheckDeclarations(context);
 212   StatementSemanticsPass1{context}.Walk(program);
 213   StatementSemanticsPass2 pass2{context};
 214   pass2.Walk(program);
 215   if (context.languageFeatures().IsEnabled(common::LanguageFeature::OpenACC)) {
 216     SemanticsVisitor<AccStructureChecker>{context}.Walk(program);
 217   }
 218   if (context.languageFeatures().IsEnabled(common::LanguageFeature::OpenMP)) {
 219     SemanticsVisitor<OmpStructureChecker>{context}.Walk(program);
 220   }
 221   if (context.languageFeatures().IsEnabled(common::LanguageFeature::CUDA)) {
 222     SemanticsVisitor<CUDAChecker>{context}.Walk(program);
 223   }
 224   if (!context.messages().AnyFatalError()) {
 225     WarnUndefinedFunctionResult(context, context.globalScope());
 226   }
 227   if (!context.AnyFatalError()) {
 228     pass2.CompileDataInitializationsIntoInitializers();
 229   }
 230   return !context.AnyFatalError();
 231 }
 232
 233 /// This class keeps track of the common block appearances with the biggest size
 234 /// and with an initial value (if any) in a program. This allows reporting
 235 /// conflicting initialization and warning about appearances of a same
 236 /// named common block with different sizes. The biggest common block size and
 237 /// initialization (if any) can later be provided so that lowering can generate
 238 /// the correct symbol size and initial values, even when named common blocks
 239 /// appears with different sizes and are initialized outside of block data.
 240 class CommonBlockMap {
 241 private:
 242   struct CommonBlockInfo {
 243     // Common block symbol for the appearance with the biggest size.
 244     SymbolRef biggestSize;
 245     // Common block symbol for the appearance with the initialized members (if
 246     // any).
 247     std::optional<SymbolRef> initialization;
 248   };
 249
 250 public:
 251   void MapCommonBlockAndCheckConflicts(
 252       SemanticsContext &context, const Symbol &common) {
 253     const Symbol *isInitialized{CommonBlockIsInitialized(common)};
 254     // Merge common according to the name they will have in the object files.
 255     // This allows merging BIND(C) and non BIND(C) common block instead of
 256     // later crashing. This "merge" matches what ifort/gfortran/nvfortran are
 257     // doing and what a linker would do if the definition were in distinct
 258     // files.
 259     std::string commonName{
 260         GetCommonBlockObjectName(common, context.underscoring())};
 261     auto [it, firstAppearance] = commonBlocks_.insert({commonName,
 262         isInitialized ? CommonBlockInfo{common, common}
 263                       : CommonBlockInfo{common, std::nullopt}});
 264     if (!firstAppearance) {
 265       CommonBlockInfo &info{it->second};
 266       if (isInitialized) {
 267         if (info.initialization.has_value() &&
 268             &**info.initialization != &common) {
 269           // Use the location of the initialization in the error message because
 270           // common block symbols may have no location if they are blank
 271           // commons.
 272           const Symbol &previousInit{
 273               DEREF(CommonBlockIsInitialized(**info.initialization))};
 274           context
 275               .Say(isInitialized->name(),
 276                   "Multiple initialization of COMMON block /%s/"_err_en_US,
 277                   common.name())
 278               .Attach(previousInit.name(),
 279                   "Previous initialization of COMMON block /%s/"_en_US,
 280                   common.name());
 281         } else {
 282           info.initialization = common;
 283         }
 284       }
 285       if (common.size() != info.biggestSize->size() && !common.name().empty()) {
 286         if (auto *msg{context.Warn(common::LanguageFeature::DistinctCommonSizes,
 287                 common.name(),
 288                 "A named COMMON block should have the same size everywhere it appears (%zd bytes here)"_port_en_US,
 289                 common.size())}) {
 290           msg->Attach(info.biggestSize->name(),
 291               "Previously defined with a size of %zd bytes"_en_US,
 292               info.biggestSize->size());
 293         }
 294       }
 295       if (common.size() > info.biggestSize->size()) {
 296         info.biggestSize = common;
 297       }
 298     }
 299   }
 300
 301   CommonBlockList GetCommonBlocks() const {
 302     CommonBlockList result;
 303     for (const auto &[_, blockInfo] : commonBlocks_) {
 304       result.emplace_back(
 305           std::make_pair(blockInfo.initialization ? *blockInfo.initialization
 306                                                   : blockInfo.biggestSize,
 307               blockInfo.biggestSize->size()));
 308     }
 309     return result;
 310   }
 311
 312 private:
 313   /// Return the symbol of an initialized member if a COMMON block
 314   /// is initalized. Otherwise, return nullptr.
 315   static Symbol *CommonBlockIsInitialized(const Symbol &common) {
 316     const auto &commonDetails =
 317         common.get<Fortran::semantics::CommonBlockDetails>();
 318
 319     for (const auto &member : commonDetails.objects()) {
 320       if (IsInitialized(*member)) {
 321         return &*member;
 322       }
 323     }
 324
 325     // Common block may be initialized via initialized variables that are in an
 326     // equivalence with the common block members.
 327     for (const Fortran::semantics::EquivalenceSet &set :
 328         common.owner().equivalenceSets()) {
 329       for (const Fortran::semantics::EquivalenceObject &obj : set) {
 330         if (!obj.symbol.test(
 331                 Fortran::semantics::Symbol::Flag::CompilerCreated)) {
 332           if (FindCommonBlockContaining(obj.symbol) == &common &&
 333               IsInitialized(obj.symbol)) {
 334             return &obj.symbol;
 335           }
 336         }
 337       }
 338     }
 339     return nullptr;
 340   }
 341
 342   std::map<std::string, CommonBlockInfo> commonBlocks_;
 343 };
 344
 345 SemanticsContext::SemanticsContext(
 346     const common::IntrinsicTypeDefaultKinds &defaultKinds,
 347     const common::LanguageFeatureControl &languageFeatures,
 348     const common::LangOptions &langOpts,
 349     parser::AllCookedSources &allCookedSources)
 350     : defaultKinds_{defaultKinds}, languageFeatures_{languageFeatures},
 351       langOpts_{langOpts}, allCookedSources_{allCookedSources},
 352       intrinsics_{evaluate::IntrinsicProcTable::Configure(defaultKinds_)},
 353       globalScope_{*this}, intrinsicModulesScope_{globalScope_.MakeScope(
 354                                Scope::Kind::IntrinsicModules, nullptr)},
 355       foldingContext_{parser::ContextualMessages{&messages_}, defaultKinds_,
 356           intrinsics_, targetCharacteristics_, languageFeatures_, tempNames_} {}
 357
 358 SemanticsContext::~SemanticsContext() {}
 359
 360 int SemanticsContext::GetDefaultKind(TypeCategory category) const {
 361   return defaultKinds_.GetDefaultKind(category);
 362 }
 363
 364 const DeclTypeSpec &SemanticsContext::MakeNumericType(
 365     TypeCategory category, int kind) {
 366   if (kind == 0) {
 367     kind = GetDefaultKind(category);
 368   }
 369   return globalScope_.MakeNumericType(category, KindExpr{kind});
 370 }
 371 const DeclTypeSpec &SemanticsContext::MakeLogicalType(int kind) {
 372   if (kind == 0) {
 373     kind = GetDefaultKind(TypeCategory::Logical);
 374   }
 375   return globalScope_.MakeLogicalType(KindExpr{kind});
 376 }
 377
 378 bool SemanticsContext::AnyFatalError() const {
 379   return !messages_.empty() &&
 380       (warningsAreErrors_ || messages_.AnyFatalError());
 381 }
 382 bool SemanticsContext::HasError(const Symbol &symbol) {
 383   return errorSymbols_.count(symbol) > 0;
 384 }
 385 bool SemanticsContext::HasError(const Symbol *symbol) {
 386   return !symbol || HasError(*symbol);
 387 }
 388 bool SemanticsContext::HasError(const parser::Name &name) {
 389   return HasError(name.symbol);
 390 }
 391 void SemanticsContext::SetError(const Symbol &symbol, bool value) {
 392   if (value) {
 393     CheckError(symbol);
 394     errorSymbols_.emplace(symbol);
 395   }
 396 }
 397 void SemanticsContext::CheckError(const Symbol &symbol) {
 398   if (!AnyFatalError()) {
 399     std::string buf;
 400     llvm::raw_string_ostream ss{buf};
 401     ss << symbol;
 402     common::die(
 403         "No error was reported but setting error on: %s", ss.str().c_str());
 404   }
 405 }
 406
 407 bool SemanticsContext::ScopeIndexComparator::operator()(
 408     parser::CharBlock x, parser::CharBlock y) const {
 409   return x.begin() < y.begin() ||
 410       (x.begin() == y.begin() && x.size() > y.size());
 411 }
 412
 413 auto SemanticsContext::SearchScopeIndex(parser::CharBlock source)
 414     -> ScopeIndex::iterator {
 415   if (!scopeIndex_.empty()) {
 416     auto iter{scopeIndex_.upper_bound(source)};
 417     auto begin{scopeIndex_.begin()};
 418     do {
 419       --iter;
 420       if (iter->first.Contains(source)) {
 421         return iter;
 422       }
 423     } while (iter != begin);
 424   }
 425   return scopeIndex_.end();
 426 }
 427
 428 const Scope &SemanticsContext::FindScope(parser::CharBlock source) const {
 429   return const_cast<SemanticsContext *>(this)->FindScope(source);
 430 }
 431
 432 Scope &SemanticsContext::FindScope(parser::CharBlock source) {
 433   if (auto iter{SearchScopeIndex(source)}; iter != scopeIndex_.end()) {
 434     return iter->second;
 435   } else {
 436     common::die(
 437         "SemanticsContext::FindScope(): invalid source location for '%s'",
 438         source.ToString().c_str());
 439   }
 440 }
 441
 442 void SemanticsContext::UpdateScopeIndex(
 443     Scope &scope, parser::CharBlock newSource) {
 444   if (scope.sourceRange().empty()) {
 445     scopeIndex_.emplace(newSource, scope);
 446   } else if (!scope.sourceRange().Contains(newSource)) {
 447     auto iter{SearchScopeIndex(scope.sourceRange())};
 448     CHECK(iter != scopeIndex_.end());
 449     while (&iter->second != &scope) {
 450       CHECK(iter != scopeIndex_.begin());
 451       --iter;
 452     }
 453     scopeIndex_.erase(iter);
 454     scopeIndex_.emplace(newSource, scope);
 455   }
 456 }
 457
 458 bool SemanticsContext::IsInModuleFile(parser::CharBlock source) const {
 459   for (const Scope *scope{&FindScope(source)}; !scope->IsGlobal();
 460        scope = &scope->parent()) {
 461     if (scope->IsModuleFile()) {
 462       return true;
 463     }
 464   }
 465   return false;
 466 }
 467
 468 void SemanticsContext::PopConstruct() {
 469   CHECK(!constructStack_.empty());
 470   constructStack_.pop_back();
 471 }
 472
 473 parser::Message *SemanticsContext::CheckIndexVarRedefine(
 474     const parser::CharBlock &location, const Symbol &variable,
 475     parser::MessageFixedText &&message) {
 476   const Symbol &symbol{ResolveAssociations(variable)};
 477   auto it{activeIndexVars_.find(symbol)};
 478   if (it != activeIndexVars_.end()) {
 479     std::string kind{EnumToString(it->second.kind)};
 480     return &Say(location, std::move(message), kind, symbol.name())
 481                 .Attach(
 482                     it->second.location, "Enclosing %s construct"_en_US, kind);
 483   } else {
 484     return nullptr;
 485   }
 486 }
 487
 488 void SemanticsContext::WarnIndexVarRedefine(
 489     const parser::CharBlock &location, const Symbol &variable) {
 490   if (ShouldWarn(common::UsageWarning::IndexVarRedefinition)) {
 491     if (auto *msg{CheckIndexVarRedefine(location, variable,
 492             "Possible redefinition of %s variable '%s'"_warn_en_US)}) {
 493       msg->set_usageWarning(common::UsageWarning::IndexVarRedefinition);
 494     }
 495   }
 496 }
 497
 498 void SemanticsContext::CheckIndexVarRedefine(
 499     const parser::CharBlock &location, const Symbol &variable) {
 500   CheckIndexVarRedefine(
 501       location, variable, "Cannot redefine %s variable '%s'"_err_en_US);
 502 }
 503
 504 void SemanticsContext::CheckIndexVarRedefine(const parser::Variable &variable) {
 505   if (const Symbol * entity{GetLastName(variable).symbol}) {
 506     CheckIndexVarRedefine(variable.GetSource(), *entity);
 507   }
 508 }
 509
 510 void SemanticsContext::CheckIndexVarRedefine(const parser::Name &name) {
 511   if (const Symbol * entity{name.symbol}) {
 512     CheckIndexVarRedefine(name.source, *entity);
 513   }
 514 }
 515
 516 void SemanticsContext::ActivateIndexVar(
 517     const parser::Name &name, IndexVarKind kind) {
 518   CheckIndexVarRedefine(name);
 519   if (const Symbol * indexVar{name.symbol}) {
 520     activeIndexVars_.emplace(
 521         ResolveAssociations(*indexVar), IndexVarInfo{name.source, kind});
 522   }
 523 }
 524
 525 void SemanticsContext::DeactivateIndexVar(const parser::Name &name) {
 526   if (Symbol * indexVar{name.symbol}) {
 527     auto it{activeIndexVars_.find(ResolveAssociations(*indexVar))};
 528     if (it != activeIndexVars_.end() && it->second.location == name.source) {
 529       activeIndexVars_.erase(it);
 530     }
 531   }
 532 }
 533
 534 SymbolVector SemanticsContext::GetIndexVars(IndexVarKind kind) {
 535   SymbolVector result;
 536   for (const auto &[symbol, info] : activeIndexVars_) {
 537     if (info.kind == kind) {
 538       result.push_back(symbol);
 539     }
 540   }
 541   return result;
 542 }
 543
 544 SourceName SemanticsContext::SaveTempName(std::string &&name) {
 545   return {*tempNames_.emplace(std::move(name)).first};
 546 }
 547
 548 SourceName SemanticsContext::GetTempName(const Scope &scope) {
 549   for (const auto &str : tempNames_) {
 550     if (IsTempName(str)) {
 551       SourceName name{str};
 552       if (scope.find(name) == scope.end()) {
 553         return name;
 554       }
 555     }
 556   }
 557   return SaveTempName(".F18."s + std::to_string(tempNames_.size()));
 558 }
 559
 560 bool SemanticsContext::IsTempName(const std::string &name) {
 561   return name.size() > 5 && name.substr(0, 5) == ".F18.";
 562 }
 563
 564 Scope *SemanticsContext::GetBuiltinModule(const char *name) {
 565   return ModFileReader{*this}.Read(SourceName{name, std::strlen(name)},
 566       true /*intrinsic*/, nullptr, /*silent=*/true);
 567 }
 568
 569 void SemanticsContext::UseFortranBuiltinsModule() {
 570   if (builtinsScope_ == nullptr) {
 571     builtinsScope_ = GetBuiltinModule("__fortran_builtins");
 572     if (builtinsScope_) {
 573       intrinsics_.SupplyBuiltins(*builtinsScope_);
 574     }
 575   }
 576 }
 577
 578 void SemanticsContext::UsePPCBuiltinTypesModule() {
 579   if (ppcBuiltinTypesScope_ == nullptr) {
 580     ppcBuiltinTypesScope_ = GetBuiltinModule("__ppc_types");
 581   }
 582 }
 583
 584 const Scope &SemanticsContext::GetCUDABuiltinsScope() {
 585   if (!cudaBuiltinsScope_) {
 586     cudaBuiltinsScope_ = GetBuiltinModule("__cuda_builtins");
 587     CHECK(cudaBuiltinsScope_.value() != nullptr);
 588   }
 589   return **cudaBuiltinsScope_;
 590 }
 591
 592 const Scope &SemanticsContext::GetCUDADeviceScope() {
 593   if (!cudaDeviceScope_) {
 594     cudaDeviceScope_ = GetBuiltinModule("cudadevice");
 595     CHECK(cudaDeviceScope_.value() != nullptr);
 596   }
 597   return **cudaDeviceScope_;
 598 }
 599
 600 void SemanticsContext::UsePPCBuiltinsModule() {
 601   if (ppcBuiltinsScope_ == nullptr) {
 602     ppcBuiltinsScope_ = GetBuiltinModule("__ppc_intrinsics");
 603   }
 604 }
 605
 606 parser::Program &SemanticsContext::SaveParseTree(parser::Program &&tree) {
 607   return modFileParseTrees_.emplace_back(std::move(tree));
 608 }
 609
 610 bool Semantics::Perform() {
 611   // Implicitly USE the __Fortran_builtins module so that special types
 612   // (e.g., __builtin_team_type) are available to semantics, esp. for
 613   // intrinsic checking.
 614   if (!program_.v.empty()) {
 615     const auto *frontModule{std::get_if<common::Indirection<parser::Module>>(
 616         &program_.v.front().u)};
 617     if (frontModule &&
 618         (std::get<parser::Statement<parser::ModuleStmt>>(frontModule->value().t)
 619                     .statement.v.source == "__fortran_builtins" ||
 620             std::get<parser::Statement<parser::ModuleStmt>>(
 621                 frontModule->value().t)
 622                     .statement.v.source == "__ppc_types")) {
 623       // Don't try to read the builtins module when we're actually building it.
 624     } else if (frontModule &&
 625         (std::get<parser::Statement<parser::ModuleStmt>>(frontModule->value().t)
 626                     .statement.v.source == "__ppc_intrinsics" ||
 627             std::get<parser::Statement<parser::ModuleStmt>>(
 628                 frontModule->value().t)
 629                     .statement.v.source == "mma")) {
 630       // The derived type definition for the vectors is needed.
 631       context_.UsePPCBuiltinTypesModule();
 632     } else {
 633       context_.UseFortranBuiltinsModule();
 634       llvm::Triple targetTriple{llvm::Triple(
 635           llvm::Triple::normalize(llvm::sys::getDefaultTargetTriple()))};
 636       // Only use __ppc_intrinsics module when targetting PowerPC arch
 637       if (context_.targetCharacteristics().isPPC()) {
 638         context_.UsePPCBuiltinTypesModule();
 639         context_.UsePPCBuiltinsModule();
 640       }
 641     }
 642   }
 643   return ValidateLabels(context_, program_) &&
 644       parser::CanonicalizeDo(program_) && // force line break
 645       CanonicalizeAcc(context_.messages(), program_) &&
 646       CanonicalizeOmp(context_.messages(), program_) &&
 647       CanonicalizeCUDA(program_) &&
 648       PerformStatementSemantics(context_, program_) &&
 649       CanonicalizeDirectives(context_.messages(), program_) &&
 650       ModFileWriter{context_}
 651           .set_hermeticModuleFileOutput(hermeticModuleFileOutput_)
 652           .WriteAll();
 653 }
 654
 655 void Semantics::EmitMessages(llvm::raw_ostream &os) {
 656   // Resolve the CharBlock locations of the Messages to ProvenanceRanges
 657   // so messages from parsing and semantics are intermixed in source order.
 658   context_.messages().ResolveProvenances(context_.allCookedSources());
 659   context_.messages().Emit(os, context_.allCookedSources());
 660 }
 661
 662 void SemanticsContext::DumpSymbols(llvm::raw_ostream &os) {
 663   DoDumpSymbols(os, globalScope());
 664 }
 665
 666 ProgramTree &SemanticsContext::SaveProgramTree(ProgramTree &&tree) {
 667   return programTrees_.emplace_back(std::move(tree));
 668 }
 669
 670 void Semantics::DumpSymbols(llvm::raw_ostream &os) { context_.DumpSymbols(os); }
 671
 672 void Semantics::DumpSymbolsSources(llvm::raw_ostream &os) const {
 673   NameToSymbolMap symbols;
 674   GetSymbolNames(context_.globalScope(), symbols);
 675   const parser::AllCookedSources &allCooked{context_.allCookedSources()};
 676   for (const auto &pair : symbols) {
 677     const Symbol &symbol{pair.second};
 678     if (auto sourceInfo{allCooked.GetSourcePositionRange(symbol.name())}) {
 679       os << symbol.name().ToString() << ": " << sourceInfo->first.path << ", "
 680          << sourceInfo->first.line << ", " << sourceInfo->first.column << "-"
 681          << sourceInfo->second.column << "\n";
 682     } else if (symbol.has<semantics::UseDetails>()) {
 683       os << symbol.name().ToString() << ": "
 684          << symbol.GetUltimate().owner().symbol()->name().ToString() << "\n";
 685     }
 686   }
 687 }
 688
 689 void DoDumpSymbols(llvm::raw_ostream &os, const Scope &scope, int indent) {
 690   PutIndent(os, indent);
 691   os << Scope::EnumToString(scope.kind()) << " scope:";
 692   if (const auto *symbol{scope.symbol()}) {
 693     os << ' ' << symbol->name();
 694   }
 695   if (scope.alignment().has_value()) {
 696     os << " size=" << scope.size() << " alignment=" << *scope.alignment();
 697   }
 698   if (scope.derivedTypeSpec()) {
 699     os << " instantiation of " << *scope.derivedTypeSpec();
 700   }
 701   os << " sourceRange=" << scope.sourceRange().size() << " bytes\n";
 702   ++indent;
 703   for (const auto &pair : scope) {
 704     const auto &symbol{*pair.second};
 705     PutIndent(os, indent);
 706     os << symbol << '\n';
 707     if (const auto *details{symbol.detailsIf<GenericDetails>()}) {
 708       if (const auto &type{details->derivedType()}) {
 709         PutIndent(os, indent);
 710         os << *type << '\n';
 711       }
 712     }
 713   }
 714   if (!scope.equivalenceSets().empty()) {
 715     PutIndent(os, indent);
 716     os << "Equivalence Sets:";
 717     for (const auto &set : scope.equivalenceSets()) {
 718       os << ' ';
 719       char sep = '(';
 720       for (const auto &object : set) {
 721         os << sep << object.AsFortran();
 722         sep = ',';
 723       }
 724       os << ')';
 725     }
 726     os << '\n';
 727   }
 728   if (!scope.crayPointers().empty()) {
 729     PutIndent(os, indent);
 730     os << "Cray Pointers:";
 731     for (const auto &[pointee, pointer] : scope.crayPointers()) {
 732       os << " (" << pointer->name() << ',' << pointee << ')';
 733     }
 734   }
 735   for (const auto &pair : scope.commonBlocks()) {
 736     const auto &symbol{*pair.second};
 737     PutIndent(os, indent);
 738     os << symbol << '\n';
 739   }
 740   for (const auto &child : scope.children()) {
 741     DoDumpSymbols(os, child, indent);
 742   }
 743   --indent;
 744 }
 745
 746 static void PutIndent(llvm::raw_ostream &os, int indent) {
 747   for (int i = 0; i < indent; ++i) {
 748     os << "  ";
 749   }
 750 }
 751
 752 void SemanticsContext::MapCommonBlockAndCheckConflicts(const Symbol &common) {
 753   if (!commonBlockMap_) {
 754     commonBlockMap_ = std::make_unique<CommonBlockMap>();
 755   }
 756   commonBlockMap_->MapCommonBlockAndCheckConflicts(*this, common);
 757 }
 758
 759 CommonBlockList SemanticsContext::GetCommonBlocks() const {
 760   if (commonBlockMap_) {
 761     return commonBlockMap_->GetCommonBlocks();
 762   }
 763   return {};
 764 }
 765
 766 void SemanticsContext::NoteDefinedSymbol(const Symbol &symbol) {
 767   isDefined_.insert(symbol);
 768 }
 769
 770 bool SemanticsContext::IsSymbolDefined(const Symbol &symbol) const {
 771   return isDefined_.find(symbol) != isDefined_.end();
 772 }
 773
 774 } // namespace Fortran::semantics