1 //===-- FIRBuilder.cpp ----------------------------------------------------===//
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 #include "flang/Optimizer/Builder/FIRBuilder.h"
10 #include "flang/Lower/Todo.h"
11 #include "flang/Optimizer/Builder/BoxValue.h"
12 #include "flang/Optimizer/Builder/Character.h"
13 #include "flang/Optimizer/Builder/Complex.h"
14 #include "flang/Optimizer/Builder/MutableBox.h"
15 #include "flang/Optimizer/Builder/Runtime/Assign.h"
16 #include "flang/Optimizer/Dialect/FIRAttr.h"
17 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
18 #include "flang/Optimizer/Support/FatalError.h"
19 #include "flang/Optimizer/Support/InternalNames.h"
20 #include "mlir/Dialect/OpenMP/OpenMPDialect.h"
21 #include "llvm/ADT/ArrayRef.h"
22 #include "llvm/ADT/StringExtras.h"
23 #include "llvm/Support/CommandLine.h"
24 #include "llvm/Support/ErrorHandling.h"
25 #include "llvm/Support/MD5.h"
26 
27 static constexpr std::size_t nameLengthHashSize = 32;
28 
29 mlir::FuncOp fir::FirOpBuilder::createFunction(mlir::Location loc,
30                                                mlir::ModuleOp module,
31                                                llvm::StringRef name,
32                                                mlir::FunctionType ty) {
33   return fir::createFuncOp(loc, module, name, ty);
34 }
35 
36 mlir::FuncOp fir::FirOpBuilder::getNamedFunction(mlir::ModuleOp modOp,
37                                                  llvm::StringRef name) {
38   return modOp.lookupSymbol<mlir::FuncOp>(name);
39 }
40 
41 fir::GlobalOp fir::FirOpBuilder::getNamedGlobal(mlir::ModuleOp modOp,
42                                                 llvm::StringRef name) {
43   return modOp.lookupSymbol<fir::GlobalOp>(name);
44 }
45 
46 mlir::Type fir::FirOpBuilder::getRefType(mlir::Type eleTy) {
47   assert(!eleTy.isa<fir::ReferenceType>() && "cannot be a reference type");
48   return fir::ReferenceType::get(eleTy);
49 }
50 
51 mlir::Type fir::FirOpBuilder::getVarLenSeqTy(mlir::Type eleTy, unsigned rank) {
52   fir::SequenceType::Shape shape(rank, fir::SequenceType::getUnknownExtent());
53   return fir::SequenceType::get(shape, eleTy);
54 }
55 
56 mlir::Type fir::FirOpBuilder::getRealType(int kind) {
57   switch (kindMap.getRealTypeID(kind)) {
58   case llvm::Type::TypeID::HalfTyID:
59     return mlir::FloatType::getF16(getContext());
60   case llvm::Type::TypeID::FloatTyID:
61     return mlir::FloatType::getF32(getContext());
62   case llvm::Type::TypeID::DoubleTyID:
63     return mlir::FloatType::getF64(getContext());
64   case llvm::Type::TypeID::X86_FP80TyID:
65     return mlir::FloatType::getF80(getContext());
66   case llvm::Type::TypeID::FP128TyID:
67     return mlir::FloatType::getF128(getContext());
68   default:
69     fir::emitFatalError(UnknownLoc::get(getContext()),
70                         "unsupported type !fir.real<kind>");
71   }
72 }
73 
74 mlir::Value fir::FirOpBuilder::createNullConstant(mlir::Location loc,
75                                                   mlir::Type ptrType) {
76   auto ty = ptrType ? ptrType : getRefType(getNoneType());
77   return create<fir::ZeroOp>(loc, ty);
78 }
79 
80 mlir::Value fir::FirOpBuilder::createIntegerConstant(mlir::Location loc,
81                                                      mlir::Type ty,
82                                                      std::int64_t cst) {
83   return create<mlir::ConstantOp>(loc, ty, getIntegerAttr(ty, cst));
84 }
85 
86 mlir::Value
87 fir::FirOpBuilder::createRealConstant(mlir::Location loc, mlir::Type fltTy,
88                                       llvm::APFloat::integerPart val) {
89   auto apf = [&]() -> llvm::APFloat {
90     if (auto ty = fltTy.dyn_cast<fir::RealType>())
91       return llvm::APFloat(kindMap.getFloatSemantics(ty.getFKind()), val);
92     if (fltTy.isF16())
93       return llvm::APFloat(llvm::APFloat::IEEEhalf(), val);
94     if (fltTy.isBF16())
95       return llvm::APFloat(llvm::APFloat::BFloat(), val);
96     if (fltTy.isF32())
97       return llvm::APFloat(llvm::APFloat::IEEEsingle(), val);
98     if (fltTy.isF64())
99       return llvm::APFloat(llvm::APFloat::IEEEdouble(), val);
100     if (fltTy.isF80())
101       return llvm::APFloat(llvm::APFloat::x87DoubleExtended(), val);
102     if (fltTy.isF128())
103       return llvm::APFloat(llvm::APFloat::IEEEquad(), val);
104     llvm_unreachable("unhandled MLIR floating-point type");
105   };
106   return createRealConstant(loc, fltTy, apf());
107 }
108 
109 mlir::Value fir::FirOpBuilder::createRealConstant(mlir::Location loc,
110                                                   mlir::Type fltTy,
111                                                   const llvm::APFloat &value) {
112   if (fltTy.isa<mlir::FloatType>()) {
113     auto attr = getFloatAttr(fltTy, value);
114     return create<mlir::arith::ConstantOp>(loc, fltTy, attr);
115   }
116   llvm_unreachable("should use builtin floating-point type");
117 }
118 
119 static llvm::SmallVector<mlir::Value>
120 elideExtentsAlreadyInType(mlir::Type type, mlir::ValueRange shape) {
121   auto arrTy = type.dyn_cast<fir::SequenceType>();
122   if (shape.empty() || !arrTy)
123     return {};
124   // elide the constant dimensions before construction
125   assert(shape.size() == arrTy.getDimension());
126   llvm::SmallVector<mlir::Value> dynamicShape;
127   auto typeShape = arrTy.getShape();
128   for (unsigned i = 0, end = arrTy.getDimension(); i < end; ++i)
129     if (typeShape[i] == fir::SequenceType::getUnknownExtent())
130       dynamicShape.push_back(shape[i]);
131   return dynamicShape;
132 }
133 
134 static llvm::SmallVector<mlir::Value>
135 elideLengthsAlreadyInType(mlir::Type type, mlir::ValueRange lenParams) {
136   if (lenParams.empty())
137     return {};
138   if (auto arrTy = type.dyn_cast<fir::SequenceType>())
139     type = arrTy.getEleTy();
140   if (fir::hasDynamicSize(type))
141     return lenParams;
142   return {};
143 }
144 
145 /// Allocate a local variable.
146 /// A local variable ought to have a name in the source code.
147 mlir::Value fir::FirOpBuilder::allocateLocal(
148     mlir::Location loc, mlir::Type ty, llvm::StringRef uniqName,
149     llvm::StringRef name, bool pinned, llvm::ArrayRef<mlir::Value> shape,
150     llvm::ArrayRef<mlir::Value> lenParams, bool asTarget) {
151   // Convert the shape extents to `index`, as needed.
152   llvm::SmallVector<mlir::Value> indices;
153   llvm::SmallVector<mlir::Value> elidedShape =
154       elideExtentsAlreadyInType(ty, shape);
155   llvm::SmallVector<mlir::Value> elidedLenParams =
156       elideLengthsAlreadyInType(ty, lenParams);
157   auto idxTy = getIndexType();
158   llvm::for_each(elidedShape, [&](mlir::Value sh) {
159     indices.push_back(createConvert(loc, idxTy, sh));
160   });
161   // Add a target attribute, if needed.
162   llvm::SmallVector<mlir::NamedAttribute> attrs;
163   if (asTarget)
164     attrs.emplace_back(
165         mlir::StringAttr::get(getContext(), fir::getTargetAttrName()),
166         getUnitAttr());
167   // Create the local variable.
168   if (name.empty()) {
169     if (uniqName.empty())
170       return create<fir::AllocaOp>(loc, ty, pinned, elidedLenParams, indices,
171                                    attrs);
172     return create<fir::AllocaOp>(loc, ty, uniqName, pinned, elidedLenParams,
173                                  indices, attrs);
174   }
175   return create<fir::AllocaOp>(loc, ty, uniqName, name, pinned, elidedLenParams,
176                                indices, attrs);
177 }
178 
179 mlir::Value fir::FirOpBuilder::allocateLocal(
180     mlir::Location loc, mlir::Type ty, llvm::StringRef uniqName,
181     llvm::StringRef name, llvm::ArrayRef<mlir::Value> shape,
182     llvm::ArrayRef<mlir::Value> lenParams, bool asTarget) {
183   return allocateLocal(loc, ty, uniqName, name, /*pinned=*/false, shape,
184                        lenParams, asTarget);
185 }
186 
187 /// Get the block for adding Allocas.
188 mlir::Block *fir::FirOpBuilder::getAllocaBlock() {
189   // auto iface =
190   //     getRegion().getParentOfType<mlir::omp::OutlineableOpenMPOpInterface>();
191   // return iface ? iface.getAllocaBlock() : getEntryBlock();
192   return getEntryBlock();
193 }
194 
195 /// Create a temporary variable on the stack. Anonymous temporaries have no
196 /// `name` value. Temporaries do not require a uniqued name.
197 mlir::Value
198 fir::FirOpBuilder::createTemporary(mlir::Location loc, mlir::Type type,
199                                    llvm::StringRef name, mlir::ValueRange shape,
200                                    mlir::ValueRange lenParams,
201                                    llvm::ArrayRef<mlir::NamedAttribute> attrs) {
202   llvm::SmallVector<mlir::Value> dynamicShape =
203       elideExtentsAlreadyInType(type, shape);
204   llvm::SmallVector<mlir::Value> dynamicLength =
205       elideLengthsAlreadyInType(type, lenParams);
206   InsertPoint insPt;
207   const bool hoistAlloc = dynamicShape.empty() && dynamicLength.empty();
208   if (hoistAlloc) {
209     insPt = saveInsertionPoint();
210     setInsertionPointToStart(getAllocaBlock());
211   }
212 
213   // If the alloca is inside an OpenMP Op which will be outlined then pin the
214   // alloca here.
215   const bool pinned =
216       getRegion().getParentOfType<mlir::omp::OutlineableOpenMPOpInterface>();
217   assert(!type.isa<fir::ReferenceType>() && "cannot be a reference");
218   auto ae =
219       create<fir::AllocaOp>(loc, type, /*unique_name=*/llvm::StringRef{}, name,
220                             pinned, dynamicLength, dynamicShape, attrs);
221   if (hoistAlloc)
222     restoreInsertionPoint(insPt);
223   return ae;
224 }
225 
226 /// Create a global variable in the (read-only) data section. A global variable
227 /// must have a unique name to identify and reference it.
228 fir::GlobalOp
229 fir::FirOpBuilder::createGlobal(mlir::Location loc, mlir::Type type,
230                                 llvm::StringRef name, mlir::StringAttr linkage,
231                                 mlir::Attribute value, bool isConst) {
232   auto module = getModule();
233   auto insertPt = saveInsertionPoint();
234   if (auto glob = module.lookupSymbol<fir::GlobalOp>(name))
235     return glob;
236   setInsertionPoint(module.getBody(), module.getBody()->end());
237   auto glob = create<fir::GlobalOp>(loc, name, isConst, type, value, linkage);
238   restoreInsertionPoint(insertPt);
239   return glob;
240 }
241 
242 fir::GlobalOp fir::FirOpBuilder::createGlobal(
243     mlir::Location loc, mlir::Type type, llvm::StringRef name, bool isConst,
244     std::function<void(FirOpBuilder &)> bodyBuilder, mlir::StringAttr linkage) {
245   auto module = getModule();
246   auto insertPt = saveInsertionPoint();
247   if (auto glob = module.lookupSymbol<fir::GlobalOp>(name))
248     return glob;
249   setInsertionPoint(module.getBody(), module.getBody()->end());
250   auto glob = create<fir::GlobalOp>(loc, name, isConst, type, mlir::Attribute{},
251                                     linkage);
252   auto &region = glob.getRegion();
253   region.push_back(new mlir::Block);
254   auto &block = glob.getRegion().back();
255   setInsertionPointToStart(&block);
256   bodyBuilder(*this);
257   restoreInsertionPoint(insertPt);
258   return glob;
259 }
260 
261 mlir::Value fir::FirOpBuilder::convertWithSemantics(mlir::Location loc,
262                                                     mlir::Type toTy,
263                                                     mlir::Value val) {
264   assert(toTy && "store location must be typed");
265   auto fromTy = val.getType();
266   if (fromTy == toTy)
267     return val;
268   fir::factory::Complex helper{*this, loc};
269   if ((fir::isa_real(fromTy) || fir::isa_integer(fromTy)) &&
270       fir::isa_complex(toTy)) {
271     // imaginary part is zero
272     auto eleTy = helper.getComplexPartType(toTy);
273     auto cast = createConvert(loc, eleTy, val);
274     llvm::APFloat zero{
275         kindMap.getFloatSemantics(toTy.cast<fir::ComplexType>().getFKind()), 0};
276     auto imag = createRealConstant(loc, eleTy, zero);
277     return helper.createComplex(toTy, cast, imag);
278   }
279   if (fir::isa_complex(fromTy) &&
280       (fir::isa_integer(toTy) || fir::isa_real(toTy))) {
281     // drop the imaginary part
282     auto rp = helper.extractComplexPart(val, /*isImagPart=*/false);
283     return createConvert(loc, toTy, rp);
284   }
285   return createConvert(loc, toTy, val);
286 }
287 
288 mlir::Value fir::FirOpBuilder::createConvert(mlir::Location loc,
289                                              mlir::Type toTy, mlir::Value val) {
290   if (val.getType() != toTy) {
291     assert(!fir::isa_derived(toTy));
292     return create<fir::ConvertOp>(loc, toTy, val);
293   }
294   return val;
295 }
296 
297 fir::StringLitOp fir::FirOpBuilder::createStringLitOp(mlir::Location loc,
298                                                       llvm::StringRef data) {
299   auto type = fir::CharacterType::get(getContext(), 1, data.size());
300   auto strAttr = mlir::StringAttr::get(getContext(), data);
301   auto valTag = mlir::StringAttr::get(getContext(), fir::StringLitOp::value());
302   mlir::NamedAttribute dataAttr(valTag, strAttr);
303   auto sizeTag = mlir::StringAttr::get(getContext(), fir::StringLitOp::size());
304   mlir::NamedAttribute sizeAttr(sizeTag, getI64IntegerAttr(data.size()));
305   llvm::SmallVector<mlir::NamedAttribute> attrs{dataAttr, sizeAttr};
306   return create<fir::StringLitOp>(loc, llvm::ArrayRef<mlir::Type>{type},
307                                   llvm::None, attrs);
308 }
309 
310 mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
311                                         llvm::ArrayRef<mlir::Value> exts) {
312   auto shapeType = fir::ShapeType::get(getContext(), exts.size());
313   return create<fir::ShapeOp>(loc, shapeType, exts);
314 }
315 
316 mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
317                                         llvm::ArrayRef<mlir::Value> shift,
318                                         llvm::ArrayRef<mlir::Value> exts) {
319   auto shapeType = fir::ShapeShiftType::get(getContext(), exts.size());
320   llvm::SmallVector<mlir::Value> shapeArgs;
321   auto idxTy = getIndexType();
322   for (auto [lbnd, ext] : llvm::zip(shift, exts)) {
323     auto lb = createConvert(loc, idxTy, lbnd);
324     shapeArgs.push_back(lb);
325     shapeArgs.push_back(ext);
326   }
327   return create<fir::ShapeShiftOp>(loc, shapeType, shapeArgs);
328 }
329 
330 mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
331                                         const fir::AbstractArrayBox &arr) {
332   if (arr.lboundsAllOne())
333     return genShape(loc, arr.getExtents());
334   return genShape(loc, arr.getLBounds(), arr.getExtents());
335 }
336 
337 mlir::Value fir::FirOpBuilder::createShape(mlir::Location loc,
338                                            const fir::ExtendedValue &exv) {
339   return exv.match(
340       [&](const fir::ArrayBoxValue &box) { return genShape(loc, box); },
341       [&](const fir::CharArrayBoxValue &box) { return genShape(loc, box); },
342       [&](const fir::BoxValue &box) -> mlir::Value {
343         if (!box.getLBounds().empty()) {
344           auto shiftType =
345               fir::ShiftType::get(getContext(), box.getLBounds().size());
346           return create<fir::ShiftOp>(loc, shiftType, box.getLBounds());
347         }
348         return {};
349       },
350       [&](const fir::MutableBoxValue &) -> mlir::Value {
351         // MutableBoxValue must be read into another category to work with them
352         // outside of allocation/assignment contexts.
353         fir::emitFatalError(loc, "createShape on MutableBoxValue");
354       },
355       [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });
356 }
357 
358 mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
359                                          const fir::ExtendedValue &exv) {
360   mlir::Value itemAddr = fir::getBase(exv);
361   if (itemAddr.getType().isa<fir::BoxType>())
362     return itemAddr;
363   auto elementType = fir::dyn_cast_ptrEleTy(itemAddr.getType());
364   if (!elementType) {
365     mlir::emitError(loc, "internal: expected a memory reference type ")
366         << itemAddr.getType();
367     llvm_unreachable("not a memory reference type");
368   }
369   mlir::Type boxTy = fir::BoxType::get(elementType);
370   return exv.match(
371       [&](const fir::ArrayBoxValue &box) -> mlir::Value {
372         mlir::Value s = createShape(loc, exv);
373         return create<fir::EmboxOp>(loc, boxTy, itemAddr, s);
374       },
375       [&](const fir::CharArrayBoxValue &box) -> mlir::Value {
376         mlir::Value s = createShape(loc, exv);
377         if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))
378           return create<fir::EmboxOp>(loc, boxTy, itemAddr, s);
379 
380         mlir::Value emptySlice;
381         llvm::SmallVector<mlir::Value> lenParams{box.getLen()};
382         return create<fir::EmboxOp>(loc, boxTy, itemAddr, s, emptySlice,
383                                     lenParams);
384       },
385       [&](const fir::CharBoxValue &box) -> mlir::Value {
386         if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))
387           return create<fir::EmboxOp>(loc, boxTy, itemAddr);
388         mlir::Value emptyShape, emptySlice;
389         llvm::SmallVector<mlir::Value> lenParams{box.getLen()};
390         return create<fir::EmboxOp>(loc, boxTy, itemAddr, emptyShape,
391                                     emptySlice, lenParams);
392       },
393       [&](const fir::MutableBoxValue &x) -> mlir::Value {
394         return create<fir::LoadOp>(
395             loc, fir::factory::getMutableIRBox(*this, loc, x));
396       },
397       // UnboxedValue, ProcBoxValue or BoxValue.
398       [&](const auto &) -> mlir::Value {
399         return create<fir::EmboxOp>(loc, boxTy, itemAddr);
400       });
401 }
402 
403 static mlir::Value
404 genNullPointerComparison(fir::FirOpBuilder &builder, mlir::Location loc,
405                          mlir::Value addr,
406                          mlir::arith::CmpIPredicate condition) {
407   auto intPtrTy = builder.getIntPtrType();
408   auto ptrToInt = builder.createConvert(loc, intPtrTy, addr);
409   auto c0 = builder.createIntegerConstant(loc, intPtrTy, 0);
410   return builder.create<mlir::arith::CmpIOp>(loc, condition, ptrToInt, c0);
411 }
412 
413 mlir::Value fir::FirOpBuilder::genIsNotNull(mlir::Location loc,
414                                             mlir::Value addr) {
415   return genNullPointerComparison(*this, loc, addr,
416                                   mlir::arith::CmpIPredicate::ne);
417 }
418 
419 mlir::Value fir::FirOpBuilder::genIsNull(mlir::Location loc, mlir::Value addr) {
420   return genNullPointerComparison(*this, loc, addr,
421                                   mlir::arith::CmpIPredicate::eq);
422 }
423 
424 //===--------------------------------------------------------------------===//
425 // ExtendedValue inquiry helper implementation
426 //===--------------------------------------------------------------------===//
427 
428 mlir::Value fir::factory::readCharLen(fir::FirOpBuilder &builder,
429                                       mlir::Location loc,
430                                       const fir::ExtendedValue &box) {
431   return box.match(
432       [&](const fir::CharBoxValue &x) -> mlir::Value { return x.getLen(); },
433       [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
434         return x.getLen();
435       },
436       [&](const fir::BoxValue &x) -> mlir::Value {
437         assert(x.isCharacter());
438         if (!x.getExplicitParameters().empty())
439           return x.getExplicitParameters()[0];
440         return fir::factory::CharacterExprHelper{builder, loc}
441             .readLengthFromBox(x.getAddr());
442       },
443       [&](const fir::MutableBoxValue &) -> mlir::Value {
444         // MutableBoxValue must be read into another category to work with them
445         // outside of allocation/assignment contexts.
446         fir::emitFatalError(loc, "readCharLen on MutableBoxValue");
447       },
448       [&](const auto &) -> mlir::Value {
449         fir::emitFatalError(
450             loc, "Character length inquiry on a non-character entity");
451       });
452 }
453 
454 mlir::Value fir::factory::readExtent(fir::FirOpBuilder &builder,
455                                      mlir::Location loc,
456                                      const fir::ExtendedValue &box,
457                                      unsigned dim) {
458   assert(box.rank() > dim);
459   return box.match(
460       [&](const fir::ArrayBoxValue &x) -> mlir::Value {
461         return x.getExtents()[dim];
462       },
463       [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
464         return x.getExtents()[dim];
465       },
466       [&](const fir::BoxValue &x) -> mlir::Value {
467         if (!x.getExplicitExtents().empty())
468           return x.getExplicitExtents()[dim];
469         auto idxTy = builder.getIndexType();
470         auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);
471         return builder
472             .create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, x.getAddr(),
473                                     dimVal)
474             .getResult(1);
475       },
476       [&](const fir::MutableBoxValue &x) -> mlir::Value {
477         // MutableBoxValue must be read into another category to work with them
478         // outside of allocation/assignment contexts.
479         fir::emitFatalError(loc, "readExtents on MutableBoxValue");
480       },
481       [&](const auto &) -> mlir::Value {
482         fir::emitFatalError(loc, "extent inquiry on scalar");
483       });
484 }
485 
486 llvm::SmallVector<mlir::Value>
487 fir::factory::readExtents(fir::FirOpBuilder &builder, mlir::Location loc,
488                           const fir::BoxValue &box) {
489   llvm::SmallVector<mlir::Value> result;
490   auto explicitExtents = box.getExplicitExtents();
491   if (!explicitExtents.empty()) {
492     result.append(explicitExtents.begin(), explicitExtents.end());
493     return result;
494   }
495   auto rank = box.rank();
496   auto idxTy = builder.getIndexType();
497   for (decltype(rank) dim = 0; dim < rank; ++dim) {
498     auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);
499     auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
500                                                   box.getAddr(), dimVal);
501     result.emplace_back(dimInfo.getResult(1));
502   }
503   return result;
504 }
505 
506 llvm::SmallVector<mlir::Value>
507 fir::factory::getExtents(fir::FirOpBuilder &builder, mlir::Location loc,
508                          const fir::ExtendedValue &box) {
509   return box.match(
510       [&](const fir::ArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {
511         return {x.getExtents().begin(), x.getExtents().end()};
512       },
513       [&](const fir::CharArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {
514         return {x.getExtents().begin(), x.getExtents().end()};
515       },
516       [&](const fir::BoxValue &x) -> llvm::SmallVector<mlir::Value> {
517         return fir::factory::readExtents(builder, loc, x);
518       },
519       [&](const fir::MutableBoxValue &x) -> llvm::SmallVector<mlir::Value> {
520         auto load = fir::factory::genMutableBoxRead(builder, loc, x);
521         return fir::factory::getExtents(builder, loc, load);
522       },
523       [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });
524 }
525 
526 std::string fir::factory::uniqueCGIdent(llvm::StringRef prefix,
527                                         llvm::StringRef name) {
528   // For "long" identifiers use a hash value
529   if (name.size() > nameLengthHashSize) {
530     llvm::MD5 hash;
531     hash.update(name);
532     llvm::MD5::MD5Result result;
533     hash.final(result);
534     llvm::SmallString<32> str;
535     llvm::MD5::stringifyResult(result, str);
536     std::string hashName = prefix.str();
537     hashName.append(".").append(str.c_str());
538     return fir::NameUniquer::doGenerated(hashName);
539   }
540   // "Short" identifiers use a reversible hex string
541   std::string nm = prefix.str();
542   return fir::NameUniquer::doGenerated(
543       nm.append(".").append(llvm::toHex(name)));
544 }
545 
546 mlir::Value fir::factory::locationToFilename(fir::FirOpBuilder &builder,
547                                              mlir::Location loc) {
548   if (auto flc = loc.dyn_cast<mlir::FileLineColLoc>()) {
549     // must be encoded as asciiz, C string
550     auto fn = flc.getFilename().str() + '\0';
551     return fir::getBase(createStringLiteral(builder, loc, fn));
552   }
553   return builder.createNullConstant(loc);
554 }
555 
556 mlir::Value fir::factory::locationToLineNo(fir::FirOpBuilder &builder,
557                                            mlir::Location loc,
558                                            mlir::Type type) {
559   if (auto flc = loc.dyn_cast<mlir::FileLineColLoc>())
560     return builder.createIntegerConstant(loc, type, flc.getLine());
561   return builder.createIntegerConstant(loc, type, 0);
562 }
563 
564 fir::ExtendedValue fir::factory::createStringLiteral(fir::FirOpBuilder &builder,
565                                                      mlir::Location loc,
566                                                      llvm::StringRef str) {
567   std::string globalName = fir::factory::uniqueCGIdent("cl", str);
568   auto type = fir::CharacterType::get(builder.getContext(), 1, str.size());
569   auto global = builder.getNamedGlobal(globalName);
570   if (!global)
571     global = builder.createGlobalConstant(
572         loc, type, globalName,
573         [&](fir::FirOpBuilder &builder) {
574           auto stringLitOp = builder.createStringLitOp(loc, str);
575           builder.create<fir::HasValueOp>(loc, stringLitOp);
576         },
577         builder.createLinkOnceLinkage());
578   auto addr = builder.create<fir::AddrOfOp>(loc, global.resultType(),
579                                             global.getSymbol());
580   auto len = builder.createIntegerConstant(
581       loc, builder.getCharacterLengthType(), str.size());
582   return fir::CharBoxValue{addr, len};
583 }
584 
585 llvm::SmallVector<mlir::Value>
586 fir::factory::createExtents(fir::FirOpBuilder &builder, mlir::Location loc,
587                             fir::SequenceType seqTy) {
588   llvm::SmallVector<mlir::Value> extents;
589   auto idxTy = builder.getIndexType();
590   for (auto ext : seqTy.getShape())
591     extents.emplace_back(
592         ext == fir::SequenceType::getUnknownExtent()
593             ? builder.create<fir::UndefOp>(loc, idxTy).getResult()
594             : builder.createIntegerConstant(loc, idxTy, ext));
595   return extents;
596 }
597 
598 mlir::TupleType
599 fir::factory::getRaggedArrayHeaderType(fir::FirOpBuilder &builder) {
600   mlir::IntegerType i64Ty = builder.getIntegerType(64);
601   auto arrTy = fir::SequenceType::get(builder.getIntegerType(8), 1);
602   auto buffTy = fir::HeapType::get(arrTy);
603   auto extTy = fir::SequenceType::get(i64Ty, 1);
604   auto shTy = fir::HeapType::get(extTy);
605   return mlir::TupleType::get(builder.getContext(), {i64Ty, buffTy, shTy});
606 }
607