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/Runtime/Derived.h"
16#include "flang/Optimizer/Builder/Todo.h"
17#include "flang/Optimizer/Dialect/FIRAttr.h"
18#include "flang/Optimizer/Dialect/FIROpsSupport.h"
19#include "flang/Optimizer/Dialect/FIRType.h"
20#include "flang/Optimizer/Support/FatalError.h"
21#include "flang/Optimizer/Support/InternalNames.h"
22#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
23#include "mlir/Dialect/OpenACC/OpenACC.h"
24#include "mlir/Dialect/OpenMP/OpenMPDialect.h"
25#include "llvm/ADT/ArrayRef.h"
26#include "llvm/ADT/StringExtras.h"
27#include "llvm/Support/CommandLine.h"
28#include "llvm/Support/ErrorHandling.h"
29#include "llvm/Support/MD5.h"
30#include <optional>
31
32static llvm::cl::opt<std::size_t>
33 nameLengthHashSize("length-to-hash-string-literal",
34 llvm::cl::desc("string literals that exceed this length"
35 " will use a hash value as their symbol "
36 "name"),
37 llvm::cl::init(Val: 32));
38
39mlir::func::FuncOp
40fir::FirOpBuilder::createFunction(mlir::Location loc, mlir::ModuleOp module,
41 llvm::StringRef name, mlir::FunctionType ty,
42 mlir::SymbolTable *symbolTable) {
43 return fir::createFuncOp(loc, module, name, ty, /*attrs*/ {}, symbolTable);
44}
45
46mlir::func::FuncOp
47fir::FirOpBuilder::getNamedFunction(mlir::ModuleOp modOp,
48 const mlir::SymbolTable *symbolTable,
49 llvm::StringRef name) {
50 if (symbolTable)
51 if (auto func = symbolTable->lookup<mlir::func::FuncOp>(name)) {
52#ifdef EXPENSIVE_CHECKS
53 assert(func == modOp.lookupSymbol<mlir::func::FuncOp>(name) &&
54 "symbolTable and module out of sync");
55#endif
56 return func;
57 }
58 return modOp.lookupSymbol<mlir::func::FuncOp>(name);
59}
60
61mlir::func::FuncOp
62fir::FirOpBuilder::getNamedFunction(mlir::ModuleOp modOp,
63 const mlir::SymbolTable *symbolTable,
64 mlir::SymbolRefAttr symbol) {
65 if (symbolTable)
66 if (auto func = symbolTable->lookup<mlir::func::FuncOp>(
67 symbol.getLeafReference())) {
68#ifdef EXPENSIVE_CHECKS
69 assert(func == modOp.lookupSymbol<mlir::func::FuncOp>(symbol) &&
70 "symbolTable and module out of sync");
71#endif
72 return func;
73 }
74 return modOp.lookupSymbol<mlir::func::FuncOp>(symbol);
75}
76
77fir::GlobalOp
78fir::FirOpBuilder::getNamedGlobal(mlir::ModuleOp modOp,
79 const mlir::SymbolTable *symbolTable,
80 llvm::StringRef name) {
81 if (symbolTable)
82 if (auto global = symbolTable->lookup<fir::GlobalOp>(name)) {
83#ifdef EXPENSIVE_CHECKS
84 assert(global == modOp.lookupSymbol<fir::GlobalOp>(name) &&
85 "symbolTable and module out of sync");
86#endif
87 return global;
88 }
89 return modOp.lookupSymbol<fir::GlobalOp>(name);
90}
91
92mlir::Type fir::FirOpBuilder::getRefType(mlir::Type eleTy) {
93 assert(!eleTy.isa<fir::ReferenceType>() && "cannot be a reference type");
94 return fir::ReferenceType::get(eleTy);
95}
96
97mlir::Type fir::FirOpBuilder::getVarLenSeqTy(mlir::Type eleTy, unsigned rank) {
98 fir::SequenceType::Shape shape(rank, fir::SequenceType::getUnknownExtent());
99 return fir::SequenceType::get(shape, eleTy);
100}
101
102mlir::Type fir::FirOpBuilder::getRealType(int kind) {
103 switch (kindMap.getRealTypeID(kind)) {
104 case llvm::Type::TypeID::HalfTyID:
105 return mlir::FloatType::getF16(getContext());
106 case llvm::Type::TypeID::BFloatTyID:
107 return mlir::FloatType::getBF16(getContext());
108 case llvm::Type::TypeID::FloatTyID:
109 return mlir::FloatType::getF32(getContext());
110 case llvm::Type::TypeID::DoubleTyID:
111 return mlir::FloatType::getF64(getContext());
112 case llvm::Type::TypeID::X86_FP80TyID:
113 return mlir::FloatType::getF80(getContext());
114 case llvm::Type::TypeID::FP128TyID:
115 return mlir::FloatType::getF128(getContext());
116 default:
117 fir::emitFatalError(mlir::UnknownLoc::get(getContext()),
118 "unsupported type !fir.real<kind>");
119 }
120}
121
122mlir::Value fir::FirOpBuilder::createNullConstant(mlir::Location loc,
123 mlir::Type ptrType) {
124 auto ty = ptrType ? ptrType : getRefType(getNoneType());
125 return create<fir::ZeroOp>(loc, ty);
126}
127
128mlir::Value fir::FirOpBuilder::createIntegerConstant(mlir::Location loc,
129 mlir::Type ty,
130 std::int64_t cst) {
131 assert((cst >= 0 || mlir::isa<mlir::IndexType>(ty) ||
132 mlir::cast<mlir::IntegerType>(ty).getWidth() <= 64) &&
133 "must use APint");
134 return create<mlir::arith::ConstantOp>(loc, ty, getIntegerAttr(ty, cst));
135}
136
137mlir::Value fir::FirOpBuilder::createAllOnesInteger(mlir::Location loc,
138 mlir::Type ty) {
139 if (mlir::isa<mlir::IndexType>(ty))
140 return createIntegerConstant(loc, ty, -1);
141 llvm::APInt allOnes =
142 llvm::APInt::getAllOnes(mlir::cast<mlir::IntegerType>(ty).getWidth());
143 return create<mlir::arith::ConstantOp>(loc, ty, getIntegerAttr(ty, allOnes));
144}
145
146mlir::Value
147fir::FirOpBuilder::createRealConstant(mlir::Location loc, mlir::Type fltTy,
148 llvm::APFloat::integerPart val) {
149 auto apf = [&]() -> llvm::APFloat {
150 if (auto ty = fltTy.dyn_cast<fir::RealType>())
151 return llvm::APFloat(kindMap.getFloatSemantics(ty.getFKind()), val);
152 if (fltTy.isF16())
153 return llvm::APFloat(llvm::APFloat::IEEEhalf(), val);
154 if (fltTy.isBF16())
155 return llvm::APFloat(llvm::APFloat::BFloat(), val);
156 if (fltTy.isF32())
157 return llvm::APFloat(llvm::APFloat::IEEEsingle(), val);
158 if (fltTy.isF64())
159 return llvm::APFloat(llvm::APFloat::IEEEdouble(), val);
160 if (fltTy.isF80())
161 return llvm::APFloat(llvm::APFloat::x87DoubleExtended(), val);
162 if (fltTy.isF128())
163 return llvm::APFloat(llvm::APFloat::IEEEquad(), val);
164 llvm_unreachable("unhandled MLIR floating-point type");
165 };
166 return createRealConstant(loc, fltTy, apf());
167}
168
169mlir::Value fir::FirOpBuilder::createRealConstant(mlir::Location loc,
170 mlir::Type fltTy,
171 const llvm::APFloat &value) {
172 if (fltTy.isa<mlir::FloatType>()) {
173 auto attr = getFloatAttr(fltTy, value);
174 return create<mlir::arith::ConstantOp>(loc, fltTy, attr);
175 }
176 llvm_unreachable("should use builtin floating-point type");
177}
178
179static llvm::SmallVector<mlir::Value>
180elideExtentsAlreadyInType(mlir::Type type, mlir::ValueRange shape) {
181 auto arrTy = type.dyn_cast<fir::SequenceType>();
182 if (shape.empty() || !arrTy)
183 return {};
184 // elide the constant dimensions before construction
185 assert(shape.size() == arrTy.getDimension());
186 llvm::SmallVector<mlir::Value> dynamicShape;
187 auto typeShape = arrTy.getShape();
188 for (unsigned i = 0, end = arrTy.getDimension(); i < end; ++i)
189 if (typeShape[i] == fir::SequenceType::getUnknownExtent())
190 dynamicShape.push_back(Elt: shape[i]);
191 return dynamicShape;
192}
193
194static llvm::SmallVector<mlir::Value>
195elideLengthsAlreadyInType(mlir::Type type, mlir::ValueRange lenParams) {
196 if (lenParams.empty())
197 return {};
198 if (auto arrTy = type.dyn_cast<fir::SequenceType>())
199 type = arrTy.getEleTy();
200 if (fir::hasDynamicSize(type))
201 return lenParams;
202 return {};
203}
204
205/// Allocate a local variable.
206/// A local variable ought to have a name in the source code.
207mlir::Value fir::FirOpBuilder::allocateLocal(
208 mlir::Location loc, mlir::Type ty, llvm::StringRef uniqName,
209 llvm::StringRef name, bool pinned, llvm::ArrayRef<mlir::Value> shape,
210 llvm::ArrayRef<mlir::Value> lenParams, bool asTarget) {
211 // Convert the shape extents to `index`, as needed.
212 llvm::SmallVector<mlir::Value> indices;
213 llvm::SmallVector<mlir::Value> elidedShape =
214 elideExtentsAlreadyInType(ty, shape);
215 llvm::SmallVector<mlir::Value> elidedLenParams =
216 elideLengthsAlreadyInType(ty, lenParams);
217 auto idxTy = getIndexType();
218 for (mlir::Value sh : elidedShape)
219 indices.push_back(createConvert(loc, idxTy, sh));
220 // Add a target attribute, if needed.
221 llvm::SmallVector<mlir::NamedAttribute> attrs;
222 if (asTarget)
223 attrs.emplace_back(
224 mlir::StringAttr::get(getContext(), fir::getTargetAttrName()),
225 getUnitAttr());
226 // Create the local variable.
227 if (name.empty()) {
228 if (uniqName.empty())
229 return create<fir::AllocaOp>(loc, ty, pinned, elidedLenParams, indices,
230 attrs);
231 return create<fir::AllocaOp>(loc, ty, uniqName, pinned, elidedLenParams,
232 indices, attrs);
233 }
234 return create<fir::AllocaOp>(loc, ty, uniqName, name, pinned, elidedLenParams,
235 indices, attrs);
236}
237
238mlir::Value fir::FirOpBuilder::allocateLocal(
239 mlir::Location loc, mlir::Type ty, llvm::StringRef uniqName,
240 llvm::StringRef name, llvm::ArrayRef<mlir::Value> shape,
241 llvm::ArrayRef<mlir::Value> lenParams, bool asTarget) {
242 return allocateLocal(loc, ty, uniqName, name, /*pinned=*/false, shape,
243 lenParams, asTarget);
244}
245
246/// Get the block for adding Allocas.
247mlir::Block *fir::FirOpBuilder::getAllocaBlock() {
248 if (auto ompOutlineableIface =
249 getRegion()
250 .getParentOfType<mlir::omp::OutlineableOpenMPOpInterface>()) {
251 return ompOutlineableIface.getAllocaBlock();
252 }
253 if (getRegion().getParentOfType<mlir::omp::DeclareReductionOp>())
254 return &getRegion().front();
255 if (auto accRecipeIface =
256 getRegion().getParentOfType<mlir::acc::RecipeInterface>()) {
257 return accRecipeIface.getAllocaBlock(getRegion());
258 }
259
260 return getEntryBlock();
261}
262
263mlir::Value fir::FirOpBuilder::createTemporaryAlloc(
264 mlir::Location loc, mlir::Type type, llvm::StringRef name,
265 mlir::ValueRange lenParams, mlir::ValueRange shape,
266 llvm::ArrayRef<mlir::NamedAttribute> attrs) {
267 assert(!type.isa<fir::ReferenceType>() && "cannot be a reference");
268 // If the alloca is inside an OpenMP Op which will be outlined then pin
269 // the alloca here.
270 const bool pinned =
271 getRegion().getParentOfType<mlir::omp::OutlineableOpenMPOpInterface>();
272 mlir::Value temp =
273 create<fir::AllocaOp>(loc, type, /*unique_name=*/llvm::StringRef{}, name,
274 pinned, lenParams, shape, attrs);
275 return temp;
276}
277
278/// Create a temporary variable on the stack. Anonymous temporaries have no
279/// `name` value. Temporaries do not require a uniqued name.
280mlir::Value
281fir::FirOpBuilder::createTemporary(mlir::Location loc, mlir::Type type,
282 llvm::StringRef name, mlir::ValueRange shape,
283 mlir::ValueRange lenParams,
284 llvm::ArrayRef<mlir::NamedAttribute> attrs) {
285 llvm::SmallVector<mlir::Value> dynamicShape =
286 elideExtentsAlreadyInType(type, shape);
287 llvm::SmallVector<mlir::Value> dynamicLength =
288 elideLengthsAlreadyInType(type, lenParams);
289 InsertPoint insPt;
290 const bool hoistAlloc = dynamicShape.empty() && dynamicLength.empty();
291 if (hoistAlloc) {
292 insPt = saveInsertionPoint();
293 setInsertionPointToStart(getAllocaBlock());
294 }
295
296 mlir::Value ae =
297 createTemporaryAlloc(loc, type, name, dynamicLength, dynamicShape, attrs);
298
299 if (hoistAlloc)
300 restoreInsertionPoint(insPt);
301 return ae;
302}
303
304mlir::Value fir::FirOpBuilder::createHeapTemporary(
305 mlir::Location loc, mlir::Type type, llvm::StringRef name,
306 mlir::ValueRange shape, mlir::ValueRange lenParams,
307 llvm::ArrayRef<mlir::NamedAttribute> attrs) {
308 llvm::SmallVector<mlir::Value> dynamicShape =
309 elideExtentsAlreadyInType(type, shape);
310 llvm::SmallVector<mlir::Value> dynamicLength =
311 elideLengthsAlreadyInType(type, lenParams);
312
313 assert(!type.isa<fir::ReferenceType>() && "cannot be a reference");
314 return create<fir::AllocMemOp>(loc, type, /*unique_name=*/llvm::StringRef{},
315 name, dynamicLength, dynamicShape, attrs);
316}
317
318/// Create a global variable in the (read-only) data section. A global variable
319/// must have a unique name to identify and reference it.
320fir::GlobalOp fir::FirOpBuilder::createGlobal(
321 mlir::Location loc, mlir::Type type, llvm::StringRef name,
322 mlir::StringAttr linkage, mlir::Attribute value, bool isConst,
323 bool isTarget, fir::CUDADataAttributeAttr cudaAttr) {
324 if (auto global = getNamedGlobal(name))
325 return global;
326 auto module = getModule();
327 auto insertPt = saveInsertionPoint();
328 setInsertionPoint(module.getBody(), module.getBody()->end());
329 llvm::SmallVector<mlir::NamedAttribute> attrs;
330 if (cudaAttr) {
331 auto globalOpName = mlir::OperationName(fir::GlobalOp::getOperationName(),
332 module.getContext());
333 attrs.push_back(mlir::NamedAttribute(
334 fir::GlobalOp::getCudaAttrAttrName(globalOpName), cudaAttr));
335 }
336 auto glob = create<fir::GlobalOp>(loc, name, isConst, isTarget, type, value,
337 linkage, attrs);
338 restoreInsertionPoint(insertPt);
339 if (symbolTable)
340 symbolTable->insert(glob);
341 return glob;
342}
343
344fir::GlobalOp fir::FirOpBuilder::createGlobal(
345 mlir::Location loc, mlir::Type type, llvm::StringRef name, bool isConst,
346 bool isTarget, std::function<void(FirOpBuilder &)> bodyBuilder,
347 mlir::StringAttr linkage, fir::CUDADataAttributeAttr cudaAttr) {
348 if (auto global = getNamedGlobal(name))
349 return global;
350 auto module = getModule();
351 auto insertPt = saveInsertionPoint();
352 setInsertionPoint(module.getBody(), module.getBody()->end());
353 auto glob = create<fir::GlobalOp>(loc, name, isConst, isTarget, type,
354 mlir::Attribute{}, linkage);
355 auto &region = glob.getRegion();
356 region.push_back(new mlir::Block);
357 auto &block = glob.getRegion().back();
358 setInsertionPointToStart(&block);
359 bodyBuilder(*this);
360 restoreInsertionPoint(insertPt);
361 if (symbolTable)
362 symbolTable->insert(glob);
363 return glob;
364}
365
366mlir::Value fir::FirOpBuilder::convertWithSemantics(
367 mlir::Location loc, mlir::Type toTy, mlir::Value val,
368 bool allowCharacterConversion, bool allowRebox) {
369 assert(toTy && "store location must be typed");
370 auto fromTy = val.getType();
371 if (fromTy == toTy)
372 return val;
373 fir::factory::Complex helper{*this, loc};
374 if ((fir::isa_real(fromTy) || fir::isa_integer(fromTy)) &&
375 fir::isa_complex(toTy)) {
376 // imaginary part is zero
377 auto eleTy = helper.getComplexPartType(toTy);
378 auto cast = createConvert(loc, eleTy, val);
379 llvm::APFloat zero{
380 kindMap.getFloatSemantics(toTy.cast<fir::ComplexType>().getFKind()), 0};
381 auto imag = createRealConstant(loc, eleTy, zero);
382 return helper.createComplex(toTy, cast, imag);
383 }
384 if (fir::isa_complex(fromTy) &&
385 (fir::isa_integer(toTy) || fir::isa_real(toTy))) {
386 // drop the imaginary part
387 auto rp = helper.extractComplexPart(val, /*isImagPart=*/false);
388 return createConvert(loc, toTy, rp);
389 }
390 if (allowCharacterConversion) {
391 if (fromTy.isa<fir::BoxCharType>()) {
392 // Extract the address of the character string and pass it
393 fir::factory::CharacterExprHelper charHelper{*this, loc};
394 std::pair<mlir::Value, mlir::Value> unboxchar =
395 charHelper.createUnboxChar(val);
396 return createConvert(loc, toTy, unboxchar.first);
397 }
398 if (auto boxType = toTy.dyn_cast<fir::BoxCharType>()) {
399 // Extract the address of the actual argument and create a boxed
400 // character value with an undefined length
401 // TODO: We should really calculate the total size of the actual
402 // argument in characters and use it as the length of the string
403 auto refType = getRefType(boxType.getEleTy());
404 mlir::Value charBase = createConvert(loc, refType, val);
405 mlir::Value unknownLen = create<fir::UndefOp>(loc, getIndexType());
406 fir::factory::CharacterExprHelper charHelper{*this, loc};
407 return charHelper.createEmboxChar(charBase, unknownLen);
408 }
409 }
410 if (fir::isa_ref_type(toTy) && fir::isa_box_type(fromTy)) {
411 // Call is expecting a raw data pointer, not a box. Get the data pointer out
412 // of the box and pass that.
413 assert((fir::unwrapRefType(toTy) ==
414 fir::unwrapRefType(fir::unwrapPassByRefType(fromTy)) &&
415 "element types expected to match"));
416 return create<fir::BoxAddrOp>(loc, toTy, val);
417 }
418 if (fir::isa_ref_type(fromTy) && toTy.isa<fir::BoxProcType>()) {
419 // Call is expecting a boxed procedure, not a reference to other data type.
420 // Convert the reference to a procedure and embox it.
421 mlir::Type procTy = toTy.cast<fir::BoxProcType>().getEleTy();
422 mlir::Value proc = createConvert(loc, procTy, val);
423 return create<fir::EmboxProcOp>(loc, toTy, proc);
424 }
425
426 // Legacy: remove when removing non HLFIR lowering path.
427 if (allowRebox)
428 if (((fir::isPolymorphicType(fromTy) &&
429 (fir::isAllocatableType(fromTy) || fir::isPointerType(fromTy)) &&
430 fir::isPolymorphicType(toTy)) ||
431 (fir::isPolymorphicType(fromTy) && toTy.isa<fir::BoxType>())) &&
432 !(fir::isUnlimitedPolymorphicType(fromTy) && fir::isAssumedType(toTy)))
433 return create<fir::ReboxOp>(loc, toTy, val, mlir::Value{},
434 /*slice=*/mlir::Value{});
435
436 return createConvert(loc, toTy, val);
437}
438
439mlir::Value fir::FirOpBuilder::createConvert(mlir::Location loc,
440 mlir::Type toTy, mlir::Value val) {
441 if (val.getType() != toTy) {
442 assert(!fir::isa_derived(toTy));
443 return create<fir::ConvertOp>(loc, toTy, val);
444 }
445 return val;
446}
447
448void fir::FirOpBuilder::createStoreWithConvert(mlir::Location loc,
449 mlir::Value val,
450 mlir::Value addr) {
451 mlir::Value cast =
452 createConvert(loc, fir::unwrapRefType(addr.getType()), val);
453 create<fir::StoreOp>(loc, cast, addr);
454}
455
456mlir::Value fir::FirOpBuilder::loadIfRef(mlir::Location loc, mlir::Value val) {
457 if (fir::isa_ref_type(val.getType()))
458 return create<fir::LoadOp>(loc, val);
459 return val;
460}
461
462fir::StringLitOp fir::FirOpBuilder::createStringLitOp(mlir::Location loc,
463 llvm::StringRef data) {
464 auto type = fir::CharacterType::get(getContext(), 1, data.size());
465 auto strAttr = mlir::StringAttr::get(getContext(), data);
466 auto valTag = mlir::StringAttr::get(getContext(), fir::StringLitOp::value());
467 mlir::NamedAttribute dataAttr(valTag, strAttr);
468 auto sizeTag = mlir::StringAttr::get(getContext(), fir::StringLitOp::size());
469 mlir::NamedAttribute sizeAttr(sizeTag, getI64IntegerAttr(data.size()));
470 llvm::SmallVector<mlir::NamedAttribute> attrs{dataAttr, sizeAttr};
471 return create<fir::StringLitOp>(loc, llvm::ArrayRef<mlir::Type>{type},
472 std::nullopt, attrs);
473}
474
475mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
476 llvm::ArrayRef<mlir::Value> exts) {
477 return create<fir::ShapeOp>(loc, exts);
478}
479
480mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
481 llvm::ArrayRef<mlir::Value> shift,
482 llvm::ArrayRef<mlir::Value> exts) {
483 auto shapeType = fir::ShapeShiftType::get(getContext(), exts.size());
484 llvm::SmallVector<mlir::Value> shapeArgs;
485 auto idxTy = getIndexType();
486 for (auto [lbnd, ext] : llvm::zip(shift, exts)) {
487 auto lb = createConvert(loc, idxTy, lbnd);
488 shapeArgs.push_back(lb);
489 shapeArgs.push_back(ext);
490 }
491 return create<fir::ShapeShiftOp>(loc, shapeType, shapeArgs);
492}
493
494mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
495 const fir::AbstractArrayBox &arr) {
496 if (arr.lboundsAllOne())
497 return genShape(loc, arr.getExtents());
498 return genShape(loc, arr.getLBounds(), arr.getExtents());
499}
500
501mlir::Value fir::FirOpBuilder::genShift(mlir::Location loc,
502 llvm::ArrayRef<mlir::Value> shift) {
503 auto shiftType = fir::ShiftType::get(getContext(), shift.size());
504 return create<fir::ShiftOp>(loc, shiftType, shift);
505}
506
507mlir::Value fir::FirOpBuilder::createShape(mlir::Location loc,
508 const fir::ExtendedValue &exv) {
509 return exv.match(
510 [&](const fir::ArrayBoxValue &box) { return genShape(loc, box); },
511 [&](const fir::CharArrayBoxValue &box) { return genShape(loc, box); },
512 [&](const fir::BoxValue &box) -> mlir::Value {
513 if (!box.getLBounds().empty()) {
514 auto shiftType =
515 fir::ShiftType::get(getContext(), box.getLBounds().size());
516 return create<fir::ShiftOp>(loc, shiftType, box.getLBounds());
517 }
518 return {};
519 },
520 [&](const fir::MutableBoxValue &) -> mlir::Value {
521 // MutableBoxValue must be read into another category to work with them
522 // outside of allocation/assignment contexts.
523 fir::emitFatalError(loc, "createShape on MutableBoxValue");
524 },
525 [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });
526}
527
528mlir::Value fir::FirOpBuilder::createSlice(mlir::Location loc,
529 const fir::ExtendedValue &exv,
530 mlir::ValueRange triples,
531 mlir::ValueRange path) {
532 if (triples.empty()) {
533 // If there is no slicing by triple notation, then take the whole array.
534 auto fullShape = [&](const llvm::ArrayRef<mlir::Value> lbounds,
535 llvm::ArrayRef<mlir::Value> extents) -> mlir::Value {
536 llvm::SmallVector<mlir::Value> trips;
537 auto idxTy = getIndexType();
538 auto one = createIntegerConstant(loc, idxTy, 1);
539 if (lbounds.empty()) {
540 for (auto v : extents) {
541 trips.push_back(one);
542 trips.push_back(v);
543 trips.push_back(one);
544 }
545 return create<fir::SliceOp>(loc, trips, path);
546 }
547 for (auto [lbnd, extent] : llvm::zip(lbounds, extents)) {
548 auto lb = createConvert(loc, idxTy, lbnd);
549 auto ext = createConvert(loc, idxTy, extent);
550 auto shift = create<mlir::arith::SubIOp>(loc, lb, one);
551 auto ub = create<mlir::arith::AddIOp>(loc, ext, shift);
552 trips.push_back(lb);
553 trips.push_back(ub);
554 trips.push_back(one);
555 }
556 return create<fir::SliceOp>(loc, trips, path);
557 };
558 return exv.match(
559 [&](const fir::ArrayBoxValue &box) {
560 return fullShape(box.getLBounds(), box.getExtents());
561 },
562 [&](const fir::CharArrayBoxValue &box) {
563 return fullShape(box.getLBounds(), box.getExtents());
564 },
565 [&](const fir::BoxValue &box) {
566 auto extents = fir::factory::readExtents(*this, loc, box);
567 return fullShape(box.getLBounds(), extents);
568 },
569 [&](const fir::MutableBoxValue &) -> mlir::Value {
570 // MutableBoxValue must be read into another category to work with
571 // them outside of allocation/assignment contexts.
572 fir::emitFatalError(loc, "createSlice on MutableBoxValue");
573 },
574 [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });
575 }
576 return create<fir::SliceOp>(loc, triples, path);
577}
578
579mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
580 const fir::ExtendedValue &exv,
581 bool isPolymorphic,
582 bool isAssumedType) {
583 mlir::Value itemAddr = fir::getBase(exv);
584 if (itemAddr.getType().isa<fir::BaseBoxType>())
585 return itemAddr;
586 auto elementType = fir::dyn_cast_ptrEleTy(itemAddr.getType());
587 if (!elementType) {
588 mlir::emitError(loc, "internal: expected a memory reference type ")
589 << itemAddr.getType();
590 llvm_unreachable("not a memory reference type");
591 }
592 mlir::Type boxTy;
593 mlir::Value tdesc;
594 // Avoid to wrap a box/class with box/class.
595 if (elementType.isa<fir::BaseBoxType>()) {
596 boxTy = elementType;
597 } else {
598 boxTy = fir::BoxType::get(elementType);
599 if (isPolymorphic) {
600 elementType = fir::updateTypeForUnlimitedPolymorphic(elementType);
601 if (isAssumedType)
602 boxTy = fir::BoxType::get(elementType);
603 else
604 boxTy = fir::ClassType::get(elementType);
605 }
606 }
607
608 return exv.match(
609 [&](const fir::ArrayBoxValue &box) -> mlir::Value {
610 mlir::Value empty;
611 mlir::ValueRange emptyRange;
612 mlir::Value s = createShape(loc, exv);
613 return create<fir::EmboxOp>(loc, boxTy, itemAddr, s, /*slice=*/empty,
614 /*typeparams=*/emptyRange,
615 isPolymorphic ? box.getSourceBox() : tdesc);
616 },
617 [&](const fir::CharArrayBoxValue &box) -> mlir::Value {
618 mlir::Value s = createShape(loc, exv);
619 if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))
620 return create<fir::EmboxOp>(loc, boxTy, itemAddr, s);
621
622 mlir::Value emptySlice;
623 llvm::SmallVector<mlir::Value> lenParams{box.getLen()};
624 return create<fir::EmboxOp>(loc, boxTy, itemAddr, s, emptySlice,
625 lenParams);
626 },
627 [&](const fir::CharBoxValue &box) -> mlir::Value {
628 if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))
629 return create<fir::EmboxOp>(loc, boxTy, itemAddr);
630 mlir::Value emptyShape, emptySlice;
631 llvm::SmallVector<mlir::Value> lenParams{box.getLen()};
632 return create<fir::EmboxOp>(loc, boxTy, itemAddr, emptyShape,
633 emptySlice, lenParams);
634 },
635 [&](const fir::MutableBoxValue &x) -> mlir::Value {
636 return create<fir::LoadOp>(
637 loc, fir::factory::getMutableIRBox(*this, loc, x));
638 },
639 [&](const fir::PolymorphicValue &p) -> mlir::Value {
640 mlir::Value empty;
641 mlir::ValueRange emptyRange;
642 return create<fir::EmboxOp>(loc, boxTy, itemAddr, empty, empty,
643 emptyRange,
644 isPolymorphic ? p.getSourceBox() : tdesc);
645 },
646 [&](const auto &) -> mlir::Value {
647 mlir::Value empty;
648 mlir::ValueRange emptyRange;
649 return create<fir::EmboxOp>(loc, boxTy, itemAddr, empty, empty,
650 emptyRange, tdesc);
651 });
652}
653
654mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc, mlir::Type boxType,
655 mlir::Value addr, mlir::Value shape,
656 mlir::Value slice,
657 llvm::ArrayRef<mlir::Value> lengths,
658 mlir::Value tdesc) {
659 mlir::Type valueOrSequenceType = fir::unwrapPassByRefType(boxType);
660 return create<fir::EmboxOp>(
661 loc, boxType, addr, shape, slice,
662 elideLengthsAlreadyInType(valueOrSequenceType, lengths), tdesc);
663}
664
665void fir::FirOpBuilder::dumpFunc() { getFunction().dump(); }
666
667static mlir::Value
668genNullPointerComparison(fir::FirOpBuilder &builder, mlir::Location loc,
669 mlir::Value addr,
670 mlir::arith::CmpIPredicate condition) {
671 auto intPtrTy = builder.getIntPtrType();
672 auto ptrToInt = builder.createConvert(loc, intPtrTy, addr);
673 auto c0 = builder.createIntegerConstant(loc, intPtrTy, 0);
674 return builder.create<mlir::arith::CmpIOp>(loc, condition, ptrToInt, c0);
675}
676
677mlir::Value fir::FirOpBuilder::genIsNotNullAddr(mlir::Location loc,
678 mlir::Value addr) {
679 return genNullPointerComparison(*this, loc, addr,
680 mlir::arith::CmpIPredicate::ne);
681}
682
683mlir::Value fir::FirOpBuilder::genIsNullAddr(mlir::Location loc,
684 mlir::Value addr) {
685 return genNullPointerComparison(*this, loc, addr,
686 mlir::arith::CmpIPredicate::eq);
687}
688
689mlir::Value fir::FirOpBuilder::genExtentFromTriplet(mlir::Location loc,
690 mlir::Value lb,
691 mlir::Value ub,
692 mlir::Value step,
693 mlir::Type type) {
694 auto zero = createIntegerConstant(loc, type, 0);
695 lb = createConvert(loc, type, lb);
696 ub = createConvert(loc, type, ub);
697 step = createConvert(loc, type, step);
698 auto diff = create<mlir::arith::SubIOp>(loc, ub, lb);
699 auto add = create<mlir::arith::AddIOp>(loc, diff, step);
700 auto div = create<mlir::arith::DivSIOp>(loc, add, step);
701 auto cmp = create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::sgt,
702 div, zero);
703 return create<mlir::arith::SelectOp>(loc, cmp, div, zero);
704}
705
706mlir::Value fir::FirOpBuilder::genAbsentOp(mlir::Location loc,
707 mlir::Type argTy) {
708 if (!fir::isCharacterProcedureTuple(argTy))
709 return create<fir::AbsentOp>(loc, argTy);
710
711 auto boxProc =
712 create<fir::AbsentOp>(loc, argTy.cast<mlir::TupleType>().getType(0));
713 mlir::Value charLen = create<fir::UndefOp>(loc, getCharacterLengthType());
714 return fir::factory::createCharacterProcedureTuple(*this, loc, argTy, boxProc,
715 charLen);
716}
717
718void fir::FirOpBuilder::setCommonAttributes(mlir::Operation *op) const {
719 auto fmi = mlir::dyn_cast<mlir::arith::ArithFastMathInterface>(*op);
720 if (!fmi)
721 return;
722 // TODO: use fmi.setFastMathFlagsAttr() after D137114 is merged.
723 // For now set the attribute by the name.
724 llvm::StringRef arithFMFAttrName = fmi.getFastMathAttrName();
725 if (fastMathFlags != mlir::arith::FastMathFlags::none)
726 op->setAttr(arithFMFAttrName, mlir::arith::FastMathFlagsAttr::get(
727 op->getContext(), fastMathFlags));
728}
729
730void fir::FirOpBuilder::setFastMathFlags(
731 Fortran::common::MathOptionsBase options) {
732 mlir::arith::FastMathFlags arithFMF{};
733 if (options.getFPContractEnabled()) {
734 arithFMF = arithFMF | mlir::arith::FastMathFlags::contract;
735 }
736 if (options.getNoHonorInfs()) {
737 arithFMF = arithFMF | mlir::arith::FastMathFlags::ninf;
738 }
739 if (options.getNoHonorNaNs()) {
740 arithFMF = arithFMF | mlir::arith::FastMathFlags::nnan;
741 }
742 if (options.getApproxFunc()) {
743 arithFMF = arithFMF | mlir::arith::FastMathFlags::afn;
744 }
745 if (options.getNoSignedZeros()) {
746 arithFMF = arithFMF | mlir::arith::FastMathFlags::nsz;
747 }
748 if (options.getAssociativeMath()) {
749 arithFMF = arithFMF | mlir::arith::FastMathFlags::reassoc;
750 }
751 if (options.getReciprocalMath()) {
752 arithFMF = arithFMF | mlir::arith::FastMathFlags::arcp;
753 }
754 setFastMathFlags(arithFMF);
755}
756
757//===--------------------------------------------------------------------===//
758// ExtendedValue inquiry helper implementation
759//===--------------------------------------------------------------------===//
760
761mlir::Value fir::factory::readCharLen(fir::FirOpBuilder &builder,
762 mlir::Location loc,
763 const fir::ExtendedValue &box) {
764 return box.match(
765 [&](const fir::CharBoxValue &x) -> mlir::Value { return x.getLen(); },
766 [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
767 return x.getLen();
768 },
769 [&](const fir::BoxValue &x) -> mlir::Value {
770 assert(x.isCharacter());
771 if (!x.getExplicitParameters().empty())
772 return x.getExplicitParameters()[0];
773 return fir::factory::CharacterExprHelper{builder, loc}
774 .readLengthFromBox(x.getAddr());
775 },
776 [&](const fir::MutableBoxValue &x) -> mlir::Value {
777 return readCharLen(builder, loc,
778 fir::factory::genMutableBoxRead(builder, loc, x));
779 },
780 [&](const auto &) -> mlir::Value {
781 fir::emitFatalError(
782 loc, "Character length inquiry on a non-character entity");
783 });
784}
785
786mlir::Value fir::factory::readExtent(fir::FirOpBuilder &builder,
787 mlir::Location loc,
788 const fir::ExtendedValue &box,
789 unsigned dim) {
790 assert(box.rank() > dim);
791 return box.match(
792 [&](const fir::ArrayBoxValue &x) -> mlir::Value {
793 return x.getExtents()[dim];
794 },
795 [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
796 return x.getExtents()[dim];
797 },
798 [&](const fir::BoxValue &x) -> mlir::Value {
799 if (!x.getExplicitExtents().empty())
800 return x.getExplicitExtents()[dim];
801 auto idxTy = builder.getIndexType();
802 auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);
803 return builder
804 .create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, x.getAddr(),
805 dimVal)
806 .getResult(1);
807 },
808 [&](const fir::MutableBoxValue &x) -> mlir::Value {
809 return readExtent(builder, loc,
810 fir::factory::genMutableBoxRead(builder, loc, x),
811 dim);
812 },
813 [&](const auto &) -> mlir::Value {
814 fir::emitFatalError(loc, "extent inquiry on scalar");
815 });
816}
817
818mlir::Value fir::factory::readLowerBound(fir::FirOpBuilder &builder,
819 mlir::Location loc,
820 const fir::ExtendedValue &box,
821 unsigned dim,
822 mlir::Value defaultValue) {
823 assert(box.rank() > dim);
824 auto lb = box.match(
825 [&](const fir::ArrayBoxValue &x) -> mlir::Value {
826 return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
827 },
828 [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
829 return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
830 },
831 [&](const fir::BoxValue &x) -> mlir::Value {
832 return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
833 },
834 [&](const fir::MutableBoxValue &x) -> mlir::Value {
835 return readLowerBound(builder, loc,
836 fir::factory::genMutableBoxRead(builder, loc, x),
837 dim, defaultValue);
838 },
839 [&](const auto &) -> mlir::Value {
840 fir::emitFatalError(loc, "lower bound inquiry on scalar");
841 });
842 if (lb)
843 return lb;
844 return defaultValue;
845}
846
847llvm::SmallVector<mlir::Value>
848fir::factory::readExtents(fir::FirOpBuilder &builder, mlir::Location loc,
849 const fir::BoxValue &box) {
850 llvm::SmallVector<mlir::Value> result;
851 auto explicitExtents = box.getExplicitExtents();
852 if (!explicitExtents.empty()) {
853 result.append(explicitExtents.begin(), explicitExtents.end());
854 return result;
855 }
856 auto rank = box.rank();
857 auto idxTy = builder.getIndexType();
858 for (decltype(rank) dim = 0; dim < rank; ++dim) {
859 auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);
860 auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
861 box.getAddr(), dimVal);
862 result.emplace_back(dimInfo.getResult(1));
863 }
864 return result;
865}
866
867llvm::SmallVector<mlir::Value>
868fir::factory::getExtents(mlir::Location loc, fir::FirOpBuilder &builder,
869 const fir::ExtendedValue &box) {
870 return box.match(
871 [&](const fir::ArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {
872 return {x.getExtents().begin(), x.getExtents().end()};
873 },
874 [&](const fir::CharArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {
875 return {x.getExtents().begin(), x.getExtents().end()};
876 },
877 [&](const fir::BoxValue &x) -> llvm::SmallVector<mlir::Value> {
878 return fir::factory::readExtents(builder, loc, x);
879 },
880 [&](const fir::MutableBoxValue &x) -> llvm::SmallVector<mlir::Value> {
881 auto load = fir::factory::genMutableBoxRead(builder, loc, x);
882 return fir::factory::getExtents(loc, builder, load);
883 },
884 [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });
885}
886
887fir::ExtendedValue fir::factory::readBoxValue(fir::FirOpBuilder &builder,
888 mlir::Location loc,
889 const fir::BoxValue &box) {
890 assert(!box.hasAssumedRank() &&
891 "cannot read unlimited polymorphic or assumed rank fir.box");
892 auto addr =
893 builder.create<fir::BoxAddrOp>(loc, box.getMemTy(), box.getAddr());
894 if (box.isCharacter()) {
895 auto len = fir::factory::readCharLen(builder, loc, box);
896 if (box.rank() == 0)
897 return fir::CharBoxValue(addr, len);
898 return fir::CharArrayBoxValue(addr, len,
899 fir::factory::readExtents(builder, loc, box),
900 box.getLBounds());
901 }
902 if (box.isDerivedWithLenParameters())
903 TODO(loc, "read fir.box with length parameters");
904 mlir::Value sourceBox;
905 if (box.isPolymorphic())
906 sourceBox = box.getAddr();
907 if (box.isPolymorphic() && box.rank() == 0)
908 return fir::PolymorphicValue(addr, sourceBox);
909 if (box.rank() == 0)
910 return addr;
911 return fir::ArrayBoxValue(addr, fir::factory::readExtents(builder, loc, box),
912 box.getLBounds(), sourceBox);
913}
914
915llvm::SmallVector<mlir::Value>
916fir::factory::getNonDefaultLowerBounds(fir::FirOpBuilder &builder,
917 mlir::Location loc,
918 const fir::ExtendedValue &exv) {
919 return exv.match(
920 [&](const fir::ArrayBoxValue &array) -> llvm::SmallVector<mlir::Value> {
921 return {array.getLBounds().begin(), array.getLBounds().end()};
922 },
923 [&](const fir::CharArrayBoxValue &array)
924 -> llvm::SmallVector<mlir::Value> {
925 return {array.getLBounds().begin(), array.getLBounds().end()};
926 },
927 [&](const fir::BoxValue &box) -> llvm::SmallVector<mlir::Value> {
928 return {box.getLBounds().begin(), box.getLBounds().end()};
929 },
930 [&](const fir::MutableBoxValue &box) -> llvm::SmallVector<mlir::Value> {
931 auto load = fir::factory::genMutableBoxRead(builder, loc, box);
932 return fir::factory::getNonDefaultLowerBounds(builder, loc, load);
933 },
934 [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });
935}
936
937llvm::SmallVector<mlir::Value>
938fir::factory::getNonDeferredLenParams(const fir::ExtendedValue &exv) {
939 return exv.match(
940 [&](const fir::CharArrayBoxValue &character)
941 -> llvm::SmallVector<mlir::Value> { return {character.getLen()}; },
942 [&](const fir::CharBoxValue &character)
943 -> llvm::SmallVector<mlir::Value> { return {character.getLen()}; },
944 [&](const fir::MutableBoxValue &box) -> llvm::SmallVector<mlir::Value> {
945 return {box.nonDeferredLenParams().begin(),
946 box.nonDeferredLenParams().end()};
947 },
948 [&](const fir::BoxValue &box) -> llvm::SmallVector<mlir::Value> {
949 return {box.getExplicitParameters().begin(),
950 box.getExplicitParameters().end()};
951 },
952 [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });
953}
954
955// If valTy is a box type, then we need to extract the type parameters from
956// the box value.
957static llvm::SmallVector<mlir::Value> getFromBox(mlir::Location loc,
958 fir::FirOpBuilder &builder,
959 mlir::Type valTy,
960 mlir::Value boxVal) {
961 if (auto boxTy = valTy.dyn_cast<fir::BaseBoxType>()) {
962 auto eleTy = fir::unwrapAllRefAndSeqType(boxTy.getEleTy());
963 if (auto recTy = eleTy.dyn_cast<fir::RecordType>()) {
964 if (recTy.getNumLenParams() > 0) {
965 // Walk each type parameter in the record and get the value.
966 TODO(loc, "generate code to get LEN type parameters");
967 }
968 } else if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) {
969 if (charTy.hasDynamicLen()) {
970 auto idxTy = builder.getIndexType();
971 auto eleSz = builder.create<fir::BoxEleSizeOp>(loc, idxTy, boxVal);
972 auto kindBytes =
973 builder.getKindMap().getCharacterBitsize(charTy.getFKind()) / 8;
974 mlir::Value charSz =
975 builder.createIntegerConstant(loc, idxTy, kindBytes);
976 mlir::Value len =
977 builder.create<mlir::arith::DivSIOp>(loc, eleSz, charSz);
978 return {len};
979 }
980 }
981 }
982 return {};
983}
984
985// fir::getTypeParams() will get the type parameters from the extended value.
986// When the extended value is a BoxValue or MutableBoxValue, it may be necessary
987// to generate code, so this factory function handles those cases.
988// TODO: fix the inverted type tests, etc.
989llvm::SmallVector<mlir::Value>
990fir::factory::getTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
991 const fir::ExtendedValue &exv) {
992 auto handleBoxed = [&](const auto &box) -> llvm::SmallVector<mlir::Value> {
993 if (box.isCharacter())
994 return {fir::factory::readCharLen(builder, loc, exv)};
995 if (box.isDerivedWithLenParameters()) {
996 // This should generate code to read the type parameters from the box.
997 // This requires some consideration however as MutableBoxValues need to be
998 // in a sane state to be provide the correct values.
999 TODO(loc, "derived type with type parameters");
1000 }
1001 return {};
1002 };
1003 // Intentionally reuse the original code path to get type parameters for the
1004 // cases that were supported rather than introduce a new path.
1005 return exv.match(
1006 [&](const fir::BoxValue &box) { return handleBoxed(box); },
1007 [&](const fir::MutableBoxValue &box) { return handleBoxed(box); },
1008 [&](const auto &) { return fir::getTypeParams(exv); });
1009}
1010
1011llvm::SmallVector<mlir::Value>
1012fir::factory::getTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
1013 fir::ArrayLoadOp load) {
1014 mlir::Type memTy = load.getMemref().getType();
1015 if (auto boxTy = memTy.dyn_cast<fir::BaseBoxType>())
1016 return getFromBox(loc, builder, boxTy, load.getMemref());
1017 return load.getTypeparams();
1018}
1019
1020std::string fir::factory::uniqueCGIdent(llvm::StringRef prefix,
1021 llvm::StringRef name) {
1022 // For "long" identifiers use a hash value
1023 if (name.size() > nameLengthHashSize) {
1024 llvm::MD5 hash;
1025 hash.update(name);
1026 llvm::MD5::MD5Result result;
1027 hash.final(result);
1028 llvm::SmallString<32> str;
1029 llvm::MD5::stringifyResult(result, str);
1030 std::string hashName = prefix.str();
1031 hashName.append("X").append(str.c_str());
1032 return fir::NameUniquer::doGenerated(hashName);
1033 }
1034 // "Short" identifiers use a reversible hex string
1035 std::string nm = prefix.str();
1036 return fir::NameUniquer::doGenerated(
1037 nm.append("X").append(llvm::toHex(name)));
1038}
1039
1040mlir::Value fir::factory::locationToFilename(fir::FirOpBuilder &builder,
1041 mlir::Location loc) {
1042 if (auto flc = loc.dyn_cast<mlir::FileLineColLoc>()) {
1043 // must be encoded as asciiz, C string
1044 auto fn = flc.getFilename().str() + '\0';
1045 return fir::getBase(createStringLiteral(builder, loc, fn));
1046 }
1047 return builder.createNullConstant(loc);
1048}
1049
1050mlir::Value fir::factory::locationToLineNo(fir::FirOpBuilder &builder,
1051 mlir::Location loc,
1052 mlir::Type type) {
1053 if (auto flc = loc.dyn_cast<mlir::FileLineColLoc>())
1054 return builder.createIntegerConstant(loc, type, flc.getLine());
1055 return builder.createIntegerConstant(loc, type, 0);
1056}
1057
1058fir::ExtendedValue fir::factory::createStringLiteral(fir::FirOpBuilder &builder,
1059 mlir::Location loc,
1060 llvm::StringRef str) {
1061 std::string globalName = fir::factory::uniqueCGIdent("cl", str);
1062 auto type = fir::CharacterType::get(builder.getContext(), 1, str.size());
1063 auto global = builder.getNamedGlobal(globalName);
1064 if (!global)
1065 global = builder.createGlobalConstant(
1066 loc, type, globalName,
1067 [&](fir::FirOpBuilder &builder) {
1068 auto stringLitOp = builder.createStringLitOp(loc, str);
1069 builder.create<fir::HasValueOp>(loc, stringLitOp);
1070 },
1071 builder.createLinkOnceLinkage());
1072 auto addr = builder.create<fir::AddrOfOp>(loc, global.resultType(),
1073 global.getSymbol());
1074 auto len = builder.createIntegerConstant(
1075 loc, builder.getCharacterLengthType(), str.size());
1076 return fir::CharBoxValue{addr, len};
1077}
1078
1079llvm::SmallVector<mlir::Value>
1080fir::factory::createExtents(fir::FirOpBuilder &builder, mlir::Location loc,
1081 fir::SequenceType seqTy) {
1082 llvm::SmallVector<mlir::Value> extents;
1083 auto idxTy = builder.getIndexType();
1084 for (auto ext : seqTy.getShape())
1085 extents.emplace_back(
1086 ext == fir::SequenceType::getUnknownExtent()
1087 ? builder.create<fir::UndefOp>(loc, idxTy).getResult()
1088 : builder.createIntegerConstant(loc, idxTy, ext));
1089 return extents;
1090}
1091
1092// FIXME: This needs some work. To correctly determine the extended value of a
1093// component, one needs the base object, its type, and its type parameters. (An
1094// alternative would be to provide an already computed address of the final
1095// component rather than the base object's address, the point being the result
1096// will require the address of the final component to create the extended
1097// value.) One further needs the full path of components being applied. One
1098// needs to apply type-based expressions to type parameters along this said
1099// path. (See applyPathToType for a type-only derivation.) Finally, one needs to
1100// compose the extended value of the terminal component, including all of its
1101// parameters: array lower bounds expressions, extents, type parameters, etc.
1102// Any of these properties may be deferred until runtime in Fortran. This
1103// operation may therefore generate a sizeable block of IR, including calls to
1104// type-based helper functions, so caching the result of this operation in the
1105// client would be advised as well.
1106fir::ExtendedValue fir::factory::componentToExtendedValue(
1107 fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value component) {
1108 auto fieldTy = component.getType();
1109 if (auto ty = fir::dyn_cast_ptrEleTy(fieldTy))
1110 fieldTy = ty;
1111 if (fieldTy.isa<fir::BaseBoxType>()) {
1112 llvm::SmallVector<mlir::Value> nonDeferredTypeParams;
1113 auto eleTy = fir::unwrapSequenceType(fir::dyn_cast_ptrOrBoxEleTy(fieldTy));
1114 if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) {
1115 auto lenTy = builder.getCharacterLengthType();
1116 if (charTy.hasConstantLen())
1117 nonDeferredTypeParams.emplace_back(
1118 builder.createIntegerConstant(loc, lenTy, charTy.getLen()));
1119 // TODO: Starting, F2003, the dynamic character length might be dependent
1120 // on a PDT length parameter. There is no way to make a difference with
1121 // deferred length here yet.
1122 }
1123 if (auto recTy = eleTy.dyn_cast<fir::RecordType>())
1124 if (recTy.getNumLenParams() > 0)
1125 TODO(loc, "allocatable and pointer components non deferred length "
1126 "parameters");
1127
1128 return fir::MutableBoxValue(component, nonDeferredTypeParams,
1129 /*mutableProperties=*/{});
1130 }
1131 llvm::SmallVector<mlir::Value> extents;
1132 if (auto seqTy = fieldTy.dyn_cast<fir::SequenceType>()) {
1133 fieldTy = seqTy.getEleTy();
1134 auto idxTy = builder.getIndexType();
1135 for (auto extent : seqTy.getShape()) {
1136 if (extent == fir::SequenceType::getUnknownExtent())
1137 TODO(loc, "array component shape depending on length parameters");
1138 extents.emplace_back(builder.createIntegerConstant(loc, idxTy, extent));
1139 }
1140 }
1141 if (auto charTy = fieldTy.dyn_cast<fir::CharacterType>()) {
1142 auto cstLen = charTy.getLen();
1143 if (cstLen == fir::CharacterType::unknownLen())
1144 TODO(loc, "get character component length from length type parameters");
1145 auto len = builder.createIntegerConstant(
1146 loc, builder.getCharacterLengthType(), cstLen);
1147 if (!extents.empty())
1148 return fir::CharArrayBoxValue{component, len, extents};
1149 return fir::CharBoxValue{component, len};
1150 }
1151 if (auto recordTy = fieldTy.dyn_cast<fir::RecordType>())
1152 if (recordTy.getNumLenParams() != 0)
1153 TODO(loc,
1154 "lower component ref that is a derived type with length parameter");
1155 if (!extents.empty())
1156 return fir::ArrayBoxValue{component, extents};
1157 return component;
1158}
1159
1160fir::ExtendedValue fir::factory::arrayElementToExtendedValue(
1161 fir::FirOpBuilder &builder, mlir::Location loc,
1162 const fir::ExtendedValue &array, mlir::Value element) {
1163 return array.match(
1164 [&](const fir::CharBoxValue &cb) -> fir::ExtendedValue {
1165 return cb.clone(element);
1166 },
1167 [&](const fir::CharArrayBoxValue &bv) -> fir::ExtendedValue {
1168 return bv.cloneElement(element);
1169 },
1170 [&](const fir::BoxValue &box) -> fir::ExtendedValue {
1171 if (box.isCharacter()) {
1172 auto len = fir::factory::readCharLen(builder, loc, box);
1173 return fir::CharBoxValue{element, len};
1174 }
1175 if (box.isDerivedWithLenParameters())
1176 TODO(loc, "get length parameters from derived type BoxValue");
1177 if (box.isPolymorphic()) {
1178 return fir::PolymorphicValue(element, fir::getBase(box));
1179 }
1180 return element;
1181 },
1182 [&](const fir::ArrayBoxValue &box) -> fir::ExtendedValue {
1183 if (box.getSourceBox())
1184 return fir::PolymorphicValue(element, box.getSourceBox());
1185 return element;
1186 },
1187 [&](const auto &) -> fir::ExtendedValue { return element; });
1188}
1189
1190fir::ExtendedValue fir::factory::arraySectionElementToExtendedValue(
1191 fir::FirOpBuilder &builder, mlir::Location loc,
1192 const fir::ExtendedValue &array, mlir::Value element, mlir::Value slice) {
1193 if (!slice)
1194 return arrayElementToExtendedValue(builder, loc, array, element);
1195 auto sliceOp = mlir::dyn_cast_or_null<fir::SliceOp>(slice.getDefiningOp());
1196 assert(sliceOp && "slice must be a sliceOp");
1197 if (sliceOp.getFields().empty())
1198 return arrayElementToExtendedValue(builder, loc, array, element);
1199 // For F95, using componentToExtendedValue will work, but when PDTs are
1200 // lowered. It will be required to go down the slice to propagate the length
1201 // parameters.
1202 return fir::factory::componentToExtendedValue(builder, loc, element);
1203}
1204
1205void fir::factory::genScalarAssignment(fir::FirOpBuilder &builder,
1206 mlir::Location loc,
1207 const fir::ExtendedValue &lhs,
1208 const fir::ExtendedValue &rhs,
1209 bool needFinalization,
1210 bool isTemporaryLHS) {
1211 assert(lhs.rank() == 0 && rhs.rank() == 0 && "must be scalars");
1212 auto type = fir::unwrapSequenceType(
1213 fir::unwrapPassByRefType(fir::getBase(lhs).getType()));
1214 if (type.isa<fir::CharacterType>()) {
1215 const fir::CharBoxValue *toChar = lhs.getCharBox();
1216 const fir::CharBoxValue *fromChar = rhs.getCharBox();
1217 assert(toChar && fromChar);
1218 fir::factory::CharacterExprHelper helper{builder, loc};
1219 helper.createAssign(fir::ExtendedValue{*toChar},
1220 fir::ExtendedValue{*fromChar});
1221 } else if (type.isa<fir::RecordType>()) {
1222 fir::factory::genRecordAssignment(builder, loc, lhs, rhs, needFinalization,
1223 isTemporaryLHS);
1224 } else {
1225 assert(!fir::hasDynamicSize(type));
1226 auto rhsVal = fir::getBase(rhs);
1227 if (fir::isa_ref_type(rhsVal.getType()))
1228 rhsVal = builder.create<fir::LoadOp>(loc, rhsVal);
1229 mlir::Value lhsAddr = fir::getBase(lhs);
1230 rhsVal = builder.createConvert(loc, fir::unwrapRefType(lhsAddr.getType()),
1231 rhsVal);
1232 builder.create<fir::StoreOp>(loc, rhsVal, lhsAddr);
1233 }
1234}
1235
1236static void genComponentByComponentAssignment(fir::FirOpBuilder &builder,
1237 mlir::Location loc,
1238 const fir::ExtendedValue &lhs,
1239 const fir::ExtendedValue &rhs,
1240 bool isTemporaryLHS) {
1241 auto lbaseType = fir::unwrapPassByRefType(fir::getBase(lhs).getType());
1242 auto lhsType = lbaseType.dyn_cast<fir::RecordType>();
1243 assert(lhsType && "lhs must be a scalar record type");
1244 auto rbaseType = fir::unwrapPassByRefType(fir::getBase(rhs).getType());
1245 auto rhsType = rbaseType.dyn_cast<fir::RecordType>();
1246 assert(rhsType && "rhs must be a scalar record type");
1247 auto fieldIndexType = fir::FieldType::get(lhsType.getContext());
1248 for (auto [lhsPair, rhsPair] :
1249 llvm::zip(lhsType.getTypeList(), rhsType.getTypeList())) {
1250 auto &[lFieldName, lFieldTy] = lhsPair;
1251 auto &[rFieldName, rFieldTy] = rhsPair;
1252 assert(!fir::hasDynamicSize(lFieldTy) && !fir::hasDynamicSize(rFieldTy));
1253 mlir::Value rField = builder.create<fir::FieldIndexOp>(
1254 loc, fieldIndexType, rFieldName, rhsType, fir::getTypeParams(rhs));
1255 auto rFieldRefType = builder.getRefType(rFieldTy);
1256 mlir::Value fromCoor = builder.create<fir::CoordinateOp>(
1257 loc, rFieldRefType, fir::getBase(rhs), rField);
1258 mlir::Value field = builder.create<fir::FieldIndexOp>(
1259 loc, fieldIndexType, lFieldName, lhsType, fir::getTypeParams(lhs));
1260 auto fieldRefType = builder.getRefType(lFieldTy);
1261 mlir::Value toCoor = builder.create<fir::CoordinateOp>(
1262 loc, fieldRefType, fir::getBase(lhs), field);
1263 std::optional<fir::DoLoopOp> outerLoop;
1264 if (auto sequenceType = lFieldTy.dyn_cast<fir::SequenceType>()) {
1265 // Create loops to assign array components elements by elements.
1266 // Note that, since these are components, they either do not overlap,
1267 // or are the same and exactly overlap. They also have compile time
1268 // constant shapes.
1269 mlir::Type idxTy = builder.getIndexType();
1270 llvm::SmallVector<mlir::Value> indices;
1271 mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);
1272 mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
1273 for (auto extent : llvm::reverse(sequenceType.getShape())) {
1274 // TODO: add zero size test !
1275 mlir::Value ub = builder.createIntegerConstant(loc, idxTy, extent - 1);
1276 auto loop = builder.create<fir::DoLoopOp>(loc, zero, ub, one);
1277 if (!outerLoop)
1278 outerLoop = loop;
1279 indices.push_back(loop.getInductionVar());
1280 builder.setInsertionPointToStart(loop.getBody());
1281 }
1282 // Set indices in column-major order.
1283 std::reverse(indices.begin(), indices.end());
1284 auto elementRefType = builder.getRefType(sequenceType.getEleTy());
1285 toCoor = builder.create<fir::CoordinateOp>(loc, elementRefType, toCoor,
1286 indices);
1287 fromCoor = builder.create<fir::CoordinateOp>(loc, elementRefType,
1288 fromCoor, indices);
1289 }
1290 if (auto fieldEleTy = fir::unwrapSequenceType(lFieldTy);
1291 fieldEleTy.isa<fir::BaseBoxType>()) {
1292 assert(fieldEleTy.cast<fir::BaseBoxType>()
1293 .getEleTy()
1294 .isa<fir::PointerType>() &&
1295 "allocatable members require deep copy");
1296 auto fromPointerValue = builder.create<fir::LoadOp>(loc, fromCoor);
1297 auto castTo = builder.createConvert(loc, fieldEleTy, fromPointerValue);
1298 builder.create<fir::StoreOp>(loc, castTo, toCoor);
1299 } else {
1300 auto from =
1301 fir::factory::componentToExtendedValue(builder, loc, fromCoor);
1302 auto to = fir::factory::componentToExtendedValue(builder, loc, toCoor);
1303 // If LHS finalization is needed it is expected to be done
1304 // for the parent record, so that component-by-component
1305 // assignments may avoid finalization calls.
1306 fir::factory::genScalarAssignment(builder, loc, to, from,
1307 /*needFinalization=*/false,
1308 isTemporaryLHS);
1309 }
1310 if (outerLoop)
1311 builder.setInsertionPointAfter(*outerLoop);
1312 }
1313}
1314
1315/// Can the assignment of this record type be implement with a simple memory
1316/// copy (it requires no deep copy or user defined assignment of components )?
1317static bool recordTypeCanBeMemCopied(fir::RecordType recordType) {
1318 if (fir::hasDynamicSize(recordType))
1319 return false;
1320 for (auto [_, fieldType] : recordType.getTypeList()) {
1321 // Derived type component may have user assignment (so far, we cannot tell
1322 // in FIR, so assume it is always the case, TODO: get the actual info).
1323 if (fir::unwrapSequenceType(fieldType).isa<fir::RecordType>())
1324 return false;
1325 // Allocatable components need deep copy.
1326 if (auto boxType = fieldType.dyn_cast<fir::BaseBoxType>())
1327 if (boxType.getEleTy().isa<fir::HeapType>())
1328 return false;
1329 }
1330 // Constant size components without user defined assignment and pointers can
1331 // be memcopied.
1332 return true;
1333}
1334
1335static bool mayHaveFinalizer(fir::RecordType recordType,
1336 fir::FirOpBuilder &builder) {
1337 if (auto typeInfo = builder.getModule().lookupSymbol<fir::TypeInfoOp>(
1338 recordType.getName()))
1339 return !typeInfo.getNoFinal();
1340 // No info, be pessimistic.
1341 return true;
1342}
1343
1344void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder,
1345 mlir::Location loc,
1346 const fir::ExtendedValue &lhs,
1347 const fir::ExtendedValue &rhs,
1348 bool needFinalization,
1349 bool isTemporaryLHS) {
1350 assert(lhs.rank() == 0 && rhs.rank() == 0 && "assume scalar assignment");
1351 auto baseTy = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(lhs).getType());
1352 assert(baseTy && "must be a memory type");
1353 // Box operands may be polymorphic, it is not entirely clear from 10.2.1.3
1354 // if the assignment is performed on the dynamic of declared type. Use the
1355 // runtime assuming it is performed on the dynamic type.
1356 bool hasBoxOperands = fir::getBase(lhs).getType().isa<fir::BaseBoxType>() ||
1357 fir::getBase(rhs).getType().isa<fir::BaseBoxType>();
1358 auto recTy = baseTy.dyn_cast<fir::RecordType>();
1359 assert(recTy && "must be a record type");
1360 if ((needFinalization && mayHaveFinalizer(recTy, builder)) ||
1361 hasBoxOperands || !recordTypeCanBeMemCopied(recTy)) {
1362 auto to = fir::getBase(builder.createBox(loc, lhs));
1363 auto from = fir::getBase(builder.createBox(loc, rhs));
1364 // The runtime entry point may modify the LHS descriptor if it is
1365 // an allocatable. Allocatable assignment is handle elsewhere in lowering,
1366 // so just create a fir.ref<fir.box<>> from the fir.box to comply with the
1367 // runtime interface, but assume the fir.box is unchanged.
1368 // TODO: does this holds true with polymorphic entities ?
1369 auto toMutableBox = builder.createTemporary(loc, to.getType());
1370 builder.create<fir::StoreOp>(loc, to, toMutableBox);
1371 if (isTemporaryLHS)
1372 fir::runtime::genAssignTemporary(builder, loc, toMutableBox, from);
1373 else
1374 fir::runtime::genAssign(builder, loc, toMutableBox, from);
1375 return;
1376 }
1377
1378 // Otherwise, the derived type has compile time constant size and for which
1379 // the component by component assignment can be replaced by a memory copy.
1380 // Since we do not know the size of the derived type in lowering, do a
1381 // component by component assignment. Note that a single fir.load/fir.store
1382 // could be used on "small" record types, but as the type size grows, this
1383 // leads to issues in LLVM (long compile times, long IR files, and even
1384 // asserts at some point). Since there is no good size boundary, just always
1385 // use component by component assignment here.
1386 genComponentByComponentAssignment(builder, loc, lhs, rhs, isTemporaryLHS);
1387}
1388
1389mlir::TupleType
1390fir::factory::getRaggedArrayHeaderType(fir::FirOpBuilder &builder) {
1391 mlir::IntegerType i64Ty = builder.getIntegerType(64);
1392 auto arrTy = fir::SequenceType::get(builder.getIntegerType(8), 1);
1393 auto buffTy = fir::HeapType::get(arrTy);
1394 auto extTy = fir::SequenceType::get(i64Ty, 1);
1395 auto shTy = fir::HeapType::get(extTy);
1396 return mlir::TupleType::get(builder.getContext(), {i64Ty, buffTy, shTy});
1397}
1398
1399mlir::Value fir::factory::genLenOfCharacter(
1400 fir::FirOpBuilder &builder, mlir::Location loc, fir::ArrayLoadOp arrLoad,
1401 llvm::ArrayRef<mlir::Value> path, llvm::ArrayRef<mlir::Value> substring) {
1402 llvm::SmallVector<mlir::Value> typeParams(arrLoad.getTypeparams());
1403 return genLenOfCharacter(builder, loc,
1404 arrLoad.getType().cast<fir::SequenceType>(),
1405 arrLoad.getMemref(), typeParams, path, substring);
1406}
1407
1408mlir::Value fir::factory::genLenOfCharacter(
1409 fir::FirOpBuilder &builder, mlir::Location loc, fir::SequenceType seqTy,
1410 mlir::Value memref, llvm::ArrayRef<mlir::Value> typeParams,
1411 llvm::ArrayRef<mlir::Value> path, llvm::ArrayRef<mlir::Value> substring) {
1412 auto idxTy = builder.getIndexType();
1413 auto zero = builder.createIntegerConstant(loc, idxTy, 0);
1414 auto saturatedDiff = [&](mlir::Value lower, mlir::Value upper) {
1415 auto diff = builder.create<mlir::arith::SubIOp>(loc, upper, lower);
1416 auto one = builder.createIntegerConstant(loc, idxTy, 1);
1417 auto size = builder.create<mlir::arith::AddIOp>(loc, diff, one);
1418 auto cmp = builder.create<mlir::arith::CmpIOp>(
1419 loc, mlir::arith::CmpIPredicate::sgt, size, zero);
1420 return builder.create<mlir::arith::SelectOp>(loc, cmp, size, zero);
1421 };
1422 if (substring.size() == 2) {
1423 auto upper = builder.createConvert(loc, idxTy, substring.back());
1424 auto lower = builder.createConvert(loc, idxTy, substring.front());
1425 return saturatedDiff(lower, upper);
1426 }
1427 auto lower = zero;
1428 if (substring.size() == 1)
1429 lower = builder.createConvert(loc, idxTy, substring.front());
1430 auto eleTy = fir::applyPathToType(seqTy, path);
1431 if (!fir::hasDynamicSize(eleTy)) {
1432 if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) {
1433 // Use LEN from the type.
1434 return builder.createIntegerConstant(loc, idxTy, charTy.getLen());
1435 }
1436 // Do we need to support !fir.array<!fir.char<k,n>>?
1437 fir::emitFatalError(loc,
1438 "application of path did not result in a !fir.char");
1439 }
1440 if (fir::isa_box_type(memref.getType())) {
1441 if (memref.getType().isa<fir::BoxCharType>())
1442 return builder.create<fir::BoxCharLenOp>(loc, idxTy, memref);
1443 if (memref.getType().isa<fir::BoxType>())
1444 return CharacterExprHelper(builder, loc).readLengthFromBox(memref);
1445 fir::emitFatalError(loc, "memref has wrong type");
1446 }
1447 if (typeParams.empty()) {
1448 fir::emitFatalError(loc, "array_load must have typeparams");
1449 }
1450 if (fir::isa_char(seqTy.getEleTy())) {
1451 assert(typeParams.size() == 1 && "too many typeparams");
1452 return typeParams.front();
1453 }
1454 TODO(loc, "LEN of character must be computed at runtime");
1455}
1456
1457mlir::Value fir::factory::createZeroValue(fir::FirOpBuilder &builder,
1458 mlir::Location loc, mlir::Type type) {
1459 mlir::Type i1 = builder.getIntegerType(1);
1460 if (type.isa<fir::LogicalType>() || type == i1)
1461 return builder.createConvert(loc, type, builder.createBool(loc, false));
1462 if (fir::isa_integer(type))
1463 return builder.createIntegerConstant(loc, type, 0);
1464 if (fir::isa_real(type))
1465 return builder.createRealZeroConstant(loc, type);
1466 if (fir::isa_complex(type)) {
1467 fir::factory::Complex complexHelper(builder, loc);
1468 mlir::Type partType = complexHelper.getComplexPartType(type);
1469 mlir::Value zeroPart = builder.createRealZeroConstant(loc, partType);
1470 return complexHelper.createComplex(type, zeroPart, zeroPart);
1471 }
1472 fir::emitFatalError(loc, "internal: trying to generate zero value of non "
1473 "numeric or logical type");
1474}
1475
1476std::optional<std::int64_t>
1477fir::factory::getExtentFromTriplet(mlir::Value lb, mlir::Value ub,
1478 mlir::Value stride) {
1479 std::function<std::optional<std::int64_t>(mlir::Value)> getConstantValue =
1480 [&](mlir::Value value) -> std::optional<std::int64_t> {
1481 if (auto valInt = fir::getIntIfConstant(value))
1482 return *valInt;
1483 auto *definingOp = value.getDefiningOp();
1484 if (mlir::isa_and_nonnull<fir::ConvertOp>(definingOp)) {
1485 auto valOp = mlir::dyn_cast<fir::ConvertOp>(definingOp);
1486 return getConstantValue(valOp.getValue());
1487 }
1488 return {};
1489 };
1490 if (auto lbInt = getConstantValue(lb)) {
1491 if (auto ubInt = getConstantValue(ub)) {
1492 if (auto strideInt = getConstantValue(stride)) {
1493 if (*strideInt != 0) {
1494 std::int64_t extent = 1 + (*ubInt - *lbInt) / *strideInt;
1495 if (extent > 0)
1496 return extent;
1497 }
1498 }
1499 }
1500 }
1501 return {};
1502}
1503
1504mlir::Value fir::factory::genMaxWithZero(fir::FirOpBuilder &builder,
1505 mlir::Location loc,
1506 mlir::Value value) {
1507 mlir::Value zero = builder.createIntegerConstant(loc, value.getType(), 0);
1508 if (mlir::Operation *definingOp = value.getDefiningOp())
1509 if (auto cst = mlir::dyn_cast<mlir::arith::ConstantOp>(definingOp))
1510 if (auto intAttr = cst.getValue().dyn_cast<mlir::IntegerAttr>())
1511 return intAttr.getInt() > 0 ? value : zero;
1512 mlir::Value valueIsGreater = builder.create<mlir::arith::CmpIOp>(
1513 loc, mlir::arith::CmpIPredicate::sgt, value, zero);
1514 return builder.create<mlir::arith::SelectOp>(loc, valueIsGreater, value,
1515 zero);
1516}
1517
1518mlir::Value fir::factory::genCPtrOrCFunptrAddr(fir::FirOpBuilder &builder,
1519 mlir::Location loc,
1520 mlir::Value cPtr,
1521 mlir::Type ty) {
1522 assert(ty.isa<fir::RecordType>());
1523 auto recTy = ty.dyn_cast<fir::RecordType>();
1524 assert(recTy.getTypeList().size() == 1);
1525 auto fieldName = recTy.getTypeList()[0].first;
1526 mlir::Type fieldTy = recTy.getTypeList()[0].second;
1527 auto fieldIndexType = fir::FieldType::get(ty.getContext());
1528 mlir::Value field =
1529 builder.create<fir::FieldIndexOp>(loc, fieldIndexType, fieldName, recTy,
1530 /*typeParams=*/mlir::ValueRange{});
1531 return builder.create<fir::CoordinateOp>(loc, builder.getRefType(fieldTy),
1532 cPtr, field);
1533}
1534
1535fir::BoxValue fir::factory::createBoxValue(fir::FirOpBuilder &builder,
1536 mlir::Location loc,
1537 const fir::ExtendedValue &exv) {
1538 if (auto *boxValue = exv.getBoxOf<fir::BoxValue>())
1539 return *boxValue;
1540 mlir::Value box = builder.createBox(loc, exv);
1541 llvm::SmallVector<mlir::Value> lbounds;
1542 llvm::SmallVector<mlir::Value> explicitTypeParams;
1543 exv.match(
1544 [&](const fir::ArrayBoxValue &box) {
1545 lbounds.append(box.getLBounds().begin(), box.getLBounds().end());
1546 },
1547 [&](const fir::CharArrayBoxValue &box) {
1548 lbounds.append(box.getLBounds().begin(), box.getLBounds().end());
1549 explicitTypeParams.emplace_back(box.getLen());
1550 },
1551 [&](const fir::CharBoxValue &box) {
1552 explicitTypeParams.emplace_back(box.getLen());
1553 },
1554 [&](const fir::MutableBoxValue &x) {
1555 if (x.rank() > 0) {
1556 // The resulting box lbounds must be coming from the mutable box.
1557 fir::ExtendedValue boxVal =
1558 fir::factory::genMutableBoxRead(builder, loc, x);
1559 // Make sure we do not recurse infinitely.
1560 if (boxVal.getBoxOf<fir::MutableBoxValue>())
1561 fir::emitFatalError(loc, "mutable box read cannot be mutable box");
1562 fir::BoxValue box =
1563 fir::factory::createBoxValue(builder, loc, boxVal);
1564 lbounds.append(box.getLBounds().begin(), box.getLBounds().end());
1565 }
1566 explicitTypeParams.append(x.nonDeferredLenParams().begin(),
1567 x.nonDeferredLenParams().end());
1568 },
1569 [](const auto &) {});
1570 return fir::BoxValue(box, lbounds, explicitTypeParams);
1571}
1572
1573mlir::Value fir::factory::genCPtrOrCFunptrValue(fir::FirOpBuilder &builder,
1574 mlir::Location loc,
1575 mlir::Value cPtr) {
1576 mlir::Type cPtrTy = fir::unwrapRefType(cPtr.getType());
1577 mlir::Value cPtrAddr =
1578 fir::factory::genCPtrOrCFunptrAddr(builder, loc, cPtr, cPtrTy);
1579 return builder.create<fir::LoadOp>(loc, cPtrAddr);
1580}
1581
1582mlir::Value fir::factory::createNullBoxProc(fir::FirOpBuilder &builder,
1583 mlir::Location loc,
1584 mlir::Type boxType) {
1585 auto boxTy{boxType.dyn_cast<fir::BoxProcType>()};
1586 if (!boxTy)
1587 fir::emitFatalError(loc, "Procedure pointer must be of BoxProcType");
1588 auto boxEleTy{fir::unwrapRefType(boxTy.getEleTy())};
1589 mlir::Value initVal{builder.create<fir::ZeroOp>(loc, boxEleTy)};
1590 return builder.create<fir::EmboxProcOp>(loc, boxTy, initVal);
1591}
1592
1593void fir::factory::setInternalLinkage(mlir::func::FuncOp func) {
1594 auto internalLinkage = mlir::LLVM::linkage::Linkage::Internal;
1595 auto linkage =
1596 mlir::LLVM::LinkageAttr::get(func->getContext(), internalLinkage);
1597 func->setAttr("llvm.linkage", linkage);
1598}
1599

source code of flang/lib/Optimizer/Builder/FIRBuilder.cpp