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