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 mlir::FuncOp fir::FirOpBuilder::getNamedFunction(mlir::ModuleOp modOp,
42                                                  mlir::SymbolRefAttr symbol) {
43   return modOp.lookupSymbol<mlir::FuncOp>(symbol);
44 }
45 
46 fir::GlobalOp fir::FirOpBuilder::getNamedGlobal(mlir::ModuleOp modOp,
47                                                 llvm::StringRef name) {
48   return modOp.lookupSymbol<fir::GlobalOp>(name);
49 }
50 
51 mlir::Type fir::FirOpBuilder::getRefType(mlir::Type eleTy) {
52   assert(!eleTy.isa<fir::ReferenceType>() && "cannot be a reference type");
53   return fir::ReferenceType::get(eleTy);
54 }
55 
56 mlir::Type fir::FirOpBuilder::getVarLenSeqTy(mlir::Type eleTy, unsigned rank) {
57   fir::SequenceType::Shape shape(rank, fir::SequenceType::getUnknownExtent());
58   return fir::SequenceType::get(shape, eleTy);
59 }
60 
61 mlir::Type fir::FirOpBuilder::getRealType(int kind) {
62   switch (kindMap.getRealTypeID(kind)) {
63   case llvm::Type::TypeID::HalfTyID:
64     return mlir::FloatType::getF16(getContext());
65   case llvm::Type::TypeID::FloatTyID:
66     return mlir::FloatType::getF32(getContext());
67   case llvm::Type::TypeID::DoubleTyID:
68     return mlir::FloatType::getF64(getContext());
69   case llvm::Type::TypeID::X86_FP80TyID:
70     return mlir::FloatType::getF80(getContext());
71   case llvm::Type::TypeID::FP128TyID:
72     return mlir::FloatType::getF128(getContext());
73   default:
74     fir::emitFatalError(mlir::UnknownLoc::get(getContext()),
75                         "unsupported type !fir.real<kind>");
76   }
77 }
78 
79 mlir::Value fir::FirOpBuilder::createNullConstant(mlir::Location loc,
80                                                   mlir::Type ptrType) {
81   auto ty = ptrType ? ptrType : getRefType(getNoneType());
82   return create<fir::ZeroOp>(loc, ty);
83 }
84 
85 mlir::Value fir::FirOpBuilder::createIntegerConstant(mlir::Location loc,
86                                                      mlir::Type ty,
87                                                      std::int64_t cst) {
88   return create<mlir::arith::ConstantOp>(loc, ty, getIntegerAttr(ty, cst));
89 }
90 
91 mlir::Value
92 fir::FirOpBuilder::createRealConstant(mlir::Location loc, mlir::Type fltTy,
93                                       llvm::APFloat::integerPart val) {
94   auto apf = [&]() -> llvm::APFloat {
95     if (auto ty = fltTy.dyn_cast<fir::RealType>())
96       return llvm::APFloat(kindMap.getFloatSemantics(ty.getFKind()), val);
97     if (fltTy.isF16())
98       return llvm::APFloat(llvm::APFloat::IEEEhalf(), val);
99     if (fltTy.isBF16())
100       return llvm::APFloat(llvm::APFloat::BFloat(), val);
101     if (fltTy.isF32())
102       return llvm::APFloat(llvm::APFloat::IEEEsingle(), val);
103     if (fltTy.isF64())
104       return llvm::APFloat(llvm::APFloat::IEEEdouble(), val);
105     if (fltTy.isF80())
106       return llvm::APFloat(llvm::APFloat::x87DoubleExtended(), val);
107     if (fltTy.isF128())
108       return llvm::APFloat(llvm::APFloat::IEEEquad(), val);
109     llvm_unreachable("unhandled MLIR floating-point type");
110   };
111   return createRealConstant(loc, fltTy, apf());
112 }
113 
114 mlir::Value fir::FirOpBuilder::createRealConstant(mlir::Location loc,
115                                                   mlir::Type fltTy,
116                                                   const llvm::APFloat &value) {
117   if (fltTy.isa<mlir::FloatType>()) {
118     auto attr = getFloatAttr(fltTy, value);
119     return create<mlir::arith::ConstantOp>(loc, fltTy, attr);
120   }
121   llvm_unreachable("should use builtin floating-point type");
122 }
123 
124 static llvm::SmallVector<mlir::Value>
125 elideExtentsAlreadyInType(mlir::Type type, mlir::ValueRange shape) {
126   auto arrTy = type.dyn_cast<fir::SequenceType>();
127   if (shape.empty() || !arrTy)
128     return {};
129   // elide the constant dimensions before construction
130   assert(shape.size() == arrTy.getDimension());
131   llvm::SmallVector<mlir::Value> dynamicShape;
132   auto typeShape = arrTy.getShape();
133   for (unsigned i = 0, end = arrTy.getDimension(); i < end; ++i)
134     if (typeShape[i] == fir::SequenceType::getUnknownExtent())
135       dynamicShape.push_back(shape[i]);
136   return dynamicShape;
137 }
138 
139 static llvm::SmallVector<mlir::Value>
140 elideLengthsAlreadyInType(mlir::Type type, mlir::ValueRange lenParams) {
141   if (lenParams.empty())
142     return {};
143   if (auto arrTy = type.dyn_cast<fir::SequenceType>())
144     type = arrTy.getEleTy();
145   if (fir::hasDynamicSize(type))
146     return lenParams;
147   return {};
148 }
149 
150 /// Allocate a local variable.
151 /// A local variable ought to have a name in the source code.
152 mlir::Value fir::FirOpBuilder::allocateLocal(
153     mlir::Location loc, mlir::Type ty, llvm::StringRef uniqName,
154     llvm::StringRef name, bool pinned, llvm::ArrayRef<mlir::Value> shape,
155     llvm::ArrayRef<mlir::Value> lenParams, bool asTarget) {
156   // Convert the shape extents to `index`, as needed.
157   llvm::SmallVector<mlir::Value> indices;
158   llvm::SmallVector<mlir::Value> elidedShape =
159       elideExtentsAlreadyInType(ty, shape);
160   llvm::SmallVector<mlir::Value> elidedLenParams =
161       elideLengthsAlreadyInType(ty, lenParams);
162   auto idxTy = getIndexType();
163   llvm::for_each(elidedShape, [&](mlir::Value sh) {
164     indices.push_back(createConvert(loc, idxTy, sh));
165   });
166   // Add a target attribute, if needed.
167   llvm::SmallVector<mlir::NamedAttribute> attrs;
168   if (asTarget)
169     attrs.emplace_back(
170         mlir::StringAttr::get(getContext(), fir::getTargetAttrName()),
171         getUnitAttr());
172   // Create the local variable.
173   if (name.empty()) {
174     if (uniqName.empty())
175       return create<fir::AllocaOp>(loc, ty, pinned, elidedLenParams, indices,
176                                    attrs);
177     return create<fir::AllocaOp>(loc, ty, uniqName, pinned, elidedLenParams,
178                                  indices, attrs);
179   }
180   return create<fir::AllocaOp>(loc, ty, uniqName, name, pinned, elidedLenParams,
181                                indices, attrs);
182 }
183 
184 mlir::Value fir::FirOpBuilder::allocateLocal(
185     mlir::Location loc, mlir::Type ty, llvm::StringRef uniqName,
186     llvm::StringRef name, llvm::ArrayRef<mlir::Value> shape,
187     llvm::ArrayRef<mlir::Value> lenParams, bool asTarget) {
188   return allocateLocal(loc, ty, uniqName, name, /*pinned=*/false, shape,
189                        lenParams, asTarget);
190 }
191 
192 /// Get the block for adding Allocas.
193 mlir::Block *fir::FirOpBuilder::getAllocaBlock() {
194   // auto iface =
195   //     getRegion().getParentOfType<mlir::omp::OutlineableOpenMPOpInterface>();
196   // return iface ? iface.getAllocaBlock() : getEntryBlock();
197   return getEntryBlock();
198 }
199 
200 /// Create a temporary variable on the stack. Anonymous temporaries have no
201 /// `name` value. Temporaries do not require a uniqued name.
202 mlir::Value
203 fir::FirOpBuilder::createTemporary(mlir::Location loc, mlir::Type type,
204                                    llvm::StringRef name, mlir::ValueRange shape,
205                                    mlir::ValueRange lenParams,
206                                    llvm::ArrayRef<mlir::NamedAttribute> attrs) {
207   llvm::SmallVector<mlir::Value> dynamicShape =
208       elideExtentsAlreadyInType(type, shape);
209   llvm::SmallVector<mlir::Value> dynamicLength =
210       elideLengthsAlreadyInType(type, lenParams);
211   InsertPoint insPt;
212   const bool hoistAlloc = dynamicShape.empty() && dynamicLength.empty();
213   if (hoistAlloc) {
214     insPt = saveInsertionPoint();
215     setInsertionPointToStart(getAllocaBlock());
216   }
217 
218   // If the alloca is inside an OpenMP Op which will be outlined then pin the
219   // alloca here.
220   const bool pinned =
221       getRegion().getParentOfType<mlir::omp::OutlineableOpenMPOpInterface>();
222   assert(!type.isa<fir::ReferenceType>() && "cannot be a reference");
223   auto ae =
224       create<fir::AllocaOp>(loc, type, /*unique_name=*/llvm::StringRef{}, name,
225                             pinned, dynamicLength, dynamicShape, attrs);
226   if (hoistAlloc)
227     restoreInsertionPoint(insPt);
228   return ae;
229 }
230 
231 /// Create a global variable in the (read-only) data section. A global variable
232 /// must have a unique name to identify and reference it.
233 fir::GlobalOp
234 fir::FirOpBuilder::createGlobal(mlir::Location loc, mlir::Type type,
235                                 llvm::StringRef name, mlir::StringAttr linkage,
236                                 mlir::Attribute value, bool isConst) {
237   auto module = getModule();
238   auto insertPt = saveInsertionPoint();
239   if (auto glob = module.lookupSymbol<fir::GlobalOp>(name))
240     return glob;
241   setInsertionPoint(module.getBody(), module.getBody()->end());
242   auto glob = create<fir::GlobalOp>(loc, name, isConst, type, value, linkage);
243   restoreInsertionPoint(insertPt);
244   return glob;
245 }
246 
247 fir::GlobalOp fir::FirOpBuilder::createGlobal(
248     mlir::Location loc, mlir::Type type, llvm::StringRef name, bool isConst,
249     std::function<void(FirOpBuilder &)> bodyBuilder, mlir::StringAttr linkage) {
250   auto module = getModule();
251   auto insertPt = saveInsertionPoint();
252   if (auto glob = module.lookupSymbol<fir::GlobalOp>(name))
253     return glob;
254   setInsertionPoint(module.getBody(), module.getBody()->end());
255   auto glob = create<fir::GlobalOp>(loc, name, isConst, type, mlir::Attribute{},
256                                     linkage);
257   auto &region = glob.getRegion();
258   region.push_back(new mlir::Block);
259   auto &block = glob.getRegion().back();
260   setInsertionPointToStart(&block);
261   bodyBuilder(*this);
262   restoreInsertionPoint(insertPt);
263   return glob;
264 }
265 
266 mlir::Value
267 fir::FirOpBuilder::convertWithSemantics(mlir::Location loc, mlir::Type toTy,
268                                         mlir::Value val,
269                                         bool allowCharacterConversion) {
270   assert(toTy && "store location must be typed");
271   auto fromTy = val.getType();
272   if (fromTy == toTy)
273     return val;
274   fir::factory::Complex helper{*this, loc};
275   if ((fir::isa_real(fromTy) || fir::isa_integer(fromTy)) &&
276       fir::isa_complex(toTy)) {
277     // imaginary part is zero
278     auto eleTy = helper.getComplexPartType(toTy);
279     auto cast = createConvert(loc, eleTy, val);
280     llvm::APFloat zero{
281         kindMap.getFloatSemantics(toTy.cast<fir::ComplexType>().getFKind()), 0};
282     auto imag = createRealConstant(loc, eleTy, zero);
283     return helper.createComplex(toTy, cast, imag);
284   }
285   if (fir::isa_complex(fromTy) &&
286       (fir::isa_integer(toTy) || fir::isa_real(toTy))) {
287     // drop the imaginary part
288     auto rp = helper.extractComplexPart(val, /*isImagPart=*/false);
289     return createConvert(loc, toTy, rp);
290   }
291   if (allowCharacterConversion) {
292     if (fromTy.isa<fir::BoxCharType>()) {
293       // Extract the address of the character string and pass it
294       fir::factory::CharacterExprHelper charHelper{*this, loc};
295       std::pair<mlir::Value, mlir::Value> unboxchar =
296           charHelper.createUnboxChar(val);
297       return createConvert(loc, toTy, unboxchar.first);
298     }
299     if (auto boxType = toTy.dyn_cast<fir::BoxCharType>()) {
300       // Extract the address of the actual argument and create a boxed
301       // character value with an undefined length
302       // TODO: We should really calculate the total size of the actual
303       // argument in characters and use it as the length of the string
304       auto refType = getRefType(boxType.getEleTy());
305       mlir::Value charBase = createConvert(loc, refType, val);
306       mlir::Value unknownLen = create<fir::UndefOp>(loc, getIndexType());
307       fir::factory::CharacterExprHelper charHelper{*this, loc};
308       return charHelper.createEmboxChar(charBase, unknownLen);
309     }
310   }
311   if (fir::isa_ref_type(toTy) && fir::isa_box_type(fromTy)) {
312     // Call is expecting a raw data pointer, not a box. Get the data pointer out
313     // of the box and pass that.
314     assert((fir::unwrapRefType(toTy) ==
315                 fir::unwrapRefType(fir::unwrapPassByRefType(fromTy)) &&
316             "element types expected to match"));
317     return create<fir::BoxAddrOp>(loc, toTy, val);
318   }
319 
320   return createConvert(loc, toTy, val);
321 }
322 
323 mlir::Value fir::FirOpBuilder::createConvert(mlir::Location loc,
324                                              mlir::Type toTy, mlir::Value val) {
325   if (val.getType() != toTy) {
326     assert(!fir::isa_derived(toTy));
327     return create<fir::ConvertOp>(loc, toTy, val);
328   }
329   return val;
330 }
331 
332 fir::StringLitOp fir::FirOpBuilder::createStringLitOp(mlir::Location loc,
333                                                       llvm::StringRef data) {
334   auto type = fir::CharacterType::get(getContext(), 1, data.size());
335   auto strAttr = mlir::StringAttr::get(getContext(), data);
336   auto valTag = mlir::StringAttr::get(getContext(), fir::StringLitOp::value());
337   mlir::NamedAttribute dataAttr(valTag, strAttr);
338   auto sizeTag = mlir::StringAttr::get(getContext(), fir::StringLitOp::size());
339   mlir::NamedAttribute sizeAttr(sizeTag, getI64IntegerAttr(data.size()));
340   llvm::SmallVector<mlir::NamedAttribute> attrs{dataAttr, sizeAttr};
341   return create<fir::StringLitOp>(loc, llvm::ArrayRef<mlir::Type>{type},
342                                   llvm::None, attrs);
343 }
344 
345 mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
346                                         llvm::ArrayRef<mlir::Value> exts) {
347   auto shapeType = fir::ShapeType::get(getContext(), exts.size());
348   return create<fir::ShapeOp>(loc, shapeType, exts);
349 }
350 
351 mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
352                                         llvm::ArrayRef<mlir::Value> shift,
353                                         llvm::ArrayRef<mlir::Value> exts) {
354   auto shapeType = fir::ShapeShiftType::get(getContext(), exts.size());
355   llvm::SmallVector<mlir::Value> shapeArgs;
356   auto idxTy = getIndexType();
357   for (auto [lbnd, ext] : llvm::zip(shift, exts)) {
358     auto lb = createConvert(loc, idxTy, lbnd);
359     shapeArgs.push_back(lb);
360     shapeArgs.push_back(ext);
361   }
362   return create<fir::ShapeShiftOp>(loc, shapeType, shapeArgs);
363 }
364 
365 mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
366                                         const fir::AbstractArrayBox &arr) {
367   if (arr.lboundsAllOne())
368     return genShape(loc, arr.getExtents());
369   return genShape(loc, arr.getLBounds(), arr.getExtents());
370 }
371 
372 mlir::Value fir::FirOpBuilder::createShape(mlir::Location loc,
373                                            const fir::ExtendedValue &exv) {
374   return exv.match(
375       [&](const fir::ArrayBoxValue &box) { return genShape(loc, box); },
376       [&](const fir::CharArrayBoxValue &box) { return genShape(loc, box); },
377       [&](const fir::BoxValue &box) -> mlir::Value {
378         if (!box.getLBounds().empty()) {
379           auto shiftType =
380               fir::ShiftType::get(getContext(), box.getLBounds().size());
381           return create<fir::ShiftOp>(loc, shiftType, box.getLBounds());
382         }
383         return {};
384       },
385       [&](const fir::MutableBoxValue &) -> mlir::Value {
386         // MutableBoxValue must be read into another category to work with them
387         // outside of allocation/assignment contexts.
388         fir::emitFatalError(loc, "createShape on MutableBoxValue");
389       },
390       [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });
391 }
392 
393 mlir::Value fir::FirOpBuilder::createSlice(mlir::Location loc,
394                                            const fir::ExtendedValue &exv,
395                                            mlir::ValueRange triples,
396                                            mlir::ValueRange path) {
397   if (triples.empty()) {
398     // If there is no slicing by triple notation, then take the whole array.
399     auto fullShape = [&](const llvm::ArrayRef<mlir::Value> lbounds,
400                          llvm::ArrayRef<mlir::Value> extents) -> mlir::Value {
401       llvm::SmallVector<mlir::Value> trips;
402       auto idxTy = getIndexType();
403       auto one = createIntegerConstant(loc, idxTy, 1);
404       if (lbounds.empty()) {
405         for (auto v : extents) {
406           trips.push_back(one);
407           trips.push_back(v);
408           trips.push_back(one);
409         }
410         return create<fir::SliceOp>(loc, trips, path);
411       }
412       for (auto [lbnd, extent] : llvm::zip(lbounds, extents)) {
413         auto lb = createConvert(loc, idxTy, lbnd);
414         auto ext = createConvert(loc, idxTy, extent);
415         auto shift = create<mlir::arith::SubIOp>(loc, lb, one);
416         auto ub = create<mlir::arith::AddIOp>(loc, ext, shift);
417         trips.push_back(lb);
418         trips.push_back(ub);
419         trips.push_back(one);
420       }
421       return create<fir::SliceOp>(loc, trips, path);
422     };
423     return exv.match(
424         [&](const fir::ArrayBoxValue &box) {
425           return fullShape(box.getLBounds(), box.getExtents());
426         },
427         [&](const fir::CharArrayBoxValue &box) {
428           return fullShape(box.getLBounds(), box.getExtents());
429         },
430         [&](const fir::BoxValue &box) {
431           auto extents = fir::factory::readExtents(*this, loc, box);
432           return fullShape(box.getLBounds(), extents);
433         },
434         [&](const fir::MutableBoxValue &) -> mlir::Value {
435           // MutableBoxValue must be read into another category to work with
436           // them outside of allocation/assignment contexts.
437           fir::emitFatalError(loc, "createSlice on MutableBoxValue");
438         },
439         [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });
440   }
441   return create<fir::SliceOp>(loc, triples, path);
442 }
443 
444 mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
445                                          const fir::ExtendedValue &exv) {
446   mlir::Value itemAddr = fir::getBase(exv);
447   if (itemAddr.getType().isa<fir::BoxType>())
448     return itemAddr;
449   auto elementType = fir::dyn_cast_ptrEleTy(itemAddr.getType());
450   if (!elementType) {
451     mlir::emitError(loc, "internal: expected a memory reference type ")
452         << itemAddr.getType();
453     llvm_unreachable("not a memory reference type");
454   }
455   mlir::Type boxTy = fir::BoxType::get(elementType);
456   return exv.match(
457       [&](const fir::ArrayBoxValue &box) -> mlir::Value {
458         mlir::Value s = createShape(loc, exv);
459         return create<fir::EmboxOp>(loc, boxTy, itemAddr, s);
460       },
461       [&](const fir::CharArrayBoxValue &box) -> mlir::Value {
462         mlir::Value s = createShape(loc, exv);
463         if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))
464           return create<fir::EmboxOp>(loc, boxTy, itemAddr, s);
465 
466         mlir::Value emptySlice;
467         llvm::SmallVector<mlir::Value> lenParams{box.getLen()};
468         return create<fir::EmboxOp>(loc, boxTy, itemAddr, s, emptySlice,
469                                     lenParams);
470       },
471       [&](const fir::CharBoxValue &box) -> mlir::Value {
472         if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))
473           return create<fir::EmboxOp>(loc, boxTy, itemAddr);
474         mlir::Value emptyShape, emptySlice;
475         llvm::SmallVector<mlir::Value> lenParams{box.getLen()};
476         return create<fir::EmboxOp>(loc, boxTy, itemAddr, emptyShape,
477                                     emptySlice, lenParams);
478       },
479       [&](const fir::MutableBoxValue &x) -> mlir::Value {
480         return create<fir::LoadOp>(
481             loc, fir::factory::getMutableIRBox(*this, loc, x));
482       },
483       // UnboxedValue, ProcBoxValue or BoxValue.
484       [&](const auto &) -> mlir::Value {
485         return create<fir::EmboxOp>(loc, boxTy, itemAddr);
486       });
487 }
488 
489 static mlir::Value
490 genNullPointerComparison(fir::FirOpBuilder &builder, mlir::Location loc,
491                          mlir::Value addr,
492                          mlir::arith::CmpIPredicate condition) {
493   auto intPtrTy = builder.getIntPtrType();
494   auto ptrToInt = builder.createConvert(loc, intPtrTy, addr);
495   auto c0 = builder.createIntegerConstant(loc, intPtrTy, 0);
496   return builder.create<mlir::arith::CmpIOp>(loc, condition, ptrToInt, c0);
497 }
498 
499 mlir::Value fir::FirOpBuilder::genIsNotNull(mlir::Location loc,
500                                             mlir::Value addr) {
501   return genNullPointerComparison(*this, loc, addr,
502                                   mlir::arith::CmpIPredicate::ne);
503 }
504 
505 mlir::Value fir::FirOpBuilder::genIsNull(mlir::Location loc, mlir::Value addr) {
506   return genNullPointerComparison(*this, loc, addr,
507                                   mlir::arith::CmpIPredicate::eq);
508 }
509 
510 mlir::Value fir::FirOpBuilder::genExtentFromTriplet(mlir::Location loc,
511                                                     mlir::Value lb,
512                                                     mlir::Value ub,
513                                                     mlir::Value step,
514                                                     mlir::Type type) {
515   auto zero = createIntegerConstant(loc, type, 0);
516   lb = createConvert(loc, type, lb);
517   ub = createConvert(loc, type, ub);
518   step = createConvert(loc, type, step);
519   auto diff = create<mlir::arith::SubIOp>(loc, ub, lb);
520   auto add = create<mlir::arith::AddIOp>(loc, diff, step);
521   auto div = create<mlir::arith::DivSIOp>(loc, add, step);
522   auto cmp = create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::sgt,
523                                          div, zero);
524   return create<mlir::arith::SelectOp>(loc, cmp, div, zero);
525 }
526 
527 //===--------------------------------------------------------------------===//
528 // ExtendedValue inquiry helper implementation
529 //===--------------------------------------------------------------------===//
530 
531 mlir::Value fir::factory::readCharLen(fir::FirOpBuilder &builder,
532                                       mlir::Location loc,
533                                       const fir::ExtendedValue &box) {
534   return box.match(
535       [&](const fir::CharBoxValue &x) -> mlir::Value { return x.getLen(); },
536       [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
537         return x.getLen();
538       },
539       [&](const fir::BoxValue &x) -> mlir::Value {
540         assert(x.isCharacter());
541         if (!x.getExplicitParameters().empty())
542           return x.getExplicitParameters()[0];
543         return fir::factory::CharacterExprHelper{builder, loc}
544             .readLengthFromBox(x.getAddr());
545       },
546       [&](const fir::MutableBoxValue &) -> mlir::Value {
547         // MutableBoxValue must be read into another category to work with them
548         // outside of allocation/assignment contexts.
549         fir::emitFatalError(loc, "readCharLen on MutableBoxValue");
550       },
551       [&](const auto &) -> mlir::Value {
552         fir::emitFatalError(
553             loc, "Character length inquiry on a non-character entity");
554       });
555 }
556 
557 mlir::Value fir::factory::readExtent(fir::FirOpBuilder &builder,
558                                      mlir::Location loc,
559                                      const fir::ExtendedValue &box,
560                                      unsigned dim) {
561   assert(box.rank() > dim);
562   return box.match(
563       [&](const fir::ArrayBoxValue &x) -> mlir::Value {
564         return x.getExtents()[dim];
565       },
566       [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
567         return x.getExtents()[dim];
568       },
569       [&](const fir::BoxValue &x) -> mlir::Value {
570         if (!x.getExplicitExtents().empty())
571           return x.getExplicitExtents()[dim];
572         auto idxTy = builder.getIndexType();
573         auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);
574         return builder
575             .create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, x.getAddr(),
576                                     dimVal)
577             .getResult(1);
578       },
579       [&](const fir::MutableBoxValue &x) -> mlir::Value {
580         // MutableBoxValue must be read into another category to work with them
581         // outside of allocation/assignment contexts.
582         fir::emitFatalError(loc, "readExtents on MutableBoxValue");
583       },
584       [&](const auto &) -> mlir::Value {
585         fir::emitFatalError(loc, "extent inquiry on scalar");
586       });
587 }
588 
589 mlir::Value fir::factory::readLowerBound(fir::FirOpBuilder &builder,
590                                          mlir::Location loc,
591                                          const fir::ExtendedValue &box,
592                                          unsigned dim,
593                                          mlir::Value defaultValue) {
594   assert(box.rank() > dim);
595   auto lb = box.match(
596       [&](const fir::ArrayBoxValue &x) -> mlir::Value {
597         return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
598       },
599       [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
600         return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
601       },
602       [&](const fir::BoxValue &x) -> mlir::Value {
603         return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
604       },
605       [&](const fir::MutableBoxValue &x) -> mlir::Value {
606         return readLowerBound(builder, loc,
607                               fir::factory::genMutableBoxRead(builder, loc, x),
608                               dim, defaultValue);
609       },
610       [&](const auto &) -> mlir::Value {
611         fir::emitFatalError(loc, "lower bound inquiry on scalar");
612       });
613   if (lb)
614     return lb;
615   return defaultValue;
616 }
617 
618 llvm::SmallVector<mlir::Value>
619 fir::factory::readExtents(fir::FirOpBuilder &builder, mlir::Location loc,
620                           const fir::BoxValue &box) {
621   llvm::SmallVector<mlir::Value> result;
622   auto explicitExtents = box.getExplicitExtents();
623   if (!explicitExtents.empty()) {
624     result.append(explicitExtents.begin(), explicitExtents.end());
625     return result;
626   }
627   auto rank = box.rank();
628   auto idxTy = builder.getIndexType();
629   for (decltype(rank) dim = 0; dim < rank; ++dim) {
630     auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);
631     auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
632                                                   box.getAddr(), dimVal);
633     result.emplace_back(dimInfo.getResult(1));
634   }
635   return result;
636 }
637 
638 llvm::SmallVector<mlir::Value>
639 fir::factory::getExtents(fir::FirOpBuilder &builder, mlir::Location loc,
640                          const fir::ExtendedValue &box) {
641   return box.match(
642       [&](const fir::ArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {
643         return {x.getExtents().begin(), x.getExtents().end()};
644       },
645       [&](const fir::CharArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {
646         return {x.getExtents().begin(), x.getExtents().end()};
647       },
648       [&](const fir::BoxValue &x) -> llvm::SmallVector<mlir::Value> {
649         return fir::factory::readExtents(builder, loc, x);
650       },
651       [&](const fir::MutableBoxValue &x) -> llvm::SmallVector<mlir::Value> {
652         auto load = fir::factory::genMutableBoxRead(builder, loc, x);
653         return fir::factory::getExtents(builder, loc, load);
654       },
655       [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });
656 }
657 
658 fir::ExtendedValue fir::factory::readBoxValue(fir::FirOpBuilder &builder,
659                                               mlir::Location loc,
660                                               const fir::BoxValue &box) {
661   assert(!box.isUnlimitedPolymorphic() && !box.hasAssumedRank() &&
662          "cannot read unlimited polymorphic or assumed rank fir.box");
663   auto addr =
664       builder.create<fir::BoxAddrOp>(loc, box.getMemTy(), box.getAddr());
665   if (box.isCharacter()) {
666     auto len = fir::factory::readCharLen(builder, loc, box);
667     if (box.rank() == 0)
668       return fir::CharBoxValue(addr, len);
669     return fir::CharArrayBoxValue(addr, len,
670                                   fir::factory::readExtents(builder, loc, box),
671                                   box.getLBounds());
672   }
673   if (box.isDerivedWithLengthParameters())
674     TODO(loc, "read fir.box with length parameters");
675   if (box.rank() == 0)
676     return addr;
677   return fir::ArrayBoxValue(addr, fir::factory::readExtents(builder, loc, box),
678                             box.getLBounds());
679 }
680 
681 llvm::SmallVector<mlir::Value>
682 fir::factory::getNonDefaultLowerBounds(fir::FirOpBuilder &builder,
683                                        mlir::Location loc,
684                                        const fir::ExtendedValue &exv) {
685   return exv.match(
686       [&](const fir::ArrayBoxValue &array) -> llvm::SmallVector<mlir::Value> {
687         return {array.getLBounds().begin(), array.getLBounds().end()};
688       },
689       [&](const fir::CharArrayBoxValue &array)
690           -> llvm::SmallVector<mlir::Value> {
691         return {array.getLBounds().begin(), array.getLBounds().end()};
692       },
693       [&](const fir::BoxValue &box) -> llvm::SmallVector<mlir::Value> {
694         return {box.getLBounds().begin(), box.getLBounds().end()};
695       },
696       [&](const fir::MutableBoxValue &box) -> llvm::SmallVector<mlir::Value> {
697         auto load = fir::factory::genMutableBoxRead(builder, loc, box);
698         return fir::factory::getNonDefaultLowerBounds(builder, loc, load);
699       },
700       [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });
701 }
702 
703 llvm::SmallVector<mlir::Value>
704 fir::factory::getNonDeferredLengthParams(const fir::ExtendedValue &exv) {
705   return exv.match(
706       [&](const fir::CharArrayBoxValue &character)
707           -> llvm::SmallVector<mlir::Value> { return {character.getLen()}; },
708       [&](const fir::CharBoxValue &character)
709           -> llvm::SmallVector<mlir::Value> { return {character.getLen()}; },
710       [&](const fir::MutableBoxValue &box) -> llvm::SmallVector<mlir::Value> {
711         return {box.nonDeferredLenParams().begin(),
712                 box.nonDeferredLenParams().end()};
713       },
714       [&](const fir::BoxValue &box) -> llvm::SmallVector<mlir::Value> {
715         return {box.getExplicitParameters().begin(),
716                 box.getExplicitParameters().end()};
717       },
718       [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });
719 }
720 
721 std::string fir::factory::uniqueCGIdent(llvm::StringRef prefix,
722                                         llvm::StringRef name) {
723   // For "long" identifiers use a hash value
724   if (name.size() > nameLengthHashSize) {
725     llvm::MD5 hash;
726     hash.update(name);
727     llvm::MD5::MD5Result result;
728     hash.final(result);
729     llvm::SmallString<32> str;
730     llvm::MD5::stringifyResult(result, str);
731     std::string hashName = prefix.str();
732     hashName.append(".").append(str.c_str());
733     return fir::NameUniquer::doGenerated(hashName);
734   }
735   // "Short" identifiers use a reversible hex string
736   std::string nm = prefix.str();
737   return fir::NameUniquer::doGenerated(
738       nm.append(".").append(llvm::toHex(name)));
739 }
740 
741 mlir::Value fir::factory::locationToFilename(fir::FirOpBuilder &builder,
742                                              mlir::Location loc) {
743   if (auto flc = loc.dyn_cast<mlir::FileLineColLoc>()) {
744     // must be encoded as asciiz, C string
745     auto fn = flc.getFilename().str() + '\0';
746     return fir::getBase(createStringLiteral(builder, loc, fn));
747   }
748   return builder.createNullConstant(loc);
749 }
750 
751 mlir::Value fir::factory::locationToLineNo(fir::FirOpBuilder &builder,
752                                            mlir::Location loc,
753                                            mlir::Type type) {
754   if (auto flc = loc.dyn_cast<mlir::FileLineColLoc>())
755     return builder.createIntegerConstant(loc, type, flc.getLine());
756   return builder.createIntegerConstant(loc, type, 0);
757 }
758 
759 fir::ExtendedValue fir::factory::createStringLiteral(fir::FirOpBuilder &builder,
760                                                      mlir::Location loc,
761                                                      llvm::StringRef str) {
762   std::string globalName = fir::factory::uniqueCGIdent("cl", str);
763   auto type = fir::CharacterType::get(builder.getContext(), 1, str.size());
764   auto global = builder.getNamedGlobal(globalName);
765   if (!global)
766     global = builder.createGlobalConstant(
767         loc, type, globalName,
768         [&](fir::FirOpBuilder &builder) {
769           auto stringLitOp = builder.createStringLitOp(loc, str);
770           builder.create<fir::HasValueOp>(loc, stringLitOp);
771         },
772         builder.createLinkOnceLinkage());
773   auto addr = builder.create<fir::AddrOfOp>(loc, global.resultType(),
774                                             global.getSymbol());
775   auto len = builder.createIntegerConstant(
776       loc, builder.getCharacterLengthType(), str.size());
777   return fir::CharBoxValue{addr, len};
778 }
779 
780 llvm::SmallVector<mlir::Value>
781 fir::factory::createExtents(fir::FirOpBuilder &builder, mlir::Location loc,
782                             fir::SequenceType seqTy) {
783   llvm::SmallVector<mlir::Value> extents;
784   auto idxTy = builder.getIndexType();
785   for (auto ext : seqTy.getShape())
786     extents.emplace_back(
787         ext == fir::SequenceType::getUnknownExtent()
788             ? builder.create<fir::UndefOp>(loc, idxTy).getResult()
789             : builder.createIntegerConstant(loc, idxTy, ext));
790   return extents;
791 }
792 
793 // FIXME: This needs some work. To correctly determine the extended value of a
794 // component, one needs the base object, its type, and its type parameters. (An
795 // alternative would be to provide an already computed address of the final
796 // component rather than the base object's address, the point being the result
797 // will require the address of the final component to create the extended
798 // value.) One further needs the full path of components being applied. One
799 // needs to apply type-based expressions to type parameters along this said
800 // path. (See applyPathToType for a type-only derivation.) Finally, one needs to
801 // compose the extended value of the terminal component, including all of its
802 // parameters: array lower bounds expressions, extents, type parameters, etc.
803 // Any of these properties may be deferred until runtime in Fortran. This
804 // operation may therefore generate a sizeable block of IR, including calls to
805 // type-based helper functions, so caching the result of this operation in the
806 // client would be advised as well.
807 fir::ExtendedValue fir::factory::componentToExtendedValue(
808     fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value component) {
809   auto fieldTy = component.getType();
810   if (auto ty = fir::dyn_cast_ptrEleTy(fieldTy))
811     fieldTy = ty;
812   if (fieldTy.isa<fir::BoxType>()) {
813     llvm::SmallVector<mlir::Value> nonDeferredTypeParams;
814     auto eleTy = fir::unwrapSequenceType(fir::dyn_cast_ptrOrBoxEleTy(fieldTy));
815     if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) {
816       auto lenTy = builder.getCharacterLengthType();
817       if (charTy.hasConstantLen())
818         nonDeferredTypeParams.emplace_back(
819             builder.createIntegerConstant(loc, lenTy, charTy.getLen()));
820       // TODO: Starting, F2003, the dynamic character length might be dependent
821       // on a PDT length parameter. There is no way to make a difference with
822       // deferred length here yet.
823     }
824     if (auto recTy = eleTy.dyn_cast<fir::RecordType>())
825       if (recTy.getNumLenParams() > 0)
826         TODO(loc, "allocatable and pointer components non deferred length "
827                   "parameters");
828 
829     return fir::MutableBoxValue(component, nonDeferredTypeParams,
830                                 /*mutableProperties=*/{});
831   }
832   llvm::SmallVector<mlir::Value> extents;
833   if (auto seqTy = fieldTy.dyn_cast<fir::SequenceType>()) {
834     fieldTy = seqTy.getEleTy();
835     auto idxTy = builder.getIndexType();
836     for (auto extent : seqTy.getShape()) {
837       if (extent == fir::SequenceType::getUnknownExtent())
838         TODO(loc, "array component shape depending on length parameters");
839       extents.emplace_back(builder.createIntegerConstant(loc, idxTy, extent));
840     }
841   }
842   if (auto charTy = fieldTy.dyn_cast<fir::CharacterType>()) {
843     auto cstLen = charTy.getLen();
844     if (cstLen == fir::CharacterType::unknownLen())
845       TODO(loc, "get character component length from length type parameters");
846     auto len = builder.createIntegerConstant(
847         loc, builder.getCharacterLengthType(), cstLen);
848     if (!extents.empty())
849       return fir::CharArrayBoxValue{component, len, extents};
850     return fir::CharBoxValue{component, len};
851   }
852   if (auto recordTy = fieldTy.dyn_cast<fir::RecordType>())
853     if (recordTy.getNumLenParams() != 0)
854       TODO(loc,
855            "lower component ref that is a derived type with length parameter");
856   if (!extents.empty())
857     return fir::ArrayBoxValue{component, extents};
858   return component;
859 }
860 
861 fir::ExtendedValue fir::factory::arrayElementToExtendedValue(
862     fir::FirOpBuilder &builder, mlir::Location loc,
863     const fir::ExtendedValue &array, mlir::Value element) {
864   return array.match(
865       [&](const fir::CharBoxValue &cb) -> fir::ExtendedValue {
866         return cb.clone(element);
867       },
868       [&](const fir::CharArrayBoxValue &bv) -> fir::ExtendedValue {
869         return bv.cloneElement(element);
870       },
871       [&](const fir::BoxValue &box) -> fir::ExtendedValue {
872         if (box.isCharacter()) {
873           auto len = fir::factory::readCharLen(builder, loc, box);
874           return fir::CharBoxValue{element, len};
875         }
876         if (box.isDerivedWithLengthParameters())
877           TODO(loc, "get length parameters from derived type BoxValue");
878         return element;
879       },
880       [&](const auto &) -> fir::ExtendedValue { return element; });
881 }
882 
883 fir::ExtendedValue fir::factory::arraySectionElementToExtendedValue(
884     fir::FirOpBuilder &builder, mlir::Location loc,
885     const fir::ExtendedValue &array, mlir::Value element, mlir::Value slice) {
886   if (!slice)
887     return arrayElementToExtendedValue(builder, loc, array, element);
888   auto sliceOp = mlir::dyn_cast_or_null<fir::SliceOp>(slice.getDefiningOp());
889   assert(sliceOp && "slice must be a sliceOp");
890   if (sliceOp.getFields().empty())
891     return arrayElementToExtendedValue(builder, loc, array, element);
892   // For F95, using componentToExtendedValue will work, but when PDTs are
893   // lowered. It will be required to go down the slice to propagate the length
894   // parameters.
895   return fir::factory::componentToExtendedValue(builder, loc, element);
896 }
897 
898 mlir::TupleType
899 fir::factory::getRaggedArrayHeaderType(fir::FirOpBuilder &builder) {
900   mlir::IntegerType i64Ty = builder.getIntegerType(64);
901   auto arrTy = fir::SequenceType::get(builder.getIntegerType(8), 1);
902   auto buffTy = fir::HeapType::get(arrTy);
903   auto extTy = fir::SequenceType::get(i64Ty, 1);
904   auto shTy = fir::HeapType::get(extTy);
905   return mlir::TupleType::get(builder.getContext(), {i64Ty, buffTy, shTy});
906 }
907 
908 mlir::Value fir::factory::createZeroValue(fir::FirOpBuilder &builder,
909                                           mlir::Location loc, mlir::Type type) {
910   mlir::Type i1 = builder.getIntegerType(1);
911   if (type.isa<fir::LogicalType>() || type == i1)
912     return builder.createConvert(loc, type, builder.createBool(loc, false));
913   if (fir::isa_integer(type))
914     return builder.createIntegerConstant(loc, type, 0);
915   if (fir::isa_real(type))
916     return builder.createRealZeroConstant(loc, type);
917   if (fir::isa_complex(type)) {
918     fir::factory::Complex complexHelper(builder, loc);
919     mlir::Type partType = complexHelper.getComplexPartType(type);
920     mlir::Value zeroPart = builder.createRealZeroConstant(loc, partType);
921     return complexHelper.createComplex(type, zeroPart, zeroPart);
922   }
923   fir::emitFatalError(loc, "internal: trying to generate zero value of non "
924                            "numeric or logical type");
925 }
926 
927 void fir::factory::genScalarAssignment(fir::FirOpBuilder &builder,
928                                        mlir::Location loc,
929                                        const fir::ExtendedValue &lhs,
930                                        const fir::ExtendedValue &rhs) {
931   assert(lhs.rank() == 0 && rhs.rank() == 0 && "must be scalars");
932   auto type = fir::unwrapSequenceType(
933       fir::unwrapPassByRefType(fir::getBase(lhs).getType()));
934   if (type.isa<fir::CharacterType>()) {
935     const fir::CharBoxValue *toChar = lhs.getCharBox();
936     const fir::CharBoxValue *fromChar = rhs.getCharBox();
937     assert(toChar && fromChar);
938     fir::factory::CharacterExprHelper helper{builder, loc};
939     helper.createAssign(fir::ExtendedValue{*toChar},
940                         fir::ExtendedValue{*fromChar});
941   } else if (type.isa<fir::RecordType>()) {
942     fir::factory::genRecordAssignment(builder, loc, lhs, rhs);
943   } else {
944     assert(!fir::hasDynamicSize(type));
945     auto rhsVal = fir::getBase(rhs);
946     if (fir::isa_ref_type(rhsVal.getType()))
947       rhsVal = builder.create<fir::LoadOp>(loc, rhsVal);
948     mlir::Value lhsAddr = fir::getBase(lhs);
949     rhsVal = builder.createConvert(loc, fir::unwrapRefType(lhsAddr.getType()),
950                                    rhsVal);
951     builder.create<fir::StoreOp>(loc, rhsVal, lhsAddr);
952   }
953 }
954 
955 static void genComponentByComponentAssignment(fir::FirOpBuilder &builder,
956                                               mlir::Location loc,
957                                               const fir::ExtendedValue &lhs,
958                                               const fir::ExtendedValue &rhs) {
959   auto baseType = fir::unwrapPassByRefType(fir::getBase(lhs).getType());
960   auto lhsType = baseType.dyn_cast<fir::RecordType>();
961   assert(lhsType && "lhs must be a scalar record type");
962   auto fieldIndexType = fir::FieldType::get(lhsType.getContext());
963   for (auto [fieldName, fieldType] : lhsType.getTypeList()) {
964     assert(!fir::hasDynamicSize(fieldType));
965     mlir::Value field = builder.create<fir::FieldIndexOp>(
966         loc, fieldIndexType, fieldName, lhsType, fir::getTypeParams(lhs));
967     auto fieldRefType = builder.getRefType(fieldType);
968     mlir::Value fromCoor = builder.create<fir::CoordinateOp>(
969         loc, fieldRefType, fir::getBase(rhs), field);
970     mlir::Value toCoor = builder.create<fir::CoordinateOp>(
971         loc, fieldRefType, fir::getBase(lhs), field);
972     llvm::Optional<fir::DoLoopOp> outerLoop;
973     if (auto sequenceType = fieldType.dyn_cast<fir::SequenceType>()) {
974       // Create loops to assign array components elements by elements.
975       // Note that, since these are components, they either do not overlap,
976       // or are the same and exactly overlap. They also have compile time
977       // constant shapes.
978       mlir::Type idxTy = builder.getIndexType();
979       llvm::SmallVector<mlir::Value> indices;
980       mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);
981       mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
982       for (auto extent : llvm::reverse(sequenceType.getShape())) {
983         // TODO: add zero size test !
984         mlir::Value ub = builder.createIntegerConstant(loc, idxTy, extent - 1);
985         auto loop = builder.create<fir::DoLoopOp>(loc, zero, ub, one);
986         if (!outerLoop)
987           outerLoop = loop;
988         indices.push_back(loop.getInductionVar());
989         builder.setInsertionPointToStart(loop.getBody());
990       }
991       // Set indices in column-major order.
992       std::reverse(indices.begin(), indices.end());
993       auto elementRefType = builder.getRefType(sequenceType.getEleTy());
994       toCoor = builder.create<fir::CoordinateOp>(loc, elementRefType, toCoor,
995                                                  indices);
996       fromCoor = builder.create<fir::CoordinateOp>(loc, elementRefType,
997                                                    fromCoor, indices);
998     }
999     auto fieldElementType = fir::unwrapSequenceType(fieldType);
1000     if (fieldElementType.isa<fir::BoxType>()) {
1001       assert(fieldElementType.cast<fir::BoxType>()
1002                  .getEleTy()
1003                  .isa<fir::PointerType>() &&
1004              "allocatable require deep copy");
1005       auto fromPointerValue = builder.create<fir::LoadOp>(loc, fromCoor);
1006       builder.create<fir::StoreOp>(loc, fromPointerValue, toCoor);
1007     } else {
1008       auto from =
1009           fir::factory::componentToExtendedValue(builder, loc, fromCoor);
1010       auto to = fir::factory::componentToExtendedValue(builder, loc, toCoor);
1011       fir::factory::genScalarAssignment(builder, loc, to, from);
1012     }
1013     if (outerLoop)
1014       builder.setInsertionPointAfter(*outerLoop);
1015   }
1016 }
1017 
1018 /// Can the assignment of this record type be implement with a simple memory
1019 /// copy (it requires no deep copy or user defined assignment of components )?
1020 static bool recordTypeCanBeMemCopied(fir::RecordType recordType) {
1021   if (fir::hasDynamicSize(recordType))
1022     return false;
1023   for (auto [_, fieldType] : recordType.getTypeList()) {
1024     // Derived type component may have user assignment (so far, we cannot tell
1025     // in FIR, so assume it is always the case, TODO: get the actual info).
1026     if (fir::unwrapSequenceType(fieldType).isa<fir::RecordType>())
1027       return false;
1028     // Allocatable components need deep copy.
1029     if (auto boxType = fieldType.dyn_cast<fir::BoxType>())
1030       if (boxType.getEleTy().isa<fir::HeapType>())
1031         return false;
1032   }
1033   // Constant size components without user defined assignment and pointers can
1034   // be memcopied.
1035   return true;
1036 }
1037 
1038 void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder,
1039                                        mlir::Location loc,
1040                                        const fir::ExtendedValue &lhs,
1041                                        const fir::ExtendedValue &rhs) {
1042   assert(lhs.rank() == 0 && rhs.rank() == 0 && "assume scalar assignment");
1043   auto baseTy = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(lhs).getType());
1044   assert(baseTy && "must be a memory type");
1045   // Box operands may be polymorphic, it is not entirely clear from 10.2.1.3
1046   // if the assignment is performed on the dynamic of declared type. Use the
1047   // runtime assuming it is performed on the dynamic type.
1048   bool hasBoxOperands = fir::getBase(lhs).getType().isa<fir::BoxType>() ||
1049                         fir::getBase(rhs).getType().isa<fir::BoxType>();
1050   auto recTy = baseTy.dyn_cast<fir::RecordType>();
1051   assert(recTy && "must be a record type");
1052   if (hasBoxOperands || !recordTypeCanBeMemCopied(recTy)) {
1053     auto to = fir::getBase(builder.createBox(loc, lhs));
1054     auto from = fir::getBase(builder.createBox(loc, rhs));
1055     // The runtime entry point may modify the LHS descriptor if it is
1056     // an allocatable. Allocatable assignment is handle elsewhere in lowering,
1057     // so just create a fir.ref<fir.box<>> from the fir.box to comply with the
1058     // runtime interface, but assume the fir.box is unchanged.
1059     // TODO: does this holds true with polymorphic entities ?
1060     auto toMutableBox = builder.createTemporary(loc, to.getType());
1061     builder.create<fir::StoreOp>(loc, to, toMutableBox);
1062     fir::runtime::genAssign(builder, loc, toMutableBox, from);
1063     return;
1064   }
1065   // Otherwise, the derived type has compile time constant size and for which
1066   // the component by component assignment can be replaced by a memory copy.
1067   // Since we do not know the size of the derived type in lowering, do a
1068   // component by component assignment. Note that a single fir.load/fir.store
1069   // could be used on "small" record types, but as the type size grows, this
1070   // leads to issues in LLVM (long compile times, long IR files, and even
1071   // asserts at some point). Since there is no good size boundary, just always
1072   // use component by component assignment here.
1073   genComponentByComponentAssignment(builder, loc, lhs, rhs);
1074 }
1075 
1076 mlir::Value fir::factory::genLenOfCharacter(
1077     fir::FirOpBuilder &builder, mlir::Location loc, fir::ArrayLoadOp arrLoad,
1078     llvm::ArrayRef<mlir::Value> path, llvm::ArrayRef<mlir::Value> substring) {
1079   llvm::SmallVector<mlir::Value> typeParams(arrLoad.getTypeparams());
1080   return genLenOfCharacter(builder, loc,
1081                            arrLoad.getType().cast<fir::SequenceType>(),
1082                            arrLoad.getMemref(), typeParams, path, substring);
1083 }
1084 
1085 mlir::Value fir::factory::genLenOfCharacter(
1086     fir::FirOpBuilder &builder, mlir::Location loc, fir::SequenceType seqTy,
1087     mlir::Value memref, llvm::ArrayRef<mlir::Value> typeParams,
1088     llvm::ArrayRef<mlir::Value> path, llvm::ArrayRef<mlir::Value> substring) {
1089   auto idxTy = builder.getIndexType();
1090   auto zero = builder.createIntegerConstant(loc, idxTy, 0);
1091   auto saturatedDiff = [&](mlir::Value lower, mlir::Value upper) {
1092     auto diff = builder.create<mlir::arith::SubIOp>(loc, upper, lower);
1093     auto one = builder.createIntegerConstant(loc, idxTy, 1);
1094     auto size = builder.create<mlir::arith::AddIOp>(loc, diff, one);
1095     auto cmp = builder.create<mlir::arith::CmpIOp>(
1096         loc, mlir::arith::CmpIPredicate::sgt, size, zero);
1097     return builder.create<mlir::arith::SelectOp>(loc, cmp, size, zero);
1098   };
1099   if (substring.size() == 2) {
1100     auto upper = builder.createConvert(loc, idxTy, substring.back());
1101     auto lower = builder.createConvert(loc, idxTy, substring.front());
1102     return saturatedDiff(lower, upper);
1103   }
1104   auto lower = zero;
1105   if (substring.size() == 1)
1106     lower = builder.createConvert(loc, idxTy, substring.front());
1107   auto eleTy = fir::applyPathToType(seqTy, path);
1108   if (!fir::hasDynamicSize(eleTy)) {
1109     if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) {
1110       // Use LEN from the type.
1111       return builder.createIntegerConstant(loc, idxTy, charTy.getLen());
1112     }
1113     // Do we need to support !fir.array<!fir.char<k,n>>?
1114     fir::emitFatalError(loc,
1115                         "application of path did not result in a !fir.char");
1116   }
1117   if (fir::isa_box_type(memref.getType())) {
1118     if (memref.getType().isa<fir::BoxCharType>())
1119       return builder.create<fir::BoxCharLenOp>(loc, idxTy, memref);
1120     if (memref.getType().isa<fir::BoxType>())
1121       return CharacterExprHelper(builder, loc).readLengthFromBox(memref);
1122     fir::emitFatalError(loc, "memref has wrong type");
1123   }
1124   if (typeParams.empty()) {
1125     fir::emitFatalError(loc, "array_load must have typeparams");
1126   }
1127   if (fir::isa_char(seqTy.getEleTy())) {
1128     assert(typeParams.size() == 1 && "too many typeparams");
1129     return typeParams.front();
1130   }
1131   TODO(loc, "LEN of character must be computed at runtime");
1132 }
1133