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 lower a scalar expression using a specific symbol mapping.
39 static mlir::Value genScalarValue(Fortran::lower::AbstractConverter &converter,
40                                   mlir::Location loc,
41                                   const Fortran::lower::SomeExpr &expr,
42                                   Fortran::lower::SymMap &symMap,
43                                   Fortran::lower::StatementContext &context) {
44   // This does not use the AbstractConverter member function to override the
45   // symbol mapping to be used expression lowering.
46   return fir::getBase(Fortran::lower::createSomeExtendedExpression(
47       loc, converter, expr, symMap, context));
48 }
49 
50 //===----------------------------------------------------------------===//
51 // Local variables instantiation (not for alias)
52 //===----------------------------------------------------------------===//
53 
54 /// Create a stack slot for a local variable. Precondition: the insertion
55 /// point of the builder must be in the entry block, which is currently being
56 /// constructed.
57 static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter,
58                                   mlir::Location loc,
59                                   const Fortran::lower::pft::Variable &var,
60                                   mlir::Value preAlloc,
61                                   llvm::ArrayRef<mlir::Value> shape = {},
62                                   llvm::ArrayRef<mlir::Value> lenParams = {}) {
63   if (preAlloc)
64     return preAlloc;
65   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
66   std::string nm = Fortran::lower::mangle::mangleName(var.getSymbol());
67   mlir::Type ty = converter.genType(var);
68   const Fortran::semantics::Symbol &ultimateSymbol =
69       var.getSymbol().GetUltimate();
70   llvm::StringRef symNm = toStringRef(ultimateSymbol.name());
71   bool isTarg = var.isTarget();
72   // Let the builder do all the heavy lifting.
73   return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);
74 }
75 
76 /// Instantiate a local variable. Precondition: Each variable will be visited
77 /// such that if its properties depend on other variables, the variables upon
78 /// which its properties depend will already have been visited.
79 static void instantiateLocal(Fortran::lower::AbstractConverter &converter,
80                              const Fortran::lower::pft::Variable &var,
81                              Fortran::lower::SymMap &symMap) {
82   assert(!var.isAlias());
83   Fortran::lower::StatementContext stmtCtx;
84   mapSymbolAttributes(converter, var, symMap, stmtCtx);
85 }
86 
87 /// Helper to decide if a dummy argument must be tracked in an BoxValue.
88 static bool lowerToBoxValue(const Fortran::semantics::Symbol &sym,
89                             mlir::Value dummyArg) {
90   // Only dummy arguments coming as fir.box can be tracked in an BoxValue.
91   if (!dummyArg || !dummyArg.getType().isa<fir::BoxType>())
92     return false;
93   // Non contiguous arrays must be tracked in an BoxValue.
94   if (sym.Rank() > 0 && !sym.attrs().test(Fortran::semantics::Attr::CONTIGUOUS))
95     return true;
96   // Assumed rank and optional fir.box cannot yet be read while lowering the
97   // specifications.
98   if (Fortran::evaluate::IsAssumedRank(sym) ||
99       Fortran::semantics::IsOptional(sym))
100     return true;
101   // Polymorphic entity should be tracked through a fir.box that has the
102   // dynamic type info.
103   if (const Fortran::semantics::DeclTypeSpec *type = sym.GetType())
104     if (type->IsPolymorphic())
105       return true;
106   return false;
107 }
108 
109 /// Compute extent from lower and upper bound.
110 static mlir::Value computeExtent(fir::FirOpBuilder &builder, mlir::Location loc,
111                                  mlir::Value lb, mlir::Value ub) {
112   mlir::IndexType idxTy = builder.getIndexType();
113   // Let the folder deal with the common `ub - <const> + 1` case.
114   auto diff = builder.create<mlir::arith::SubIOp>(loc, idxTy, ub, lb);
115   mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
116   return builder.create<mlir::arith::AddIOp>(loc, idxTy, diff, one);
117 }
118 
119 /// Lower explicit lower bounds into \p result. Does nothing if this is not an
120 /// array, or if the lower bounds are deferred, or all implicit or one.
121 static void lowerExplicitLowerBounds(
122     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
123     const Fortran::lower::BoxAnalyzer &box,
124     llvm::SmallVectorImpl<mlir::Value> &result, Fortran::lower::SymMap &symMap,
125     Fortran::lower::StatementContext &stmtCtx) {
126   if (!box.isArray() || box.lboundIsAllOnes())
127     return;
128   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
129   mlir::IndexType idxTy = builder.getIndexType();
130   if (box.isStaticArray()) {
131     for (int64_t lb : box.staticLBound())
132       result.emplace_back(builder.createIntegerConstant(loc, idxTy, lb));
133     return;
134   }
135   for (const Fortran::semantics::ShapeSpec *spec : box.dynamicBound()) {
136     if (auto low = spec->lbound().GetExplicit()) {
137       auto expr = Fortran::lower::SomeExpr{*low};
138       mlir::Value lb = builder.createConvert(
139           loc, idxTy, genScalarValue(converter, loc, expr, symMap, stmtCtx));
140       result.emplace_back(lb);
141     } else if (!spec->lbound().isColon()) {
142       // Implicit lower bound is 1 (Fortran 2018 section 8.5.8.3 point 3.)
143       result.emplace_back(builder.createIntegerConstant(loc, idxTy, 1));
144     }
145   }
146   assert(result.empty() || result.size() == box.dynamicBound().size());
147 }
148 
149 /// Lower explicit extents into \p result if this is an explicit-shape or
150 /// assumed-size array. Does nothing if this is not an explicit-shape or
151 /// assumed-size array.
152 static void lowerExplicitExtents(Fortran::lower::AbstractConverter &converter,
153                                  mlir::Location loc,
154                                  const Fortran::lower::BoxAnalyzer &box,
155                                  llvm::ArrayRef<mlir::Value> lowerBounds,
156                                  llvm::SmallVectorImpl<mlir::Value> &result,
157                                  Fortran::lower::SymMap &symMap,
158                                  Fortran::lower::StatementContext &stmtCtx) {
159   if (!box.isArray())
160     return;
161   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
162   mlir::IndexType idxTy = builder.getIndexType();
163   if (box.isStaticArray()) {
164     for (int64_t extent : box.staticShape())
165       result.emplace_back(builder.createIntegerConstant(loc, idxTy, extent));
166     return;
167   }
168   for (const auto &spec : llvm::enumerate(box.dynamicBound())) {
169     if (auto up = spec.value()->ubound().GetExplicit()) {
170       auto expr = Fortran::lower::SomeExpr{*up};
171       mlir::Value ub = builder.createConvert(
172           loc, idxTy, genScalarValue(converter, loc, expr, symMap, stmtCtx));
173       if (lowerBounds.empty())
174         result.emplace_back(ub);
175       else
176         result.emplace_back(
177             computeExtent(builder, loc, lowerBounds[spec.index()], ub));
178     } else if (spec.value()->ubound().isStar()) {
179       // Assumed extent is undefined. Must be provided by user's code.
180       result.emplace_back(builder.create<fir::UndefOp>(loc, idxTy));
181     }
182   }
183   assert(result.empty() || result.size() == box.dynamicBound().size());
184 }
185 
186 /// Treat negative values as undefined. Assumed size arrays will return -1 from
187 /// the front end for example. Using negative values can produce hard to find
188 /// bugs much further along in the compilation.
189 static mlir::Value genExtentValue(fir::FirOpBuilder &builder,
190                                   mlir::Location loc, mlir::Type idxTy,
191                                   long frontEndExtent) {
192   if (frontEndExtent >= 0)
193     return builder.createIntegerConstant(loc, idxTy, frontEndExtent);
194   return builder.create<fir::UndefOp>(loc, idxTy);
195 }
196 
197 /// Lower specification expressions and attributes of variable \p var and
198 /// add it to the symbol map.
199 /// For global and aliases, the address must be pre-computed and provided
200 /// in \p preAlloc.
201 /// Dummy arguments must have already been mapped to mlir block arguments
202 /// their mapping may be updated here.
203 void Fortran::lower::mapSymbolAttributes(
204     AbstractConverter &converter, const Fortran::lower::pft::Variable &var,
205     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
206     mlir::Value preAlloc) {
207   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
208   const Fortran::semantics::Symbol &sym = var.getSymbol();
209   const mlir::Location loc = converter.genLocation(sym.name());
210   mlir::IndexType idxTy = builder.getIndexType();
211   const bool isDummy = Fortran::semantics::IsDummy(sym);
212   const bool isResult = Fortran::semantics::IsFunctionResult(sym);
213   const bool replace = isDummy || isResult;
214   fir::factory::CharacterExprHelper charHelp{builder, loc};
215   Fortran::lower::BoxAnalyzer ba;
216   ba.analyze(sym);
217 
218   // First deal with pointers an allocatables, because their handling here
219   // is the same regardless of their rank.
220   if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
221     // Get address of fir.box describing the entity.
222     // global
223     mlir::Value boxAlloc = preAlloc;
224     // dummy or passed result
225     if (!boxAlloc)
226       if (Fortran::lower::SymbolBox symbox = symMap.lookupSymbol(sym))
227         boxAlloc = symbox.getAddr();
228     // local
229     if (!boxAlloc)
230       boxAlloc = createNewLocal(converter, loc, var, preAlloc);
231     // Lower non deferred parameters.
232     llvm::SmallVector<mlir::Value> nonDeferredLenParams;
233     if (ba.isChar()) {
234       TODO(loc, "mapSymbolAttributes allocatble or pointer char");
235     } else if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType()) {
236       if (const Fortran::semantics::DerivedTypeSpec *derived =
237               declTy->AsDerived())
238         if (Fortran::semantics::CountLenParameters(*derived) != 0)
239           TODO(loc,
240                "derived type allocatable or pointer with length parameters");
241     }
242     fir::MutableBoxValue box = Fortran::lower::createMutableBox(
243         converter, loc, var, boxAlloc, nonDeferredLenParams);
244     symMap.addAllocatableOrPointer(var.getSymbol(), box, replace);
245     return;
246   }
247 
248   if (isDummy) {
249     mlir::Value dummyArg = symMap.lookupSymbol(sym).getAddr();
250     if (lowerToBoxValue(sym, dummyArg)) {
251       llvm::SmallVector<mlir::Value> lbounds;
252       llvm::SmallVector<mlir::Value> extents;
253       llvm::SmallVector<mlir::Value> explicitParams;
254       // Lower lower bounds, explicit type parameters and explicit
255       // extents if any.
256       if (ba.isChar())
257         TODO(loc, "lowerToBoxValue character");
258       // TODO: derived type length parameters.
259       lowerExplicitLowerBounds(converter, loc, ba, lbounds, symMap, stmtCtx);
260       lowerExplicitExtents(converter, loc, ba, lbounds, extents, symMap,
261                            stmtCtx);
262       symMap.addBoxSymbol(sym, dummyArg, lbounds, explicitParams, extents,
263                           replace);
264       return;
265     }
266   }
267 
268   // For symbols reaching this point, all properties are constant and can be
269   // read/computed already into ssa values.
270 
271   ba.match(
272       //===--------------------------------------------------------------===//
273       // Trivial case.
274       //===--------------------------------------------------------------===//
275       [&](const Fortran::lower::details::ScalarSym &) {
276         if (isDummy) {
277           // This is an argument.
278           if (!symMap.lookupSymbol(sym))
279             mlir::emitError(loc, "symbol \"")
280                 << toStringRef(sym.name()) << "\" must already be in map";
281           return;
282         } else if (isResult) {
283           // Some Fortran results may be passed by argument (e.g. derived
284           // types)
285           if (symMap.lookupSymbol(sym))
286             return;
287         }
288         // Otherwise, it's a local variable or function result.
289         mlir::Value local = createNewLocal(converter, loc, var, preAlloc);
290         symMap.addSymbol(sym, local);
291       },
292 
293       //===--------------------------------------------------------------===//
294       // The non-trivial cases are when we have an argument or local that has
295       // a repetition value. Arguments might be passed as simple pointers and
296       // need to be cast to a multi-dimensional array with constant bounds
297       // (possibly with a missing column), bounds computed in the callee
298       // (here), or with bounds from the caller (boxed somewhere else). Locals
299       // have the same properties except they are never boxed arguments from
300       // the caller and never having a missing column size.
301       //===--------------------------------------------------------------===//
302 
303       [&](const Fortran::lower::details::ScalarStaticChar &x) {
304         // type is a CHARACTER, determine the LEN value
305         auto charLen = x.charLen();
306         if (replace) {
307           Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
308           std::pair<mlir::Value, mlir::Value> unboxchar =
309               charHelp.createUnboxChar(symBox.getAddr());
310           mlir::Value boxAddr = unboxchar.first;
311           // Set/override LEN with a constant
312           mlir::Value len = builder.createIntegerConstant(loc, idxTy, charLen);
313           symMap.addCharSymbol(sym, boxAddr, len, true);
314           return;
315         }
316         mlir::Value len = builder.createIntegerConstant(loc, idxTy, charLen);
317         if (preAlloc) {
318           symMap.addCharSymbol(sym, preAlloc, len);
319           return;
320         }
321         mlir::Value local = createNewLocal(converter, loc, var, preAlloc);
322         symMap.addCharSymbol(sym, local, len);
323       },
324 
325       //===--------------------------------------------------------------===//
326 
327       [&](const Fortran::lower::details::ScalarDynamicChar &x) {
328         TODO(loc, "ScalarDynamicChar variable lowering");
329       },
330 
331       //===--------------------------------------------------------------===//
332 
333       [&](const Fortran::lower::details::StaticArray &x) {
334         // object shape is constant, not a character
335         mlir::Type castTy = builder.getRefType(converter.genType(var));
336         mlir::Value addr = symMap.lookupSymbol(sym).getAddr();
337         if (addr)
338           addr = builder.createConvert(loc, castTy, addr);
339         if (x.lboundAllOnes()) {
340           // if lower bounds are all ones, build simple shaped object
341           llvm::SmallVector<mlir::Value> shape;
342           for (int64_t i : x.shapes)
343             shape.push_back(genExtentValue(builder, loc, idxTy, i));
344           mlir::Value local =
345               isDummy ? addr : createNewLocal(converter, loc, var, preAlloc);
346           symMap.addSymbolWithShape(sym, local, shape, isDummy);
347           return;
348         }
349         // If object is an array process the lower bound and extent values by
350         // constructing constants and populating the lbounds and extents.
351         llvm::SmallVector<mlir::Value> extents;
352         llvm::SmallVector<mlir::Value> lbounds;
353         for (auto [fst, snd] : llvm::zip(x.lbounds, x.shapes)) {
354           lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst));
355           extents.emplace_back(genExtentValue(builder, loc, idxTy, snd));
356         }
357         mlir::Value local =
358             isDummy ? addr
359                     : createNewLocal(converter, loc, var, preAlloc, extents);
360         assert(isDummy || Fortran::lower::isExplicitShape(sym));
361         symMap.addSymbolWithBounds(sym, local, extents, lbounds, isDummy);
362       },
363 
364       //===--------------------------------------------------------------===//
365 
366       [&](const Fortran::lower::details::DynamicArray &x) {
367         TODO(loc, "DynamicArray variable lowering");
368       },
369 
370       //===--------------------------------------------------------------===//
371 
372       [&](const Fortran::lower::details::StaticArrayStaticChar &x) {
373         TODO(loc, "StaticArrayStaticChar variable lowering");
374       },
375 
376       //===--------------------------------------------------------------===//
377 
378       [&](const Fortran::lower::details::StaticArrayDynamicChar &x) {
379         TODO(loc, "StaticArrayDynamicChar variable lowering");
380       },
381 
382       //===--------------------------------------------------------------===//
383 
384       [&](const Fortran::lower::details::DynamicArrayStaticChar &x) {
385         TODO(loc, "DynamicArrayStaticChar variable lowering");
386       },
387 
388       //===--------------------------------------------------------------===//
389 
390       [&](const Fortran::lower::details::DynamicArrayDynamicChar &x) {
391         TODO(loc, "DynamicArrayDynamicChar variable lowering");
392       },
393 
394       //===--------------------------------------------------------------===//
395 
396       [&](const Fortran::lower::BoxAnalyzer::None &) {
397         mlir::emitError(loc, "symbol analysis failed on ")
398             << toStringRef(sym.name());
399       });
400 }
401 
402 void Fortran::lower::instantiateVariable(AbstractConverter &converter,
403                                          const pft::Variable &var,
404                                          SymMap &symMap) {
405   const Fortran::semantics::Symbol &sym = var.getSymbol();
406   const mlir::Location loc = converter.genLocation(sym.name());
407   if (var.isAggregateStore()) {
408     TODO(loc, "instantiateVariable AggregateStore");
409   } else if (Fortran::semantics::FindCommonBlockContaining(
410                  var.getSymbol().GetUltimate())) {
411     TODO(loc, "instantiateVariable Common");
412   } else if (var.isAlias()) {
413     TODO(loc, "instantiateVariable Alias");
414   } else if (var.isGlobal()) {
415     TODO(loc, "instantiateVariable Global");
416   } else {
417     instantiateLocal(converter, var, symMap);
418   }
419 }
420 
421 void Fortran::lower::mapCallInterfaceSymbols(
422     AbstractConverter &converter, const Fortran::lower::CallerInterface &caller,
423     SymMap &symMap) {
424   const Fortran::semantics::Symbol &result = caller.getResultSymbol();
425   for (Fortran::lower::pft::Variable var :
426        Fortran::lower::pft::buildFuncResultDependencyList(result)) {
427     if (var.isAggregateStore()) {
428       instantiateVariable(converter, var, symMap);
429     } else {
430       const Fortran::semantics::Symbol &sym = var.getSymbol();
431       const auto *hostDetails =
432           sym.detailsIf<Fortran::semantics::HostAssocDetails>();
433       if (hostDetails && !var.isModuleVariable()) {
434         // The callee is an internal procedure `A` whose result properties
435         // depend on host variables. The caller may be the host, or another
436         // internal procedure `B` contained in the same host.  In the first
437         // case, the host symbol is obviously mapped, in the second case, it
438         // must also be mapped because
439         // HostAssociations::internalProcedureBindings that was called when
440         // lowering `B` will have mapped all host symbols of captured variables
441         // to the tuple argument containing the composite of all host associated
442         // variables, whether or not the host symbol is actually referred to in
443         // `B`. Hence it is possible to simply lookup the variable associated to
444         // the host symbol without having to go back to the tuple argument.
445         Fortran::lower::SymbolBox hostValue =
446             symMap.lookupSymbol(hostDetails->symbol());
447         assert(hostValue && "callee host symbol must be mapped on caller side");
448         symMap.addSymbol(sym, hostValue.toExtendedValue());
449         // The SymbolBox associated to the host symbols is complete, skip
450         // instantiateVariable that would try to allocate a new storage.
451         continue;
452       }
453       if (Fortran::semantics::IsDummy(sym) && sym.owner() == result.owner()) {
454         // Get the argument for the dummy argument symbols of the current call.
455         symMap.addSymbol(sym, caller.getArgumentValue(sym));
456         // All the properties of the dummy variable may not come from the actual
457         // argument, let instantiateVariable handle this.
458       }
459       // If this is neither a host associated or dummy symbol, it must be a
460       // module or common block variable to satisfy specification expression
461       // requirements in 10.1.11, instantiateVariable will get its address and
462       // properties.
463       instantiateVariable(converter, var, symMap);
464     }
465   }
466 }
467