1 //===-- Bridge.cpp -- bridge to lower to MLIR -----------------------------===//
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 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
10 //
11 //===----------------------------------------------------------------------===//
12 
13 #include "flang/Lower/Bridge.h"
14 #include "flang/Evaluate/tools.h"
15 #include "flang/Lower/CallInterface.h"
16 #include "flang/Lower/ConvertExpr.h"
17 #include "flang/Lower/ConvertType.h"
18 #include "flang/Lower/ConvertVariable.h"
19 #include "flang/Lower/Mangler.h"
20 #include "flang/Lower/PFTBuilder.h"
21 #include "flang/Lower/Runtime.h"
22 #include "flang/Lower/SymbolMap.h"
23 #include "flang/Lower/Todo.h"
24 #include "flang/Optimizer/Support/FIRContext.h"
25 #include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h"
26 #include "mlir/IR/PatternMatch.h"
27 #include "mlir/Transforms/RegionUtils.h"
28 #include "llvm/Support/CommandLine.h"
29 #include "llvm/Support/Debug.h"
30 
31 #define DEBUG_TYPE "flang-lower-bridge"
32 
33 static llvm::cl::opt<bool> dumpBeforeFir(
34     "fdebug-dump-pre-fir", llvm::cl::init(false),
35     llvm::cl::desc("dump the Pre-FIR tree prior to FIR generation"));
36 
37 //===----------------------------------------------------------------------===//
38 // FirConverter
39 //===----------------------------------------------------------------------===//
40 
41 namespace {
42 
43 /// Traverse the pre-FIR tree (PFT) to generate the FIR dialect of MLIR.
44 class FirConverter : public Fortran::lower::AbstractConverter {
45 public:
46   explicit FirConverter(Fortran::lower::LoweringBridge &bridge)
47       : bridge{bridge}, foldingContext{bridge.createFoldingContext()} {}
48   virtual ~FirConverter() = default;
49 
50   /// Convert the PFT to FIR.
51   void run(Fortran::lower::pft::Program &pft) {
52     // Primary translation pass.
53     for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
54       std::visit(
55           Fortran::common::visitors{
56               [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); },
57               [&](Fortran::lower::pft::ModuleLikeUnit &m) {},
58               [&](Fortran::lower::pft::BlockDataUnit &b) {},
59               [&](Fortran::lower::pft::CompilerDirectiveUnit &d) {
60                 setCurrentPosition(
61                     d.get<Fortran::parser::CompilerDirective>().source);
62                 mlir::emitWarning(toLocation(),
63                                   "ignoring all compiler directives");
64               },
65           },
66           u);
67     }
68   }
69 
70   //===--------------------------------------------------------------------===//
71   // AbstractConverter overrides
72   //===--------------------------------------------------------------------===//
73 
74   mlir::Value getSymbolAddress(Fortran::lower::SymbolRef sym) override final {
75     return lookupSymbol(sym).getAddr();
76   }
77 
78   fir::ExtendedValue genExprAddr(const Fortran::lower::SomeExpr &expr,
79                                  mlir::Location *loc = nullptr) override final {
80     TODO_NOLOC("Not implemented genExprAddr. Needed for more complex "
81                "expression lowering");
82   }
83   fir::ExtendedValue
84   genExprValue(const Fortran::lower::SomeExpr &expr,
85                mlir::Location *loc = nullptr) override final {
86     return createSomeExtendedExpression(loc ? *loc : toLocation(), *this, expr,
87                                         localSymbols);
88   }
89 
90   Fortran::evaluate::FoldingContext &getFoldingContext() override final {
91     return foldingContext;
92   }
93 
94   mlir::Type genType(const Fortran::evaluate::DataRef &) override final {
95     TODO_NOLOC("Not implemented genType DataRef. Needed for more complex "
96                "expression lowering");
97   }
98   mlir::Type genType(const Fortran::lower::SomeExpr &) override final {
99     TODO_NOLOC("Not implemented genType SomeExpr. Needed for more complex "
100                "expression lowering");
101   }
102   mlir::Type genType(Fortran::lower::SymbolRef sym) override final {
103     return Fortran::lower::translateSymbolToFIRType(*this, sym);
104   }
105   mlir::Type genType(Fortran::common::TypeCategory tc) override final {
106     TODO_NOLOC("Not implemented genType TypeCategory. Needed for more complex "
107                "expression lowering");
108   }
109   mlir::Type genType(Fortran::common::TypeCategory tc,
110                      int kind) override final {
111     return Fortran::lower::getFIRType(&getMLIRContext(), tc, kind);
112   }
113   mlir::Type genType(const Fortran::lower::pft::Variable &var) override final {
114     return Fortran::lower::translateVariableToFIRType(*this, var);
115   }
116 
117   void setCurrentPosition(const Fortran::parser::CharBlock &position) {
118     if (position != Fortran::parser::CharBlock{})
119       currentPosition = position;
120   }
121 
122   //===--------------------------------------------------------------------===//
123   // Utility methods
124   //===--------------------------------------------------------------------===//
125 
126   /// Convert a parser CharBlock to a Location
127   mlir::Location toLocation(const Fortran::parser::CharBlock &cb) {
128     return genLocation(cb);
129   }
130 
131   mlir::Location toLocation() { return toLocation(currentPosition); }
132   void setCurrentEval(Fortran::lower::pft::Evaluation &eval) {
133     evalPtr = &eval;
134   }
135   Fortran::lower::pft::Evaluation &getEval() {
136     assert(evalPtr && "current evaluation not set");
137     return *evalPtr;
138   }
139 
140   mlir::Location getCurrentLocation() override final { return toLocation(); }
141 
142   /// Generate a dummy location.
143   mlir::Location genUnknownLocation() override final {
144     // Note: builder may not be instantiated yet
145     return mlir::UnknownLoc::get(&getMLIRContext());
146   }
147 
148   /// Generate a `Location` from the `CharBlock`.
149   mlir::Location
150   genLocation(const Fortran::parser::CharBlock &block) override final {
151     if (const Fortran::parser::AllCookedSources *cooked =
152             bridge.getCookedSource()) {
153       if (std::optional<std::pair<Fortran::parser::SourcePosition,
154                                   Fortran::parser::SourcePosition>>
155               loc = cooked->GetSourcePositionRange(block)) {
156         // loc is a pair (begin, end); use the beginning position
157         Fortran::parser::SourcePosition &filePos = loc->first;
158         return mlir::FileLineColLoc::get(&getMLIRContext(), filePos.file.path(),
159                                          filePos.line, filePos.column);
160       }
161     }
162     return genUnknownLocation();
163   }
164 
165   fir::FirOpBuilder &getFirOpBuilder() override final { return *builder; }
166 
167   mlir::ModuleOp &getModuleOp() override final { return bridge.getModule(); }
168 
169   mlir::MLIRContext &getMLIRContext() override final {
170     return bridge.getMLIRContext();
171   }
172   std::string
173   mangleName(const Fortran::semantics::Symbol &symbol) override final {
174     return Fortran::lower::mangle::mangleName(symbol);
175   }
176 
177   const fir::KindMapping &getKindMap() override final {
178     return bridge.getKindMap();
179   }
180 
181   /// Return the predicate: "current block does not have a terminator branch".
182   bool blockIsUnterminated() {
183     mlir::Block *currentBlock = builder->getBlock();
184     return currentBlock->empty() ||
185            !currentBlock->back().hasTrait<mlir::OpTrait::IsTerminator>();
186   }
187 
188   /// Unconditionally switch code insertion to a new block.
189   void startBlock(mlir::Block *newBlock) {
190     assert(newBlock && "missing block");
191     // Default termination for the current block is a fallthrough branch to
192     // the new block.
193     if (blockIsUnterminated())
194       genFIRBranch(newBlock);
195     // Some blocks may be re/started more than once, and might not be empty.
196     // If the new block already has (only) a terminator, set the insertion
197     // point to the start of the block.  Otherwise set it to the end.
198     // Note that setting the insertion point causes the subsequent function
199     // call to check the existence of terminator in the newBlock.
200     builder->setInsertionPointToStart(newBlock);
201     if (blockIsUnterminated())
202       builder->setInsertionPointToEnd(newBlock);
203   }
204 
205   /// Conditionally switch code insertion to a new block.
206   void maybeStartBlock(mlir::Block *newBlock) {
207     if (newBlock)
208       startBlock(newBlock);
209   }
210 
211   /// Emit return and cleanup after the function has been translated.
212   void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
213     setCurrentPosition(Fortran::lower::pft::stmtSourceLoc(funit.endStmt));
214     if (funit.isMainProgram())
215       genExitRoutine();
216     else
217       genFIRProcedureExit(funit, funit.getSubprogramSymbol());
218     funit.finalBlock = nullptr;
219     LLVM_DEBUG(llvm::dbgs() << "*** Lowering result:\n\n"
220                             << *builder->getFunction() << '\n');
221     // FIXME: Simplification should happen in a normal pass, not here.
222     mlir::IRRewriter rewriter(*builder);
223     (void)mlir::simplifyRegions(rewriter,
224                                 {builder->getRegion()}); // remove dead code
225     delete builder;
226     builder = nullptr;
227     localSymbols.clear();
228   }
229 
230   /// Instantiate variable \p var and add it to the symbol map.
231   /// See ConvertVariable.cpp.
232   void instantiateVar(const Fortran::lower::pft::Variable &var) {
233     Fortran::lower::instantiateVariable(*this, var, localSymbols);
234   }
235 
236   /// Prepare to translate a new function
237   void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
238     assert(!builder && "expected nullptr");
239     Fortran::lower::CalleeInterface callee(funit, *this);
240     mlir::FuncOp func = callee.addEntryBlockAndMapArguments();
241     func.setVisibility(mlir::SymbolTable::Visibility::Public);
242     builder = new fir::FirOpBuilder(func, bridge.getKindMap());
243     assert(builder && "FirOpBuilder did not instantiate");
244     builder->setInsertionPointToStart(&func.front());
245 
246     for (const Fortran::lower::pft::Variable &var :
247          funit.getOrderedSymbolTable()) {
248       const Fortran::semantics::Symbol &sym = var.getSymbol();
249       if (!sym.IsFuncResult() || !funit.primaryResult) {
250         instantiateVar(var);
251       } else if (&sym == funit.primaryResult) {
252         instantiateVar(var);
253       }
254     }
255 
256     // Create most function blocks in advance.
257     createEmptyGlobalBlocks(funit.evaluationList);
258 
259     // Reinstate entry block as the current insertion point.
260     builder->setInsertionPointToEnd(&func.front());
261   }
262 
263   /// Create global blocks for the current function.  This eliminates the
264   /// distinction between forward and backward targets when generating
265   /// branches.  A block is "global" if it can be the target of a GOTO or
266   /// other source code branch.  A block that can only be targeted by a
267   /// compiler generated branch is "local".  For example, a DO loop preheader
268   /// block containing loop initialization code is global.  A loop header
269   /// block, which is the target of the loop back edge, is local.  Blocks
270   /// belong to a region.  Any block within a nested region must be replaced
271   /// with a block belonging to that region.  Branches may not cross region
272   /// boundaries.
273   void createEmptyGlobalBlocks(
274       std::list<Fortran::lower::pft::Evaluation> &evaluationList) {
275     mlir::Region *region = &builder->getRegion();
276     for (Fortran::lower::pft::Evaluation &eval : evaluationList) {
277       if (eval.isNewBlock)
278         eval.block = builder->createBlock(region);
279       if (eval.isConstruct() || eval.isDirective()) {
280         if (eval.lowerAsUnstructured()) {
281           createEmptyGlobalBlocks(eval.getNestedEvaluations());
282         } else if (eval.hasNestedEvaluations()) {
283           TODO(toLocation(), "Constructs with nested evaluations");
284         }
285       }
286     }
287   }
288 
289   /// Lower a procedure (nest).
290   void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) {
291     setCurrentPosition(funit.getStartingSourceLoc());
292     for (int entryIndex = 0, last = funit.entryPointList.size();
293          entryIndex < last; ++entryIndex) {
294       funit.setActiveEntry(entryIndex);
295       startNewFunction(funit); // the entry point for lowering this procedure
296       for (Fortran::lower::pft::Evaluation &eval : funit.evaluationList)
297         genFIR(eval);
298       endNewFunction(funit);
299     }
300     funit.setActiveEntry(0);
301     for (Fortran::lower::pft::FunctionLikeUnit &f : funit.nestedFunctions)
302       lowerFunc(f); // internal procedure
303   }
304 
305 private:
306   FirConverter() = delete;
307   FirConverter(const FirConverter &) = delete;
308   FirConverter &operator=(const FirConverter &) = delete;
309 
310   //===--------------------------------------------------------------------===//
311   // Helper member functions
312   //===--------------------------------------------------------------------===//
313 
314   /// Find the symbol in the local map or return null.
315   Fortran::lower::SymbolBox
316   lookupSymbol(const Fortran::semantics::Symbol &sym) {
317     if (Fortran::lower::SymbolBox v = localSymbols.lookupSymbol(sym))
318       return v;
319     return {};
320   }
321 
322   void genFIRBranch(mlir::Block *targetBlock) {
323     assert(targetBlock && "missing unconditional target block");
324     builder->create<cf::BranchOp>(toLocation(), targetBlock);
325   }
326 
327   //===--------------------------------------------------------------------===//
328   // Termination of symbolically referenced execution units
329   //===--------------------------------------------------------------------===//
330 
331   /// END of program
332   ///
333   /// Generate the cleanup block before the program exits
334   void genExitRoutine() {
335     if (blockIsUnterminated())
336       builder->create<mlir::ReturnOp>(toLocation());
337   }
338   void genFIR(const Fortran::parser::EndProgramStmt &) { genExitRoutine(); }
339 
340   /// END of procedure-like constructs
341   ///
342   /// Generate the cleanup block before the procedure exits
343   void genReturnSymbol(const Fortran::semantics::Symbol &functionSymbol) {
344     const Fortran::semantics::Symbol &resultSym =
345         functionSymbol.get<Fortran::semantics::SubprogramDetails>().result();
346     Fortran::lower::SymbolBox resultSymBox = lookupSymbol(resultSym);
347     mlir::Location loc = toLocation();
348     if (!resultSymBox) {
349       mlir::emitError(loc, "failed lowering function return");
350       return;
351     }
352     mlir::Value resultVal = resultSymBox.match(
353         [&](const fir::CharBoxValue &x) -> mlir::Value {
354           TODO(loc, "Function return CharBoxValue");
355         },
356         [&](const auto &) -> mlir::Value {
357           mlir::Value resultRef = resultSymBox.getAddr();
358           mlir::Type resultType = genType(resultSym);
359           mlir::Type resultRefType = builder->getRefType(resultType);
360           // A function with multiple entry points returning different types
361           // tags all result variables with one of the largest types to allow
362           // them to share the same storage.  Convert this to the actual type.
363           if (resultRef.getType() != resultRefType)
364             TODO(loc, "Convert to actual type");
365           return builder->create<fir::LoadOp>(loc, resultRef);
366         });
367     builder->create<mlir::ReturnOp>(loc, resultVal);
368   }
369 
370   void genFIRProcedureExit(Fortran::lower::pft::FunctionLikeUnit &funit,
371                            const Fortran::semantics::Symbol &symbol) {
372     if (mlir::Block *finalBlock = funit.finalBlock) {
373       // The current block must end with a terminator.
374       if (blockIsUnterminated())
375         builder->create<mlir::cf::BranchOp>(toLocation(), finalBlock);
376       // Set insertion point to final block.
377       builder->setInsertionPoint(finalBlock, finalBlock->end());
378     }
379     if (Fortran::semantics::IsFunction(symbol)) {
380       genReturnSymbol(symbol);
381     } else {
382       genExitRoutine();
383     }
384   }
385 
386   void genFIR(const Fortran::parser::CallStmt &stmt) {
387     TODO(toLocation(), "CallStmt lowering");
388   }
389 
390   void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) {
391     TODO(toLocation(), "ComputedGotoStmt lowering");
392   }
393 
394   void genFIR(const Fortran::parser::ArithmeticIfStmt &stmt) {
395     TODO(toLocation(), "ArithmeticIfStmt lowering");
396   }
397 
398   void genFIR(const Fortran::parser::AssignedGotoStmt &stmt) {
399     TODO(toLocation(), "AssignedGotoStmt lowering");
400   }
401 
402   void genFIR(const Fortran::parser::DoConstruct &doConstruct) {
403     TODO(toLocation(), "DoConstruct lowering");
404   }
405 
406   void genFIR(const Fortran::parser::IfConstruct &) {
407     TODO(toLocation(), "IfConstruct lowering");
408   }
409 
410   void genFIR(const Fortran::parser::CaseConstruct &) {
411     TODO(toLocation(), "CaseConstruct lowering");
412   }
413 
414   void genFIR(const Fortran::parser::ConcurrentHeader &header) {
415     TODO(toLocation(), "ConcurrentHeader lowering");
416   }
417 
418   void genFIR(const Fortran::parser::ForallAssignmentStmt &stmt) {
419     TODO(toLocation(), "ForallAssignmentStmt lowering");
420   }
421 
422   void genFIR(const Fortran::parser::EndForallStmt &) {
423     TODO(toLocation(), "EndForallStmt lowering");
424   }
425 
426   void genFIR(const Fortran::parser::ForallStmt &) {
427     TODO(toLocation(), "ForallStmt lowering");
428   }
429 
430   void genFIR(const Fortran::parser::ForallConstruct &) {
431     TODO(toLocation(), "ForallConstruct lowering");
432   }
433 
434   void genFIR(const Fortran::parser::ForallConstructStmt &) {
435     TODO(toLocation(), "ForallConstructStmt lowering");
436   }
437 
438   void genFIR(const Fortran::parser::CompilerDirective &) {
439     TODO(toLocation(), "CompilerDirective lowering");
440   }
441 
442   void genFIR(const Fortran::parser::OpenACCConstruct &) {
443     TODO(toLocation(), "OpenACCConstruct lowering");
444   }
445 
446   void genFIR(const Fortran::parser::OpenACCDeclarativeConstruct &) {
447     TODO(toLocation(), "OpenACCDeclarativeConstruct lowering");
448   }
449 
450   void genFIR(const Fortran::parser::OpenMPConstruct &) {
451     TODO(toLocation(), "OpenMPConstruct lowering");
452   }
453 
454   void genFIR(const Fortran::parser::OpenMPDeclarativeConstruct &) {
455     TODO(toLocation(), "OpenMPDeclarativeConstruct lowering");
456   }
457 
458   void genFIR(const Fortran::parser::SelectCaseStmt &) {
459     TODO(toLocation(), "SelectCaseStmt lowering");
460   }
461 
462   void genFIR(const Fortran::parser::AssociateConstruct &) {
463     TODO(toLocation(), "AssociateConstruct lowering");
464   }
465 
466   void genFIR(const Fortran::parser::BlockConstruct &blockConstruct) {
467     TODO(toLocation(), "BlockConstruct lowering");
468   }
469 
470   void genFIR(const Fortran::parser::BlockStmt &) {
471     TODO(toLocation(), "BlockStmt lowering");
472   }
473 
474   void genFIR(const Fortran::parser::EndBlockStmt &) {
475     TODO(toLocation(), "EndBlockStmt lowering");
476   }
477 
478   void genFIR(const Fortran::parser::ChangeTeamConstruct &construct) {
479     TODO(toLocation(), "ChangeTeamConstruct lowering");
480   }
481 
482   void genFIR(const Fortran::parser::ChangeTeamStmt &stmt) {
483     TODO(toLocation(), "ChangeTeamStmt lowering");
484   }
485 
486   void genFIR(const Fortran::parser::EndChangeTeamStmt &stmt) {
487     TODO(toLocation(), "EndChangeTeamStmt lowering");
488   }
489 
490   void genFIR(const Fortran::parser::CriticalConstruct &criticalConstruct) {
491     TODO(toLocation(), "CriticalConstruct lowering");
492   }
493 
494   void genFIR(const Fortran::parser::CriticalStmt &) {
495     TODO(toLocation(), "CriticalStmt lowering");
496   }
497 
498   void genFIR(const Fortran::parser::EndCriticalStmt &) {
499     TODO(toLocation(), "EndCriticalStmt lowering");
500   }
501 
502   void genFIR(const Fortran::parser::SelectRankConstruct &selectRankConstruct) {
503     TODO(toLocation(), "SelectRankConstruct lowering");
504   }
505 
506   void genFIR(const Fortran::parser::SelectRankStmt &) {
507     TODO(toLocation(), "SelectRankStmt lowering");
508   }
509 
510   void genFIR(const Fortran::parser::SelectRankCaseStmt &) {
511     TODO(toLocation(), "SelectRankCaseStmt lowering");
512   }
513 
514   void genFIR(const Fortran::parser::SelectTypeConstruct &selectTypeConstruct) {
515     TODO(toLocation(), "SelectTypeConstruct lowering");
516   }
517 
518   void genFIR(const Fortran::parser::SelectTypeStmt &) {
519     TODO(toLocation(), "SelectTypeStmt lowering");
520   }
521 
522   void genFIR(const Fortran::parser::TypeGuardStmt &) {
523     TODO(toLocation(), "TypeGuardStmt lowering");
524   }
525 
526   //===--------------------------------------------------------------------===//
527   // IO statements (see io.h)
528   //===--------------------------------------------------------------------===//
529 
530   void genFIR(const Fortran::parser::BackspaceStmt &stmt) {
531     TODO(toLocation(), "BackspaceStmt lowering");
532   }
533 
534   void genFIR(const Fortran::parser::CloseStmt &stmt) {
535     TODO(toLocation(), "CloseStmt lowering");
536   }
537 
538   void genFIR(const Fortran::parser::EndfileStmt &stmt) {
539     TODO(toLocation(), "EndfileStmt lowering");
540   }
541 
542   void genFIR(const Fortran::parser::FlushStmt &stmt) {
543     TODO(toLocation(), "FlushStmt lowering");
544   }
545 
546   void genFIR(const Fortran::parser::InquireStmt &stmt) {
547     TODO(toLocation(), "InquireStmt lowering");
548   }
549 
550   void genFIR(const Fortran::parser::OpenStmt &stmt) {
551     TODO(toLocation(), "OpenStmt lowering");
552   }
553 
554   void genFIR(const Fortran::parser::PrintStmt &stmt) {
555     TODO(toLocation(), "PrintStmt lowering");
556   }
557 
558   void genFIR(const Fortran::parser::ReadStmt &stmt) {
559     TODO(toLocation(), "ReadStmt lowering");
560   }
561 
562   void genFIR(const Fortran::parser::RewindStmt &stmt) {
563     TODO(toLocation(), "RewindStmt lowering");
564   }
565 
566   void genFIR(const Fortran::parser::WaitStmt &stmt) {
567     TODO(toLocation(), "WaitStmt lowering");
568   }
569 
570   void genFIR(const Fortran::parser::WriteStmt &stmt) {
571     TODO(toLocation(), "WriteStmt lowering");
572   }
573 
574   //===--------------------------------------------------------------------===//
575   // Memory allocation and deallocation
576   //===--------------------------------------------------------------------===//
577 
578   void genFIR(const Fortran::parser::AllocateStmt &stmt) {
579     TODO(toLocation(), "AllocateStmt lowering");
580   }
581 
582   void genFIR(const Fortran::parser::DeallocateStmt &stmt) {
583     TODO(toLocation(), "DeallocateStmt lowering");
584   }
585 
586   void genFIR(const Fortran::parser::NullifyStmt &stmt) {
587     TODO(toLocation(), "NullifyStmt lowering");
588   }
589 
590   //===--------------------------------------------------------------------===//
591 
592   void genFIR(const Fortran::parser::EventPostStmt &stmt) {
593     TODO(toLocation(), "EventPostStmt lowering");
594   }
595 
596   void genFIR(const Fortran::parser::EventWaitStmt &stmt) {
597     TODO(toLocation(), "EventWaitStmt lowering");
598   }
599 
600   void genFIR(const Fortran::parser::FormTeamStmt &stmt) {
601     TODO(toLocation(), "FormTeamStmt lowering");
602   }
603 
604   void genFIR(const Fortran::parser::LockStmt &stmt) {
605     TODO(toLocation(), "LockStmt lowering");
606   }
607 
608   void genFIR(const Fortran::parser::WhereConstruct &c) {
609     TODO(toLocation(), "WhereConstruct lowering");
610   }
611 
612   void genFIR(const Fortran::parser::WhereBodyConstruct &body) {
613     TODO(toLocation(), "WhereBodyConstruct lowering");
614   }
615 
616   void genFIR(const Fortran::parser::WhereConstructStmt &stmt) {
617     TODO(toLocation(), "WhereConstructStmt lowering");
618   }
619 
620   void genFIR(const Fortran::parser::WhereConstruct::MaskedElsewhere &ew) {
621     TODO(toLocation(), "MaskedElsewhere lowering");
622   }
623 
624   void genFIR(const Fortran::parser::MaskedElsewhereStmt &stmt) {
625     TODO(toLocation(), "MaskedElsewhereStmt lowering");
626   }
627 
628   void genFIR(const Fortran::parser::WhereConstruct::Elsewhere &ew) {
629     TODO(toLocation(), "Elsewhere lowering");
630   }
631 
632   void genFIR(const Fortran::parser::ElsewhereStmt &stmt) {
633     TODO(toLocation(), "ElsewhereStmt lowering");
634   }
635 
636   void genFIR(const Fortran::parser::EndWhereStmt &) {
637     TODO(toLocation(), "EndWhereStmt lowering");
638   }
639 
640   void genFIR(const Fortran::parser::WhereStmt &stmt) {
641     TODO(toLocation(), "WhereStmt lowering");
642   }
643 
644   void genFIR(const Fortran::parser::PointerAssignmentStmt &stmt) {
645     TODO(toLocation(), "PointerAssignmentStmt lowering");
646   }
647 
648   void genFIR(const Fortran::parser::AssignmentStmt &stmt) {
649     TODO(toLocation(), "AssignmentStmt lowering");
650   }
651 
652   void genFIR(const Fortran::parser::SyncAllStmt &stmt) {
653     TODO(toLocation(), "SyncAllStmt lowering");
654   }
655 
656   void genFIR(const Fortran::parser::SyncImagesStmt &stmt) {
657     TODO(toLocation(), "SyncImagesStmt lowering");
658   }
659 
660   void genFIR(const Fortran::parser::SyncMemoryStmt &stmt) {
661     TODO(toLocation(), "SyncMemoryStmt lowering");
662   }
663 
664   void genFIR(const Fortran::parser::SyncTeamStmt &stmt) {
665     TODO(toLocation(), "SyncTeamStmt lowering");
666   }
667 
668   void genFIR(const Fortran::parser::UnlockStmt &stmt) {
669     TODO(toLocation(), "UnlockStmt lowering");
670   }
671 
672   void genFIR(const Fortran::parser::AssignStmt &stmt) {
673     TODO(toLocation(), "AssignStmt lowering");
674   }
675 
676   void genFIR(const Fortran::parser::FormatStmt &) {
677     TODO(toLocation(), "FormatStmt lowering");
678   }
679 
680   void genFIR(const Fortran::parser::PauseStmt &stmt) {
681     genPauseStatement(*this, stmt);
682   }
683 
684   void genFIR(const Fortran::parser::FailImageStmt &stmt) {
685     TODO(toLocation(), "FailImageStmt lowering");
686   }
687 
688   // call STOP, ERROR STOP in runtime
689   void genFIR(const Fortran::parser::StopStmt &stmt) {
690     genStopStatement(*this, stmt);
691   }
692 
693   void genFIR(const Fortran::parser::ReturnStmt &stmt) {
694     Fortran::lower::pft::FunctionLikeUnit *funit =
695         getEval().getOwningProcedure();
696     assert(funit && "not inside main program, function or subroutine");
697     if (funit->isMainProgram()) {
698       genExitRoutine();
699       return;
700     }
701     mlir::Location loc = toLocation();
702     if (stmt.v) {
703       TODO(loc, "Alternate return statement");
704     }
705     // Branch to the last block of the SUBROUTINE, which has the actual return.
706     if (!funit->finalBlock) {
707       mlir::OpBuilder::InsertPoint insPt = builder->saveInsertionPoint();
708       funit->finalBlock = builder->createBlock(&builder->getRegion());
709       builder->restoreInsertionPoint(insPt);
710     }
711     builder->create<mlir::cf::BranchOp>(loc, funit->finalBlock);
712   }
713 
714   void genFIR(const Fortran::parser::CycleStmt &) {
715     TODO(toLocation(), "CycleStmt lowering");
716   }
717 
718   void genFIR(const Fortran::parser::ExitStmt &) {
719     TODO(toLocation(), "ExitStmt lowering");
720   }
721 
722   void genFIR(const Fortran::parser::GotoStmt &) {
723     genFIRBranch(getEval().controlSuccessor->block);
724   }
725 
726   void genFIR(const Fortran::parser::AssociateStmt &) {
727     TODO(toLocation(), "AssociateStmt lowering");
728   }
729 
730   void genFIR(const Fortran::parser::CaseStmt &) {
731     TODO(toLocation(), "CaseStmt lowering");
732   }
733 
734   void genFIR(const Fortran::parser::ContinueStmt &) {
735     TODO(toLocation(), "ContinueStmt lowering");
736   }
737 
738   void genFIR(const Fortran::parser::ElseIfStmt &) {
739     TODO(toLocation(), "ElseIfStmt lowering");
740   }
741 
742   void genFIR(const Fortran::parser::ElseStmt &) {
743     TODO(toLocation(), "ElseStmt lowering");
744   }
745 
746   void genFIR(const Fortran::parser::EndAssociateStmt &) {
747     TODO(toLocation(), "EndAssociateStmt lowering");
748   }
749 
750   void genFIR(const Fortran::parser::EndDoStmt &) {
751     TODO(toLocation(), "EndDoStmt lowering");
752   }
753 
754   void genFIR(const Fortran::parser::EndIfStmt &) {
755     TODO(toLocation(), "EndIfStmt lowering");
756   }
757 
758   void genFIR(const Fortran::parser::EndMpSubprogramStmt &) {
759     TODO(toLocation(), "EndMpSubprogramStmt lowering");
760   }
761 
762   void genFIR(const Fortran::parser::EndSelectStmt &) {
763     TODO(toLocation(), "EndSelectStmt lowering");
764   }
765 
766   // Nop statements - No code, or code is generated at the construct level.
767   void genFIR(const Fortran::parser::EndFunctionStmt &) {}   // nop
768   void genFIR(const Fortran::parser::EndSubroutineStmt &) {} // nop
769 
770   void genFIR(const Fortran::parser::EntryStmt &) {
771     TODO(toLocation(), "EntryStmt lowering");
772   }
773 
774   void genFIR(const Fortran::parser::IfStmt &) {
775     TODO(toLocation(), "IfStmt lowering");
776   }
777 
778   void genFIR(const Fortran::parser::IfThenStmt &) {
779     TODO(toLocation(), "IfThenStmt lowering");
780   }
781 
782   void genFIR(const Fortran::parser::NonLabelDoStmt &) {
783     TODO(toLocation(), "NonLabelDoStmt lowering");
784   }
785 
786   void genFIR(const Fortran::parser::OmpEndLoopDirective &) {
787     TODO(toLocation(), "OmpEndLoopDirective lowering");
788   }
789 
790   void genFIR(const Fortran::parser::NamelistStmt &) {
791     TODO(toLocation(), "NamelistStmt lowering");
792   }
793 
794   void genFIR(Fortran::lower::pft::Evaluation &eval,
795               bool unstructuredContext = true) {
796     if (unstructuredContext) {
797       // When transitioning from unstructured to structured code,
798       // the structured code could be a target that starts a new block.
799       maybeStartBlock(eval.isConstruct() && eval.lowerAsStructured()
800                           ? eval.getFirstNestedEvaluation().block
801                           : eval.block);
802     }
803 
804     setCurrentEval(eval);
805     setCurrentPosition(eval.position);
806     eval.visit([&](const auto &stmt) { genFIR(stmt); });
807   }
808 
809   //===--------------------------------------------------------------------===//
810 
811   Fortran::lower::LoweringBridge &bridge;
812   Fortran::evaluate::FoldingContext foldingContext;
813   fir::FirOpBuilder *builder = nullptr;
814   Fortran::lower::pft::Evaluation *evalPtr = nullptr;
815   Fortran::lower::SymMap localSymbols;
816   Fortran::parser::CharBlock currentPosition;
817 };
818 
819 } // namespace
820 
821 Fortran::evaluate::FoldingContext
822 Fortran::lower::LoweringBridge::createFoldingContext() const {
823   return {getDefaultKinds(), getIntrinsicTable()};
824 }
825 
826 void Fortran::lower::LoweringBridge::lower(
827     const Fortran::parser::Program &prg,
828     const Fortran::semantics::SemanticsContext &semanticsContext) {
829   std::unique_ptr<Fortran::lower::pft::Program> pft =
830       Fortran::lower::createPFT(prg, semanticsContext);
831   if (dumpBeforeFir)
832     Fortran::lower::dumpPFT(llvm::errs(), *pft);
833   FirConverter converter{*this};
834   converter.run(*pft);
835 }
836 
837 Fortran::lower::LoweringBridge::LoweringBridge(
838     mlir::MLIRContext &context,
839     const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds,
840     const Fortran::evaluate::IntrinsicProcTable &intrinsics,
841     const Fortran::parser::AllCookedSources &cooked, llvm::StringRef triple,
842     fir::KindMapping &kindMap)
843     : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked},
844       context{context}, kindMap{kindMap} {
845   // Register the diagnostic handler.
846   context.getDiagEngine().registerHandler([](mlir::Diagnostic &diag) {
847     llvm::raw_ostream &os = llvm::errs();
848     switch (diag.getSeverity()) {
849     case mlir::DiagnosticSeverity::Error:
850       os << "error: ";
851       break;
852     case mlir::DiagnosticSeverity::Remark:
853       os << "info: ";
854       break;
855     case mlir::DiagnosticSeverity::Warning:
856       os << "warning: ";
857       break;
858     default:
859       break;
860     }
861     if (!diag.getLocation().isa<UnknownLoc>())
862       os << diag.getLocation() << ": ";
863     os << diag << '\n';
864     os.flush();
865     return mlir::success();
866   });
867 
868   // Create the module and attach the attributes.
869   module = std::make_unique<mlir::ModuleOp>(
870       mlir::ModuleOp::create(mlir::UnknownLoc::get(&context)));
871   assert(module.get() && "module was not created");
872   fir::setTargetTriple(*module.get(), triple);
873   fir::setKindMapping(*module.get(), kindMap);
874 }
875