1 //===-- ConvertVariable.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/ConvertVariable.h"
14 #include "flang/Lower/AbstractConverter.h"
15 #include "flang/Lower/Allocatable.h"
16 #include "flang/Lower/BoxAnalyzer.h"
17 #include "flang/Lower/CallInterface.h"
18 #include "flang/Lower/ConvertExpr.h"
19 #include "flang/Lower/Mangler.h"
20 #include "flang/Lower/PFTBuilder.h"
21 #include "flang/Lower/StatementContext.h"
22 #include "flang/Lower/Support/Utils.h"
23 #include "flang/Lower/SymbolMap.h"
24 #include "flang/Lower/Todo.h"
25 #include "flang/Optimizer/Builder/Character.h"
26 #include "flang/Optimizer/Builder/FIRBuilder.h"
27 #include "flang/Optimizer/Builder/Runtime/Derived.h"
28 #include "flang/Optimizer/Dialect/FIRAttr.h"
29 #include "flang/Optimizer/Dialect/FIRDialect.h"
30 #include "flang/Optimizer/Dialect/FIROps.h"
31 #include "flang/Optimizer/Support/FIRContext.h"
32 #include "flang/Optimizer/Support/FatalError.h"
33 #include "flang/Semantics/tools.h"
34 #include "llvm/Support/Debug.h"
35 
36 #define DEBUG_TYPE "flang-lower-variable"
37 
38 /// Helper to retrieve a copy of a character literal string from a SomeExpr.
39 /// Required to build character global initializers.
40 template <int KIND>
41 static llvm::Optional<std::tuple<std::string, std::size_t>>
42 getCharacterLiteralCopy(
43     const Fortran::evaluate::Expr<
44         Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>
45         &x) {
46   if (const auto *con =
47           Fortran::evaluate::UnwrapConstantValue<Fortran::evaluate::Type<
48               Fortran::common::TypeCategory::Character, KIND>>(x))
49     if (auto val = con->GetScalarValue())
50       return std::tuple<std::string, std::size_t>{
51           std::string{(const char *)val->c_str(),
52                       KIND * (std::size_t)con->LEN()},
53           (std::size_t)con->LEN()};
54   return llvm::None;
55 }
56 static llvm::Optional<std::tuple<std::string, std::size_t>>
57 getCharacterLiteralCopy(
58     const Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter> &x) {
59   return std::visit([](const auto &e) { return getCharacterLiteralCopy(e); },
60                     x.u);
61 }
62 static llvm::Optional<std::tuple<std::string, std::size_t>>
63 getCharacterLiteralCopy(const Fortran::lower::SomeExpr &x) {
64   if (const auto *e = Fortran::evaluate::UnwrapExpr<
65           Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter>>(x))
66     return getCharacterLiteralCopy(*e);
67   return llvm::None;
68 }
69 template <typename A>
70 static llvm::Optional<std::tuple<std::string, std::size_t>>
71 getCharacterLiteralCopy(const std::optional<A> &x) {
72   if (x)
73     return getCharacterLiteralCopy(*x);
74   return llvm::None;
75 }
76 
77 /// Helper to lower a scalar expression using a specific symbol mapping.
78 static mlir::Value genScalarValue(Fortran::lower::AbstractConverter &converter,
79                                   mlir::Location loc,
80                                   const Fortran::lower::SomeExpr &expr,
81                                   Fortran::lower::SymMap &symMap,
82                                   Fortran::lower::StatementContext &context) {
83   // This does not use the AbstractConverter member function to override the
84   // symbol mapping to be used expression lowering.
85   return fir::getBase(Fortran::lower::createSomeExtendedExpression(
86       loc, converter, expr, symMap, context));
87 }
88 
89 /// Does this variable have a default initialization?
90 static bool hasDefaultInitialization(const Fortran::semantics::Symbol &sym) {
91   if (sym.has<Fortran::semantics::ObjectEntityDetails>() && sym.size())
92     if (!Fortran::semantics::IsAllocatableOrPointer(sym))
93       if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType())
94         if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
95                 declTypeSpec->AsDerived())
96           return derivedTypeSpec->HasDefaultInitialization();
97   return false;
98 }
99 
100 //===----------------------------------------------------------------===//
101 // Global variables instantiation (not for alias and common)
102 //===----------------------------------------------------------------===//
103 
104 /// Helper to generate expression value inside global initializer.
105 static fir::ExtendedValue
106 genInitializerExprValue(Fortran::lower::AbstractConverter &converter,
107                         mlir::Location loc,
108                         const Fortran::lower::SomeExpr &expr,
109                         Fortran::lower::StatementContext &stmtCtx) {
110   // Data initializer are constant value and should not depend on other symbols
111   // given the front-end fold parameter references. In any case, the "current"
112   // map of the converter should not be used since it holds mapping to
113   // mlir::Value from another mlir region. If these value are used by accident
114   // in the initializer, this will lead to segfaults in mlir code.
115   Fortran::lower::SymMap emptyMap;
116   return Fortran::lower::createSomeInitializerExpression(loc, converter, expr,
117                                                          emptyMap, stmtCtx);
118 }
119 
120 /// Can this symbol constant be placed in read-only memory?
121 static bool isConstant(const Fortran::semantics::Symbol &sym) {
122   return sym.attrs().test(Fortran::semantics::Attr::PARAMETER) ||
123          sym.test(Fortran::semantics::Symbol::Flag::ReadOnly);
124 }
125 
126 /// Create the global op declaration without any initializer
127 static fir::GlobalOp declareGlobal(Fortran::lower::AbstractConverter &converter,
128                                    const Fortran::lower::pft::Variable &var,
129                                    llvm::StringRef globalName,
130                                    mlir::StringAttr linkage) {
131   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
132   if (fir::GlobalOp global = builder.getNamedGlobal(globalName))
133     return global;
134   const Fortran::semantics::Symbol &sym = var.getSymbol();
135   mlir::Location loc = converter.genLocation(sym.name());
136   // Resolve potential host and module association before checking that this
137   // symbol is an object of a function pointer.
138   const Fortran::semantics::Symbol &ultimate = sym.GetUltimate();
139   if (!ultimate.has<Fortran::semantics::ObjectEntityDetails>() &&
140       !ultimate.has<Fortran::semantics::ProcEntityDetails>())
141     mlir::emitError(loc, "lowering global declaration: symbol '")
142         << toStringRef(sym.name()) << "' has unexpected details\n";
143   return builder.createGlobal(loc, converter.genType(var), globalName, linkage,
144                               mlir::Attribute{}, isConstant(ultimate));
145 }
146 
147 /// Temporary helper to catch todos in initial data target lowering.
148 static bool
149 hasDerivedTypeWithLengthParameters(const Fortran::semantics::Symbol &sym) {
150   if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType())
151     if (const Fortran::semantics::DerivedTypeSpec *derived =
152             declTy->AsDerived())
153       return Fortran::semantics::CountLenParameters(*derived) > 0;
154   return false;
155 }
156 
157 static mlir::Type unwrapElementType(mlir::Type type) {
158   if (mlir::Type ty = fir::dyn_cast_ptrOrBoxEleTy(type))
159     type = ty;
160   if (auto seqType = type.dyn_cast<fir::SequenceType>())
161     type = seqType.getEleTy();
162   return type;
163 }
164 
165 fir::ExtendedValue Fortran::lower::genExtAddrInInitializer(
166     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
167     const Fortran::lower::SomeExpr &addr) {
168   Fortran::lower::SymMap globalOpSymMap;
169   Fortran::lower::AggregateStoreMap storeMap;
170   Fortran::lower::StatementContext stmtCtx;
171   if (const Fortran::semantics::Symbol *sym =
172           Fortran::evaluate::GetFirstSymbol(addr)) {
173     // Length parameters processing will need care in global initializer
174     // context.
175     if (hasDerivedTypeWithLengthParameters(*sym))
176       TODO(loc, "initial-data-target with derived type length parameters");
177 
178     auto var = Fortran::lower::pft::Variable(*sym, /*global=*/true);
179     Fortran::lower::instantiateVariable(converter, var, globalOpSymMap,
180                                         storeMap);
181   }
182   return Fortran::lower::createInitializerAddress(loc, converter, addr,
183                                                   globalOpSymMap, stmtCtx);
184 }
185 
186 /// create initial-data-target fir.box in a global initializer region.
187 mlir::Value Fortran::lower::genInitialDataTarget(
188     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
189     mlir::Type boxType, const Fortran::lower::SomeExpr &initialTarget) {
190   Fortran::lower::SymMap globalOpSymMap;
191   Fortran::lower::AggregateStoreMap storeMap;
192   Fortran::lower::StatementContext stmtCtx;
193   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
194   if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
195           initialTarget))
196     return fir::factory::createUnallocatedBox(builder, loc, boxType,
197                                               /*nonDeferredParams=*/llvm::None);
198   // Pointer initial data target, and NULL(mold).
199   if (const Fortran::semantics::Symbol *sym =
200           Fortran::evaluate::GetFirstSymbol(initialTarget)) {
201     // Length parameters processing will need care in global initializer
202     // context.
203     if (hasDerivedTypeWithLengthParameters(*sym))
204       TODO(loc, "initial-data-target with derived type length parameters");
205 
206     auto var = Fortran::lower::pft::Variable(*sym, /*global=*/true);
207     Fortran::lower::instantiateVariable(converter, var, globalOpSymMap,
208                                         storeMap);
209   }
210   mlir::Value box;
211   if (initialTarget.Rank() > 0) {
212     box = fir::getBase(Fortran::lower::createSomeArrayBox(
213         converter, initialTarget, globalOpSymMap, stmtCtx));
214   } else {
215     fir::ExtendedValue addr = Fortran::lower::createInitializerAddress(
216         loc, converter, initialTarget, globalOpSymMap, stmtCtx);
217     box = builder.createBox(loc, addr);
218   }
219   // box is a fir.box<T>, not a fir.box<fir.ptr<T>> as it should to be used
220   // for pointers. A fir.convert should not be used here, because it would
221   // not actually set the pointer attribute in the descriptor.
222   // In a normal context, fir.rebox would be used to set the pointer attribute
223   // while copying the projection from another fir.box. But fir.rebox cannot be
224   // used in initializer because its current codegen expects that the input
225   // fir.box is in memory, which is not the case in initializers.
226   // So, just replace the fir.embox that created addr with one with
227   // fir.box<fir.ptr<T>> result type.
228   // Note that the descriptor cannot have been created with fir.rebox because
229   // the initial-data-target cannot be a fir.box itself (it cannot be
230   // assumed-shape, deferred-shape, or polymorphic as per C765). However the
231   // case where the initial data target is a derived type with length parameters
232   // will most likely be a bit trickier, hence the TODO above.
233 
234   mlir::Operation *op = box.getDefiningOp();
235   if (!op || !mlir::isa<fir::EmboxOp>(*op))
236     fir::emitFatalError(
237         loc, "fir.box must be created with embox in global initializers");
238   mlir::Type targetEleTy = unwrapElementType(box.getType());
239   if (!fir::isa_char(targetEleTy))
240     return builder.create<fir::EmboxOp>(loc, boxType, op->getOperands(),
241                                         op->getAttrs());
242 
243   // Handle the character case length particularities: embox takes a length
244   // value argument when the result type has unknown length, but not when the
245   // result type has constant length. The type of the initial target must be
246   // constant length, but the one of the pointer may not be. In this case, a
247   // length operand must be added.
248   auto targetLen = targetEleTy.cast<fir::CharacterType>().getLen();
249   auto ptrLen = unwrapElementType(boxType).cast<fir::CharacterType>().getLen();
250   if (ptrLen == targetLen)
251     // Nothing to do
252     return builder.create<fir::EmboxOp>(loc, boxType, op->getOperands(),
253                                         op->getAttrs());
254   auto embox = mlir::cast<fir::EmboxOp>(*op);
255   auto ptrType = boxType.cast<fir::BoxType>().getEleTy();
256   mlir::Value memref = builder.createConvert(loc, ptrType, embox.getMemref());
257   if (targetLen == fir::CharacterType::unknownLen())
258     // Drop the length argument.
259     return builder.create<fir::EmboxOp>(loc, boxType, memref, embox.getShape(),
260                                         embox.getSlice());
261   // targetLen is constant and ptrLen is unknown. Add a length argument.
262   mlir::Value targetLenValue =
263       builder.createIntegerConstant(loc, builder.getIndexType(), targetLen);
264   return builder.create<fir::EmboxOp>(loc, boxType, memref, embox.getShape(),
265                                       embox.getSlice(),
266                                       mlir::ValueRange{targetLenValue});
267 }
268 
269 static mlir::Value genDefaultInitializerValue(
270     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
271     const Fortran::semantics::Symbol &sym, mlir::Type symTy,
272     Fortran::lower::StatementContext &stmtCtx) {
273   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
274   mlir::Type scalarType = symTy;
275   fir::SequenceType sequenceType;
276   if (auto ty = symTy.dyn_cast<fir::SequenceType>()) {
277     sequenceType = ty;
278     scalarType = ty.getEleTy();
279   }
280   // Build a scalar default value of the symbol type, looping through the
281   // components to build each component initial value.
282   auto recTy = scalarType.cast<fir::RecordType>();
283   auto fieldTy = fir::FieldType::get(scalarType.getContext());
284   mlir::Value initialValue = builder.create<fir::UndefOp>(loc, scalarType);
285   const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType();
286   assert(declTy && "var with default initialization must have a type");
287   Fortran::semantics::OrderedComponentIterator components(
288       declTy->derivedTypeSpec());
289   for (const auto &component : components) {
290     // Skip parent components, the sub-components of parent types are part of
291     // components and will be looped through right after.
292     if (component.test(Fortran::semantics::Symbol::Flag::ParentComp))
293       continue;
294     mlir::Value componentValue;
295     llvm::StringRef name = toStringRef(component.name());
296     mlir::Type componentTy = recTy.getType(name);
297     assert(componentTy && "component not found in type");
298     if (const auto *object{
299             component.detailsIf<Fortran::semantics::ObjectEntityDetails>()}) {
300       if (const auto &init = object->init()) {
301         // Component has explicit initialization.
302         if (Fortran::semantics::IsPointer(component))
303           // Initial data target.
304           componentValue =
305               genInitialDataTarget(converter, loc, componentTy, *init);
306         else
307           // Initial value.
308           componentValue = fir::getBase(
309               genInitializerExprValue(converter, loc, *init, stmtCtx));
310       } else if (Fortran::semantics::IsAllocatableOrPointer(component)) {
311         // Pointer or allocatable without initialization.
312         // Create deallocated/disassociated value.
313         // From a standard point of view, pointer without initialization do not
314         // need to be disassociated, but for sanity and simplicity, do it in
315         // global constructor since this has no runtime cost.
316         componentValue = fir::factory::createUnallocatedBox(
317             builder, loc, componentTy, llvm::None);
318       } else if (hasDefaultInitialization(component)) {
319         // Component type has default initialization.
320         componentValue = genDefaultInitializerValue(converter, loc, component,
321                                                     componentTy, stmtCtx);
322       } else {
323         // Component has no initial value.
324         componentValue = builder.create<fir::UndefOp>(loc, componentTy);
325       }
326     } else if (const auto *proc{
327                    component
328                        .detailsIf<Fortran::semantics::ProcEntityDetails>()}) {
329       if (proc->init().has_value())
330         TODO(loc, "procedure pointer component default initialization");
331       else
332         componentValue = builder.create<fir::UndefOp>(loc, componentTy);
333     }
334     assert(componentValue && "must have been computed");
335     componentValue = builder.createConvert(loc, componentTy, componentValue);
336     // FIXME: type parameters must come from the derived-type-spec
337     auto field = builder.create<fir::FieldIndexOp>(
338         loc, fieldTy, name, scalarType,
339         /*typeParams=*/mlir::ValueRange{} /*TODO*/);
340     initialValue = builder.create<fir::InsertValueOp>(
341         loc, recTy, initialValue, componentValue,
342         builder.getArrayAttr(field.getAttributes()));
343   }
344 
345   if (sequenceType) {
346     // For arrays, duplicate the scalar value to all elements with an
347     // fir.insert_range covering the whole array.
348     auto arrayInitialValue = builder.create<fir::UndefOp>(loc, sequenceType);
349     llvm::SmallVector<int64_t> rangeBounds;
350     for (int64_t extent : sequenceType.getShape()) {
351       if (extent == fir::SequenceType::getUnknownExtent())
352         TODO(loc,
353              "default initial value of array component with length parameters");
354       rangeBounds.push_back(0);
355       rangeBounds.push_back(extent - 1);
356     }
357     return builder.create<fir::InsertOnRangeOp>(
358         loc, sequenceType, arrayInitialValue, initialValue,
359         builder.getIndexVectorAttr(rangeBounds));
360   }
361   return initialValue;
362 }
363 
364 /// Does this global already have an initializer ?
365 static bool globalIsInitialized(fir::GlobalOp global) {
366   return !global.getRegion().empty() || global.getInitVal();
367 }
368 
369 /// Call \p genInit to generate code inside \p global initializer region.
370 static void
371 createGlobalInitialization(fir::FirOpBuilder &builder, fir::GlobalOp global,
372                            std::function<void(fir::FirOpBuilder &)> genInit) {
373   mlir::Region &region = global.getRegion();
374   region.push_back(new mlir::Block);
375   mlir::Block &block = region.back();
376   auto insertPt = builder.saveInsertionPoint();
377   builder.setInsertionPointToStart(&block);
378   genInit(builder);
379   builder.restoreInsertionPoint(insertPt);
380 }
381 
382 /// Create the global op and its init if it has one
383 static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
384                                   const Fortran::lower::pft::Variable &var,
385                                   llvm::StringRef globalName,
386                                   mlir::StringAttr linkage) {
387   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
388   const Fortran::semantics::Symbol &sym = var.getSymbol();
389   mlir::Location loc = converter.genLocation(sym.name());
390   bool isConst = isConstant(sym);
391   fir::GlobalOp global = builder.getNamedGlobal(globalName);
392   mlir::Type symTy = converter.genType(var);
393 
394   if (global && globalIsInitialized(global))
395     return global;
396   // If this is an array, check to see if we can use a dense attribute
397   // with a tensor mlir type.  This optimization currently only supports
398   // rank-1 Fortran arrays of integer, real, or logical. The tensor
399   // type does not support nested structures which are needed for
400   // complex numbers.
401   // To get multidimensional arrays to work, we will have to use column major
402   // array ordering with the tensor type (so it matches column major ordering
403   // with the Fortran fir.array).  By default, tensor types assume row major
404   // ordering. How to create this tensor type is to be determined.
405   if (symTy.isa<fir::SequenceType>() && sym.Rank() == 1 &&
406       !Fortran::semantics::IsAllocatableOrPointer(sym)) {
407     mlir::Type eleTy = symTy.cast<fir::SequenceType>().getEleTy();
408     if (eleTy.isa<mlir::IntegerType, mlir::FloatType, fir::LogicalType>()) {
409       const auto *details =
410           sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
411       if (details->init()) {
412         global = Fortran::lower::createDenseGlobal(
413             loc, symTy, globalName, linkage, isConst, details->init().value(),
414             converter);
415         if (global) {
416           global.setVisibility(mlir::SymbolTable::Visibility::Public);
417           return global;
418         }
419       }
420     }
421   }
422   if (!global)
423     global = builder.createGlobal(loc, symTy, globalName, linkage,
424                                   mlir::Attribute{}, isConst);
425   if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
426     const auto *details =
427         sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
428     if (details && details->init()) {
429       auto expr = *details->init();
430       createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) {
431         mlir::Value box =
432             Fortran::lower::genInitialDataTarget(converter, loc, symTy, expr);
433         b.create<fir::HasValueOp>(loc, box);
434       });
435     } else {
436       // Create unallocated/disassociated descriptor if no explicit init
437       createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) {
438         mlir::Value box =
439             fir::factory::createUnallocatedBox(b, loc, symTy, llvm::None);
440         b.create<fir::HasValueOp>(loc, box);
441       });
442     }
443 
444   } else if (const auto *details =
445                  sym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
446     if (details->init()) {
447       if (fir::isa_char(symTy)) {
448         // CHARACTER literal
449         if (auto chLit = getCharacterLiteralCopy(details->init().value())) {
450           mlir::StringAttr init =
451               builder.getStringAttr(std::get<std::string>(*chLit));
452           global->setAttr(global.getInitValAttrName(), init);
453         } else {
454           fir::emitFatalError(loc, "CHARACTER has unexpected initial value");
455         }
456       } else {
457         createGlobalInitialization(
458             builder, global, [&](fir::FirOpBuilder &builder) {
459               Fortran::lower::StatementContext stmtCtx(
460                   /*cleanupProhibited=*/true);
461               fir::ExtendedValue initVal = genInitializerExprValue(
462                   converter, loc, details->init().value(), stmtCtx);
463               mlir::Value castTo =
464                   builder.createConvert(loc, symTy, fir::getBase(initVal));
465               builder.create<fir::HasValueOp>(loc, castTo);
466             });
467       }
468     } else if (hasDefaultInitialization(sym)) {
469       createGlobalInitialization(
470           builder, global, [&](fir::FirOpBuilder &builder) {
471             Fortran::lower::StatementContext stmtCtx(
472                 /*cleanupProhibited=*/true);
473             mlir::Value initVal =
474                 genDefaultInitializerValue(converter, loc, sym, symTy, stmtCtx);
475             mlir::Value castTo = builder.createConvert(loc, symTy, initVal);
476             builder.create<fir::HasValueOp>(loc, castTo);
477           });
478     }
479   } else if (sym.has<Fortran::semantics::CommonBlockDetails>()) {
480     mlir::emitError(loc, "COMMON symbol processed elsewhere");
481   } else {
482     TODO(loc, "global"); // Procedure pointer or something else
483   }
484   // Creates undefined initializer for globals without initializers
485   if (!globalIsInitialized(global))
486     createGlobalInitialization(
487         builder, global, [&](fir::FirOpBuilder &builder) {
488           builder.create<fir::HasValueOp>(
489               loc, builder.create<fir::UndefOp>(loc, symTy));
490         });
491   // Set public visibility to prevent global definition to be optimized out
492   // even if they have no initializer and are unused in this compilation unit.
493   global.setVisibility(mlir::SymbolTable::Visibility::Public);
494   return global;
495 }
496 
497 /// Return linkage attribute for \p var.
498 static mlir::StringAttr
499 getLinkageAttribute(fir::FirOpBuilder &builder,
500                     const Fortran::lower::pft::Variable &var) {
501   if (var.isModuleVariable())
502     return {}; // external linkage
503   // Otherwise, the variable is owned by a procedure and must not be visible in
504   // other compilation units.
505   return builder.createInternalLinkage();
506 }
507 
508 /// Instantiate a global variable. If it hasn't already been processed, add
509 /// the global to the ModuleOp as a new uniqued symbol and initialize it with
510 /// the correct value. It will be referenced on demand using `fir.addr_of`.
511 static void instantiateGlobal(Fortran::lower::AbstractConverter &converter,
512                               const Fortran::lower::pft::Variable &var,
513                               Fortran::lower::SymMap &symMap) {
514   const Fortran::semantics::Symbol &sym = var.getSymbol();
515   assert(!var.isAlias() && "must be handled in instantiateAlias");
516   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
517   std::string globalName = Fortran::lower::mangle::mangleName(sym);
518   mlir::Location loc = converter.genLocation(sym.name());
519   fir::GlobalOp global = builder.getNamedGlobal(globalName);
520   mlir::StringAttr linkage = getLinkageAttribute(builder, var);
521   if (var.isModuleVariable()) {
522     // A module global was or will be defined when lowering the module. Emit
523     // only a declaration if the global does not exist at that point.
524     global = declareGlobal(converter, var, globalName, linkage);
525   } else {
526     global = defineGlobal(converter, var, globalName, linkage);
527   }
528   auto addrOf = builder.create<fir::AddrOfOp>(loc, global.resultType(),
529                                               global.getSymbol());
530   Fortran::lower::StatementContext stmtCtx;
531   mapSymbolAttributes(converter, var, symMap, stmtCtx, addrOf);
532 }
533 
534 //===----------------------------------------------------------------===//
535 // Local variables instantiation (not for alias)
536 //===----------------------------------------------------------------===//
537 
538 /// Create a stack slot for a local variable. Precondition: the insertion
539 /// point of the builder must be in the entry block, which is currently being
540 /// constructed.
541 static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter,
542                                   mlir::Location loc,
543                                   const Fortran::lower::pft::Variable &var,
544                                   mlir::Value preAlloc,
545                                   llvm::ArrayRef<mlir::Value> shape = {},
546                                   llvm::ArrayRef<mlir::Value> lenParams = {}) {
547   if (preAlloc)
548     return preAlloc;
549   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
550   std::string nm = Fortran::lower::mangle::mangleName(var.getSymbol());
551   mlir::Type ty = converter.genType(var);
552   const Fortran::semantics::Symbol &ultimateSymbol =
553       var.getSymbol().GetUltimate();
554   llvm::StringRef symNm = toStringRef(ultimateSymbol.name());
555   bool isTarg = var.isTarget();
556   // Let the builder do all the heavy lifting.
557   return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);
558 }
559 
560 /// Instantiate a local variable. Precondition: Each variable will be visited
561 /// such that if its properties depend on other variables, the variables upon
562 /// which its properties depend will already have been visited.
563 static void instantiateLocal(Fortran::lower::AbstractConverter &converter,
564                              const Fortran::lower::pft::Variable &var,
565                              Fortran::lower::SymMap &symMap) {
566   assert(!var.isAlias());
567   Fortran::lower::StatementContext stmtCtx;
568   mapSymbolAttributes(converter, var, symMap, stmtCtx);
569 }
570 
571 /// Helper to decide if a dummy argument must be tracked in an BoxValue.
572 static bool lowerToBoxValue(const Fortran::semantics::Symbol &sym,
573                             mlir::Value dummyArg) {
574   // Only dummy arguments coming as fir.box can be tracked in an BoxValue.
575   if (!dummyArg || !dummyArg.getType().isa<fir::BoxType>())
576     return false;
577   // Non contiguous arrays must be tracked in an BoxValue.
578   if (sym.Rank() > 0 && !sym.attrs().test(Fortran::semantics::Attr::CONTIGUOUS))
579     return true;
580   // Assumed rank and optional fir.box cannot yet be read while lowering the
581   // specifications.
582   if (Fortran::evaluate::IsAssumedRank(sym) ||
583       Fortran::semantics::IsOptional(sym))
584     return true;
585   // Polymorphic entity should be tracked through a fir.box that has the
586   // dynamic type info.
587   if (const Fortran::semantics::DeclTypeSpec *type = sym.GetType())
588     if (type->IsPolymorphic())
589       return true;
590   return false;
591 }
592 
593 /// Compute extent from lower and upper bound.
594 static mlir::Value computeExtent(fir::FirOpBuilder &builder, mlir::Location loc,
595                                  mlir::Value lb, mlir::Value ub) {
596   mlir::IndexType idxTy = builder.getIndexType();
597   // Let the folder deal with the common `ub - <const> + 1` case.
598   auto diff = builder.create<mlir::arith::SubIOp>(loc, idxTy, ub, lb);
599   mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
600   return builder.create<mlir::arith::AddIOp>(loc, idxTy, diff, one);
601 }
602 
603 /// Lower explicit lower bounds into \p result. Does nothing if this is not an
604 /// array, or if the lower bounds are deferred, or all implicit or one.
605 static void lowerExplicitLowerBounds(
606     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
607     const Fortran::lower::BoxAnalyzer &box,
608     llvm::SmallVectorImpl<mlir::Value> &result, Fortran::lower::SymMap &symMap,
609     Fortran::lower::StatementContext &stmtCtx) {
610   if (!box.isArray() || box.lboundIsAllOnes())
611     return;
612   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
613   mlir::IndexType idxTy = builder.getIndexType();
614   if (box.isStaticArray()) {
615     for (int64_t lb : box.staticLBound())
616       result.emplace_back(builder.createIntegerConstant(loc, idxTy, lb));
617     return;
618   }
619   for (const Fortran::semantics::ShapeSpec *spec : box.dynamicBound()) {
620     if (auto low = spec->lbound().GetExplicit()) {
621       auto expr = Fortran::lower::SomeExpr{*low};
622       mlir::Value lb = builder.createConvert(
623           loc, idxTy, genScalarValue(converter, loc, expr, symMap, stmtCtx));
624       result.emplace_back(lb);
625     } else if (!spec->lbound().isColon()) {
626       // Implicit lower bound is 1 (Fortran 2018 section 8.5.8.3 point 3.)
627       result.emplace_back(builder.createIntegerConstant(loc, idxTy, 1));
628     }
629   }
630   assert(result.empty() || result.size() == box.dynamicBound().size());
631 }
632 
633 /// Lower explicit extents into \p result if this is an explicit-shape or
634 /// assumed-size array. Does nothing if this is not an explicit-shape or
635 /// assumed-size array.
636 static void lowerExplicitExtents(Fortran::lower::AbstractConverter &converter,
637                                  mlir::Location loc,
638                                  const Fortran::lower::BoxAnalyzer &box,
639                                  llvm::ArrayRef<mlir::Value> lowerBounds,
640                                  llvm::SmallVectorImpl<mlir::Value> &result,
641                                  Fortran::lower::SymMap &symMap,
642                                  Fortran::lower::StatementContext &stmtCtx) {
643   if (!box.isArray())
644     return;
645   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
646   mlir::IndexType idxTy = builder.getIndexType();
647   if (box.isStaticArray()) {
648     for (int64_t extent : box.staticShape())
649       result.emplace_back(builder.createIntegerConstant(loc, idxTy, extent));
650     return;
651   }
652   for (const auto &spec : llvm::enumerate(box.dynamicBound())) {
653     if (auto up = spec.value()->ubound().GetExplicit()) {
654       auto expr = Fortran::lower::SomeExpr{*up};
655       mlir::Value ub = builder.createConvert(
656           loc, idxTy, genScalarValue(converter, loc, expr, symMap, stmtCtx));
657       if (lowerBounds.empty())
658         result.emplace_back(ub);
659       else
660         result.emplace_back(
661             computeExtent(builder, loc, lowerBounds[spec.index()], ub));
662     } else if (spec.value()->ubound().isStar()) {
663       // Assumed extent is undefined. Must be provided by user's code.
664       result.emplace_back(builder.create<fir::UndefOp>(loc, idxTy));
665     }
666   }
667   assert(result.empty() || result.size() == box.dynamicBound().size());
668 }
669 
670 /// Lower explicit character length if any. Return empty mlir::Value if no
671 /// explicit length.
672 static mlir::Value
673 lowerExplicitCharLen(Fortran::lower::AbstractConverter &converter,
674                      mlir::Location loc, const Fortran::lower::BoxAnalyzer &box,
675                      Fortran::lower::SymMap &symMap,
676                      Fortran::lower::StatementContext &stmtCtx) {
677   if (!box.isChar())
678     return mlir::Value{};
679   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
680   mlir::Type lenTy = builder.getCharacterLengthType();
681   if (llvm::Optional<int64_t> len = box.getCharLenConst())
682     return builder.createIntegerConstant(loc, lenTy, *len);
683   if (llvm::Optional<Fortran::lower::SomeExpr> lenExpr = box.getCharLenExpr())
684     return genScalarValue(converter, loc, *lenExpr, symMap, stmtCtx);
685   return mlir::Value{};
686 }
687 
688 /// Treat negative values as undefined. Assumed size arrays will return -1 from
689 /// the front end for example. Using negative values can produce hard to find
690 /// bugs much further along in the compilation.
691 static mlir::Value genExtentValue(fir::FirOpBuilder &builder,
692                                   mlir::Location loc, mlir::Type idxTy,
693                                   long frontEndExtent) {
694   if (frontEndExtent >= 0)
695     return builder.createIntegerConstant(loc, idxTy, frontEndExtent);
696   return builder.create<fir::UndefOp>(loc, idxTy);
697 }
698 
699 /// Lower specification expressions and attributes of variable \p var and
700 /// add it to the symbol map.
701 /// For global and aliases, the address must be pre-computed and provided
702 /// in \p preAlloc.
703 /// Dummy arguments must have already been mapped to mlir block arguments
704 /// their mapping may be updated here.
705 void Fortran::lower::mapSymbolAttributes(
706     AbstractConverter &converter, const Fortran::lower::pft::Variable &var,
707     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
708     mlir::Value preAlloc) {
709   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
710   const Fortran::semantics::Symbol &sym = var.getSymbol();
711   const mlir::Location loc = converter.genLocation(sym.name());
712   mlir::IndexType idxTy = builder.getIndexType();
713   const bool isDummy = Fortran::semantics::IsDummy(sym);
714   const bool isResult = Fortran::semantics::IsFunctionResult(sym);
715   const bool replace = isDummy || isResult;
716   fir::factory::CharacterExprHelper charHelp{builder, loc};
717   Fortran::lower::BoxAnalyzer ba;
718   ba.analyze(sym);
719 
720   // First deal with pointers an allocatables, because their handling here
721   // is the same regardless of their rank.
722   if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
723     // Get address of fir.box describing the entity.
724     // global
725     mlir::Value boxAlloc = preAlloc;
726     // dummy or passed result
727     if (!boxAlloc)
728       if (Fortran::lower::SymbolBox symbox = symMap.lookupSymbol(sym))
729         boxAlloc = symbox.getAddr();
730     // local
731     if (!boxAlloc)
732       boxAlloc = createNewLocal(converter, loc, var, preAlloc);
733     // Lower non deferred parameters.
734     llvm::SmallVector<mlir::Value> nonDeferredLenParams;
735     if (ba.isChar()) {
736       if (mlir::Value len =
737               lowerExplicitCharLen(converter, loc, ba, symMap, stmtCtx))
738         nonDeferredLenParams.push_back(len);
739       else if (Fortran::semantics::IsAssumedLengthCharacter(sym))
740         TODO(loc, "assumed length character allocatable");
741     } else if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType()) {
742       if (const Fortran::semantics::DerivedTypeSpec *derived =
743               declTy->AsDerived())
744         if (Fortran::semantics::CountLenParameters(*derived) != 0)
745           TODO(loc,
746                "derived type allocatable or pointer with length parameters");
747     }
748     fir::MutableBoxValue box = Fortran::lower::createMutableBox(
749         converter, loc, var, boxAlloc, nonDeferredLenParams);
750     symMap.addAllocatableOrPointer(var.getSymbol(), box, replace);
751     return;
752   }
753 
754   if (isDummy) {
755     mlir::Value dummyArg = symMap.lookupSymbol(sym).getAddr();
756     if (lowerToBoxValue(sym, dummyArg)) {
757       llvm::SmallVector<mlir::Value> lbounds;
758       llvm::SmallVector<mlir::Value> extents;
759       llvm::SmallVector<mlir::Value> explicitParams;
760       // Lower lower bounds, explicit type parameters and explicit
761       // extents if any.
762       if (ba.isChar())
763         if (mlir::Value len =
764                 lowerExplicitCharLen(converter, loc, ba, symMap, stmtCtx))
765           explicitParams.push_back(len);
766       // TODO: derived type length parameters.
767       lowerExplicitLowerBounds(converter, loc, ba, lbounds, symMap, stmtCtx);
768       lowerExplicitExtents(converter, loc, ba, lbounds, extents, symMap,
769                            stmtCtx);
770       symMap.addBoxSymbol(sym, dummyArg, lbounds, explicitParams, extents,
771                           replace);
772       return;
773     }
774   }
775 
776   // Helper to generate scalars for the symbol properties.
777   auto genValue = [&](const Fortran::lower::SomeExpr &expr) {
778     return genScalarValue(converter, loc, expr, symMap, stmtCtx);
779   };
780 
781   // For symbols reaching this point, all properties are constant and can be
782   // read/computed already into ssa values.
783 
784   // The origin must be \vec{1}.
785   auto populateShape = [&](auto &shapes, const auto &bounds, mlir::Value box) {
786     for (auto iter : llvm::enumerate(bounds)) {
787       auto *spec = iter.value();
788       assert(spec->lbound().GetExplicit() &&
789              "lbound must be explicit with constant value 1");
790       if (auto high = spec->ubound().GetExplicit()) {
791         Fortran::lower::SomeExpr highEx{*high};
792         mlir::Value ub = genValue(highEx);
793         shapes.emplace_back(builder.createConvert(loc, idxTy, ub));
794       } else if (spec->ubound().isColon()) {
795         assert(box && "assumed bounds require a descriptor");
796         mlir::Value dim =
797             builder.createIntegerConstant(loc, idxTy, iter.index());
798         auto dimInfo =
799             builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, box, dim);
800         shapes.emplace_back(dimInfo.getResult(1));
801       } else if (spec->ubound().isStar()) {
802         shapes.emplace_back(builder.create<fir::UndefOp>(loc, idxTy));
803       } else {
804         llvm::report_fatal_error("unknown bound category");
805       }
806     }
807   };
808 
809   // The origin is not \vec{1}.
810   auto populateLBoundsExtents = [&](auto &lbounds, auto &extents,
811                                     const auto &bounds, mlir::Value box) {
812     for (auto iter : llvm::enumerate(bounds)) {
813       auto *spec = iter.value();
814       fir::BoxDimsOp dimInfo;
815       mlir::Value ub, lb;
816       if (spec->lbound().isColon() || spec->ubound().isColon()) {
817         // This is an assumed shape because allocatables and pointers extents
818         // are not constant in the scope and are not read here.
819         assert(box && "deferred bounds require a descriptor");
820         mlir::Value dim =
821             builder.createIntegerConstant(loc, idxTy, iter.index());
822         dimInfo =
823             builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, box, dim);
824         extents.emplace_back(dimInfo.getResult(1));
825         if (auto low = spec->lbound().GetExplicit()) {
826           auto expr = Fortran::lower::SomeExpr{*low};
827           mlir::Value lb = builder.createConvert(loc, idxTy, genValue(expr));
828           lbounds.emplace_back(lb);
829         } else {
830           // Implicit lower bound is 1 (Fortran 2018 section 8.5.8.3 point 3.)
831           lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, 1));
832         }
833       } else {
834         if (auto low = spec->lbound().GetExplicit()) {
835           auto expr = Fortran::lower::SomeExpr{*low};
836           lb = builder.createConvert(loc, idxTy, genValue(expr));
837         } else {
838           TODO(loc, "assumed rank lowering");
839         }
840 
841         if (auto high = spec->ubound().GetExplicit()) {
842           auto expr = Fortran::lower::SomeExpr{*high};
843           ub = builder.createConvert(loc, idxTy, genValue(expr));
844           lbounds.emplace_back(lb);
845           extents.emplace_back(computeExtent(builder, loc, lb, ub));
846         } else {
847           // An assumed size array. The extent is not computed.
848           assert(spec->ubound().isStar() && "expected assumed size");
849           lbounds.emplace_back(lb);
850           extents.emplace_back(builder.create<fir::UndefOp>(loc, idxTy));
851         }
852       }
853     }
854   };
855 
856   // Lower length expression for non deferred and non dummy assumed length
857   // characters.
858   auto genExplicitCharLen =
859       [&](llvm::Optional<Fortran::lower::SomeExpr> charLen) -> mlir::Value {
860     if (!charLen)
861       fir::emitFatalError(loc, "expected explicit character length");
862     mlir::Value rawLen = genValue(*charLen);
863     // If the length expression is negative, the length is zero. See
864     // F2018 7.4.4.2 point 5.
865     return genMaxWithZero(builder, loc, rawLen);
866   };
867 
868   ba.match(
869       //===--------------------------------------------------------------===//
870       // Trivial case.
871       //===--------------------------------------------------------------===//
872       [&](const Fortran::lower::details::ScalarSym &) {
873         if (isDummy) {
874           // This is an argument.
875           if (!symMap.lookupSymbol(sym))
876             mlir::emitError(loc, "symbol \"")
877                 << toStringRef(sym.name()) << "\" must already be in map";
878           return;
879         } else if (isResult) {
880           // Some Fortran results may be passed by argument (e.g. derived
881           // types)
882           if (symMap.lookupSymbol(sym))
883             return;
884         }
885         // Otherwise, it's a local variable or function result.
886         mlir::Value local = createNewLocal(converter, loc, var, preAlloc);
887         symMap.addSymbol(sym, local);
888       },
889 
890       //===--------------------------------------------------------------===//
891       // The non-trivial cases are when we have an argument or local that has
892       // a repetition value. Arguments might be passed as simple pointers and
893       // need to be cast to a multi-dimensional array with constant bounds
894       // (possibly with a missing column), bounds computed in the callee
895       // (here), or with bounds from the caller (boxed somewhere else). Locals
896       // have the same properties except they are never boxed arguments from
897       // the caller and never having a missing column size.
898       //===--------------------------------------------------------------===//
899 
900       [&](const Fortran::lower::details::ScalarStaticChar &x) {
901         // type is a CHARACTER, determine the LEN value
902         auto charLen = x.charLen();
903         if (replace) {
904           Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
905           std::pair<mlir::Value, mlir::Value> unboxchar =
906               charHelp.createUnboxChar(symBox.getAddr());
907           mlir::Value boxAddr = unboxchar.first;
908           // Set/override LEN with a constant
909           mlir::Value len = builder.createIntegerConstant(loc, idxTy, charLen);
910           symMap.addCharSymbol(sym, boxAddr, len, true);
911           return;
912         }
913         mlir::Value len = builder.createIntegerConstant(loc, idxTy, charLen);
914         if (preAlloc) {
915           symMap.addCharSymbol(sym, preAlloc, len);
916           return;
917         }
918         mlir::Value local = createNewLocal(converter, loc, var, preAlloc);
919         symMap.addCharSymbol(sym, local, len);
920       },
921 
922       //===--------------------------------------------------------------===//
923 
924       [&](const Fortran::lower::details::ScalarDynamicChar &x) {
925         // type is a CHARACTER, determine the LEN value
926         auto charLen = x.charLen();
927         if (replace) {
928           Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
929           mlir::Value boxAddr = symBox.getAddr();
930           mlir::Value len;
931           mlir::Type addrTy = boxAddr.getType();
932           if (addrTy.isa<fir::BoxCharType>() || addrTy.isa<fir::BoxType>()) {
933             std::tie(boxAddr, len) = charHelp.createUnboxChar(symBox.getAddr());
934           } else {
935             // dummy from an other entry case: we cannot get a dynamic length
936             // for it, it's illegal for the user program to use it. However,
937             // since we are lowering all function unit statements regardless
938             // of whether the execution will reach them or not, we need to
939             // fill a value for the length here.
940             len = builder.createIntegerConstant(
941                 loc, builder.getCharacterLengthType(), 1);
942           }
943           // Override LEN with an expression
944           if (charLen)
945             len = genExplicitCharLen(charLen);
946           symMap.addCharSymbol(sym, boxAddr, len, true);
947           return;
948         }
949         // local CHARACTER variable
950         mlir::Value len = genExplicitCharLen(charLen);
951         if (preAlloc) {
952           symMap.addCharSymbol(sym, preAlloc, len);
953           return;
954         }
955         llvm::SmallVector<mlir::Value> lengths = {len};
956         mlir::Value local =
957             createNewLocal(converter, loc, var, preAlloc, llvm::None, lengths);
958         symMap.addCharSymbol(sym, local, len);
959       },
960 
961       //===--------------------------------------------------------------===//
962 
963       [&](const Fortran::lower::details::StaticArray &x) {
964         // object shape is constant, not a character
965         mlir::Type castTy = builder.getRefType(converter.genType(var));
966         mlir::Value addr = symMap.lookupSymbol(sym).getAddr();
967         if (addr)
968           addr = builder.createConvert(loc, castTy, addr);
969         if (x.lboundAllOnes()) {
970           // if lower bounds are all ones, build simple shaped object
971           llvm::SmallVector<mlir::Value> shape;
972           for (int64_t i : x.shapes)
973             shape.push_back(genExtentValue(builder, loc, idxTy, i));
974           mlir::Value local =
975               isDummy ? addr : createNewLocal(converter, loc, var, preAlloc);
976           symMap.addSymbolWithShape(sym, local, shape, isDummy);
977           return;
978         }
979         // If object is an array process the lower bound and extent values by
980         // constructing constants and populating the lbounds and extents.
981         llvm::SmallVector<mlir::Value> extents;
982         llvm::SmallVector<mlir::Value> lbounds;
983         for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) {
984           lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst));
985           extents.emplace_back(genExtentValue(builder, loc, idxTy, snd));
986         }
987         mlir::Value local =
988             isDummy ? addr
989                     : createNewLocal(converter, loc, var, preAlloc, extents);
990         assert(isDummy || Fortran::lower::isExplicitShape(sym));
991         symMap.addSymbolWithBounds(sym, local, extents, lbounds, isDummy);
992       },
993 
994       //===--------------------------------------------------------------===//
995 
996       [&](const Fortran::lower::details::DynamicArray &x) {
997         // cast to the known constant parts from the declaration
998         mlir::Type varType = converter.genType(var);
999         mlir::Value addr = symMap.lookupSymbol(sym).getAddr();
1000         mlir::Value argBox;
1001         mlir::Type castTy = builder.getRefType(varType);
1002         if (addr) {
1003           if (auto boxTy = addr.getType().dyn_cast<fir::BoxType>()) {
1004             argBox = addr;
1005             mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
1006             addr = builder.create<fir::BoxAddrOp>(loc, refTy, argBox);
1007           }
1008           addr = builder.createConvert(loc, castTy, addr);
1009         }
1010         if (x.lboundAllOnes()) {
1011           // if lower bounds are all ones, build simple shaped object
1012           llvm::SmallVector<mlir::Value> shapes;
1013           populateShape(shapes, x.bounds, argBox);
1014           if (isDummy) {
1015             symMap.addSymbolWithShape(sym, addr, shapes, true);
1016             return;
1017           }
1018           // local array with computed bounds
1019           assert(Fortran::lower::isExplicitShape(sym) ||
1020                  Fortran::semantics::IsAllocatableOrPointer(sym));
1021           mlir::Value local =
1022               createNewLocal(converter, loc, var, preAlloc, shapes);
1023           symMap.addSymbolWithShape(sym, local, shapes);
1024           return;
1025         }
1026         // if object is an array process the lower bound and extent values
1027         llvm::SmallVector<mlir::Value> extents;
1028         llvm::SmallVector<mlir::Value> lbounds;
1029         populateLBoundsExtents(lbounds, extents, x.bounds, argBox);
1030         if (isDummy) {
1031           symMap.addSymbolWithBounds(sym, addr, extents, lbounds, true);
1032           return;
1033         }
1034         // local array with computed bounds
1035         assert(Fortran::lower::isExplicitShape(sym));
1036         mlir::Value local =
1037             createNewLocal(converter, loc, var, preAlloc, extents);
1038         symMap.addSymbolWithBounds(sym, local, extents, lbounds);
1039       },
1040 
1041       //===--------------------------------------------------------------===//
1042 
1043       [&](const Fortran::lower::details::StaticArrayStaticChar &x) {
1044         // if element type is a CHARACTER, determine the LEN value
1045         auto charLen = x.charLen();
1046         mlir::Value addr;
1047         mlir::Value len;
1048         if (isDummy) {
1049           Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
1050           std::pair<mlir::Value, mlir::Value> unboxchar =
1051               charHelp.createUnboxChar(symBox.getAddr());
1052           addr = unboxchar.first;
1053           // Set/override LEN with a constant
1054           len = builder.createIntegerConstant(loc, idxTy, charLen);
1055         } else {
1056           // local CHARACTER variable
1057           len = builder.createIntegerConstant(loc, idxTy, charLen);
1058         }
1059 
1060         // object shape is constant
1061         mlir::Type castTy = builder.getRefType(converter.genType(var));
1062         if (addr)
1063           addr = builder.createConvert(loc, castTy, addr);
1064 
1065         if (x.lboundAllOnes()) {
1066           // if lower bounds are all ones, build simple shaped object
1067           llvm::SmallVector<mlir::Value> shape;
1068           for (int64_t i : x.shapes)
1069             shape.push_back(genExtentValue(builder, loc, idxTy, i));
1070           mlir::Value local =
1071               isDummy ? addr : createNewLocal(converter, loc, var, preAlloc);
1072           symMap.addCharSymbolWithShape(sym, local, len, shape, isDummy);
1073           return;
1074         }
1075 
1076         // if object is an array process the lower bound and extent values
1077         llvm::SmallVector<mlir::Value> extents;
1078         llvm::SmallVector<mlir::Value> lbounds;
1079         // construct constants and populate `bounds`
1080         for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) {
1081           lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst));
1082           extents.emplace_back(genExtentValue(builder, loc, idxTy, snd));
1083         }
1084 
1085         if (isDummy) {
1086           symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
1087                                          true);
1088           return;
1089         }
1090         // local CHARACTER array with computed bounds
1091         assert(Fortran::lower::isExplicitShape(sym));
1092         mlir::Value local =
1093             createNewLocal(converter, loc, var, preAlloc, extents);
1094         symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
1095       },
1096 
1097       //===--------------------------------------------------------------===//
1098 
1099       [&](const Fortran::lower::details::StaticArrayDynamicChar &x) {
1100         mlir::Value addr;
1101         mlir::Value len;
1102         [[maybe_unused]] bool mustBeDummy = false;
1103         auto charLen = x.charLen();
1104         // if element type is a CHARACTER, determine the LEN value
1105         if (isDummy) {
1106           Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
1107           std::pair<mlir::Value, mlir::Value> unboxchar =
1108               charHelp.createUnboxChar(symBox.getAddr());
1109           addr = unboxchar.first;
1110           if (charLen) {
1111             // Set/override LEN with an expression
1112             len = genExplicitCharLen(charLen);
1113           } else {
1114             // LEN is from the boxchar
1115             len = unboxchar.second;
1116             mustBeDummy = true;
1117           }
1118         } else {
1119           // local CHARACTER variable
1120           len = genExplicitCharLen(charLen);
1121         }
1122         llvm::SmallVector<mlir::Value> lengths = {len};
1123 
1124         // cast to the known constant parts from the declaration
1125         mlir::Type castTy = builder.getRefType(converter.genType(var));
1126         if (addr)
1127           addr = builder.createConvert(loc, castTy, addr);
1128 
1129         if (x.lboundAllOnes()) {
1130           // if lower bounds are all ones, build simple shaped object
1131           llvm::SmallVector<mlir::Value> shape;
1132           for (int64_t i : x.shapes)
1133             shape.push_back(genExtentValue(builder, loc, idxTy, i));
1134           if (isDummy) {
1135             symMap.addCharSymbolWithShape(sym, addr, len, shape, true);
1136             return;
1137           }
1138           // local CHARACTER array with constant size
1139           mlir::Value local = createNewLocal(converter, loc, var, preAlloc,
1140                                              llvm::None, lengths);
1141           symMap.addCharSymbolWithShape(sym, local, len, shape);
1142           return;
1143         }
1144 
1145         // if object is an array process the lower bound and extent values
1146         llvm::SmallVector<mlir::Value> extents;
1147         llvm::SmallVector<mlir::Value> lbounds;
1148 
1149         // construct constants and populate `bounds`
1150         for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) {
1151           lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst));
1152           extents.emplace_back(genExtentValue(builder, loc, idxTy, snd));
1153         }
1154         if (isDummy) {
1155           symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
1156                                          true);
1157           return;
1158         }
1159         // local CHARACTER array with computed bounds
1160         assert((!mustBeDummy) && (Fortran::lower::isExplicitShape(sym)));
1161         mlir::Value local =
1162             createNewLocal(converter, loc, var, preAlloc, llvm::None, lengths);
1163         symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
1164       },
1165 
1166       //===--------------------------------------------------------------===//
1167 
1168       [&](const Fortran::lower::details::DynamicArrayStaticChar &x) {
1169         TODO(loc, "DynamicArrayStaticChar variable lowering");
1170       },
1171 
1172       //===--------------------------------------------------------------===//
1173 
1174       [&](const Fortran::lower::details::DynamicArrayDynamicChar &x) {
1175         TODO(loc, "DynamicArrayDynamicChar variable lowering");
1176       },
1177 
1178       //===--------------------------------------------------------------===//
1179 
1180       [&](const Fortran::lower::BoxAnalyzer::None &) {
1181         mlir::emitError(loc, "symbol analysis failed on ")
1182             << toStringRef(sym.name());
1183       });
1184 }
1185 
1186 void Fortran::lower::defineModuleVariable(
1187     AbstractConverter &converter, const Fortran::lower::pft::Variable &var) {
1188   // Use empty linkage for module variables, which makes them available
1189   // for use in another unit.
1190   mlir::StringAttr externalLinkage;
1191   if (!var.isGlobal())
1192     fir::emitFatalError(converter.getCurrentLocation(),
1193                         "attempting to lower module variable as local");
1194   // Define aggregate storages for equivalenced objects.
1195   if (var.isAggregateStore()) {
1196     const mlir::Location loc = converter.genLocation(var.getSymbol().name());
1197     TODO(loc, "defineModuleVariable aggregateStore");
1198   }
1199   const Fortran::semantics::Symbol &sym = var.getSymbol();
1200   if (Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) {
1201     const mlir::Location loc = converter.genLocation(sym.name());
1202     TODO(loc, "defineModuleVariable common block");
1203   } else if (var.isAlias()) {
1204     // Do nothing. Mapping will be done on user side.
1205   } else {
1206     std::string globalName = Fortran::lower::mangle::mangleName(sym);
1207     defineGlobal(converter, var, globalName, externalLinkage);
1208   }
1209 }
1210 
1211 void Fortran::lower::instantiateVariable(AbstractConverter &converter,
1212                                          const pft::Variable &var,
1213                                          SymMap &symMap,
1214                                          AggregateStoreMap &storeMap) {
1215   const Fortran::semantics::Symbol &sym = var.getSymbol();
1216   const mlir::Location loc = converter.genLocation(sym.name());
1217   if (var.isAggregateStore()) {
1218     TODO(loc, "instantiateVariable AggregateStore");
1219   } else if (Fortran::semantics::FindCommonBlockContaining(
1220                  var.getSymbol().GetUltimate())) {
1221     TODO(loc, "instantiateVariable Common");
1222   } else if (var.isAlias()) {
1223     TODO(loc, "instantiateVariable Alias");
1224   } else if (var.isGlobal()) {
1225     instantiateGlobal(converter, var, symMap);
1226   } else {
1227     instantiateLocal(converter, var, symMap);
1228   }
1229 }
1230 
1231 void Fortran::lower::mapCallInterfaceSymbols(
1232     AbstractConverter &converter, const Fortran::lower::CallerInterface &caller,
1233     SymMap &symMap) {
1234   Fortran::lower::AggregateStoreMap storeMap;
1235   const Fortran::semantics::Symbol &result = caller.getResultSymbol();
1236   for (Fortran::lower::pft::Variable var :
1237        Fortran::lower::pft::buildFuncResultDependencyList(result)) {
1238     if (var.isAggregateStore()) {
1239       instantiateVariable(converter, var, symMap, storeMap);
1240     } else {
1241       const Fortran::semantics::Symbol &sym = var.getSymbol();
1242       const auto *hostDetails =
1243           sym.detailsIf<Fortran::semantics::HostAssocDetails>();
1244       if (hostDetails && !var.isModuleVariable()) {
1245         // The callee is an internal procedure `A` whose result properties
1246         // depend on host variables. The caller may be the host, or another
1247         // internal procedure `B` contained in the same host.  In the first
1248         // case, the host symbol is obviously mapped, in the second case, it
1249         // must also be mapped because
1250         // HostAssociations::internalProcedureBindings that was called when
1251         // lowering `B` will have mapped all host symbols of captured variables
1252         // to the tuple argument containing the composite of all host associated
1253         // variables, whether or not the host symbol is actually referred to in
1254         // `B`. Hence it is possible to simply lookup the variable associated to
1255         // the host symbol without having to go back to the tuple argument.
1256         Fortran::lower::SymbolBox hostValue =
1257             symMap.lookupSymbol(hostDetails->symbol());
1258         assert(hostValue && "callee host symbol must be mapped on caller side");
1259         symMap.addSymbol(sym, hostValue.toExtendedValue());
1260         // The SymbolBox associated to the host symbols is complete, skip
1261         // instantiateVariable that would try to allocate a new storage.
1262         continue;
1263       }
1264       if (Fortran::semantics::IsDummy(sym) && sym.owner() == result.owner()) {
1265         // Get the argument for the dummy argument symbols of the current call.
1266         symMap.addSymbol(sym, caller.getArgumentValue(sym));
1267         // All the properties of the dummy variable may not come from the actual
1268         // argument, let instantiateVariable handle this.
1269       }
1270       // If this is neither a host associated or dummy symbol, it must be a
1271       // module or common block variable to satisfy specification expression
1272       // requirements in 10.1.11, instantiateVariable will get its address and
1273       // properties.
1274       instantiateVariable(converter, var, symMap, storeMap);
1275     }
1276   }
1277 }
1278