506 lines · cpp
1//===-- lib/Semantics/rewrite-parse-tree.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-exception6//7//===----------------------------------------------------------------------===//8 9#include "rewrite-parse-tree.h"10 11#include "flang/Common/indirection.h"12#include "flang/Parser/openmp-utils.h"13#include "flang/Parser/parse-tree-visitor.h"14#include "flang/Parser/parse-tree.h"15#include "flang/Parser/tools.h"16#include "flang/Semantics/openmp-directive-sets.h"17#include "flang/Semantics/scope.h"18#include "flang/Semantics/semantics.h"19#include "flang/Semantics/symbol.h"20#include "flang/Semantics/tools.h"21#include <list>22 23namespace Fortran::semantics {24 25using namespace parser::literals;26 27/// Convert misidentified statement functions to array element assignments28/// or pointer-valued function result assignments.29/// Convert misidentified format expressions to namelist group names.30/// Convert misidentified character variables in I/O units to integer31/// unit number expressions.32/// Convert misidentified named constants in data statement values to33/// initial data targets34class RewriteMutator {35public:36 RewriteMutator(SemanticsContext &context)37 : context_{context}, errorOnUnresolvedName_{!context.AnyFatalError()},38 messages_{context.messages()} {}39 40 // Default action for a parse tree node is to visit children.41 template <typename T> bool Pre(T &) { return true; }42 template <typename T> void Post(T &) {}43 44 void Post(parser::Name &);45 bool Pre(parser::MainProgram &);46 bool Pre(parser::Module &);47 bool Pre(parser::FunctionSubprogram &);48 bool Pre(parser::SubroutineSubprogram &);49 bool Pre(parser::SeparateModuleSubprogram &);50 bool Pre(parser::BlockConstruct &);51 bool Pre(parser::Block &);52 bool Pre(parser::DoConstruct &);53 bool Pre(parser::IfConstruct &);54 bool Pre(parser::ActionStmt &);55 void Post(parser::MainProgram &);56 void Post(parser::FunctionSubprogram &);57 void Post(parser::SubroutineSubprogram &);58 void Post(parser::SeparateModuleSubprogram &);59 void Post(parser::BlockConstruct &);60 void Post(parser::Block &);61 void Post(parser::DoConstruct &);62 void Post(parser::IfConstruct &);63 void Post(parser::ReadStmt &);64 void Post(parser::WriteStmt &);65 66 // Name resolution yet implemented:67 // TODO: Can some/all of these now be enabled?68 bool Pre(parser::EquivalenceStmt &) { return false; }69 bool Pre(parser::Keyword &) { return false; }70 bool Pre(parser::EntryStmt &) { return false; }71 bool Pre(parser::CompilerDirective &) { return false; }72 73 // Don't bother resolving names in end statements.74 bool Pre(parser::EndBlockDataStmt &) { return false; }75 bool Pre(parser::EndFunctionStmt &) { return false; }76 bool Pre(parser::EndInterfaceStmt &) { return false; }77 bool Pre(parser::EndModuleStmt &) { return false; }78 bool Pre(parser::EndMpSubprogramStmt &) { return false; }79 bool Pre(parser::EndProgramStmt &) { return false; }80 bool Pre(parser::EndSubmoduleStmt &) { return false; }81 bool Pre(parser::EndSubroutineStmt &) { return false; }82 bool Pre(parser::EndTypeStmt &) { return false; }83 84 bool Pre(parser::OmpBlockConstruct &);85 bool Pre(parser::OpenMPLoopConstruct &);86 void Post(parser::OmpBlockConstruct &);87 void Post(parser::OpenMPLoopConstruct &);88 89private:90 void FixMisparsedStmtFuncs(parser::SpecificationPart &, parser::Block &);91 void OpenMPSimdOnly(parser::Block &, bool);92 void OpenMPSimdOnly(parser::SpecificationPart &);93 94 SemanticsContext &context_;95 bool errorOnUnresolvedName_{true};96 parser::Messages &messages_;97};98 99// Check that name has been resolved to a symbol100void RewriteMutator::Post(parser::Name &name) {101 if (!name.symbol && errorOnUnresolvedName_) {102 messages_.Say(name.source, "Internal: no symbol found for '%s'"_err_en_US,103 name.source);104 }105}106 107static bool ReturnsDataPointer(const Symbol &symbol) {108 if (const Symbol * funcRes{FindFunctionResult(symbol)}) {109 return IsPointer(*funcRes) && !IsProcedure(*funcRes);110 } else if (const auto *generic{symbol.detailsIf<GenericDetails>()}) {111 for (auto ref : generic->specificProcs()) {112 if (ReturnsDataPointer(*ref)) {113 return true;114 }115 }116 }117 return false;118}119 120static bool LoopConstructIsSIMD(parser::OpenMPLoopConstruct *ompLoop) {121 return llvm::omp::allSimdSet.test(ompLoop->BeginDir().DirName().v);122}123 124// Remove non-SIMD OpenMPConstructs once they are parsed.125// This massively simplifies the logic inside the SimdOnlyPass for126// -fopenmp-simd.127void RewriteMutator::OpenMPSimdOnly(parser::SpecificationPart &specPart) {128 auto &list{std::get<std::list<parser::DeclarationConstruct>>(specPart.t)};129 for (auto it{list.begin()}; it != list.end();) {130 if (auto *specConstr{std::get_if<parser::SpecificationConstruct>(&it->u)}) {131 if (auto *ompDecl{std::get_if<132 common::Indirection<parser::OpenMPDeclarativeConstruct>>(133 &specConstr->u)}) {134 if (std::holds_alternative<parser::OpenMPThreadprivate>(135 ompDecl->value().u) ||136 std::holds_alternative<parser::OpenMPDeclareMapperConstruct>(137 ompDecl->value().u)) {138 it = list.erase(it);139 continue;140 }141 }142 }143 ++it;144 }145}146 147// Remove non-SIMD OpenMPConstructs once they are parsed.148// This massively simplifies the logic inside the SimdOnlyPass for149// -fopenmp-simd. `isNonSimdLoopBody` should be set to true if `block` is the150// body of a non-simd OpenMP loop. This is to indicate that scan constructs151// should be removed from the body, where they would be kept if it were a simd152// loop.153void RewriteMutator::OpenMPSimdOnly(154 parser::Block &block, bool isNonSimdLoopBody = false) {155 auto replaceInlineBlock =156 [&](std::list<parser::ExecutionPartConstruct> &innerBlock,157 auto it) -> auto {158 auto insertPos = std::next(it);159 block.splice(insertPos, innerBlock);160 block.erase(it);161 return insertPos;162 };163 164 for (auto it{block.begin()}; it != block.end();) {165 if (auto *stmt{std::get_if<parser::ExecutableConstruct>(&it->u)}) {166 if (auto *omp{std::get_if<common::Indirection<parser::OpenMPConstruct>>(167 &stmt->u)}) {168 if (auto *ompStandalone{std::get_if<parser::OpenMPStandaloneConstruct>(169 &omp->value().u)}) {170 if (std::holds_alternative<parser::OpenMPCancelConstruct>(171 ompStandalone->u) ||172 std::holds_alternative<parser::OpenMPFlushConstruct>(173 ompStandalone->u) ||174 std::holds_alternative<parser::OpenMPCancellationPointConstruct>(175 ompStandalone->u)) {176 it = block.erase(it);177 continue;178 }179 if (auto *constr{std::get_if<parser::OpenMPSimpleStandaloneConstruct>(180 &ompStandalone->u)}) {181 auto directive = constr->v.DirId();182 // Scan should only be removed from non-simd loops183 if (llvm::omp::simpleStandaloneNonSimdOnlySet.test(directive) ||184 (isNonSimdLoopBody && directive == llvm::omp::OMPD_scan)) {185 it = block.erase(it);186 continue;187 }188 }189 } else if (auto *ompBlock{std::get_if<parser::OmpBlockConstruct>(190 &omp->value().u)}) {191 it = replaceInlineBlock(std::get<parser::Block>(ompBlock->t), it);192 continue;193 } else if (auto *ompLoop{std::get_if<parser::OpenMPLoopConstruct>(194 &omp->value().u)}) {195 if (LoopConstructIsSIMD(ompLoop)) {196 ++it;197 continue;198 }199 std::list<parser::ExecutionPartConstruct> doList;200 for (auto &construct : std::get<parser::Block>(ompLoop->t)) {201 if (auto *doConstruct = const_cast<parser::DoConstruct *>(202 parser::omp::GetDoConstruct(construct))) {203 auto &loopBody = std::get<parser::Block>(doConstruct->t);204 // We can only remove some constructs from a loop when it's _not_205 // a OpenMP simd loop206 OpenMPSimdOnly(const_cast<parser::Block &>(loopBody),207 /*isNonSimdLoopBody=*/true);208 auto newLoop = parser::ExecutionPartConstruct{209 parser::ExecutableConstruct{std::move(*doConstruct)}};210 doList.insert(doList.end(), std::move(newLoop));211 }212 }213 if (!doList.empty()) {214 it = block.erase(it);215 for (auto &newLoop : doList)216 block.insert(it, std::move(newLoop));217 continue;218 }219 } else if (auto *ompCon{std::get_if<parser::OpenMPSectionsConstruct>(220 &omp->value().u)}) {221 auto §ions =222 std::get<std::list<parser::OpenMPConstruct>>(ompCon->t);223 auto insertPos = std::next(it);224 for (auto §ionCon : sections) {225 auto §ion =226 std::get<parser::OpenMPSectionConstruct>(sectionCon.u);227 auto &innerBlock = std::get<parser::Block>(section.t);228 block.splice(insertPos, innerBlock);229 }230 block.erase(it);231 it = insertPos;232 continue;233 } else if (auto *atomic{std::get_if<parser::OpenMPAtomicConstruct>(234 &omp->value().u)}) {235 it = replaceInlineBlock(std::get<parser::Block>(atomic->t), it);236 continue;237 } else if (auto *critical{std::get_if<parser::OpenMPCriticalConstruct>(238 &omp->value().u)}) {239 it = replaceInlineBlock(std::get<parser::Block>(critical->t), it);240 continue;241 }242 }243 }244 ++it;245 }246}247 248// Finds misparsed statement functions in a specification part, rewrites249// them into array element assignment statements, and moves them into the250// beginning of the corresponding (execution part's) block.251void RewriteMutator::FixMisparsedStmtFuncs(252 parser::SpecificationPart &specPart, parser::Block &block) {253 auto &list{std::get<std::list<parser::DeclarationConstruct>>(specPart.t)};254 auto origFirst{block.begin()}; // insert each elem before origFirst255 for (auto it{list.begin()}; it != list.end();) {256 bool convert{false};257 if (auto *stmt{std::get_if<258 parser::Statement<common::Indirection<parser::StmtFunctionStmt>>>(259 &it->u)}) {260 if (const Symbol *261 symbol{std::get<parser::Name>(stmt->statement.value().t).symbol}) {262 const Symbol &ultimate{symbol->GetUltimate()};263 convert =264 ultimate.has<ObjectEntityDetails>() || ReturnsDataPointer(ultimate);265 if (convert) {266 auto newStmt{stmt->statement.value().ConvertToAssignment()};267 newStmt.source = stmt->source;268 block.insert(origFirst,269 parser::ExecutionPartConstruct{270 parser::ExecutableConstruct{std::move(newStmt)}});271 }272 }273 }274 if (convert) {275 it = list.erase(it);276 } else {277 ++it;278 }279 }280}281 282bool RewriteMutator::Pre(parser::MainProgram &program) {283 FixMisparsedStmtFuncs(std::get<parser::SpecificationPart>(program.t),284 std::get<parser::ExecutionPart>(program.t).v);285 if (context_.langOptions().OpenMPSimd) {286 OpenMPSimdOnly(std::get<parser::ExecutionPart>(program.t).v);287 OpenMPSimdOnly(std::get<parser::SpecificationPart>(program.t));288 }289 return true;290}291 292void RewriteMutator::Post(parser::MainProgram &program) {293 if (context_.langOptions().OpenMPSimd) {294 OpenMPSimdOnly(std::get<parser::ExecutionPart>(program.t).v);295 }296}297 298bool RewriteMutator::Pre(parser::Module &module) {299 if (context_.langOptions().OpenMPSimd) {300 OpenMPSimdOnly(std::get<parser::SpecificationPart>(module.t));301 }302 return true;303}304 305bool RewriteMutator::Pre(parser::FunctionSubprogram &func) {306 FixMisparsedStmtFuncs(std::get<parser::SpecificationPart>(func.t),307 std::get<parser::ExecutionPart>(func.t).v);308 if (context_.langOptions().OpenMPSimd) {309 OpenMPSimdOnly(std::get<parser::ExecutionPart>(func.t).v);310 }311 return true;312}313 314void RewriteMutator::Post(parser::FunctionSubprogram &func) {315 if (context_.langOptions().OpenMPSimd) {316 OpenMPSimdOnly(std::get<parser::ExecutionPart>(func.t).v);317 }318}319 320bool RewriteMutator::Pre(parser::SubroutineSubprogram &subr) {321 FixMisparsedStmtFuncs(std::get<parser::SpecificationPart>(subr.t),322 std::get<parser::ExecutionPart>(subr.t).v);323 if (context_.langOptions().OpenMPSimd) {324 OpenMPSimdOnly(std::get<parser::ExecutionPart>(subr.t).v);325 }326 return true;327}328 329void RewriteMutator::Post(parser::SubroutineSubprogram &subr) {330 if (context_.langOptions().OpenMPSimd) {331 OpenMPSimdOnly(std::get<parser::ExecutionPart>(subr.t).v);332 }333}334 335bool RewriteMutator::Pre(parser::SeparateModuleSubprogram &subp) {336 FixMisparsedStmtFuncs(std::get<parser::SpecificationPart>(subp.t),337 std::get<parser::ExecutionPart>(subp.t).v);338 if (context_.langOptions().OpenMPSimd) {339 OpenMPSimdOnly(std::get<parser::ExecutionPart>(subp.t).v);340 }341 return true;342}343 344void RewriteMutator::Post(parser::SeparateModuleSubprogram &subp) {345 if (context_.langOptions().OpenMPSimd) {346 OpenMPSimdOnly(std::get<parser::ExecutionPart>(subp.t).v);347 }348}349 350bool RewriteMutator::Pre(parser::BlockConstruct &block) {351 FixMisparsedStmtFuncs(std::get<parser::BlockSpecificationPart>(block.t).v,352 std::get<parser::Block>(block.t));353 if (context_.langOptions().OpenMPSimd) {354 OpenMPSimdOnly(std::get<parser::Block>(block.t));355 }356 return true;357}358 359void RewriteMutator::Post(parser::BlockConstruct &block) {360 if (context_.langOptions().OpenMPSimd) {361 OpenMPSimdOnly(std::get<parser::Block>(block.t));362 }363}364 365bool RewriteMutator::Pre(parser::Block &block) {366 if (context_.langOptions().OpenMPSimd) {367 OpenMPSimdOnly(block);368 }369 return true;370}371 372void RewriteMutator::Post(parser::Block &block) { this->Pre(block); }373 374bool RewriteMutator::Pre(parser::OmpBlockConstruct &block) {375 if (context_.langOptions().OpenMPSimd) {376 auto &innerBlock = std::get<parser::Block>(block.t);377 OpenMPSimdOnly(innerBlock);378 }379 return true;380}381 382void RewriteMutator::Post(parser::OmpBlockConstruct &block) {383 this->Pre(block);384}385 386bool RewriteMutator::Pre(parser::OpenMPLoopConstruct &ompLoop) {387 if (context_.langOptions().OpenMPSimd) {388 if (LoopConstructIsSIMD(&ompLoop)) {389 return true;390 }391 // If we're looking at a non-simd OpenMP loop, we need to explicitly392 // call OpenMPSimdOnly on the nested loop block while indicating where393 // the block comes from.394 for (auto &construct : std::get<parser::Block>(ompLoop.t)) {395 if (auto *doConstruct = parser::omp::GetDoConstruct(construct)) {396 auto &innerBlock = std::get<parser::Block>(doConstruct->t);397 OpenMPSimdOnly(const_cast<parser::Block &>(innerBlock),398 /*isNonSimdLoopBody=*/true);399 }400 }401 }402 return true;403}404 405void RewriteMutator::Post(parser::OpenMPLoopConstruct &ompLoop) {406 this->Pre(ompLoop);407}408 409bool RewriteMutator::Pre(parser::DoConstruct &doConstruct) {410 if (context_.langOptions().OpenMPSimd) {411 auto &innerBlock = std::get<parser::Block>(doConstruct.t);412 OpenMPSimdOnly(innerBlock);413 }414 return true;415}416 417void RewriteMutator::Post(parser::DoConstruct &doConstruct) {418 this->Pre(doConstruct);419}420 421bool RewriteMutator::Pre(parser::IfConstruct &ifConstruct) {422 if (context_.langOptions().OpenMPSimd) {423 auto &innerBlock = std::get<parser::Block>(ifConstruct.t);424 OpenMPSimdOnly(innerBlock);425 }426 return true;427}428 429void RewriteMutator::Post(parser::IfConstruct &ifConstruct) {430 this->Pre(ifConstruct);431}432 433// Rewrite PRINT NML -> WRITE(*,NML=NML)434bool RewriteMutator::Pre(parser::ActionStmt &x) {435 if (auto *print{std::get_if<common::Indirection<parser::PrintStmt>>(&x.u)};436 print &&437 std::get<std::list<parser::OutputItem>>(print->value().t).empty()) {438 auto &format{std::get<parser::Format>(print->value().t)};439 if (std::holds_alternative<parser::Expr>(format.u)) {440 if (auto *name{parser::Unwrap<parser::Name>(format)}; name &&441 name->symbol && name->symbol->GetUltimate().has<NamelistDetails>() &&442 context_.IsEnabled(common::LanguageFeature::PrintNamelist)) {443 context_.Warn(common::LanguageFeature::PrintNamelist, name->source,444 "nonstandard: namelist in PRINT statement"_port_en_US);445 std::list<parser::IoControlSpec> controls;446 controls.emplace_back(std::move(*name));447 x.u = common::Indirection<parser::WriteStmt>::Make(448 parser::IoUnit{parser::Star{}}, std::optional<parser::Format>{},449 std::move(controls), std::list<parser::OutputItem>{});450 }451 }452 }453 return true;454}455 456// When a namelist group name appears (without NML=) in a READ or WRITE457// statement in such a way that it can be misparsed as a format expression,458// rewrite the I/O statement's parse tree node as if the namelist group459// name had appeared with NML=.460template <typename READ_OR_WRITE>461void FixMisparsedUntaggedNamelistName(READ_OR_WRITE &x) {462 if (x.iounit && x.format &&463 std::holds_alternative<parser::Expr>(x.format->u)) {464 if (const parser::Name * name{parser::Unwrap<parser::Name>(x.format)}) {465 if (name->symbol && name->symbol->GetUltimate().has<NamelistDetails>()) {466 x.controls.emplace_front(parser::IoControlSpec{std::move(*name)});467 x.format.reset();468 }469 }470 }471}472 473// READ(CVAR) [, ...] will be misparsed as UNIT=CVAR; correct474// it to READ CVAR [,...] with CVAR as a format rather than as475// an internal I/O unit for unformatted I/O, which Fortran does476// not support.477void RewriteMutator::Post(parser::ReadStmt &x) {478 if (x.iounit && !x.format && x.controls.empty()) {479 if (auto *var{std::get_if<parser::Variable>(&x.iounit->u)}) {480 const parser::Name &last{parser::GetLastName(*var)};481 DeclTypeSpec *type{last.symbol ? last.symbol->GetType() : nullptr};482 if (type && type->category() == DeclTypeSpec::Character) {483 x.format = common::visit(484 [](auto &&indirection) {485 return parser::Expr{std::move(indirection)};486 },487 std::move(var->u));488 x.iounit.reset();489 }490 }491 }492 FixMisparsedUntaggedNamelistName(x);493}494 495void RewriteMutator::Post(parser::WriteStmt &x) {496 FixMisparsedUntaggedNamelistName(x);497}498 499bool RewriteParseTree(SemanticsContext &context, parser::Program &program) {500 RewriteMutator mutator{context};501 parser::Walk(program, mutator);502 return !context.AnyFatalError();503}504 505} // namespace Fortran::semantics506