//===-- Bridge.cpp -- bridge to lower to MLIR -----------------------------===// // // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. // See https://llvm.org/LICENSE.txt for license information. // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception // //===----------------------------------------------------------------------===// // // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ // //===----------------------------------------------------------------------===// #include "flang/Lower/Bridge.h" #include "flang/Evaluate/tools.h" #include "flang/Lower/CallInterface.h" #include "flang/Lower/ConvertExpr.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/ConvertVariable.h" #include "flang/Lower/Mangler.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Runtime.h" #include "flang/Lower/StatementContext.h" #include "flang/Lower/SymbolMap.h" #include "flang/Lower/Todo.h" #include "flang/Optimizer/Support/FIRContext.h" #include "flang/Semantics/tools.h" #include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h" #include "mlir/IR/PatternMatch.h" #include "mlir/Transforms/RegionUtils.h" #include "llvm/Support/CommandLine.h" #include "llvm/Support/Debug.h" #define DEBUG_TYPE "flang-lower-bridge" static llvm::cl::opt dumpBeforeFir( "fdebug-dump-pre-fir", llvm::cl::init(false), llvm::cl::desc("dump the Pre-FIR tree prior to FIR generation")); //===----------------------------------------------------------------------===// // FirConverter //===----------------------------------------------------------------------===// namespace { /// Traverse the pre-FIR tree (PFT) to generate the FIR dialect of MLIR. class FirConverter : public Fortran::lower::AbstractConverter { public: explicit FirConverter(Fortran::lower::LoweringBridge &bridge) : bridge{bridge}, foldingContext{bridge.createFoldingContext()} {} virtual ~FirConverter() = default; /// Convert the PFT to FIR. void run(Fortran::lower::pft::Program &pft) { // Primary translation pass. for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) { std::visit( Fortran::common::visitors{ [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); }, [&](Fortran::lower::pft::ModuleLikeUnit &m) {}, [&](Fortran::lower::pft::BlockDataUnit &b) {}, [&](Fortran::lower::pft::CompilerDirectiveUnit &d) { setCurrentPosition( d.get().source); mlir::emitWarning(toLocation(), "ignoring all compiler directives"); }, }, u); } } //===--------------------------------------------------------------------===// // AbstractConverter overrides //===--------------------------------------------------------------------===// mlir::Value getSymbolAddress(Fortran::lower::SymbolRef sym) override final { return lookupSymbol(sym).getAddr(); } fir::ExtendedValue genExprAddr(const Fortran::lower::SomeExpr &expr, Fortran::lower::StatementContext &context, mlir::Location *loc = nullptr) override final { return createSomeExtendedAddress(loc ? *loc : toLocation(), *this, expr, localSymbols, context); } fir::ExtendedValue genExprValue(const Fortran::lower::SomeExpr &expr, Fortran::lower::StatementContext &context, mlir::Location *loc = nullptr) override final { return createSomeExtendedExpression(loc ? *loc : toLocation(), *this, expr, localSymbols, context); } Fortran::evaluate::FoldingContext &getFoldingContext() override final { return foldingContext; } mlir::Type genType(const Fortran::evaluate::DataRef &) override final { TODO_NOLOC("Not implemented genType DataRef. Needed for more complex " "expression lowering"); } mlir::Type genType(const Fortran::lower::SomeExpr &expr) override final { return Fortran::lower::translateSomeExprToFIRType(*this, expr); } mlir::Type genType(Fortran::lower::SymbolRef sym) override final { return Fortran::lower::translateSymbolToFIRType(*this, sym); } mlir::Type genType(Fortran::common::TypeCategory tc) override final { TODO_NOLOC("Not implemented genType TypeCategory. Needed for more complex " "expression lowering"); } mlir::Type genType(Fortran::common::TypeCategory tc, int kind) override final { return Fortran::lower::getFIRType(&getMLIRContext(), tc, kind); } mlir::Type genType(const Fortran::lower::pft::Variable &var) override final { return Fortran::lower::translateVariableToFIRType(*this, var); } void setCurrentPosition(const Fortran::parser::CharBlock &position) { if (position != Fortran::parser::CharBlock{}) currentPosition = position; } //===--------------------------------------------------------------------===// // Utility methods //===--------------------------------------------------------------------===// /// Convert a parser CharBlock to a Location mlir::Location toLocation(const Fortran::parser::CharBlock &cb) { return genLocation(cb); } mlir::Location toLocation() { return toLocation(currentPosition); } void setCurrentEval(Fortran::lower::pft::Evaluation &eval) { evalPtr = &eval; } Fortran::lower::pft::Evaluation &getEval() { assert(evalPtr && "current evaluation not set"); return *evalPtr; } mlir::Location getCurrentLocation() override final { return toLocation(); } /// Generate a dummy location. mlir::Location genUnknownLocation() override final { // Note: builder may not be instantiated yet return mlir::UnknownLoc::get(&getMLIRContext()); } /// Generate a `Location` from the `CharBlock`. mlir::Location genLocation(const Fortran::parser::CharBlock &block) override final { if (const Fortran::parser::AllCookedSources *cooked = bridge.getCookedSource()) { if (std::optional> loc = cooked->GetSourcePositionRange(block)) { // loc is a pair (begin, end); use the beginning position Fortran::parser::SourcePosition &filePos = loc->first; return mlir::FileLineColLoc::get(&getMLIRContext(), filePos.file.path(), filePos.line, filePos.column); } } return genUnknownLocation(); } fir::FirOpBuilder &getFirOpBuilder() override final { return *builder; } mlir::ModuleOp &getModuleOp() override final { return bridge.getModule(); } mlir::MLIRContext &getMLIRContext() override final { return bridge.getMLIRContext(); } std::string mangleName(const Fortran::semantics::Symbol &symbol) override final { return Fortran::lower::mangle::mangleName(symbol); } const fir::KindMapping &getKindMap() override final { return bridge.getKindMap(); } /// Return the predicate: "current block does not have a terminator branch". bool blockIsUnterminated() { mlir::Block *currentBlock = builder->getBlock(); return currentBlock->empty() || !currentBlock->back().hasTrait(); } /// Unconditionally switch code insertion to a new block. void startBlock(mlir::Block *newBlock) { assert(newBlock && "missing block"); // Default termination for the current block is a fallthrough branch to // the new block. if (blockIsUnterminated()) genFIRBranch(newBlock); // Some blocks may be re/started more than once, and might not be empty. // If the new block already has (only) a terminator, set the insertion // point to the start of the block. Otherwise set it to the end. // Note that setting the insertion point causes the subsequent function // call to check the existence of terminator in the newBlock. builder->setInsertionPointToStart(newBlock); if (blockIsUnterminated()) builder->setInsertionPointToEnd(newBlock); } /// Conditionally switch code insertion to a new block. void maybeStartBlock(mlir::Block *newBlock) { if (newBlock) startBlock(newBlock); } /// Emit return and cleanup after the function has been translated. void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { setCurrentPosition(Fortran::lower::pft::stmtSourceLoc(funit.endStmt)); if (funit.isMainProgram()) genExitRoutine(); else genFIRProcedureExit(funit, funit.getSubprogramSymbol()); funit.finalBlock = nullptr; LLVM_DEBUG(llvm::dbgs() << "*** Lowering result:\n\n" << *builder->getFunction() << '\n'); // FIXME: Simplification should happen in a normal pass, not here. mlir::IRRewriter rewriter(*builder); (void)mlir::simplifyRegions(rewriter, {builder->getRegion()}); // remove dead code delete builder; builder = nullptr; hostAssocTuple = mlir::Value{}; localSymbols.clear(); } /// Map mlir function block arguments to the corresponding Fortran dummy /// variables. When the result is passed as a hidden argument, the Fortran /// result is also mapped. The symbol map is used to hold this mapping. void mapDummiesAndResults(Fortran::lower::pft::FunctionLikeUnit &funit, const Fortran::lower::CalleeInterface &callee) { assert(builder && "require a builder object at this point"); using PassBy = Fortran::lower::CalleeInterface::PassEntityBy; auto mapPassedEntity = [&](const auto arg) -> void { if (arg.passBy == PassBy::AddressAndLength) { // // TODO: now that fir call has some attributes regarding character // // return, PassBy::AddressAndLength should be retired. // mlir::Location loc = toLocation(); // fir::factory::CharacterExprHelper charHelp{*builder, loc}; // mlir::Value box = // charHelp.createEmboxChar(arg.firArgument, arg.firLength); // addSymbol(arg.entity->get(), box); } else { if (arg.entity.has_value()) { addSymbol(arg.entity->get(), arg.firArgument); } else { // assert(funit.parentHasHostAssoc()); // funit.parentHostAssoc().internalProcedureBindings(*this, // localSymbols); } } }; for (const Fortran::lower::CalleeInterface::PassedEntity &arg : callee.getPassedArguments()) mapPassedEntity(arg); // Allocate local skeleton instances of dummies from other entry points. // Most of these locals will not survive into final generated code, but // some will. It is illegal to reference them at run time if they do. for (const Fortran::semantics::Symbol *arg : funit.nonUniversalDummyArguments) { if (lookupSymbol(*arg)) continue; mlir::Type type = genType(*arg); // TODO: Account for VALUE arguments (and possibly other variants). type = builder->getRefType(type); addSymbol(*arg, builder->create(toLocation(), type)); } if (std::optional passedResult = callee.getPassedResult()) { mapPassedEntity(*passedResult); // FIXME: need to make sure things are OK here. addSymbol may not be OK if (funit.primaryResult && passedResult->entity->get() != *funit.primaryResult) addSymbol(*funit.primaryResult, getSymbolAddress(passedResult->entity->get())); } } /// Instantiate variable \p var and add it to the symbol map. /// See ConvertVariable.cpp. void instantiateVar(const Fortran::lower::pft::Variable &var) { Fortran::lower::instantiateVariable(*this, var, localSymbols); } /// Prepare to translate a new function void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) { assert(!builder && "expected nullptr"); Fortran::lower::CalleeInterface callee(funit, *this); mlir::FuncOp func = callee.addEntryBlockAndMapArguments(); func.setVisibility(mlir::SymbolTable::Visibility::Public); builder = new fir::FirOpBuilder(func, bridge.getKindMap()); assert(builder && "FirOpBuilder did not instantiate"); builder->setInsertionPointToStart(&func.front()); mapDummiesAndResults(funit, callee); for (const Fortran::lower::pft::Variable &var : funit.getOrderedSymbolTable()) { const Fortran::semantics::Symbol &sym = var.getSymbol(); if (!sym.IsFuncResult() || !funit.primaryResult) { instantiateVar(var); } else if (&sym == funit.primaryResult) { instantiateVar(var); } } // Create most function blocks in advance. createEmptyGlobalBlocks(funit.evaluationList); // Reinstate entry block as the current insertion point. builder->setInsertionPointToEnd(&func.front()); } /// Create global blocks for the current function. This eliminates the /// distinction between forward and backward targets when generating /// branches. A block is "global" if it can be the target of a GOTO or /// other source code branch. A block that can only be targeted by a /// compiler generated branch is "local". For example, a DO loop preheader /// block containing loop initialization code is global. A loop header /// block, which is the target of the loop back edge, is local. Blocks /// belong to a region. Any block within a nested region must be replaced /// with a block belonging to that region. Branches may not cross region /// boundaries. void createEmptyGlobalBlocks( std::list &evaluationList) { mlir::Region *region = &builder->getRegion(); for (Fortran::lower::pft::Evaluation &eval : evaluationList) { if (eval.isNewBlock) eval.block = builder->createBlock(region); if (eval.isConstruct() || eval.isDirective()) { if (eval.lowerAsUnstructured()) { createEmptyGlobalBlocks(eval.getNestedEvaluations()); } else if (eval.hasNestedEvaluations()) { TODO(toLocation(), "Constructs with nested evaluations"); } } } } /// Lower a procedure (nest). void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) { setCurrentPosition(funit.getStartingSourceLoc()); for (int entryIndex = 0, last = funit.entryPointList.size(); entryIndex < last; ++entryIndex) { funit.setActiveEntry(entryIndex); startNewFunction(funit); // the entry point for lowering this procedure for (Fortran::lower::pft::Evaluation &eval : funit.evaluationList) genFIR(eval); endNewFunction(funit); } funit.setActiveEntry(0); for (Fortran::lower::pft::FunctionLikeUnit &f : funit.nestedFunctions) lowerFunc(f); // internal procedure } mlir::Value hostAssocTupleValue() override final { return hostAssocTuple; } private: FirConverter() = delete; FirConverter(const FirConverter &) = delete; FirConverter &operator=(const FirConverter &) = delete; //===--------------------------------------------------------------------===// // Helper member functions //===--------------------------------------------------------------------===// /// Find the symbol in the local map or return null. Fortran::lower::SymbolBox lookupSymbol(const Fortran::semantics::Symbol &sym) { if (Fortran::lower::SymbolBox v = localSymbols.lookupSymbol(sym)) return v; return {}; } /// Add the symbol to the local map and return `true`. If the symbol is /// already in the map and \p forced is `false`, the map is not updated. /// Instead the value `false` is returned. bool addSymbol(const Fortran::semantics::SymbolRef sym, mlir::Value val, bool forced = false) { if (!forced && lookupSymbol(sym)) return false; localSymbols.addSymbol(sym, val, forced); return true; } bool isNumericScalarCategory(Fortran::common::TypeCategory cat) { return cat == Fortran::common::TypeCategory::Integer || cat == Fortran::common::TypeCategory::Real || cat == Fortran::common::TypeCategory::Complex || cat == Fortran::common::TypeCategory::Logical; } bool isCharacterCategory(Fortran::common::TypeCategory cat) { return cat == Fortran::common::TypeCategory::Character; } bool isDerivedCategory(Fortran::common::TypeCategory cat) { return cat == Fortran::common::TypeCategory::Derived; } void genFIRBranch(mlir::Block *targetBlock) { assert(targetBlock && "missing unconditional target block"); builder->create(toLocation(), targetBlock); } //===--------------------------------------------------------------------===// // Termination of symbolically referenced execution units //===--------------------------------------------------------------------===// /// END of program /// /// Generate the cleanup block before the program exits void genExitRoutine() { if (blockIsUnterminated()) builder->create(toLocation()); } void genFIR(const Fortran::parser::EndProgramStmt &) { genExitRoutine(); } /// END of procedure-like constructs /// /// Generate the cleanup block before the procedure exits void genReturnSymbol(const Fortran::semantics::Symbol &functionSymbol) { const Fortran::semantics::Symbol &resultSym = functionSymbol.get().result(); Fortran::lower::SymbolBox resultSymBox = lookupSymbol(resultSym); mlir::Location loc = toLocation(); if (!resultSymBox) { mlir::emitError(loc, "failed lowering function return"); return; } mlir::Value resultVal = resultSymBox.match( [&](const fir::CharBoxValue &x) -> mlir::Value { TODO(loc, "Function return CharBoxValue"); }, [&](const auto &) -> mlir::Value { mlir::Value resultRef = resultSymBox.getAddr(); mlir::Type resultType = genType(resultSym); mlir::Type resultRefType = builder->getRefType(resultType); // A function with multiple entry points returning different types // tags all result variables with one of the largest types to allow // them to share the same storage. Convert this to the actual type. if (resultRef.getType() != resultRefType) TODO(loc, "Convert to actual type"); return builder->create(loc, resultRef); }); builder->create(loc, resultVal); } void genFIRProcedureExit(Fortran::lower::pft::FunctionLikeUnit &funit, const Fortran::semantics::Symbol &symbol) { if (mlir::Block *finalBlock = funit.finalBlock) { // The current block must end with a terminator. if (blockIsUnterminated()) builder->create(toLocation(), finalBlock); // Set insertion point to final block. builder->setInsertionPoint(finalBlock, finalBlock->end()); } if (Fortran::semantics::IsFunction(symbol)) { genReturnSymbol(symbol); } else { genExitRoutine(); } } [[maybe_unused]] static bool isFuncResultDesignator(const Fortran::lower::SomeExpr &expr) { const Fortran::semantics::Symbol *sym = Fortran::evaluate::GetFirstSymbol(expr); return sym && sym->IsFuncResult(); } static bool isWholeAllocatable(const Fortran::lower::SomeExpr &expr) { const Fortran::semantics::Symbol *sym = Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(expr); return sym && Fortran::semantics::IsAllocatable(*sym); } void genAssignment(const Fortran::evaluate::Assignment &assign) { Fortran::lower::StatementContext stmtCtx; mlir::Location loc = toLocation(); std::visit( Fortran::common::visitors{ // [1] Plain old assignment. [&](const Fortran::evaluate::Assignment::Intrinsic &) { const Fortran::semantics::Symbol *sym = Fortran::evaluate::GetLastSymbol(assign.lhs); if (!sym) TODO(loc, "assignment to pointer result of function reference"); std::optional lhsType = assign.lhs.GetType(); assert(lhsType && "lhs cannot be typeless"); // Assignment to polymorphic allocatables may require changing the // variable dynamic type (See Fortran 2018 10.2.1.3 p3). if (lhsType->IsPolymorphic() && isWholeAllocatable(assign.lhs)) TODO(loc, "assignment to polymorphic allocatable"); // Note: No ad-hoc handling for pointers is required here. The // target will be assigned as per 2018 10.2.1.3 p2. genExprAddr // on a pointer returns the target address and not the address of // the pointer variable. if (assign.lhs.Rank() > 0) { // Array assignment // See Fortran 2018 10.2.1.3 p5, p6, and p7 TODO(toLocation(), "Array assignment"); return; } // Scalar assignment const bool isNumericScalar = isNumericScalarCategory(lhsType->category()); fir::ExtendedValue rhs = isNumericScalar ? genExprValue(assign.rhs, stmtCtx) : genExprAddr(assign.rhs, stmtCtx); if (isNumericScalar) { // Fortran 2018 10.2.1.3 p8 and p9 // Conversions should have been inserted by semantic analysis, // but they can be incorrect between the rhs and lhs. Correct // that here. mlir::Value addr = fir::getBase(genExprAddr(assign.lhs, stmtCtx)); mlir::Value val = fir::getBase(rhs); // A function with multiple entry points returning different // types tags all result variables with one of the largest // types to allow them to share the same storage. Assignment // to a result variable of one of the other types requires // conversion to the actual type. mlir::Type toTy = genType(assign.lhs); mlir::Value cast = builder->convertWithSemantics(loc, toTy, val); if (fir::dyn_cast_ptrEleTy(addr.getType()) != toTy) { assert(isFuncResultDesignator(assign.lhs) && "type mismatch"); addr = builder->createConvert( toLocation(), builder->getRefType(toTy), addr); } builder->create(loc, cast, addr); } else if (isCharacterCategory(lhsType->category())) { TODO(toLocation(), "Character assignment"); } else if (isDerivedCategory(lhsType->category())) { TODO(toLocation(), "Derived type assignment"); } else { llvm_unreachable("unknown category"); } }, // [2] User defined assignment. If the context is a scalar // expression then call the procedure. [&](const Fortran::evaluate::ProcedureRef &procRef) { TODO(toLocation(), "User defined assignment"); }, // [3] Pointer assignment with possibly empty bounds-spec. R1035: a // bounds-spec is a lower bound value. [&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) { TODO(toLocation(), "Pointer assignment with possibly empty bounds-spec"); }, // [4] Pointer assignment with bounds-remapping. R1036: a // bounds-remapping is a pair, lower bound and upper bound. [&](const Fortran::evaluate::Assignment::BoundsRemapping &boundExprs) { TODO(toLocation(), "Pointer assignment with bounds-remapping"); }, }, assign.u); } /// Lowering of CALL statement void genFIR(const Fortran::parser::CallStmt &stmt) { Fortran::lower::StatementContext stmtCtx; setCurrentPosition(stmt.v.source); assert(stmt.typedCall && "Call was not analyzed"); // Call statement lowering shares code with function call lowering. mlir::Value res = Fortran::lower::createSubroutineCall( *this, *stmt.typedCall, localSymbols, stmtCtx); if (!res) return; // "Normal" subroutine call. } void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) { TODO(toLocation(), "ComputedGotoStmt lowering"); } void genFIR(const Fortran::parser::ArithmeticIfStmt &stmt) { TODO(toLocation(), "ArithmeticIfStmt lowering"); } void genFIR(const Fortran::parser::AssignedGotoStmt &stmt) { TODO(toLocation(), "AssignedGotoStmt lowering"); } void genFIR(const Fortran::parser::DoConstruct &doConstruct) { TODO(toLocation(), "DoConstruct lowering"); } void genFIR(const Fortran::parser::IfConstruct &) { TODO(toLocation(), "IfConstruct lowering"); } void genFIR(const Fortran::parser::CaseConstruct &) { TODO(toLocation(), "CaseConstruct lowering"); } void genFIR(const Fortran::parser::ConcurrentHeader &header) { TODO(toLocation(), "ConcurrentHeader lowering"); } void genFIR(const Fortran::parser::ForallAssignmentStmt &stmt) { TODO(toLocation(), "ForallAssignmentStmt lowering"); } void genFIR(const Fortran::parser::EndForallStmt &) { TODO(toLocation(), "EndForallStmt lowering"); } void genFIR(const Fortran::parser::ForallStmt &) { TODO(toLocation(), "ForallStmt lowering"); } void genFIR(const Fortran::parser::ForallConstruct &) { TODO(toLocation(), "ForallConstruct lowering"); } void genFIR(const Fortran::parser::ForallConstructStmt &) { TODO(toLocation(), "ForallConstructStmt lowering"); } void genFIR(const Fortran::parser::CompilerDirective &) { TODO(toLocation(), "CompilerDirective lowering"); } void genFIR(const Fortran::parser::OpenACCConstruct &) { TODO(toLocation(), "OpenACCConstruct lowering"); } void genFIR(const Fortran::parser::OpenACCDeclarativeConstruct &) { TODO(toLocation(), "OpenACCDeclarativeConstruct lowering"); } void genFIR(const Fortran::parser::OpenMPConstruct &) { TODO(toLocation(), "OpenMPConstruct lowering"); } void genFIR(const Fortran::parser::OpenMPDeclarativeConstruct &) { TODO(toLocation(), "OpenMPDeclarativeConstruct lowering"); } void genFIR(const Fortran::parser::SelectCaseStmt &) { TODO(toLocation(), "SelectCaseStmt lowering"); } void genFIR(const Fortran::parser::AssociateConstruct &) { TODO(toLocation(), "AssociateConstruct lowering"); } void genFIR(const Fortran::parser::BlockConstruct &blockConstruct) { TODO(toLocation(), "BlockConstruct lowering"); } void genFIR(const Fortran::parser::BlockStmt &) { TODO(toLocation(), "BlockStmt lowering"); } void genFIR(const Fortran::parser::EndBlockStmt &) { TODO(toLocation(), "EndBlockStmt lowering"); } void genFIR(const Fortran::parser::ChangeTeamConstruct &construct) { TODO(toLocation(), "ChangeTeamConstruct lowering"); } void genFIR(const Fortran::parser::ChangeTeamStmt &stmt) { TODO(toLocation(), "ChangeTeamStmt lowering"); } void genFIR(const Fortran::parser::EndChangeTeamStmt &stmt) { TODO(toLocation(), "EndChangeTeamStmt lowering"); } void genFIR(const Fortran::parser::CriticalConstruct &criticalConstruct) { TODO(toLocation(), "CriticalConstruct lowering"); } void genFIR(const Fortran::parser::CriticalStmt &) { TODO(toLocation(), "CriticalStmt lowering"); } void genFIR(const Fortran::parser::EndCriticalStmt &) { TODO(toLocation(), "EndCriticalStmt lowering"); } void genFIR(const Fortran::parser::SelectRankConstruct &selectRankConstruct) { TODO(toLocation(), "SelectRankConstruct lowering"); } void genFIR(const Fortran::parser::SelectRankStmt &) { TODO(toLocation(), "SelectRankStmt lowering"); } void genFIR(const Fortran::parser::SelectRankCaseStmt &) { TODO(toLocation(), "SelectRankCaseStmt lowering"); } void genFIR(const Fortran::parser::SelectTypeConstruct &selectTypeConstruct) { TODO(toLocation(), "SelectTypeConstruct lowering"); } void genFIR(const Fortran::parser::SelectTypeStmt &) { TODO(toLocation(), "SelectTypeStmt lowering"); } void genFIR(const Fortran::parser::TypeGuardStmt &) { TODO(toLocation(), "TypeGuardStmt lowering"); } //===--------------------------------------------------------------------===// // IO statements (see io.h) //===--------------------------------------------------------------------===// void genFIR(const Fortran::parser::BackspaceStmt &stmt) { TODO(toLocation(), "BackspaceStmt lowering"); } void genFIR(const Fortran::parser::CloseStmt &stmt) { TODO(toLocation(), "CloseStmt lowering"); } void genFIR(const Fortran::parser::EndfileStmt &stmt) { TODO(toLocation(), "EndfileStmt lowering"); } void genFIR(const Fortran::parser::FlushStmt &stmt) { TODO(toLocation(), "FlushStmt lowering"); } void genFIR(const Fortran::parser::InquireStmt &stmt) { TODO(toLocation(), "InquireStmt lowering"); } void genFIR(const Fortran::parser::OpenStmt &stmt) { TODO(toLocation(), "OpenStmt lowering"); } void genFIR(const Fortran::parser::PrintStmt &stmt) { TODO(toLocation(), "PrintStmt lowering"); } void genFIR(const Fortran::parser::ReadStmt &stmt) { TODO(toLocation(), "ReadStmt lowering"); } void genFIR(const Fortran::parser::RewindStmt &stmt) { TODO(toLocation(), "RewindStmt lowering"); } void genFIR(const Fortran::parser::WaitStmt &stmt) { TODO(toLocation(), "WaitStmt lowering"); } void genFIR(const Fortran::parser::WriteStmt &stmt) { TODO(toLocation(), "WriteStmt lowering"); } //===--------------------------------------------------------------------===// // Memory allocation and deallocation //===--------------------------------------------------------------------===// void genFIR(const Fortran::parser::AllocateStmt &stmt) { TODO(toLocation(), "AllocateStmt lowering"); } void genFIR(const Fortran::parser::DeallocateStmt &stmt) { TODO(toLocation(), "DeallocateStmt lowering"); } void genFIR(const Fortran::parser::NullifyStmt &stmt) { TODO(toLocation(), "NullifyStmt lowering"); } //===--------------------------------------------------------------------===// void genFIR(const Fortran::parser::EventPostStmt &stmt) { TODO(toLocation(), "EventPostStmt lowering"); } void genFIR(const Fortran::parser::EventWaitStmt &stmt) { TODO(toLocation(), "EventWaitStmt lowering"); } void genFIR(const Fortran::parser::FormTeamStmt &stmt) { TODO(toLocation(), "FormTeamStmt lowering"); } void genFIR(const Fortran::parser::LockStmt &stmt) { TODO(toLocation(), "LockStmt lowering"); } void genFIR(const Fortran::parser::WhereConstruct &c) { TODO(toLocation(), "WhereConstruct lowering"); } void genFIR(const Fortran::parser::WhereBodyConstruct &body) { TODO(toLocation(), "WhereBodyConstruct lowering"); } void genFIR(const Fortran::parser::WhereConstructStmt &stmt) { TODO(toLocation(), "WhereConstructStmt lowering"); } void genFIR(const Fortran::parser::WhereConstruct::MaskedElsewhere &ew) { TODO(toLocation(), "MaskedElsewhere lowering"); } void genFIR(const Fortran::parser::MaskedElsewhereStmt &stmt) { TODO(toLocation(), "MaskedElsewhereStmt lowering"); } void genFIR(const Fortran::parser::WhereConstruct::Elsewhere &ew) { TODO(toLocation(), "Elsewhere lowering"); } void genFIR(const Fortran::parser::ElsewhereStmt &stmt) { TODO(toLocation(), "ElsewhereStmt lowering"); } void genFIR(const Fortran::parser::EndWhereStmt &) { TODO(toLocation(), "EndWhereStmt lowering"); } void genFIR(const Fortran::parser::WhereStmt &stmt) { TODO(toLocation(), "WhereStmt lowering"); } void genFIR(const Fortran::parser::PointerAssignmentStmt &stmt) { TODO(toLocation(), "PointerAssignmentStmt lowering"); } void genFIR(const Fortran::parser::AssignmentStmt &stmt) { genAssignment(*stmt.typedAssignment->v); } void genFIR(const Fortran::parser::SyncAllStmt &stmt) { TODO(toLocation(), "SyncAllStmt lowering"); } void genFIR(const Fortran::parser::SyncImagesStmt &stmt) { TODO(toLocation(), "SyncImagesStmt lowering"); } void genFIR(const Fortran::parser::SyncMemoryStmt &stmt) { TODO(toLocation(), "SyncMemoryStmt lowering"); } void genFIR(const Fortran::parser::SyncTeamStmt &stmt) { TODO(toLocation(), "SyncTeamStmt lowering"); } void genFIR(const Fortran::parser::UnlockStmt &stmt) { TODO(toLocation(), "UnlockStmt lowering"); } void genFIR(const Fortran::parser::AssignStmt &stmt) { TODO(toLocation(), "AssignStmt lowering"); } void genFIR(const Fortran::parser::FormatStmt &) { TODO(toLocation(), "FormatStmt lowering"); } void genFIR(const Fortran::parser::PauseStmt &stmt) { genPauseStatement(*this, stmt); } void genFIR(const Fortran::parser::FailImageStmt &stmt) { TODO(toLocation(), "FailImageStmt lowering"); } // call STOP, ERROR STOP in runtime void genFIR(const Fortran::parser::StopStmt &stmt) { genStopStatement(*this, stmt); } void genFIR(const Fortran::parser::ReturnStmt &stmt) { Fortran::lower::pft::FunctionLikeUnit *funit = getEval().getOwningProcedure(); assert(funit && "not inside main program, function or subroutine"); if (funit->isMainProgram()) { genExitRoutine(); return; } mlir::Location loc = toLocation(); if (stmt.v) { TODO(loc, "Alternate return statement"); } // Branch to the last block of the SUBROUTINE, which has the actual return. if (!funit->finalBlock) { mlir::OpBuilder::InsertPoint insPt = builder->saveInsertionPoint(); funit->finalBlock = builder->createBlock(&builder->getRegion()); builder->restoreInsertionPoint(insPt); } builder->create(loc, funit->finalBlock); } void genFIR(const Fortran::parser::CycleStmt &) { TODO(toLocation(), "CycleStmt lowering"); } void genFIR(const Fortran::parser::ExitStmt &) { TODO(toLocation(), "ExitStmt lowering"); } void genFIR(const Fortran::parser::GotoStmt &) { genFIRBranch(getEval().controlSuccessor->block); } void genFIR(const Fortran::parser::AssociateStmt &) { TODO(toLocation(), "AssociateStmt lowering"); } void genFIR(const Fortran::parser::CaseStmt &) { TODO(toLocation(), "CaseStmt lowering"); } void genFIR(const Fortran::parser::ContinueStmt &) { TODO(toLocation(), "ContinueStmt lowering"); } void genFIR(const Fortran::parser::ElseIfStmt &) { TODO(toLocation(), "ElseIfStmt lowering"); } void genFIR(const Fortran::parser::ElseStmt &) { TODO(toLocation(), "ElseStmt lowering"); } void genFIR(const Fortran::parser::EndAssociateStmt &) { TODO(toLocation(), "EndAssociateStmt lowering"); } void genFIR(const Fortran::parser::EndDoStmt &) { TODO(toLocation(), "EndDoStmt lowering"); } void genFIR(const Fortran::parser::EndIfStmt &) { TODO(toLocation(), "EndIfStmt lowering"); } void genFIR(const Fortran::parser::EndMpSubprogramStmt &) { TODO(toLocation(), "EndMpSubprogramStmt lowering"); } void genFIR(const Fortran::parser::EndSelectStmt &) { TODO(toLocation(), "EndSelectStmt lowering"); } // Nop statements - No code, or code is generated at the construct level. void genFIR(const Fortran::parser::EndFunctionStmt &) {} // nop void genFIR(const Fortran::parser::EndSubroutineStmt &) {} // nop void genFIR(const Fortran::parser::EntryStmt &) { TODO(toLocation(), "EntryStmt lowering"); } void genFIR(const Fortran::parser::IfStmt &) { TODO(toLocation(), "IfStmt lowering"); } void genFIR(const Fortran::parser::IfThenStmt &) { TODO(toLocation(), "IfThenStmt lowering"); } void genFIR(const Fortran::parser::NonLabelDoStmt &) { TODO(toLocation(), "NonLabelDoStmt lowering"); } void genFIR(const Fortran::parser::OmpEndLoopDirective &) { TODO(toLocation(), "OmpEndLoopDirective lowering"); } void genFIR(const Fortran::parser::NamelistStmt &) { TODO(toLocation(), "NamelistStmt lowering"); } void genFIR(Fortran::lower::pft::Evaluation &eval, bool unstructuredContext = true) { if (unstructuredContext) { // When transitioning from unstructured to structured code, // the structured code could be a target that starts a new block. maybeStartBlock(eval.isConstruct() && eval.lowerAsStructured() ? eval.getFirstNestedEvaluation().block : eval.block); } setCurrentEval(eval); setCurrentPosition(eval.position); eval.visit([&](const auto &stmt) { genFIR(stmt); }); } //===--------------------------------------------------------------------===// Fortran::lower::LoweringBridge &bridge; Fortran::evaluate::FoldingContext foldingContext; fir::FirOpBuilder *builder = nullptr; Fortran::lower::pft::Evaluation *evalPtr = nullptr; Fortran::lower::SymMap localSymbols; Fortran::parser::CharBlock currentPosition; /// Tuple of host assoicated variables. mlir::Value hostAssocTuple; }; } // namespace Fortran::evaluate::FoldingContext Fortran::lower::LoweringBridge::createFoldingContext() const { return {getDefaultKinds(), getIntrinsicTable()}; } void Fortran::lower::LoweringBridge::lower( const Fortran::parser::Program &prg, const Fortran::semantics::SemanticsContext &semanticsContext) { std::unique_ptr pft = Fortran::lower::createPFT(prg, semanticsContext); if (dumpBeforeFir) Fortran::lower::dumpPFT(llvm::errs(), *pft); FirConverter converter{*this}; converter.run(*pft); } Fortran::lower::LoweringBridge::LoweringBridge( mlir::MLIRContext &context, const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds, const Fortran::evaluate::IntrinsicProcTable &intrinsics, const Fortran::parser::AllCookedSources &cooked, llvm::StringRef triple, fir::KindMapping &kindMap) : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked}, context{context}, kindMap{kindMap} { // Register the diagnostic handler. context.getDiagEngine().registerHandler([](mlir::Diagnostic &diag) { llvm::raw_ostream &os = llvm::errs(); switch (diag.getSeverity()) { case mlir::DiagnosticSeverity::Error: os << "error: "; break; case mlir::DiagnosticSeverity::Remark: os << "info: "; break; case mlir::DiagnosticSeverity::Warning: os << "warning: "; break; default: break; } if (!diag.getLocation().isa()) os << diag.getLocation() << ": "; os << diag << '\n'; os.flush(); return mlir::success(); }); // Create the module and attach the attributes. module = std::make_unique( mlir::ModuleOp::create(mlir::UnknownLoc::get(&context))); assert(module.get() && "module was not created"); fir::setTargetTriple(*module.get(), triple); fir::setKindMapping(*module.get(), kindMap); }