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