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/IR/PatternMatch.h"
26 #include "mlir/Transforms/RegionUtils.h"
27 #include "llvm/Support/CommandLine.h"
28 #include "llvm/Support/Debug.h"
29 
30 #define DEBUG_TYPE "flang-lower-bridge"
31 
32 static llvm::cl::opt<bool> dumpBeforeFir(
33     "fdebug-dump-pre-fir", llvm::cl::init(false),
34     llvm::cl::desc("dump the Pre-FIR tree prior to FIR generation"));
35 
36 //===----------------------------------------------------------------------===//
37 // FirConverter
38 //===----------------------------------------------------------------------===//
39 
40 namespace {
41 
42 /// Traverse the pre-FIR tree (PFT) to generate the FIR dialect of MLIR.
43 class FirConverter : public Fortran::lower::AbstractConverter {
44 public:
45   explicit FirConverter(Fortran::lower::LoweringBridge &bridge)
46       : bridge{bridge}, foldingContext{bridge.createFoldingContext()} {}
47   virtual ~FirConverter() = default;
48 
49   /// Convert the PFT to FIR.
50   void run(Fortran::lower::pft::Program &pft) {
51     // Primary translation pass.
52     for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
53       std::visit(
54           Fortran::common::visitors{
55               [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); },
56               [&](Fortran::lower::pft::ModuleLikeUnit &m) {},
57               [&](Fortran::lower::pft::BlockDataUnit &b) {},
58               [&](Fortran::lower::pft::CompilerDirectiveUnit &d) {
59                 setCurrentPosition(
60                     d.get<Fortran::parser::CompilerDirective>().source);
61                 mlir::emitWarning(toLocation(),
62                                   "ignoring all compiler directives");
63               },
64           },
65           u);
66     }
67   }
68 
69   //===--------------------------------------------------------------------===//
70   // AbstractConverter overrides
71   //===--------------------------------------------------------------------===//
72 
73   mlir::Value getSymbolAddress(Fortran::lower::SymbolRef sym) override final {
74     return lookupSymbol(sym).getAddr();
75   }
76 
77   fir::ExtendedValue genExprAddr(const Fortran::lower::SomeExpr &expr,
78                                  mlir::Location *loc = nullptr) override final {
79     TODO_NOLOC("Not implemented genExprAddr. Needed for more complex "
80                "expression lowering");
81   }
82   fir::ExtendedValue
83   genExprValue(const Fortran::lower::SomeExpr &expr,
84                mlir::Location *loc = nullptr) override final {
85     return createSomeExtendedExpression(loc ? *loc : toLocation(), *this, expr,
86                                         localSymbols);
87   }
88 
89   Fortran::evaluate::FoldingContext &getFoldingContext() override final {
90     return foldingContext;
91   }
92 
93   mlir::Type genType(const Fortran::evaluate::DataRef &) override final {
94     TODO_NOLOC("Not implemented genType DataRef. Needed for more complex "
95                "expression lowering");
96   }
97   mlir::Type genType(const Fortran::lower::SomeExpr &) override final {
98     TODO_NOLOC("Not implemented genType SomeExpr. Needed for more complex "
99                "expression lowering");
100   }
101   mlir::Type genType(Fortran::lower::SymbolRef) override final {
102     TODO_NOLOC("Not implemented genType SymbolRef. Needed for more complex "
103                "expression lowering");
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 
136   mlir::Location getCurrentLocation() override final { return toLocation(); }
137 
138   /// Generate a dummy location.
139   mlir::Location genUnknownLocation() override final {
140     // Note: builder may not be instantiated yet
141     return mlir::UnknownLoc::get(&getMLIRContext());
142   }
143 
144   /// Generate a `Location` from the `CharBlock`.
145   mlir::Location
146   genLocation(const Fortran::parser::CharBlock &block) override final {
147     if (const Fortran::parser::AllCookedSources *cooked =
148             bridge.getCookedSource()) {
149       if (std::optional<std::pair<Fortran::parser::SourcePosition,
150                                   Fortran::parser::SourcePosition>>
151               loc = cooked->GetSourcePositionRange(block)) {
152         // loc is a pair (begin, end); use the beginning position
153         Fortran::parser::SourcePosition &filePos = loc->first;
154         return mlir::FileLineColLoc::get(&getMLIRContext(), filePos.file.path(),
155                                          filePos.line, filePos.column);
156       }
157     }
158     return genUnknownLocation();
159   }
160 
161   fir::FirOpBuilder &getFirOpBuilder() override final { return *builder; }
162 
163   mlir::ModuleOp &getModuleOp() override final { return bridge.getModule(); }
164 
165   mlir::MLIRContext &getMLIRContext() override final {
166     return bridge.getMLIRContext();
167   }
168   std::string
169   mangleName(const Fortran::semantics::Symbol &symbol) override final {
170     return Fortran::lower::mangle::mangleName(symbol);
171   }
172 
173   const fir::KindMapping &getKindMap() override final {
174     return bridge.getKindMap();
175   }
176 
177   /// Return the predicate: "current block does not have a terminator branch".
178   bool blockIsUnterminated() {
179     mlir::Block *currentBlock = builder->getBlock();
180     return currentBlock->empty() ||
181            !currentBlock->back().hasTrait<mlir::OpTrait::IsTerminator>();
182   }
183 
184   /// Emit return and cleanup after the function has been translated.
185   void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
186     setCurrentPosition(Fortran::lower::pft::stmtSourceLoc(funit.endStmt));
187     if (funit.isMainProgram())
188       genExitRoutine();
189     else
190       genFIRProcedureExit(funit, funit.getSubprogramSymbol());
191     funit.finalBlock = nullptr;
192     LLVM_DEBUG(llvm::dbgs() << "*** Lowering result:\n\n"
193                             << *builder->getFunction() << '\n');
194     delete builder;
195     builder = nullptr;
196     localSymbols.clear();
197   }
198 
199   /// Instantiate variable \p var and add it to the symbol map.
200   /// See ConvertVariable.cpp.
201   void instantiateVar(const Fortran::lower::pft::Variable &var) {
202     Fortran::lower::instantiateVariable(*this, var, localSymbols);
203   }
204 
205   /// Prepare to translate a new function
206   void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
207     assert(!builder && "expected nullptr");
208     Fortran::lower::CalleeInterface callee(funit, *this);
209     mlir::FuncOp func = callee.addEntryBlockAndMapArguments();
210     func.setVisibility(mlir::SymbolTable::Visibility::Public);
211     builder = new fir::FirOpBuilder(func, bridge.getKindMap());
212     assert(builder && "FirOpBuilder did not instantiate");
213     builder->setInsertionPointToStart(&func.front());
214 
215     for (const Fortran::lower::pft::Variable &var :
216          funit.getOrderedSymbolTable()) {
217       const Fortran::semantics::Symbol &sym = var.getSymbol();
218       if (!sym.IsFuncResult() || !funit.primaryResult)
219         instantiateVar(var);
220     }
221   }
222 
223   /// Lower a procedure (nest).
224   void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) {
225     setCurrentPosition(funit.getStartingSourceLoc());
226     for (int entryIndex = 0, last = funit.entryPointList.size();
227          entryIndex < last; ++entryIndex) {
228       funit.setActiveEntry(entryIndex);
229       startNewFunction(funit); // the entry point for lowering this procedure
230       for (Fortran::lower::pft::Evaluation &eval : funit.evaluationList)
231         genFIR(eval);
232       endNewFunction(funit);
233     }
234     funit.setActiveEntry(0);
235     for (Fortran::lower::pft::FunctionLikeUnit &f : funit.nestedFunctions)
236       lowerFunc(f); // internal procedure
237   }
238 
239 private:
240   FirConverter() = delete;
241   FirConverter(const FirConverter &) = delete;
242   FirConverter &operator=(const FirConverter &) = delete;
243 
244   //===--------------------------------------------------------------------===//
245   // Helper member functions
246   //===--------------------------------------------------------------------===//
247 
248   /// Find the symbol in the local map or return null.
249   Fortran::lower::SymbolBox
250   lookupSymbol(const Fortran::semantics::Symbol &sym) {
251     if (Fortran::lower::SymbolBox v = localSymbols.lookupSymbol(sym))
252       return v;
253     return {};
254   }
255 
256   //===--------------------------------------------------------------------===//
257   // Termination of symbolically referenced execution units
258   //===--------------------------------------------------------------------===//
259 
260   /// END of program
261   ///
262   /// Generate the cleanup block before the program exits
263   void genExitRoutine() {
264     if (blockIsUnterminated())
265       builder->create<mlir::ReturnOp>(toLocation());
266   }
267   void genFIR(const Fortran::parser::EndProgramStmt &) { genExitRoutine(); }
268 
269   void genFIRProcedureExit(Fortran::lower::pft::FunctionLikeUnit &funit,
270                            const Fortran::semantics::Symbol &symbol) {
271     if (Fortran::semantics::IsFunction(symbol)) {
272       TODO(toLocation(), "Function lowering");
273     } else {
274       genExitRoutine();
275     }
276   }
277 
278   void genFIR(const Fortran::parser::CallStmt &stmt) {
279     TODO(toLocation(), "CallStmt lowering");
280   }
281 
282   void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) {
283     TODO(toLocation(), "ComputedGotoStmt lowering");
284   }
285 
286   void genFIR(const Fortran::parser::ArithmeticIfStmt &stmt) {
287     TODO(toLocation(), "ArithmeticIfStmt lowering");
288   }
289 
290   void genFIR(const Fortran::parser::AssignedGotoStmt &stmt) {
291     TODO(toLocation(), "AssignedGotoStmt lowering");
292   }
293 
294   void genFIR(const Fortran::parser::DoConstruct &doConstruct) {
295     TODO(toLocation(), "DoConstruct lowering");
296   }
297 
298   void genFIR(const Fortran::parser::IfConstruct &) {
299     TODO(toLocation(), "IfConstruct lowering");
300   }
301 
302   void genFIR(const Fortran::parser::CaseConstruct &) {
303     TODO(toLocation(), "CaseConstruct lowering");
304   }
305 
306   void genFIR(const Fortran::parser::ConcurrentHeader &header) {
307     TODO(toLocation(), "ConcurrentHeader lowering");
308   }
309 
310   void genFIR(const Fortran::parser::ForallAssignmentStmt &stmt) {
311     TODO(toLocation(), "ForallAssignmentStmt lowering");
312   }
313 
314   void genFIR(const Fortran::parser::EndForallStmt &) {
315     TODO(toLocation(), "EndForallStmt lowering");
316   }
317 
318   void genFIR(const Fortran::parser::ForallStmt &) {
319     TODO(toLocation(), "ForallStmt lowering");
320   }
321 
322   void genFIR(const Fortran::parser::ForallConstruct &) {
323     TODO(toLocation(), "ForallConstruct lowering");
324   }
325 
326   void genFIR(const Fortran::parser::ForallConstructStmt &) {
327     TODO(toLocation(), "ForallConstructStmt lowering");
328   }
329 
330   void genFIR(const Fortran::parser::CompilerDirective &) {
331     TODO(toLocation(), "CompilerDirective lowering");
332   }
333 
334   void genFIR(const Fortran::parser::OpenACCConstruct &) {
335     TODO(toLocation(), "OpenACCConstruct lowering");
336   }
337 
338   void genFIR(const Fortran::parser::OpenACCDeclarativeConstruct &) {
339     TODO(toLocation(), "OpenACCDeclarativeConstruct lowering");
340   }
341 
342   void genFIR(const Fortran::parser::OpenMPConstruct &) {
343     TODO(toLocation(), "OpenMPConstruct lowering");
344   }
345 
346   void genFIR(const Fortran::parser::OpenMPDeclarativeConstruct &) {
347     TODO(toLocation(), "OpenMPDeclarativeConstruct lowering");
348   }
349 
350   void genFIR(const Fortran::parser::SelectCaseStmt &) {
351     TODO(toLocation(), "SelectCaseStmt lowering");
352   }
353 
354   void genFIR(const Fortran::parser::AssociateConstruct &) {
355     TODO(toLocation(), "AssociateConstruct lowering");
356   }
357 
358   void genFIR(const Fortran::parser::BlockConstruct &blockConstruct) {
359     TODO(toLocation(), "BlockConstruct lowering");
360   }
361 
362   void genFIR(const Fortran::parser::BlockStmt &) {
363     TODO(toLocation(), "BlockStmt lowering");
364   }
365 
366   void genFIR(const Fortran::parser::EndBlockStmt &) {
367     TODO(toLocation(), "EndBlockStmt lowering");
368   }
369 
370   void genFIR(const Fortran::parser::ChangeTeamConstruct &construct) {
371     TODO(toLocation(), "ChangeTeamConstruct lowering");
372   }
373 
374   void genFIR(const Fortran::parser::ChangeTeamStmt &stmt) {
375     TODO(toLocation(), "ChangeTeamStmt lowering");
376   }
377 
378   void genFIR(const Fortran::parser::EndChangeTeamStmt &stmt) {
379     TODO(toLocation(), "EndChangeTeamStmt lowering");
380   }
381 
382   void genFIR(const Fortran::parser::CriticalConstruct &criticalConstruct) {
383     TODO(toLocation(), "CriticalConstruct lowering");
384   }
385 
386   void genFIR(const Fortran::parser::CriticalStmt &) {
387     TODO(toLocation(), "CriticalStmt lowering");
388   }
389 
390   void genFIR(const Fortran::parser::EndCriticalStmt &) {
391     TODO(toLocation(), "EndCriticalStmt lowering");
392   }
393 
394   void genFIR(const Fortran::parser::SelectRankConstruct &selectRankConstruct) {
395     TODO(toLocation(), "SelectRankConstruct lowering");
396   }
397 
398   void genFIR(const Fortran::parser::SelectRankStmt &) {
399     TODO(toLocation(), "SelectRankStmt lowering");
400   }
401 
402   void genFIR(const Fortran::parser::SelectRankCaseStmt &) {
403     TODO(toLocation(), "SelectRankCaseStmt lowering");
404   }
405 
406   void genFIR(const Fortran::parser::SelectTypeConstruct &selectTypeConstruct) {
407     TODO(toLocation(), "SelectTypeConstruct lowering");
408   }
409 
410   void genFIR(const Fortran::parser::SelectTypeStmt &) {
411     TODO(toLocation(), "SelectTypeStmt lowering");
412   }
413 
414   void genFIR(const Fortran::parser::TypeGuardStmt &) {
415     TODO(toLocation(), "TypeGuardStmt lowering");
416   }
417 
418   //===--------------------------------------------------------------------===//
419   // IO statements (see io.h)
420   //===--------------------------------------------------------------------===//
421 
422   void genFIR(const Fortran::parser::BackspaceStmt &stmt) {
423     TODO(toLocation(), "BackspaceStmt lowering");
424   }
425 
426   void genFIR(const Fortran::parser::CloseStmt &stmt) {
427     TODO(toLocation(), "CloseStmt lowering");
428   }
429 
430   void genFIR(const Fortran::parser::EndfileStmt &stmt) {
431     TODO(toLocation(), "EndfileStmt lowering");
432   }
433 
434   void genFIR(const Fortran::parser::FlushStmt &stmt) {
435     TODO(toLocation(), "FlushStmt lowering");
436   }
437 
438   void genFIR(const Fortran::parser::InquireStmt &stmt) {
439     TODO(toLocation(), "InquireStmt lowering");
440   }
441 
442   void genFIR(const Fortran::parser::OpenStmt &stmt) {
443     TODO(toLocation(), "OpenStmt lowering");
444   }
445 
446   void genFIR(const Fortran::parser::PrintStmt &stmt) {
447     TODO(toLocation(), "PrintStmt lowering");
448   }
449 
450   void genFIR(const Fortran::parser::ReadStmt &stmt) {
451     TODO(toLocation(), "ReadStmt lowering");
452   }
453 
454   void genFIR(const Fortran::parser::RewindStmt &stmt) {
455     TODO(toLocation(), "RewindStmt lowering");
456   }
457 
458   void genFIR(const Fortran::parser::WaitStmt &stmt) {
459     TODO(toLocation(), "WaitStmt lowering");
460   }
461 
462   void genFIR(const Fortran::parser::WriteStmt &stmt) {
463     TODO(toLocation(), "WriteStmt lowering");
464   }
465 
466   //===--------------------------------------------------------------------===//
467   // Memory allocation and deallocation
468   //===--------------------------------------------------------------------===//
469 
470   void genFIR(const Fortran::parser::AllocateStmt &stmt) {
471     TODO(toLocation(), "AllocateStmt lowering");
472   }
473 
474   void genFIR(const Fortran::parser::DeallocateStmt &stmt) {
475     TODO(toLocation(), "DeallocateStmt lowering");
476   }
477 
478   void genFIR(const Fortran::parser::NullifyStmt &stmt) {
479     TODO(toLocation(), "NullifyStmt lowering");
480   }
481 
482   //===--------------------------------------------------------------------===//
483 
484   void genFIR(const Fortran::parser::EventPostStmt &stmt) {
485     TODO(toLocation(), "EventPostStmt lowering");
486   }
487 
488   void genFIR(const Fortran::parser::EventWaitStmt &stmt) {
489     TODO(toLocation(), "EventWaitStmt lowering");
490   }
491 
492   void genFIR(const Fortran::parser::FormTeamStmt &stmt) {
493     TODO(toLocation(), "FormTeamStmt lowering");
494   }
495 
496   void genFIR(const Fortran::parser::LockStmt &stmt) {
497     TODO(toLocation(), "LockStmt lowering");
498   }
499 
500   void genFIR(const Fortran::parser::WhereConstruct &c) {
501     TODO(toLocation(), "WhereConstruct lowering");
502   }
503 
504   void genFIR(const Fortran::parser::WhereBodyConstruct &body) {
505     TODO(toLocation(), "WhereBodyConstruct lowering");
506   }
507 
508   void genFIR(const Fortran::parser::WhereConstructStmt &stmt) {
509     TODO(toLocation(), "WhereConstructStmt lowering");
510   }
511 
512   void genFIR(const Fortran::parser::WhereConstruct::MaskedElsewhere &ew) {
513     TODO(toLocation(), "MaskedElsewhere lowering");
514   }
515 
516   void genFIR(const Fortran::parser::MaskedElsewhereStmt &stmt) {
517     TODO(toLocation(), "MaskedElsewhereStmt lowering");
518   }
519 
520   void genFIR(const Fortran::parser::WhereConstruct::Elsewhere &ew) {
521     TODO(toLocation(), "Elsewhere lowering");
522   }
523 
524   void genFIR(const Fortran::parser::ElsewhereStmt &stmt) {
525     TODO(toLocation(), "ElsewhereStmt lowering");
526   }
527 
528   void genFIR(const Fortran::parser::EndWhereStmt &) {
529     TODO(toLocation(), "EndWhereStmt lowering");
530   }
531 
532   void genFIR(const Fortran::parser::WhereStmt &stmt) {
533     TODO(toLocation(), "WhereStmt lowering");
534   }
535 
536   void genFIR(const Fortran::parser::PointerAssignmentStmt &stmt) {
537     TODO(toLocation(), "PointerAssignmentStmt lowering");
538   }
539 
540   void genFIR(const Fortran::parser::AssignmentStmt &stmt) {
541     TODO(toLocation(), "AssignmentStmt lowering");
542   }
543 
544   void genFIR(const Fortran::parser::SyncAllStmt &stmt) {
545     TODO(toLocation(), "SyncAllStmt lowering");
546   }
547 
548   void genFIR(const Fortran::parser::SyncImagesStmt &stmt) {
549     TODO(toLocation(), "SyncImagesStmt lowering");
550   }
551 
552   void genFIR(const Fortran::parser::SyncMemoryStmt &stmt) {
553     TODO(toLocation(), "SyncMemoryStmt lowering");
554   }
555 
556   void genFIR(const Fortran::parser::SyncTeamStmt &stmt) {
557     TODO(toLocation(), "SyncTeamStmt lowering");
558   }
559 
560   void genFIR(const Fortran::parser::UnlockStmt &stmt) {
561     TODO(toLocation(), "UnlockStmt lowering");
562   }
563 
564   void genFIR(const Fortran::parser::AssignStmt &stmt) {
565     TODO(toLocation(), "AssignStmt lowering");
566   }
567 
568   void genFIR(const Fortran::parser::FormatStmt &) {
569     TODO(toLocation(), "FormatStmt lowering");
570   }
571 
572   void genFIR(const Fortran::parser::PauseStmt &stmt) {
573     genPauseStatement(*this, stmt);
574   }
575 
576   void genFIR(const Fortran::parser::FailImageStmt &stmt) {
577     TODO(toLocation(), "FailImageStmt lowering");
578   }
579 
580   // call STOP, ERROR STOP in runtime
581   void genFIR(const Fortran::parser::StopStmt &stmt) {
582     genStopStatement(*this, stmt);
583   }
584 
585   void genFIR(const Fortran::parser::ReturnStmt &stmt) {
586     TODO(toLocation(), "ReturnStmt lowering");
587   }
588 
589   void genFIR(const Fortran::parser::CycleStmt &) {
590     TODO(toLocation(), "CycleStmt lowering");
591   }
592 
593   void genFIR(const Fortran::parser::ExitStmt &) {
594     TODO(toLocation(), "ExitStmt lowering");
595   }
596 
597   void genFIR(const Fortran::parser::GotoStmt &) {
598     TODO(toLocation(), "GotoStmt lowering");
599   }
600 
601   void genFIR(const Fortran::parser::AssociateStmt &) {
602     TODO(toLocation(), "AssociateStmt lowering");
603   }
604 
605   void genFIR(const Fortran::parser::CaseStmt &) {
606     TODO(toLocation(), "CaseStmt lowering");
607   }
608 
609   void genFIR(const Fortran::parser::ContinueStmt &) {
610     TODO(toLocation(), "ContinueStmt lowering");
611   }
612 
613   void genFIR(const Fortran::parser::ElseIfStmt &) {
614     TODO(toLocation(), "ElseIfStmt lowering");
615   }
616 
617   void genFIR(const Fortran::parser::ElseStmt &) {
618     TODO(toLocation(), "ElseStmt lowering");
619   }
620 
621   void genFIR(const Fortran::parser::EndAssociateStmt &) {
622     TODO(toLocation(), "EndAssociateStmt lowering");
623   }
624 
625   void genFIR(const Fortran::parser::EndDoStmt &) {
626     TODO(toLocation(), "EndDoStmt lowering");
627   }
628 
629   void genFIR(const Fortran::parser::EndFunctionStmt &) {
630     TODO(toLocation(), "EndFunctionStmt lowering");
631   }
632 
633   void genFIR(const Fortran::parser::EndIfStmt &) {
634     TODO(toLocation(), "EndIfStmt lowering");
635   }
636 
637   void genFIR(const Fortran::parser::EndMpSubprogramStmt &) {
638     TODO(toLocation(), "EndMpSubprogramStmt lowering");
639   }
640 
641   void genFIR(const Fortran::parser::EndSelectStmt &) {
642     TODO(toLocation(), "EndSelectStmt lowering");
643   }
644 
645   // Nop statements - No code, or code is generated at the construct level.
646   void genFIR(const Fortran::parser::EndSubroutineStmt &) {} // nop
647 
648   void genFIR(const Fortran::parser::EntryStmt &) {
649     TODO(toLocation(), "EntryStmt lowering");
650   }
651 
652   void genFIR(const Fortran::parser::IfStmt &) {
653     TODO(toLocation(), "IfStmt lowering");
654   }
655 
656   void genFIR(const Fortran::parser::IfThenStmt &) {
657     TODO(toLocation(), "IfThenStmt lowering");
658   }
659 
660   void genFIR(const Fortran::parser::NonLabelDoStmt &) {
661     TODO(toLocation(), "NonLabelDoStmt lowering");
662   }
663 
664   void genFIR(const Fortran::parser::OmpEndLoopDirective &) {
665     TODO(toLocation(), "OmpEndLoopDirective lowering");
666   }
667 
668   void genFIR(const Fortran::parser::NamelistStmt &) {
669     TODO(toLocation(), "NamelistStmt lowering");
670   }
671 
672   void genFIR(Fortran::lower::pft::Evaluation &eval,
673               bool unstructuredContext = true) {
674     setCurrentEval(eval);
675     setCurrentPosition(eval.position);
676     eval.visit([&](const auto &stmt) { genFIR(stmt); });
677   }
678 
679   //===--------------------------------------------------------------------===//
680 
681   Fortran::lower::LoweringBridge &bridge;
682   Fortran::evaluate::FoldingContext foldingContext;
683   fir::FirOpBuilder *builder = nullptr;
684   Fortran::lower::pft::Evaluation *evalPtr = nullptr;
685   Fortran::lower::SymMap localSymbols;
686   Fortran::parser::CharBlock currentPosition;
687 };
688 
689 } // namespace
690 
691 Fortran::evaluate::FoldingContext
692 Fortran::lower::LoweringBridge::createFoldingContext() const {
693   return {getDefaultKinds(), getIntrinsicTable()};
694 }
695 
696 void Fortran::lower::LoweringBridge::lower(
697     const Fortran::parser::Program &prg,
698     const Fortran::semantics::SemanticsContext &semanticsContext) {
699   std::unique_ptr<Fortran::lower::pft::Program> pft =
700       Fortran::lower::createPFT(prg, semanticsContext);
701   if (dumpBeforeFir)
702     Fortran::lower::dumpPFT(llvm::errs(), *pft);
703   FirConverter converter{*this};
704   converter.run(*pft);
705 }
706 
707 Fortran::lower::LoweringBridge::LoweringBridge(
708     mlir::MLIRContext &context,
709     const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds,
710     const Fortran::evaluate::IntrinsicProcTable &intrinsics,
711     const Fortran::parser::AllCookedSources &cooked, llvm::StringRef triple,
712     fir::KindMapping &kindMap)
713     : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked},
714       context{context}, kindMap{kindMap} {
715   // Register the diagnostic handler.
716   context.getDiagEngine().registerHandler([](mlir::Diagnostic &diag) {
717     llvm::raw_ostream &os = llvm::errs();
718     switch (diag.getSeverity()) {
719     case mlir::DiagnosticSeverity::Error:
720       os << "error: ";
721       break;
722     case mlir::DiagnosticSeverity::Remark:
723       os << "info: ";
724       break;
725     case mlir::DiagnosticSeverity::Warning:
726       os << "warning: ";
727       break;
728     default:
729       break;
730     }
731     if (!diag.getLocation().isa<UnknownLoc>())
732       os << diag.getLocation() << ": ";
733     os << diag << '\n';
734     os.flush();
735     return mlir::success();
736   });
737 
738   // Create the module and attach the attributes.
739   module = std::make_unique<mlir::ModuleOp>(
740       mlir::ModuleOp::create(mlir::UnknownLoc::get(&context)));
741   assert(module.get() && "module was not created");
742   fir::setTargetTriple(*module.get(), triple);
743   fir::setKindMapping(*module.get(), kindMap);
744 }
745