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