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