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/IO.h"
20 #include "flang/Lower/IterationSpace.h"
21 #include "flang/Lower/Mangler.h"
22 #include "flang/Lower/PFTBuilder.h"
23 #include "flang/Lower/Runtime.h"
24 #include "flang/Lower/StatementContext.h"
25 #include "flang/Lower/SymbolMap.h"
26 #include "flang/Lower/Todo.h"
27 #include "flang/Optimizer/Builder/BoxValue.h"
28 #include "flang/Optimizer/Builder/Character.h"
29 #include "flang/Optimizer/Builder/MutableBox.h"
30 #include "flang/Optimizer/Support/FIRContext.h"
31 #include "flang/Runtime/iostat.h"
32 #include "flang/Semantics/tools.h"
33 #include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h"
34 #include "mlir/IR/PatternMatch.h"
35 #include "mlir/Transforms/RegionUtils.h"
36 #include "llvm/Support/CommandLine.h"
37 #include "llvm/Support/Debug.h"
38 
39 #define DEBUG_TYPE "flang-lower-bridge"
40 
41 static llvm::cl::opt<bool> dumpBeforeFir(
42     "fdebug-dump-pre-fir", llvm::cl::init(false),
43     llvm::cl::desc("dump the Pre-FIR tree prior to FIR generation"));
44 
45 //===----------------------------------------------------------------------===//
46 // FirConverter
47 //===----------------------------------------------------------------------===//
48 
49 namespace {
50 
51 /// Traverse the pre-FIR tree (PFT) to generate the FIR dialect of MLIR.
52 class FirConverter : public Fortran::lower::AbstractConverter {
53 public:
54   explicit FirConverter(Fortran::lower::LoweringBridge &bridge)
55       : bridge{bridge}, foldingContext{bridge.createFoldingContext()} {}
56   virtual ~FirConverter() = default;
57 
58   /// Convert the PFT to FIR.
59   void run(Fortran::lower::pft::Program &pft) {
60     // Primary translation pass.
61     for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
62       std::visit(
63           Fortran::common::visitors{
64               [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); },
65               [&](Fortran::lower::pft::ModuleLikeUnit &m) {},
66               [&](Fortran::lower::pft::BlockDataUnit &b) {},
67               [&](Fortran::lower::pft::CompilerDirectiveUnit &d) {
68                 setCurrentPosition(
69                     d.get<Fortran::parser::CompilerDirective>().source);
70                 mlir::emitWarning(toLocation(),
71                                   "ignoring all compiler directives");
72               },
73           },
74           u);
75     }
76   }
77 
78   //===--------------------------------------------------------------------===//
79   // AbstractConverter overrides
80   //===--------------------------------------------------------------------===//
81 
82   mlir::Value getSymbolAddress(Fortran::lower::SymbolRef sym) override final {
83     return lookupSymbol(sym).getAddr();
84   }
85 
86   bool lookupLabelSet(Fortran::lower::SymbolRef sym,
87                       Fortran::lower::pft::LabelSet &labelSet) override final {
88     Fortran::lower::pft::FunctionLikeUnit &owningProc =
89         *getEval().getOwningProcedure();
90     auto iter = owningProc.assignSymbolLabelMap.find(sym);
91     if (iter == owningProc.assignSymbolLabelMap.end())
92       return false;
93     labelSet = iter->second;
94     return true;
95   }
96 
97   Fortran::lower::pft::Evaluation *
98   lookupLabel(Fortran::lower::pft::Label label) override final {
99     Fortran::lower::pft::FunctionLikeUnit &owningProc =
100         *getEval().getOwningProcedure();
101     auto iter = owningProc.labelEvaluationMap.find(label);
102     if (iter == owningProc.labelEvaluationMap.end())
103       return nullptr;
104     return iter->second;
105   }
106 
107   fir::ExtendedValue genExprAddr(const Fortran::lower::SomeExpr &expr,
108                                  Fortran::lower::StatementContext &context,
109                                  mlir::Location *loc = nullptr) override final {
110     return createSomeExtendedAddress(loc ? *loc : toLocation(), *this, expr,
111                                      localSymbols, context);
112   }
113   fir::ExtendedValue
114   genExprValue(const Fortran::lower::SomeExpr &expr,
115                Fortran::lower::StatementContext &context,
116                mlir::Location *loc = nullptr) override final {
117     return createSomeExtendedExpression(loc ? *loc : toLocation(), *this, expr,
118                                         localSymbols, context);
119   }
120   fir::MutableBoxValue
121   genExprMutableBox(mlir::Location loc,
122                     const Fortran::lower::SomeExpr &expr) override final {
123     return Fortran::lower::createMutableBox(loc, *this, expr, localSymbols);
124   }
125   fir::ExtendedValue genExprBox(const Fortran::lower::SomeExpr &expr,
126                                 Fortran::lower::StatementContext &context,
127                                 mlir::Location loc) override final {
128     if (expr.Rank() > 0 && Fortran::evaluate::IsVariable(expr) &&
129         !Fortran::evaluate::HasVectorSubscript(expr))
130       return Fortran::lower::createSomeArrayBox(*this, expr, localSymbols,
131                                                 context);
132     return fir::BoxValue(
133         builder->createBox(loc, genExprAddr(expr, context, &loc)));
134   }
135 
136   Fortran::evaluate::FoldingContext &getFoldingContext() override final {
137     return foldingContext;
138   }
139 
140   mlir::Type genType(const Fortran::evaluate::DataRef &) override final {
141     TODO_NOLOC("Not implemented genType DataRef. Needed for more complex "
142                "expression lowering");
143   }
144   mlir::Type genType(const Fortran::lower::SomeExpr &expr) override final {
145     return Fortran::lower::translateSomeExprToFIRType(*this, expr);
146   }
147   mlir::Type genType(Fortran::lower::SymbolRef sym) override final {
148     return Fortran::lower::translateSymbolToFIRType(*this, sym);
149   }
150   mlir::Type genType(Fortran::common::TypeCategory tc) override final {
151     TODO_NOLOC("Not implemented genType TypeCategory. Needed for more complex "
152                "expression lowering");
153   }
154   mlir::Type
155   genType(Fortran::common::TypeCategory tc, int kind,
156           llvm::ArrayRef<std::int64_t> lenParameters) override final {
157     return Fortran::lower::getFIRType(&getMLIRContext(), tc, kind,
158                                       lenParameters);
159   }
160   mlir::Type genType(const Fortran::lower::pft::Variable &var) override final {
161     return Fortran::lower::translateVariableToFIRType(*this, var);
162   }
163 
164   void setCurrentPosition(const Fortran::parser::CharBlock &position) {
165     if (position != Fortran::parser::CharBlock{})
166       currentPosition = position;
167   }
168 
169   //===--------------------------------------------------------------------===//
170   // Utility methods
171   //===--------------------------------------------------------------------===//
172 
173   /// Convert a parser CharBlock to a Location
174   mlir::Location toLocation(const Fortran::parser::CharBlock &cb) {
175     return genLocation(cb);
176   }
177 
178   mlir::Location toLocation() { return toLocation(currentPosition); }
179   void setCurrentEval(Fortran::lower::pft::Evaluation &eval) {
180     evalPtr = &eval;
181   }
182   Fortran::lower::pft::Evaluation &getEval() {
183     assert(evalPtr && "current evaluation not set");
184     return *evalPtr;
185   }
186 
187   mlir::Location getCurrentLocation() override final { return toLocation(); }
188 
189   /// Generate a dummy location.
190   mlir::Location genUnknownLocation() override final {
191     // Note: builder may not be instantiated yet
192     return mlir::UnknownLoc::get(&getMLIRContext());
193   }
194 
195   /// Generate a `Location` from the `CharBlock`.
196   mlir::Location
197   genLocation(const Fortran::parser::CharBlock &block) override final {
198     if (const Fortran::parser::AllCookedSources *cooked =
199             bridge.getCookedSource()) {
200       if (std::optional<std::pair<Fortran::parser::SourcePosition,
201                                   Fortran::parser::SourcePosition>>
202               loc = cooked->GetSourcePositionRange(block)) {
203         // loc is a pair (begin, end); use the beginning position
204         Fortran::parser::SourcePosition &filePos = loc->first;
205         return mlir::FileLineColLoc::get(&getMLIRContext(), filePos.file.path(),
206                                          filePos.line, filePos.column);
207       }
208     }
209     return genUnknownLocation();
210   }
211 
212   fir::FirOpBuilder &getFirOpBuilder() override final { return *builder; }
213 
214   mlir::ModuleOp &getModuleOp() override final { return bridge.getModule(); }
215 
216   mlir::MLIRContext &getMLIRContext() override final {
217     return bridge.getMLIRContext();
218   }
219   std::string
220   mangleName(const Fortran::semantics::Symbol &symbol) override final {
221     return Fortran::lower::mangle::mangleName(symbol);
222   }
223 
224   const fir::KindMapping &getKindMap() override final {
225     return bridge.getKindMap();
226   }
227 
228   /// Return the predicate: "current block does not have a terminator branch".
229   bool blockIsUnterminated() {
230     mlir::Block *currentBlock = builder->getBlock();
231     return currentBlock->empty() ||
232            !currentBlock->back().hasTrait<mlir::OpTrait::IsTerminator>();
233   }
234 
235   /// Unconditionally switch code insertion to a new block.
236   void startBlock(mlir::Block *newBlock) {
237     assert(newBlock && "missing block");
238     // Default termination for the current block is a fallthrough branch to
239     // the new block.
240     if (blockIsUnterminated())
241       genFIRBranch(newBlock);
242     // Some blocks may be re/started more than once, and might not be empty.
243     // If the new block already has (only) a terminator, set the insertion
244     // point to the start of the block.  Otherwise set it to the end.
245     // Note that setting the insertion point causes the subsequent function
246     // call to check the existence of terminator in the newBlock.
247     builder->setInsertionPointToStart(newBlock);
248     if (blockIsUnterminated())
249       builder->setInsertionPointToEnd(newBlock);
250   }
251 
252   /// Conditionally switch code insertion to a new block.
253   void maybeStartBlock(mlir::Block *newBlock) {
254     if (newBlock)
255       startBlock(newBlock);
256   }
257 
258   /// Emit return and cleanup after the function has been translated.
259   void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
260     setCurrentPosition(Fortran::lower::pft::stmtSourceLoc(funit.endStmt));
261     if (funit.isMainProgram())
262       genExitRoutine();
263     else
264       genFIRProcedureExit(funit, funit.getSubprogramSymbol());
265     funit.finalBlock = nullptr;
266     LLVM_DEBUG(llvm::dbgs() << "*** Lowering result:\n\n"
267                             << *builder->getFunction() << '\n');
268     // FIXME: Simplification should happen in a normal pass, not here.
269     mlir::IRRewriter rewriter(*builder);
270     (void)mlir::simplifyRegions(rewriter,
271                                 {builder->getRegion()}); // remove dead code
272     delete builder;
273     builder = nullptr;
274     hostAssocTuple = mlir::Value{};
275     localSymbols.clear();
276   }
277 
278   /// Map mlir function block arguments to the corresponding Fortran dummy
279   /// variables. When the result is passed as a hidden argument, the Fortran
280   /// result is also mapped. The symbol map is used to hold this mapping.
281   void mapDummiesAndResults(Fortran::lower::pft::FunctionLikeUnit &funit,
282                             const Fortran::lower::CalleeInterface &callee) {
283     assert(builder && "require a builder object at this point");
284     using PassBy = Fortran::lower::CalleeInterface::PassEntityBy;
285     auto mapPassedEntity = [&](const auto arg) -> void {
286       if (arg.passBy == PassBy::AddressAndLength) {
287         // TODO: now that fir call has some attributes regarding character
288         // return, PassBy::AddressAndLength should be retired.
289         mlir::Location loc = toLocation();
290         fir::factory::CharacterExprHelper charHelp{*builder, loc};
291         mlir::Value box =
292             charHelp.createEmboxChar(arg.firArgument, arg.firLength);
293         addSymbol(arg.entity->get(), box);
294       } else {
295         if (arg.entity.has_value()) {
296           addSymbol(arg.entity->get(), arg.firArgument);
297         } else {
298           // assert(funit.parentHasHostAssoc());
299           // funit.parentHostAssoc().internalProcedureBindings(*this,
300           //                                                   localSymbols);
301         }
302       }
303     };
304     for (const Fortran::lower::CalleeInterface::PassedEntity &arg :
305          callee.getPassedArguments())
306       mapPassedEntity(arg);
307 
308     // Allocate local skeleton instances of dummies from other entry points.
309     // Most of these locals will not survive into final generated code, but
310     // some will.  It is illegal to reference them at run time if they do.
311     for (const Fortran::semantics::Symbol *arg :
312          funit.nonUniversalDummyArguments) {
313       if (lookupSymbol(*arg))
314         continue;
315       mlir::Type type = genType(*arg);
316       // TODO: Account for VALUE arguments (and possibly other variants).
317       type = builder->getRefType(type);
318       addSymbol(*arg, builder->create<fir::UndefOp>(toLocation(), type));
319     }
320     if (std::optional<Fortran::lower::CalleeInterface::PassedEntity>
321             passedResult = callee.getPassedResult()) {
322       mapPassedEntity(*passedResult);
323       // FIXME: need to make sure things are OK here. addSymbol may not be OK
324       if (funit.primaryResult &&
325           passedResult->entity->get() != *funit.primaryResult)
326         addSymbol(*funit.primaryResult,
327                   getSymbolAddress(passedResult->entity->get()));
328     }
329   }
330 
331   /// Instantiate variable \p var and add it to the symbol map.
332   /// See ConvertVariable.cpp.
333   void instantiateVar(const Fortran::lower::pft::Variable &var,
334                       Fortran::lower::AggregateStoreMap &storeMap) {
335     Fortran::lower::instantiateVariable(*this, var, localSymbols, storeMap);
336   }
337 
338   /// Prepare to translate a new function
339   void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
340     assert(!builder && "expected nullptr");
341     Fortran::lower::CalleeInterface callee(funit, *this);
342     mlir::FuncOp func = callee.addEntryBlockAndMapArguments();
343     func.setVisibility(mlir::SymbolTable::Visibility::Public);
344     builder = new fir::FirOpBuilder(func, bridge.getKindMap());
345     assert(builder && "FirOpBuilder did not instantiate");
346     builder->setInsertionPointToStart(&func.front());
347 
348     mapDummiesAndResults(funit, callee);
349 
350     Fortran::lower::AggregateStoreMap storeMap;
351     for (const Fortran::lower::pft::Variable &var :
352          funit.getOrderedSymbolTable()) {
353       const Fortran::semantics::Symbol &sym = var.getSymbol();
354       if (!sym.IsFuncResult() || !funit.primaryResult) {
355         instantiateVar(var, storeMap);
356       } else if (&sym == funit.primaryResult) {
357         instantiateVar(var, storeMap);
358       }
359     }
360 
361     // Create most function blocks in advance.
362     createEmptyGlobalBlocks(funit.evaluationList);
363 
364     // Reinstate entry block as the current insertion point.
365     builder->setInsertionPointToEnd(&func.front());
366   }
367 
368   /// Create global blocks for the current function.  This eliminates the
369   /// distinction between forward and backward targets when generating
370   /// branches.  A block is "global" if it can be the target of a GOTO or
371   /// other source code branch.  A block that can only be targeted by a
372   /// compiler generated branch is "local".  For example, a DO loop preheader
373   /// block containing loop initialization code is global.  A loop header
374   /// block, which is the target of the loop back edge, is local.  Blocks
375   /// belong to a region.  Any block within a nested region must be replaced
376   /// with a block belonging to that region.  Branches may not cross region
377   /// boundaries.
378   void createEmptyGlobalBlocks(
379       std::list<Fortran::lower::pft::Evaluation> &evaluationList) {
380     mlir::Region *region = &builder->getRegion();
381     for (Fortran::lower::pft::Evaluation &eval : evaluationList) {
382       if (eval.isNewBlock)
383         eval.block = builder->createBlock(region);
384       if (eval.isConstruct() || eval.isDirective()) {
385         if (eval.lowerAsUnstructured()) {
386           createEmptyGlobalBlocks(eval.getNestedEvaluations());
387         } else if (eval.hasNestedEvaluations()) {
388           TODO(toLocation(), "Constructs with nested evaluations");
389         }
390       }
391     }
392   }
393 
394   /// Lower a procedure (nest).
395   void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) {
396     setCurrentPosition(funit.getStartingSourceLoc());
397     for (int entryIndex = 0, last = funit.entryPointList.size();
398          entryIndex < last; ++entryIndex) {
399       funit.setActiveEntry(entryIndex);
400       startNewFunction(funit); // the entry point for lowering this procedure
401       for (Fortran::lower::pft::Evaluation &eval : funit.evaluationList)
402         genFIR(eval);
403       endNewFunction(funit);
404     }
405     funit.setActiveEntry(0);
406     for (Fortran::lower::pft::FunctionLikeUnit &f : funit.nestedFunctions)
407       lowerFunc(f); // internal procedure
408   }
409 
410   mlir::Value hostAssocTupleValue() override final { return hostAssocTuple; }
411 
412 private:
413   FirConverter() = delete;
414   FirConverter(const FirConverter &) = delete;
415   FirConverter &operator=(const FirConverter &) = delete;
416 
417   //===--------------------------------------------------------------------===//
418   // Helper member functions
419   //===--------------------------------------------------------------------===//
420 
421   /// Find the symbol in the local map or return null.
422   Fortran::lower::SymbolBox
423   lookupSymbol(const Fortran::semantics::Symbol &sym) {
424     if (Fortran::lower::SymbolBox v = localSymbols.lookupSymbol(sym))
425       return v;
426     return {};
427   }
428 
429   /// Add the symbol to the local map and return `true`. If the symbol is
430   /// already in the map and \p forced is `false`, the map is not updated.
431   /// Instead the value `false` is returned.
432   bool addSymbol(const Fortran::semantics::SymbolRef sym, mlir::Value val,
433                  bool forced = false) {
434     if (!forced && lookupSymbol(sym))
435       return false;
436     localSymbols.addSymbol(sym, val, forced);
437     return true;
438   }
439 
440   bool isNumericScalarCategory(Fortran::common::TypeCategory cat) {
441     return cat == Fortran::common::TypeCategory::Integer ||
442            cat == Fortran::common::TypeCategory::Real ||
443            cat == Fortran::common::TypeCategory::Complex ||
444            cat == Fortran::common::TypeCategory::Logical;
445   }
446   bool isCharacterCategory(Fortran::common::TypeCategory cat) {
447     return cat == Fortran::common::TypeCategory::Character;
448   }
449   bool isDerivedCategory(Fortran::common::TypeCategory cat) {
450     return cat == Fortran::common::TypeCategory::Derived;
451   }
452 
453   mlir::Block *blockOfLabel(Fortran::lower::pft::Evaluation &eval,
454                             Fortran::parser::Label label) {
455     const Fortran::lower::pft::LabelEvalMap &labelEvaluationMap =
456         eval.getOwningProcedure()->labelEvaluationMap;
457     const auto iter = labelEvaluationMap.find(label);
458     assert(iter != labelEvaluationMap.end() && "label missing from map");
459     mlir::Block *block = iter->second->block;
460     assert(block && "missing labeled evaluation block");
461     return block;
462   }
463 
464   void genFIRBranch(mlir::Block *targetBlock) {
465     assert(targetBlock && "missing unconditional target block");
466     builder->create<cf::BranchOp>(toLocation(), targetBlock);
467   }
468 
469   //===--------------------------------------------------------------------===//
470   // Termination of symbolically referenced execution units
471   //===--------------------------------------------------------------------===//
472 
473   /// END of program
474   ///
475   /// Generate the cleanup block before the program exits
476   void genExitRoutine() {
477     if (blockIsUnterminated())
478       builder->create<mlir::func::ReturnOp>(toLocation());
479   }
480   void genFIR(const Fortran::parser::EndProgramStmt &) { genExitRoutine(); }
481 
482   /// END of procedure-like constructs
483   ///
484   /// Generate the cleanup block before the procedure exits
485   void genReturnSymbol(const Fortran::semantics::Symbol &functionSymbol) {
486     const Fortran::semantics::Symbol &resultSym =
487         functionSymbol.get<Fortran::semantics::SubprogramDetails>().result();
488     Fortran::lower::SymbolBox resultSymBox = lookupSymbol(resultSym);
489     mlir::Location loc = toLocation();
490     if (!resultSymBox) {
491       mlir::emitError(loc, "failed lowering function return");
492       return;
493     }
494     mlir::Value resultVal = resultSymBox.match(
495         [&](const fir::CharBoxValue &x) -> mlir::Value {
496           return fir::factory::CharacterExprHelper{*builder, loc}
497               .createEmboxChar(x.getBuffer(), x.getLen());
498         },
499         [&](const auto &) -> mlir::Value {
500           mlir::Value resultRef = resultSymBox.getAddr();
501           mlir::Type resultType = genType(resultSym);
502           mlir::Type resultRefType = builder->getRefType(resultType);
503           // A function with multiple entry points returning different types
504           // tags all result variables with one of the largest types to allow
505           // them to share the same storage.  Convert this to the actual type.
506           if (resultRef.getType() != resultRefType)
507             TODO(loc, "Convert to actual type");
508           return builder->create<fir::LoadOp>(loc, resultRef);
509         });
510     builder->create<mlir::func::ReturnOp>(loc, resultVal);
511   }
512 
513   void genFIRProcedureExit(Fortran::lower::pft::FunctionLikeUnit &funit,
514                            const Fortran::semantics::Symbol &symbol) {
515     if (mlir::Block *finalBlock = funit.finalBlock) {
516       // The current block must end with a terminator.
517       if (blockIsUnterminated())
518         builder->create<mlir::cf::BranchOp>(toLocation(), finalBlock);
519       // Set insertion point to final block.
520       builder->setInsertionPoint(finalBlock, finalBlock->end());
521     }
522     if (Fortran::semantics::IsFunction(symbol)) {
523       genReturnSymbol(symbol);
524     } else {
525       genExitRoutine();
526     }
527   }
528 
529   [[maybe_unused]] static bool
530   isFuncResultDesignator(const Fortran::lower::SomeExpr &expr) {
531     const Fortran::semantics::Symbol *sym =
532         Fortran::evaluate::GetFirstSymbol(expr);
533     return sym && sym->IsFuncResult();
534   }
535 
536   static bool isWholeAllocatable(const Fortran::lower::SomeExpr &expr) {
537     const Fortran::semantics::Symbol *sym =
538         Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(expr);
539     return sym && Fortran::semantics::IsAllocatable(*sym);
540   }
541 
542   void genAssignment(const Fortran::evaluate::Assignment &assign) {
543     Fortran::lower::StatementContext stmtCtx;
544     mlir::Location loc = toLocation();
545     std::visit(
546         Fortran::common::visitors{
547             // [1] Plain old assignment.
548             [&](const Fortran::evaluate::Assignment::Intrinsic &) {
549               const Fortran::semantics::Symbol *sym =
550                   Fortran::evaluate::GetLastSymbol(assign.lhs);
551 
552               if (!sym)
553                 TODO(loc, "assignment to pointer result of function reference");
554 
555               std::optional<Fortran::evaluate::DynamicType> lhsType =
556                   assign.lhs.GetType();
557               assert(lhsType && "lhs cannot be typeless");
558               // Assignment to polymorphic allocatables may require changing the
559               // variable dynamic type (See Fortran 2018 10.2.1.3 p3).
560               if (lhsType->IsPolymorphic() && isWholeAllocatable(assign.lhs))
561                 TODO(loc, "assignment to polymorphic allocatable");
562 
563               // Note: No ad-hoc handling for pointers is required here. The
564               // target will be assigned as per 2018 10.2.1.3 p2. genExprAddr
565               // on a pointer returns the target address and not the address of
566               // the pointer variable.
567 
568               if (assign.lhs.Rank() > 0) {
569                 // Array assignment
570                 // See Fortran 2018 10.2.1.3 p5, p6, and p7
571                 genArrayAssignment(assign, stmtCtx);
572                 return;
573               }
574 
575               // Scalar assignment
576               const bool isNumericScalar =
577                   isNumericScalarCategory(lhsType->category());
578               fir::ExtendedValue rhs = isNumericScalar
579                                            ? genExprValue(assign.rhs, stmtCtx)
580                                            : genExprAddr(assign.rhs, stmtCtx);
581               bool lhsIsWholeAllocatable = isWholeAllocatable(assign.lhs);
582               llvm::Optional<fir::factory::MutableBoxReallocation> lhsRealloc;
583               llvm::Optional<fir::MutableBoxValue> lhsMutableBox;
584               auto lhs = [&]() -> fir::ExtendedValue {
585                 if (lhsIsWholeAllocatable) {
586                   lhsMutableBox = genExprMutableBox(loc, assign.lhs);
587                   llvm::SmallVector<mlir::Value> lengthParams;
588                   if (const fir::CharBoxValue *charBox = rhs.getCharBox())
589                     lengthParams.push_back(charBox->getLen());
590                   else if (fir::isDerivedWithLengthParameters(rhs))
591                     TODO(loc, "assignment to derived type allocatable with "
592                               "length parameters");
593                   lhsRealloc = fir::factory::genReallocIfNeeded(
594                       *builder, loc, *lhsMutableBox,
595                       /*shape=*/llvm::None, lengthParams);
596                   return lhsRealloc->newValue;
597                 }
598                 return genExprAddr(assign.lhs, stmtCtx);
599               }();
600 
601               if (isNumericScalar) {
602                 // Fortran 2018 10.2.1.3 p8 and p9
603                 // Conversions should have been inserted by semantic analysis,
604                 // but they can be incorrect between the rhs and lhs. Correct
605                 // that here.
606                 mlir::Value addr = fir::getBase(lhs);
607                 mlir::Value val = fir::getBase(rhs);
608                 // A function with multiple entry points returning different
609                 // types tags all result variables with one of the largest
610                 // types to allow them to share the same storage.  Assignment
611                 // to a result variable of one of the other types requires
612                 // conversion to the actual type.
613                 mlir::Type toTy = genType(assign.lhs);
614                 mlir::Value cast =
615                     builder->convertWithSemantics(loc, toTy, val);
616                 if (fir::dyn_cast_ptrEleTy(addr.getType()) != toTy) {
617                   assert(isFuncResultDesignator(assign.lhs) && "type mismatch");
618                   addr = builder->createConvert(
619                       toLocation(), builder->getRefType(toTy), addr);
620                 }
621                 builder->create<fir::StoreOp>(loc, cast, addr);
622               } else if (isCharacterCategory(lhsType->category())) {
623                 // Fortran 2018 10.2.1.3 p10 and p11
624                 fir::factory::CharacterExprHelper{*builder, loc}.createAssign(
625                     lhs, rhs);
626               } else if (isDerivedCategory(lhsType->category())) {
627                 TODO(toLocation(), "Derived type assignment");
628               } else {
629                 llvm_unreachable("unknown category");
630               }
631               if (lhsIsWholeAllocatable)
632                 fir::factory::finalizeRealloc(
633                     *builder, loc, lhsMutableBox.getValue(),
634                     /*lbounds=*/llvm::None, /*takeLboundsIfRealloc=*/false,
635                     lhsRealloc.getValue());
636             },
637 
638             // [2] User defined assignment. If the context is a scalar
639             // expression then call the procedure.
640             [&](const Fortran::evaluate::ProcedureRef &procRef) {
641               TODO(toLocation(), "User defined assignment");
642             },
643 
644             // [3] Pointer assignment with possibly empty bounds-spec. R1035: a
645             // bounds-spec is a lower bound value.
646             [&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
647               TODO(toLocation(),
648                    "Pointer assignment with possibly empty bounds-spec");
649             },
650 
651             // [4] Pointer assignment with bounds-remapping. R1036: a
652             // bounds-remapping is a pair, lower bound and upper bound.
653             [&](const Fortran::evaluate::Assignment::BoundsRemapping
654                     &boundExprs) {
655               TODO(toLocation(), "Pointer assignment with bounds-remapping");
656             },
657         },
658         assign.u);
659   }
660 
661   /// Lowering of CALL statement
662   void genFIR(const Fortran::parser::CallStmt &stmt) {
663     Fortran::lower::StatementContext stmtCtx;
664     setCurrentPosition(stmt.v.source);
665     assert(stmt.typedCall && "Call was not analyzed");
666     // Call statement lowering shares code with function call lowering.
667     mlir::Value res = Fortran::lower::createSubroutineCall(
668         *this, *stmt.typedCall, localSymbols, stmtCtx);
669     if (!res)
670       return; // "Normal" subroutine call.
671   }
672 
673   void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) {
674     TODO(toLocation(), "ComputedGotoStmt lowering");
675   }
676 
677   void genFIR(const Fortran::parser::ArithmeticIfStmt &stmt) {
678     TODO(toLocation(), "ArithmeticIfStmt lowering");
679   }
680 
681   void genFIR(const Fortran::parser::AssignedGotoStmt &stmt) {
682     TODO(toLocation(), "AssignedGotoStmt lowering");
683   }
684 
685   void genFIR(const Fortran::parser::DoConstruct &doConstruct) {
686     TODO(toLocation(), "DoConstruct lowering");
687   }
688 
689   void genFIR(const Fortran::parser::IfConstruct &) {
690     TODO(toLocation(), "IfConstruct lowering");
691   }
692 
693   void genFIR(const Fortran::parser::CaseConstruct &) {
694     TODO(toLocation(), "CaseConstruct lowering");
695   }
696 
697   void genFIR(const Fortran::parser::ConcurrentHeader &header) {
698     TODO(toLocation(), "ConcurrentHeader lowering");
699   }
700 
701   void genFIR(const Fortran::parser::ForallAssignmentStmt &stmt) {
702     TODO(toLocation(), "ForallAssignmentStmt lowering");
703   }
704 
705   void genFIR(const Fortran::parser::EndForallStmt &) {
706     TODO(toLocation(), "EndForallStmt lowering");
707   }
708 
709   void genFIR(const Fortran::parser::ForallStmt &) {
710     TODO(toLocation(), "ForallStmt lowering");
711   }
712 
713   void genFIR(const Fortran::parser::ForallConstruct &) {
714     TODO(toLocation(), "ForallConstruct lowering");
715   }
716 
717   void genFIR(const Fortran::parser::ForallConstructStmt &) {
718     TODO(toLocation(), "ForallConstructStmt lowering");
719   }
720 
721   void genFIR(const Fortran::parser::CompilerDirective &) {
722     TODO(toLocation(), "CompilerDirective lowering");
723   }
724 
725   void genFIR(const Fortran::parser::OpenACCConstruct &) {
726     TODO(toLocation(), "OpenACCConstruct lowering");
727   }
728 
729   void genFIR(const Fortran::parser::OpenACCDeclarativeConstruct &) {
730     TODO(toLocation(), "OpenACCDeclarativeConstruct lowering");
731   }
732 
733   void genFIR(const Fortran::parser::OpenMPConstruct &) {
734     TODO(toLocation(), "OpenMPConstruct lowering");
735   }
736 
737   void genFIR(const Fortran::parser::OpenMPDeclarativeConstruct &) {
738     TODO(toLocation(), "OpenMPDeclarativeConstruct lowering");
739   }
740 
741   void genFIR(const Fortran::parser::SelectCaseStmt &) {
742     TODO(toLocation(), "SelectCaseStmt lowering");
743   }
744 
745   void genFIR(const Fortran::parser::AssociateConstruct &) {
746     TODO(toLocation(), "AssociateConstruct lowering");
747   }
748 
749   void genFIR(const Fortran::parser::BlockConstruct &blockConstruct) {
750     TODO(toLocation(), "BlockConstruct lowering");
751   }
752 
753   void genFIR(const Fortran::parser::BlockStmt &) {
754     TODO(toLocation(), "BlockStmt lowering");
755   }
756 
757   void genFIR(const Fortran::parser::EndBlockStmt &) {
758     TODO(toLocation(), "EndBlockStmt lowering");
759   }
760 
761   void genFIR(const Fortran::parser::ChangeTeamConstruct &construct) {
762     TODO(toLocation(), "ChangeTeamConstruct lowering");
763   }
764 
765   void genFIR(const Fortran::parser::ChangeTeamStmt &stmt) {
766     TODO(toLocation(), "ChangeTeamStmt lowering");
767   }
768 
769   void genFIR(const Fortran::parser::EndChangeTeamStmt &stmt) {
770     TODO(toLocation(), "EndChangeTeamStmt lowering");
771   }
772 
773   void genFIR(const Fortran::parser::CriticalConstruct &criticalConstruct) {
774     TODO(toLocation(), "CriticalConstruct lowering");
775   }
776 
777   void genFIR(const Fortran::parser::CriticalStmt &) {
778     TODO(toLocation(), "CriticalStmt lowering");
779   }
780 
781   void genFIR(const Fortran::parser::EndCriticalStmt &) {
782     TODO(toLocation(), "EndCriticalStmt lowering");
783   }
784 
785   void genFIR(const Fortran::parser::SelectRankConstruct &selectRankConstruct) {
786     TODO(toLocation(), "SelectRankConstruct lowering");
787   }
788 
789   void genFIR(const Fortran::parser::SelectRankStmt &) {
790     TODO(toLocation(), "SelectRankStmt lowering");
791   }
792 
793   void genFIR(const Fortran::parser::SelectRankCaseStmt &) {
794     TODO(toLocation(), "SelectRankCaseStmt lowering");
795   }
796 
797   void genFIR(const Fortran::parser::SelectTypeConstruct &selectTypeConstruct) {
798     TODO(toLocation(), "SelectTypeConstruct lowering");
799   }
800 
801   void genFIR(const Fortran::parser::SelectTypeStmt &) {
802     TODO(toLocation(), "SelectTypeStmt lowering");
803   }
804 
805   void genFIR(const Fortran::parser::TypeGuardStmt &) {
806     TODO(toLocation(), "TypeGuardStmt lowering");
807   }
808 
809   //===--------------------------------------------------------------------===//
810   // IO statements (see io.h)
811   //===--------------------------------------------------------------------===//
812 
813   void genFIR(const Fortran::parser::BackspaceStmt &stmt) {
814     TODO(toLocation(), "BackspaceStmt lowering");
815   }
816 
817   void genFIR(const Fortran::parser::CloseStmt &stmt) {
818     TODO(toLocation(), "CloseStmt lowering");
819   }
820 
821   void genFIR(const Fortran::parser::EndfileStmt &stmt) {
822     TODO(toLocation(), "EndfileStmt lowering");
823   }
824 
825   void genFIR(const Fortran::parser::FlushStmt &stmt) {
826     TODO(toLocation(), "FlushStmt lowering");
827   }
828 
829   void genFIR(const Fortran::parser::InquireStmt &stmt) {
830     TODO(toLocation(), "InquireStmt lowering");
831   }
832 
833   void genFIR(const Fortran::parser::OpenStmt &stmt) {
834     TODO(toLocation(), "OpenStmt lowering");
835   }
836 
837   void genFIR(const Fortran::parser::PrintStmt &stmt) {
838     genPrintStatement(*this, stmt);
839   }
840 
841   void genFIR(const Fortran::parser::ReadStmt &stmt) {
842     mlir::Value iostat = genReadStatement(*this, stmt);
843     genIoConditionBranches(getEval(), stmt.controls, iostat);
844   }
845 
846   void genFIR(const Fortran::parser::RewindStmt &stmt) {
847     TODO(toLocation(), "RewindStmt lowering");
848   }
849 
850   void genFIR(const Fortran::parser::WaitStmt &stmt) {
851     TODO(toLocation(), "WaitStmt lowering");
852   }
853 
854   void genFIR(const Fortran::parser::WriteStmt &stmt) {
855     mlir::Value iostat = genWriteStatement(*this, stmt);
856     genIoConditionBranches(getEval(), stmt.controls, iostat);
857   }
858 
859   template <typename A>
860   void genIoConditionBranches(Fortran::lower::pft::Evaluation &eval,
861                               const A &specList, mlir::Value iostat) {
862     if (!iostat)
863       return;
864 
865     mlir::Block *endBlock = nullptr;
866     mlir::Block *eorBlock = nullptr;
867     mlir::Block *errBlock = nullptr;
868     for (const auto &spec : specList) {
869       std::visit(Fortran::common::visitors{
870                      [&](const Fortran::parser::EndLabel &label) {
871                        endBlock = blockOfLabel(eval, label.v);
872                      },
873                      [&](const Fortran::parser::EorLabel &label) {
874                        eorBlock = blockOfLabel(eval, label.v);
875                      },
876                      [&](const Fortran::parser::ErrLabel &label) {
877                        errBlock = blockOfLabel(eval, label.v);
878                      },
879                      [](const auto &) {}},
880                  spec.u);
881     }
882     if (!endBlock && !eorBlock && !errBlock)
883       return;
884 
885     mlir::Location loc = toLocation();
886     mlir::Type indexType = builder->getIndexType();
887     mlir::Value selector = builder->createConvert(loc, indexType, iostat);
888     llvm::SmallVector<int64_t> indexList;
889     llvm::SmallVector<mlir::Block *> blockList;
890     if (eorBlock) {
891       indexList.push_back(Fortran::runtime::io::IostatEor);
892       blockList.push_back(eorBlock);
893     }
894     if (endBlock) {
895       indexList.push_back(Fortran::runtime::io::IostatEnd);
896       blockList.push_back(endBlock);
897     }
898     if (errBlock) {
899       indexList.push_back(0);
900       blockList.push_back(eval.nonNopSuccessor().block);
901       // ERR label statement is the default successor.
902       blockList.push_back(errBlock);
903     } else {
904       // Fallthrough successor statement is the default successor.
905       blockList.push_back(eval.nonNopSuccessor().block);
906     }
907     builder->create<fir::SelectOp>(loc, selector, indexList, blockList);
908   }
909 
910   //===--------------------------------------------------------------------===//
911   // Memory allocation and deallocation
912   //===--------------------------------------------------------------------===//
913 
914   void genFIR(const Fortran::parser::AllocateStmt &stmt) {
915     TODO(toLocation(), "AllocateStmt lowering");
916   }
917 
918   void genFIR(const Fortran::parser::DeallocateStmt &stmt) {
919     TODO(toLocation(), "DeallocateStmt lowering");
920   }
921 
922   void genFIR(const Fortran::parser::NullifyStmt &stmt) {
923     TODO(toLocation(), "NullifyStmt lowering");
924   }
925 
926   //===--------------------------------------------------------------------===//
927 
928   void genFIR(const Fortran::parser::EventPostStmt &stmt) {
929     TODO(toLocation(), "EventPostStmt lowering");
930   }
931 
932   void genFIR(const Fortran::parser::EventWaitStmt &stmt) {
933     TODO(toLocation(), "EventWaitStmt lowering");
934   }
935 
936   void genFIR(const Fortran::parser::FormTeamStmt &stmt) {
937     TODO(toLocation(), "FormTeamStmt lowering");
938   }
939 
940   void genFIR(const Fortran::parser::LockStmt &stmt) {
941     TODO(toLocation(), "LockStmt lowering");
942   }
943 
944   /// Generate an array assignment.
945   /// This is an assignment expression with rank > 0. The assignment may or may
946   /// not be in a WHERE and/or FORALL context.
947   void genArrayAssignment(const Fortran::evaluate::Assignment &assign,
948                           Fortran::lower::StatementContext &stmtCtx) {
949     if (isWholeAllocatable(assign.lhs)) {
950       // Assignment to allocatables may require the lhs to be
951       // deallocated/reallocated. See Fortran 2018 10.2.1.3 p3
952       Fortran::lower::createAllocatableArrayAssignment(
953           *this, assign.lhs, assign.rhs, explicitIterSpace, implicitIterSpace,
954           localSymbols, stmtCtx);
955       return;
956     }
957 
958     // No masks and the iteration space is implied by the array, so create a
959     // simple array assignment.
960     Fortran::lower::createSomeArrayAssignment(*this, assign.lhs, assign.rhs,
961                                               localSymbols, stmtCtx);
962   }
963 
964   void genFIR(const Fortran::parser::WhereConstruct &c) {
965     TODO(toLocation(), "WhereConstruct lowering");
966   }
967 
968   void genFIR(const Fortran::parser::WhereBodyConstruct &body) {
969     TODO(toLocation(), "WhereBodyConstruct lowering");
970   }
971 
972   void genFIR(const Fortran::parser::WhereConstructStmt &stmt) {
973     TODO(toLocation(), "WhereConstructStmt lowering");
974   }
975 
976   void genFIR(const Fortran::parser::WhereConstruct::MaskedElsewhere &ew) {
977     TODO(toLocation(), "MaskedElsewhere lowering");
978   }
979 
980   void genFIR(const Fortran::parser::MaskedElsewhereStmt &stmt) {
981     TODO(toLocation(), "MaskedElsewhereStmt lowering");
982   }
983 
984   void genFIR(const Fortran::parser::WhereConstruct::Elsewhere &ew) {
985     TODO(toLocation(), "Elsewhere lowering");
986   }
987 
988   void genFIR(const Fortran::parser::ElsewhereStmt &stmt) {
989     TODO(toLocation(), "ElsewhereStmt lowering");
990   }
991 
992   void genFIR(const Fortran::parser::EndWhereStmt &) {
993     TODO(toLocation(), "EndWhereStmt lowering");
994   }
995 
996   void genFIR(const Fortran::parser::WhereStmt &stmt) {
997     TODO(toLocation(), "WhereStmt lowering");
998   }
999 
1000   void genFIR(const Fortran::parser::PointerAssignmentStmt &stmt) {
1001     TODO(toLocation(), "PointerAssignmentStmt lowering");
1002   }
1003 
1004   void genFIR(const Fortran::parser::AssignmentStmt &stmt) {
1005     genAssignment(*stmt.typedAssignment->v);
1006   }
1007 
1008   void genFIR(const Fortran::parser::SyncAllStmt &stmt) {
1009     TODO(toLocation(), "SyncAllStmt lowering");
1010   }
1011 
1012   void genFIR(const Fortran::parser::SyncImagesStmt &stmt) {
1013     TODO(toLocation(), "SyncImagesStmt lowering");
1014   }
1015 
1016   void genFIR(const Fortran::parser::SyncMemoryStmt &stmt) {
1017     TODO(toLocation(), "SyncMemoryStmt lowering");
1018   }
1019 
1020   void genFIR(const Fortran::parser::SyncTeamStmt &stmt) {
1021     TODO(toLocation(), "SyncTeamStmt lowering");
1022   }
1023 
1024   void genFIR(const Fortran::parser::UnlockStmt &stmt) {
1025     TODO(toLocation(), "UnlockStmt lowering");
1026   }
1027 
1028   void genFIR(const Fortran::parser::AssignStmt &stmt) {
1029     TODO(toLocation(), "AssignStmt lowering");
1030   }
1031 
1032   void genFIR(const Fortran::parser::FormatStmt &) {
1033     TODO(toLocation(), "FormatStmt lowering");
1034   }
1035 
1036   void genFIR(const Fortran::parser::PauseStmt &stmt) {
1037     genPauseStatement(*this, stmt);
1038   }
1039 
1040   void genFIR(const Fortran::parser::FailImageStmt &stmt) {
1041     TODO(toLocation(), "FailImageStmt lowering");
1042   }
1043 
1044   // call STOP, ERROR STOP in runtime
1045   void genFIR(const Fortran::parser::StopStmt &stmt) {
1046     genStopStatement(*this, stmt);
1047   }
1048 
1049   void genFIR(const Fortran::parser::ReturnStmt &stmt) {
1050     Fortran::lower::pft::FunctionLikeUnit *funit =
1051         getEval().getOwningProcedure();
1052     assert(funit && "not inside main program, function or subroutine");
1053     if (funit->isMainProgram()) {
1054       genExitRoutine();
1055       return;
1056     }
1057     mlir::Location loc = toLocation();
1058     if (stmt.v) {
1059       TODO(loc, "Alternate return statement");
1060     }
1061     // Branch to the last block of the SUBROUTINE, which has the actual return.
1062     if (!funit->finalBlock) {
1063       mlir::OpBuilder::InsertPoint insPt = builder->saveInsertionPoint();
1064       funit->finalBlock = builder->createBlock(&builder->getRegion());
1065       builder->restoreInsertionPoint(insPt);
1066     }
1067     builder->create<mlir::cf::BranchOp>(loc, funit->finalBlock);
1068   }
1069 
1070   void genFIR(const Fortran::parser::CycleStmt &) {
1071     TODO(toLocation(), "CycleStmt lowering");
1072   }
1073 
1074   void genFIR(const Fortran::parser::ExitStmt &) {
1075     TODO(toLocation(), "ExitStmt lowering");
1076   }
1077 
1078   void genFIR(const Fortran::parser::GotoStmt &) {
1079     genFIRBranch(getEval().controlSuccessor->block);
1080   }
1081 
1082   void genFIR(const Fortran::parser::AssociateStmt &) {
1083     TODO(toLocation(), "AssociateStmt lowering");
1084   }
1085 
1086   void genFIR(const Fortran::parser::CaseStmt &) {
1087     TODO(toLocation(), "CaseStmt lowering");
1088   }
1089 
1090   void genFIR(const Fortran::parser::ElseIfStmt &) {
1091     TODO(toLocation(), "ElseIfStmt lowering");
1092   }
1093 
1094   void genFIR(const Fortran::parser::ElseStmt &) {
1095     TODO(toLocation(), "ElseStmt lowering");
1096   }
1097 
1098   void genFIR(const Fortran::parser::EndAssociateStmt &) {
1099     TODO(toLocation(), "EndAssociateStmt lowering");
1100   }
1101 
1102   void genFIR(const Fortran::parser::EndDoStmt &) {
1103     TODO(toLocation(), "EndDoStmt lowering");
1104   }
1105 
1106   void genFIR(const Fortran::parser::EndIfStmt &) {
1107     TODO(toLocation(), "EndIfStmt lowering");
1108   }
1109 
1110   void genFIR(const Fortran::parser::EndMpSubprogramStmt &) {
1111     TODO(toLocation(), "EndMpSubprogramStmt lowering");
1112   }
1113 
1114   void genFIR(const Fortran::parser::EndSelectStmt &) {
1115     TODO(toLocation(), "EndSelectStmt lowering");
1116   }
1117 
1118   // Nop statements - No code, or code is generated at the construct level.
1119   void genFIR(const Fortran::parser::ContinueStmt &) {}      // nop
1120   void genFIR(const Fortran::parser::EndFunctionStmt &) {}   // nop
1121   void genFIR(const Fortran::parser::EndSubroutineStmt &) {} // nop
1122 
1123   void genFIR(const Fortran::parser::EntryStmt &) {
1124     TODO(toLocation(), "EntryStmt lowering");
1125   }
1126 
1127   void genFIR(const Fortran::parser::IfStmt &) {
1128     TODO(toLocation(), "IfStmt lowering");
1129   }
1130 
1131   void genFIR(const Fortran::parser::IfThenStmt &) {
1132     TODO(toLocation(), "IfThenStmt lowering");
1133   }
1134 
1135   void genFIR(const Fortran::parser::NonLabelDoStmt &) {
1136     TODO(toLocation(), "NonLabelDoStmt lowering");
1137   }
1138 
1139   void genFIR(const Fortran::parser::OmpEndLoopDirective &) {
1140     TODO(toLocation(), "OmpEndLoopDirective lowering");
1141   }
1142 
1143   void genFIR(const Fortran::parser::NamelistStmt &) {
1144     TODO(toLocation(), "NamelistStmt lowering");
1145   }
1146 
1147   void genFIR(Fortran::lower::pft::Evaluation &eval,
1148               bool unstructuredContext = true) {
1149     if (unstructuredContext) {
1150       // When transitioning from unstructured to structured code,
1151       // the structured code could be a target that starts a new block.
1152       maybeStartBlock(eval.isConstruct() && eval.lowerAsStructured()
1153                           ? eval.getFirstNestedEvaluation().block
1154                           : eval.block);
1155     }
1156 
1157     setCurrentEval(eval);
1158     setCurrentPosition(eval.position);
1159     eval.visit([&](const auto &stmt) { genFIR(stmt); });
1160   }
1161 
1162   //===--------------------------------------------------------------------===//
1163 
1164   Fortran::lower::LoweringBridge &bridge;
1165   Fortran::evaluate::FoldingContext foldingContext;
1166   fir::FirOpBuilder *builder = nullptr;
1167   Fortran::lower::pft::Evaluation *evalPtr = nullptr;
1168   Fortran::lower::SymMap localSymbols;
1169   Fortran::parser::CharBlock currentPosition;
1170 
1171   /// Tuple of host assoicated variables.
1172   mlir::Value hostAssocTuple;
1173   Fortran::lower::ImplicitIterSpace implicitIterSpace;
1174   Fortran::lower::ExplicitIterSpace explicitIterSpace;
1175 };
1176 
1177 } // namespace
1178 
1179 Fortran::evaluate::FoldingContext
1180 Fortran::lower::LoweringBridge::createFoldingContext() const {
1181   return {getDefaultKinds(), getIntrinsicTable()};
1182 }
1183 
1184 void Fortran::lower::LoweringBridge::lower(
1185     const Fortran::parser::Program &prg,
1186     const Fortran::semantics::SemanticsContext &semanticsContext) {
1187   std::unique_ptr<Fortran::lower::pft::Program> pft =
1188       Fortran::lower::createPFT(prg, semanticsContext);
1189   if (dumpBeforeFir)
1190     Fortran::lower::dumpPFT(llvm::errs(), *pft);
1191   FirConverter converter{*this};
1192   converter.run(*pft);
1193 }
1194 
1195 Fortran::lower::LoweringBridge::LoweringBridge(
1196     mlir::MLIRContext &context,
1197     const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds,
1198     const Fortran::evaluate::IntrinsicProcTable &intrinsics,
1199     const Fortran::parser::AllCookedSources &cooked, llvm::StringRef triple,
1200     fir::KindMapping &kindMap)
1201     : defaultKinds{defaultKinds}, intrinsics{intrinsics}, cooked{&cooked},
1202       context{context}, kindMap{kindMap} {
1203   // Register the diagnostic handler.
1204   context.getDiagEngine().registerHandler([](mlir::Diagnostic &diag) {
1205     llvm::raw_ostream &os = llvm::errs();
1206     switch (diag.getSeverity()) {
1207     case mlir::DiagnosticSeverity::Error:
1208       os << "error: ";
1209       break;
1210     case mlir::DiagnosticSeverity::Remark:
1211       os << "info: ";
1212       break;
1213     case mlir::DiagnosticSeverity::Warning:
1214       os << "warning: ";
1215       break;
1216     default:
1217       break;
1218     }
1219     if (!diag.getLocation().isa<UnknownLoc>())
1220       os << diag.getLocation() << ": ";
1221     os << diag << '\n';
1222     os.flush();
1223     return mlir::success();
1224   });
1225 
1226   // Create the module and attach the attributes.
1227   module = std::make_unique<mlir::ModuleOp>(
1228       mlir::ModuleOp::create(mlir::UnknownLoc::get(&context)));
1229   assert(module.get() && "module was not created");
1230   fir::setTargetTriple(*module.get(), triple);
1231   fir::setKindMapping(*module.get(), kindMap);
1232 }
1233