1//===-- HLFIROps.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// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
10//
11//===----------------------------------------------------------------------===//
12
13#include "flang/Optimizer/HLFIR/HLFIROps.h"
14
15#include "flang/Optimizer/Dialect/FIROpsSupport.h"
16#include "flang/Optimizer/Dialect/FIRType.h"
17#include "flang/Optimizer/Dialect/Support/FIRContext.h"
18#include "flang/Optimizer/HLFIR/HLFIRDialect.h"
19#include "mlir/IR/Builders.h"
20#include "mlir/IR/BuiltinAttributes.h"
21#include "mlir/IR/BuiltinTypes.h"
22#include "mlir/IR/DialectImplementation.h"
23#include "mlir/IR/Matchers.h"
24#include "mlir/IR/OpImplementation.h"
25#include "llvm/ADT/APInt.h"
26#include "llvm/ADT/TypeSwitch.h"
27#include "llvm/Support/CommandLine.h"
28#include <iterator>
29#include <mlir/Interfaces/SideEffectInterfaces.h>
30#include <optional>
31#include <tuple>
32
33static llvm::cl::opt<bool> useStrictIntrinsicVerifier(
34 "strict-intrinsic-verifier", llvm::cl::init(Val: false),
35 llvm::cl::desc("use stricter verifier for HLFIR intrinsic operations"));
36
37/// generic implementation of the memory side effects interface for hlfir
38/// transformational intrinsic operations
39static void
40getIntrinsicEffects(mlir::Operation *self,
41 llvm::SmallVectorImpl<mlir::SideEffects::EffectInstance<
42 mlir::MemoryEffects::Effect>> &effects) {
43 // allocation effect if we return an expr
44 assert(self->getNumResults() == 1 &&
45 "hlfir intrinsic ops only produce 1 result");
46 if (mlir::isa<hlfir::ExprType>(self->getResult(0).getType()))
47 effects.emplace_back(mlir::MemoryEffects::Allocate::get(),
48 self->getOpResult(0),
49 mlir::SideEffects::DefaultResource::get());
50
51 // read effect if we read from a pointer or refference type
52 // or a box who'se pointer is read from inside of the intrinsic so that
53 // loop conflicts can be detected in code like
54 // hlfir.region_assign {
55 // %2 = hlfir.transpose %0#0 : (!fir.box<!fir.array<?x?xf32>>) ->
56 // !hlfir.expr<?x?xf32> hlfir.yield %2 : !hlfir.expr<?x?xf32> cleanup {
57 // hlfir.destroy %2 : !hlfir.expr<?x?xf32>
58 // }
59 // } to {
60 // hlfir.yield %0#0 : !fir.box<!fir.array<?x?xf32>>
61 // }
62 for (mlir::OpOperand &operand : self->getOpOperands()) {
63 mlir::Type opTy = operand.get().getType();
64 fir::addVolatileMemoryEffects({opTy}, effects);
65 if (fir::isa_ref_type(opTy) || fir::isa_box_type(opTy))
66 effects.emplace_back(mlir::MemoryEffects::Read::get(), &operand,
67 mlir::SideEffects::DefaultResource::get());
68 }
69}
70
71/// Verification helper for checking if two types are the same.
72/// Set \p allowCharacterLenMismatch to true, if character types
73/// of different known lengths should be treated as the same.
74template <typename Op>
75static llvm::LogicalResult areMatchingTypes(Op &op, mlir::Type type1,
76 mlir::Type type2,
77 bool allowCharacterLenMismatch) {
78 if (auto charType1 = mlir::dyn_cast<fir::CharacterType>(type1))
79 if (auto charType2 = mlir::dyn_cast<fir::CharacterType>(type2)) {
80 // Character kinds must match.
81 if (charType1.getFKind() != charType2.getFKind())
82 return op.emitOpError("character KIND mismatch");
83
84 // Constant propagation can result in mismatching lengths
85 // in the dead code, but we should not fail on this.
86 if (!allowCharacterLenMismatch)
87 if (charType1.getLen() != fir::CharacterType::unknownLen() &&
88 charType2.getLen() != fir::CharacterType::unknownLen() &&
89 charType1.getLen() != charType2.getLen())
90 return op.emitOpError("character LEN mismatch");
91
92 return mlir::success();
93 }
94
95 return type1 == type2 ? mlir::success() : mlir::failure();
96}
97
98//===----------------------------------------------------------------------===//
99// AssignOp
100//===----------------------------------------------------------------------===//
101
102/// Is this a fir.[ref/ptr/heap]<fir.[box/class]<fir.heap<T>>> type?
103static bool isAllocatableBoxRef(mlir::Type type) {
104 fir::BaseBoxType boxType =
105 mlir::dyn_cast_or_null<fir::BaseBoxType>(fir::dyn_cast_ptrEleTy(type));
106 return boxType && mlir::isa<fir::HeapType>(boxType.getEleTy());
107}
108
109llvm::LogicalResult hlfir::AssignOp::verify() {
110 mlir::Type lhsType = getLhs().getType();
111 if (isAllocatableAssignment() && !isAllocatableBoxRef(lhsType))
112 return emitOpError("lhs must be an allocatable when `realloc` is set");
113 if (mustKeepLhsLengthInAllocatableAssignment() &&
114 !(isAllocatableAssignment() &&
115 mlir::isa<fir::CharacterType>(hlfir::getFortranElementType(lhsType))))
116 return emitOpError("`realloc` must be set and lhs must be a character "
117 "allocatable when `keep_lhs_length_if_realloc` is set");
118 return mlir::success();
119}
120
121void hlfir::AssignOp::getEffects(
122 llvm::SmallVectorImpl<
123 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
124 &effects) {
125 mlir::OpOperand &rhs = getRhsMutable();
126 mlir::OpOperand &lhs = getLhsMutable();
127 mlir::Type rhsType = getRhs().getType();
128 mlir::Type lhsType = getLhs().getType();
129 if (mlir::isa<fir::RecordType>(hlfir::getFortranElementType(lhsType))) {
130 // For derived type assignments, set unknown read/write effects since it
131 // is not known here if user defined finalization is needed, and also
132 // because allocatable components may lead to "deeper" read/write effects
133 // that cannot be described with this API.
134 effects.emplace_back(mlir::MemoryEffects::Read::get(),
135 mlir::SideEffects::DefaultResource::get());
136 effects.emplace_back(mlir::MemoryEffects::Write::get(),
137 mlir::SideEffects::DefaultResource::get());
138 } else {
139 // Read effect when RHS is a variable.
140 if (hlfir::isFortranVariableType(rhsType)) {
141 if (hlfir::isBoxAddressType(rhsType)) {
142 // Unknown read effect if the RHS is a descriptor since the read effect
143 // on the data cannot be described.
144 effects.emplace_back(mlir::MemoryEffects::Read::get(),
145 mlir::SideEffects::DefaultResource::get());
146 } else {
147 effects.emplace_back(mlir::MemoryEffects::Read::get(), &rhs,
148 mlir::SideEffects::DefaultResource::get());
149 }
150 }
151
152 // Write effects on LHS.
153 if (hlfir::isBoxAddressType(lhsType)) {
154 // If the LHS is a descriptor, the descriptor will be read and the data
155 // write cannot be described in this API (and the descriptor may be
156 // written to in case of realloc, which is covered by the unknown write
157 // effect.
158 effects.emplace_back(mlir::MemoryEffects::Read::get(), &lhs,
159 mlir::SideEffects::DefaultResource::get());
160 effects.emplace_back(mlir::MemoryEffects::Write::get(),
161 mlir::SideEffects::DefaultResource::get());
162 } else {
163 effects.emplace_back(mlir::MemoryEffects::Write::get(), &lhs,
164 mlir::SideEffects::DefaultResource::get());
165 }
166 }
167
168 fir::addVolatileMemoryEffects({lhsType, rhsType}, effects);
169
170 if (getRealloc()) {
171 // Reallocation of the data cannot be precisely described by this API.
172 effects.emplace_back(mlir::MemoryEffects::Free::get(),
173 mlir::SideEffects::DefaultResource::get());
174 effects.emplace_back(mlir::MemoryEffects::Allocate::get(),
175 mlir::SideEffects::DefaultResource::get());
176 }
177}
178
179//===----------------------------------------------------------------------===//
180// DeclareOp
181//===----------------------------------------------------------------------===//
182
183static std::pair<mlir::Type, mlir::Type>
184getDeclareOutputTypes(mlir::Type inputType, bool hasExplicitLowerBounds) {
185 // Drop pointer/allocatable attribute of descriptor values. Only descriptor
186 // addresses are ALLOCATABLE/POINTER. The HLFIR box result of an hlfir.declare
187 // without those attributes should not have these attributes set.
188 if (auto baseBoxType = mlir::dyn_cast<fir::BaseBoxType>(inputType))
189 if (baseBoxType.isPointerOrAllocatable()) {
190 mlir::Type boxWithoutAttributes =
191 baseBoxType.getBoxTypeWithNewAttr(fir::BaseBoxType::Attribute::None);
192 return {boxWithoutAttributes, boxWithoutAttributes};
193 }
194 mlir::Type type = fir::unwrapRefType(inputType);
195 if (mlir::isa<fir::BaseBoxType>(type))
196 return {inputType, inputType};
197 if (auto charType = mlir::dyn_cast<fir::CharacterType>(type))
198 if (charType.hasDynamicLen()) {
199 mlir::Type hlfirType =
200 fir::BoxCharType::get(charType.getContext(), charType.getFKind());
201 return {hlfirType, inputType};
202 }
203
204 auto seqType = mlir::dyn_cast<fir::SequenceType>(type);
205 bool hasDynamicExtents =
206 seqType && fir::sequenceWithNonConstantShape(seqType);
207 mlir::Type eleType = seqType ? seqType.getEleTy() : type;
208 bool hasDynamicLengthParams = fir::characterWithDynamicLen(eleType) ||
209 fir::isRecordWithTypeParameters(eleType);
210 if (hasExplicitLowerBounds || hasDynamicExtents || hasDynamicLengthParams) {
211 mlir::Type boxType =
212 fir::BoxType::get(type, fir::isa_volatile_type(inputType));
213 return {boxType, inputType};
214 }
215 return {inputType, inputType};
216}
217
218/// Given a FIR memory type, and information about non default lower bounds, get
219/// the related HLFIR variable type.
220mlir::Type hlfir::DeclareOp::getHLFIRVariableType(mlir::Type inputType,
221 bool hasExplicitLowerBounds) {
222 return getDeclareOutputTypes(inputType, hasExplicitLowerBounds).first;
223}
224
225static bool hasExplicitLowerBounds(mlir::Value shape) {
226 return shape &&
227 mlir::isa<fir::ShapeShiftType, fir::ShiftType>(shape.getType());
228}
229
230static std::pair<mlir::Type, mlir::Value>
231updateDeclaredInputTypeWithVolatility(mlir::Type inputType, mlir::Value memref,
232 mlir::OpBuilder &builder,
233 fir::FortranVariableFlagsEnum flags) {
234 if (!bitEnumContainsAny(flags,
235 fir::FortranVariableFlagsEnum::fortran_volatile)) {
236 return std::make_pair(inputType, memref);
237 }
238
239 // A volatile pointer's pointee is volatile.
240 const bool isPointer =
241 bitEnumContainsAny(flags, fir::FortranVariableFlagsEnum::pointer);
242 // An allocatable's inner type's volatility matches that of the reference.
243 const bool isAllocatable =
244 bitEnumContainsAny(flags, fir::FortranVariableFlagsEnum::allocatable);
245
246 auto updateType = [&](auto t) {
247 using FIRT = decltype(t);
248 auto elementType = t.getEleTy();
249 const bool elementTypeIsBox = mlir::isa<fir::BaseBoxType>(elementType);
250 const bool elementTypeIsVolatile = isPointer || isAllocatable ||
251 elementTypeIsBox ||
252 fir::isa_volatile_type(elementType);
253 auto newEleTy =
254 fir::updateTypeWithVolatility(elementType, elementTypeIsVolatile);
255 inputType = FIRT::get(newEleTy, true);
256 };
257 llvm::TypeSwitch<mlir::Type>(inputType)
258 .Case<fir::ReferenceType, fir::BoxType, fir::ClassType>(updateType);
259 memref =
260 builder.create<fir::VolatileCastOp>(memref.getLoc(), inputType, memref);
261 return std::make_pair(inputType, memref);
262}
263
264void hlfir::DeclareOp::build(mlir::OpBuilder &builder,
265 mlir::OperationState &result, mlir::Value memref,
266 llvm::StringRef uniq_name, mlir::Value shape,
267 mlir::ValueRange typeparams,
268 mlir::Value dummy_scope,
269 fir::FortranVariableFlagsAttr fortran_attrs,
270 cuf::DataAttributeAttr data_attr) {
271 auto nameAttr = builder.getStringAttr(uniq_name);
272 mlir::Type inputType = memref.getType();
273 bool hasExplicitLbs = hasExplicitLowerBounds(shape);
274 if (fortran_attrs) {
275 const auto flags = fortran_attrs.getFlags();
276 std::tie(inputType, memref) = updateDeclaredInputTypeWithVolatility(
277 inputType, memref, builder, flags);
278 }
279 auto [hlfirVariableType, firVarType] =
280 getDeclareOutputTypes(inputType, hasExplicitLbs);
281 build(builder, result, {hlfirVariableType, firVarType}, memref, shape,
282 typeparams, dummy_scope, nameAttr, fortran_attrs, data_attr);
283}
284
285llvm::LogicalResult hlfir::DeclareOp::verify() {
286 auto [hlfirVariableType, firVarType] = getDeclareOutputTypes(
287 getMemref().getType(), hasExplicitLowerBounds(getShape()));
288 if (firVarType != getResult(1).getType())
289 return emitOpError("second result type must match input memref type, "
290 "unless it is a box with heap or pointer attribute");
291 if (hlfirVariableType != getResult(0).getType())
292 return emitOpError("first result type is inconsistent with variable "
293 "properties: expected ")
294 << hlfirVariableType;
295 // The rest of the argument verification is done by the
296 // FortranVariableInterface verifier.
297 auto fortranVar =
298 mlir::cast<fir::FortranVariableOpInterface>(this->getOperation());
299 return fortranVar.verifyDeclareLikeOpImpl(getMemref());
300}
301
302//===----------------------------------------------------------------------===//
303// DesignateOp
304//===----------------------------------------------------------------------===//
305
306void hlfir::DesignateOp::build(
307 mlir::OpBuilder &builder, mlir::OperationState &result,
308 mlir::Type result_type, mlir::Value memref, llvm::StringRef component,
309 mlir::Value component_shape, llvm::ArrayRef<Subscript> subscripts,
310 mlir::ValueRange substring, std::optional<bool> complex_part,
311 mlir::Value shape, mlir::ValueRange typeparams,
312 fir::FortranVariableFlagsAttr fortran_attrs) {
313 auto componentAttr =
314 component.empty() ? mlir::StringAttr{} : builder.getStringAttr(component);
315 llvm::SmallVector<mlir::Value> indices;
316 llvm::SmallVector<bool> isTriplet;
317 for (auto subscript : subscripts) {
318 if (auto *triplet = std::get_if<Triplet>(&subscript)) {
319 isTriplet.push_back(true);
320 indices.push_back(std::get<0>(*triplet));
321 indices.push_back(std::get<1>(*triplet));
322 indices.push_back(std::get<2>(*triplet));
323 } else {
324 isTriplet.push_back(false);
325 indices.push_back(std::get<mlir::Value>(subscript));
326 }
327 }
328 auto isTripletAttr =
329 mlir::DenseBoolArrayAttr::get(builder.getContext(), isTriplet);
330 auto complexPartAttr =
331 complex_part.has_value()
332 ? mlir::BoolAttr::get(builder.getContext(), *complex_part)
333 : mlir::BoolAttr{};
334 build(builder, result, result_type, memref, componentAttr, component_shape,
335 indices, isTripletAttr, substring, complexPartAttr, shape, typeparams,
336 fortran_attrs);
337}
338
339void hlfir::DesignateOp::build(mlir::OpBuilder &builder,
340 mlir::OperationState &result,
341 mlir::Type result_type, mlir::Value memref,
342 mlir::ValueRange indices,
343 mlir::ValueRange typeparams,
344 fir::FortranVariableFlagsAttr fortran_attrs) {
345 llvm::SmallVector<bool> isTriplet(indices.size(), false);
346 auto isTripletAttr =
347 mlir::DenseBoolArrayAttr::get(builder.getContext(), isTriplet);
348 build(builder, result, result_type, memref,
349 /*componentAttr=*/mlir::StringAttr{}, /*component_shape=*/mlir::Value{},
350 indices, isTripletAttr, /*substring*/ mlir::ValueRange{},
351 /*complexPartAttr=*/mlir::BoolAttr{}, /*shape=*/mlir::Value{},
352 typeparams, fortran_attrs);
353}
354
355static mlir::ParseResult parseDesignatorIndices(
356 mlir::OpAsmParser &parser,
357 llvm::SmallVectorImpl<mlir::OpAsmParser::UnresolvedOperand> &indices,
358 mlir::DenseBoolArrayAttr &isTripletAttr) {
359 llvm::SmallVector<bool> isTriplet;
360 if (mlir::succeeded(parser.parseOptionalLParen())) {
361 do {
362 mlir::OpAsmParser::UnresolvedOperand i1, i2, i3;
363 if (parser.parseOperand(i1))
364 return mlir::failure();
365 indices.push_back(i1);
366 if (mlir::succeeded(parser.parseOptionalColon())) {
367 if (parser.parseOperand(i2) || parser.parseColon() ||
368 parser.parseOperand(i3))
369 return mlir::failure();
370 indices.push_back(i2);
371 indices.push_back(i3);
372 isTriplet.push_back(Elt: true);
373 } else {
374 isTriplet.push_back(Elt: false);
375 }
376 } while (mlir::succeeded(parser.parseOptionalComma()));
377 if (parser.parseRParen())
378 return mlir::failure();
379 }
380 isTripletAttr = mlir::DenseBoolArrayAttr::get(parser.getContext(), isTriplet);
381 return mlir::success();
382}
383
384static void
385printDesignatorIndices(mlir::OpAsmPrinter &p, hlfir::DesignateOp designateOp,
386 mlir::OperandRange indices,
387 const mlir::DenseBoolArrayAttr &isTripletAttr) {
388 if (!indices.empty()) {
389 p << '(';
390 unsigned i = 0;
391 for (auto isTriplet : isTripletAttr.asArrayRef()) {
392 if (isTriplet) {
393 assert(i + 2 < indices.size() && "ill-formed indices");
394 p << indices[i] << ":" << indices[i + 1] << ":" << indices[i + 2];
395 i += 3;
396 } else {
397 p << indices[i++];
398 }
399 if (i != indices.size())
400 p << ", ";
401 }
402 p << ')';
403 }
404}
405
406static mlir::ParseResult
407parseDesignatorComplexPart(mlir::OpAsmParser &parser,
408 mlir::BoolAttr &complexPart) {
409 if (mlir::succeeded(parser.parseOptionalKeyword("imag")))
410 complexPart = mlir::BoolAttr::get(parser.getContext(), true);
411 else if (mlir::succeeded(parser.parseOptionalKeyword("real")))
412 complexPart = mlir::BoolAttr::get(parser.getContext(), false);
413 return mlir::success();
414}
415
416static void printDesignatorComplexPart(mlir::OpAsmPrinter &p,
417 hlfir::DesignateOp designateOp,
418 mlir::BoolAttr complexPartAttr) {
419 if (complexPartAttr) {
420 if (complexPartAttr.getValue())
421 p << "imag";
422 else
423 p << "real";
424 }
425}
426template <typename Op>
427static llvm::LogicalResult verifyTypeparams(Op &op, mlir::Type elementType,
428 unsigned numLenParam) {
429 if (mlir::isa<fir::CharacterType>(elementType)) {
430 if (numLenParam != 1)
431 return op.emitOpError("must be provided one length parameter when the "
432 "result is a character");
433 } else if (fir::isRecordWithTypeParameters(elementType)) {
434 if (numLenParam !=
435 mlir::cast<fir::RecordType>(elementType).getNumLenParams())
436 return op.emitOpError("must be provided the same number of length "
437 "parameters as in the result derived type");
438 } else if (numLenParam != 0) {
439 return op.emitOpError(
440 "must not be provided length parameters if the result "
441 "type does not have length parameters");
442 }
443 return mlir::success();
444}
445
446llvm::LogicalResult hlfir::DesignateOp::verify() {
447 mlir::Type memrefType = getMemref().getType();
448 mlir::Type baseType = getFortranElementOrSequenceType(memrefType);
449 mlir::Type baseElementType = fir::unwrapSequenceType(baseType);
450 unsigned numSubscripts = getIsTriplet().size();
451 unsigned subscriptsRank =
452 llvm::count_if(getIsTriplet(), [](bool isTriplet) { return isTriplet; });
453 unsigned outputRank = 0;
454 mlir::Type outputElementType;
455 bool hasBoxComponent;
456 if (fir::useStrictVolatileVerification() &&
457 fir::isa_volatile_type(memrefType) !=
458 fir::isa_volatile_type(getResult().getType())) {
459 return emitOpError("volatility mismatch between memref and result type")
460 << " memref type: " << memrefType
461 << " result type: " << getResult().getType();
462 }
463 if (getComponent()) {
464 auto component = getComponent().value();
465 auto recType = mlir::dyn_cast<fir::RecordType>(baseElementType);
466 if (!recType)
467 return emitOpError(
468 "component must be provided only when the memref is a derived type");
469 unsigned fieldIdx = recType.getFieldIndex(component);
470 if (fieldIdx > recType.getNumFields()) {
471 return emitOpError("component ")
472 << component << " is not a component of memref element type "
473 << recType;
474 }
475 mlir::Type fieldType = recType.getType(fieldIdx);
476 mlir::Type componentBaseType = getFortranElementOrSequenceType(fieldType);
477 hasBoxComponent = mlir::isa<fir::BaseBoxType>(fieldType);
478 if (mlir::isa<fir::SequenceType>(componentBaseType) &&
479 mlir::isa<fir::SequenceType>(baseType) &&
480 (numSubscripts == 0 || subscriptsRank > 0))
481 return emitOpError("indices must be provided and must not contain "
482 "triplets when both memref and component are arrays");
483 if (numSubscripts != 0) {
484 if (!mlir::isa<fir::SequenceType>(componentBaseType))
485 return emitOpError("indices must not be provided if component appears "
486 "and is not an array component");
487 if (!getComponentShape())
488 return emitOpError(
489 "component_shape must be provided when indexing a component");
490 mlir::Type compShapeType = getComponentShape().getType();
491 unsigned componentRank =
492 mlir::cast<fir::SequenceType>(componentBaseType).getDimension();
493 auto shapeType = mlir::dyn_cast<fir::ShapeType>(compShapeType);
494 auto shapeShiftType = mlir::dyn_cast<fir::ShapeShiftType>(compShapeType);
495 if (!((shapeType && shapeType.getRank() == componentRank) ||
496 (shapeShiftType && shapeShiftType.getRank() == componentRank)))
497 return emitOpError("component_shape must be a fir.shape or "
498 "fir.shapeshift with the rank of the component");
499 if (numSubscripts > componentRank)
500 return emitOpError("indices number must match array component rank");
501 }
502 if (auto baseSeqType = mlir::dyn_cast<fir::SequenceType>(baseType))
503 // This case must come first to cover "array%array_comp(i, j)" that has
504 // subscripts for the component but whose rank come from the base.
505 outputRank = baseSeqType.getDimension();
506 else if (numSubscripts != 0)
507 outputRank = subscriptsRank;
508 else if (auto componentSeqType =
509 mlir::dyn_cast<fir::SequenceType>(componentBaseType))
510 outputRank = componentSeqType.getDimension();
511 outputElementType = fir::unwrapSequenceType(componentBaseType);
512 } else {
513 outputElementType = baseElementType;
514 unsigned baseTypeRank =
515 mlir::isa<fir::SequenceType>(baseType)
516 ? mlir::cast<fir::SequenceType>(baseType).getDimension()
517 : 0;
518 if (numSubscripts != 0) {
519 if (baseTypeRank != numSubscripts)
520 return emitOpError("indices number must match memref rank");
521 outputRank = subscriptsRank;
522 } else if (auto baseSeqType = mlir::dyn_cast<fir::SequenceType>(baseType)) {
523 outputRank = baseSeqType.getDimension();
524 }
525 }
526
527 if (!getSubstring().empty()) {
528 if (!mlir::isa<fir::CharacterType>(outputElementType))
529 return emitOpError("memref or component must have character type if "
530 "substring indices are provided");
531 if (getSubstring().size() != 2)
532 return emitOpError("substring must contain 2 indices when provided");
533 }
534 if (getComplexPart()) {
535 if (auto cplx = mlir::dyn_cast<mlir::ComplexType>(outputElementType))
536 outputElementType = cplx.getElementType();
537 else
538 return emitOpError("memref or component must have complex type if "
539 "complex_part is provided");
540 }
541 mlir::Type resultBaseType =
542 getFortranElementOrSequenceType(getResult().getType());
543 unsigned resultRank = 0;
544 if (auto resultSeqType = mlir::dyn_cast<fir::SequenceType>(resultBaseType))
545 resultRank = resultSeqType.getDimension();
546 if (resultRank != outputRank)
547 return emitOpError("result type rank is not consistent with operands, "
548 "expected rank ")
549 << outputRank;
550 mlir::Type resultElementType = fir::unwrapSequenceType(resultBaseType);
551 // result type must match the one that was inferred here, except the character
552 // length may differ because of substrings.
553 if (resultElementType != outputElementType &&
554 !(mlir::isa<fir::CharacterType>(resultElementType) &&
555 mlir::isa<fir::CharacterType>(outputElementType)))
556 return emitOpError(
557 "result element type is not consistent with operands, expected ")
558 << outputElementType;
559
560 if (isBoxAddressType(getResult().getType())) {
561 if (!hasBoxComponent || numSubscripts != 0 || !getSubstring().empty() ||
562 getComplexPart())
563 return emitOpError(
564 "result type must only be a box address type if it designates a "
565 "component that is a fir.box or fir.class and if there are no "
566 "indices, substrings, and complex part");
567
568 } else {
569 if ((resultRank == 0) != !getShape())
570 return emitOpError("shape must be provided if and only if the result is "
571 "an array that is not a box address");
572 if (resultRank != 0) {
573 auto shapeType = mlir::dyn_cast<fir::ShapeType>(getShape().getType());
574 auto shapeShiftType =
575 mlir::dyn_cast<fir::ShapeShiftType>(getShape().getType());
576 if (!((shapeType && shapeType.getRank() == resultRank) ||
577 (shapeShiftType && shapeShiftType.getRank() == resultRank)))
578 return emitOpError("shape must be a fir.shape or fir.shapeshift with "
579 "the rank of the result");
580 }
581 if (auto res =
582 verifyTypeparams(*this, outputElementType, getTypeparams().size());
583 failed(res))
584 return res;
585 }
586 return mlir::success();
587}
588
589//===----------------------------------------------------------------------===//
590// ParentComponentOp
591//===----------------------------------------------------------------------===//
592
593llvm::LogicalResult hlfir::ParentComponentOp::verify() {
594 mlir::Type baseType =
595 hlfir::getFortranElementOrSequenceType(getMemref().getType());
596 auto maybeInputSeqType = mlir::dyn_cast<fir::SequenceType>(baseType);
597 unsigned inputTypeRank =
598 maybeInputSeqType ? maybeInputSeqType.getDimension() : 0;
599 unsigned shapeRank = 0;
600 if (mlir::Value shape = getShape())
601 if (auto shapeType = mlir::dyn_cast<fir::ShapeType>(shape.getType()))
602 shapeRank = shapeType.getRank();
603 if (inputTypeRank != shapeRank)
604 return emitOpError(
605 "must be provided a shape if and only if the base is an array");
606 mlir::Type outputBaseType = hlfir::getFortranElementOrSequenceType(getType());
607 auto maybeOutputSeqType = mlir::dyn_cast<fir::SequenceType>(outputBaseType);
608 unsigned outputTypeRank =
609 maybeOutputSeqType ? maybeOutputSeqType.getDimension() : 0;
610 if (inputTypeRank != outputTypeRank)
611 return emitOpError("result type rank must match input type rank");
612 if (maybeOutputSeqType && maybeInputSeqType)
613 for (auto [inputDim, outputDim] :
614 llvm::zip(maybeInputSeqType.getShape(), maybeOutputSeqType.getShape()))
615 if (inputDim != fir::SequenceType::getUnknownExtent() &&
616 outputDim != fir::SequenceType::getUnknownExtent())
617 if (inputDim != outputDim)
618 return emitOpError(
619 "result type extents are inconsistent with memref type");
620 fir::RecordType baseRecType =
621 mlir::dyn_cast<fir::RecordType>(hlfir::getFortranElementType(baseType));
622 fir::RecordType outRecType = mlir::dyn_cast<fir::RecordType>(
623 hlfir::getFortranElementType(outputBaseType));
624 if (!baseRecType || !outRecType)
625 return emitOpError("result type and input type must be derived types");
626
627 // Note: result should not be a fir.class: its dynamic type is being set to
628 // the parent type and allowing fir.class would break the operation codegen:
629 // it would keep the input dynamic type.
630 if (mlir::isa<fir::ClassType>(getType()))
631 return emitOpError("result type must not be polymorphic");
632
633 // The array results are known to not be dis-contiguous in most cases (the
634 // exception being if the parent type was extended by a type without any
635 // components): require a fir.box to be used for the result to carry the
636 // strides.
637 if (!mlir::isa<fir::BoxType>(getType()) &&
638 (outputTypeRank != 0 || fir::isRecordWithTypeParameters(outRecType)))
639 return emitOpError("result type must be a fir.box if the result is an "
640 "array or has length parameters");
641 return mlir::success();
642}
643
644//===----------------------------------------------------------------------===//
645// LogicalReductionOp
646//===----------------------------------------------------------------------===//
647template <typename LogicalReductionOp>
648static llvm::LogicalResult
649verifyLogicalReductionOp(LogicalReductionOp reductionOp) {
650 mlir::Operation *op = reductionOp->getOperation();
651
652 auto results = op->getResultTypes();
653 assert(results.size() == 1);
654
655 mlir::Value mask = reductionOp->getMask();
656 mlir::Value dim = reductionOp->getDim();
657
658 fir::SequenceType maskTy = mlir::cast<fir::SequenceType>(
659 hlfir::getFortranElementOrSequenceType(mask.getType()));
660 mlir::Type logicalTy = maskTy.getEleTy();
661 llvm::ArrayRef<int64_t> maskShape = maskTy.getShape();
662
663 mlir::Type resultType = results[0];
664 if (mlir::isa<fir::LogicalType>(resultType)) {
665 // Result is of the same type as MASK
666 if ((resultType != logicalTy) && useStrictIntrinsicVerifier)
667 return reductionOp->emitOpError(
668 "result must have the same element type as MASK argument");
669
670 } else if (auto resultExpr =
671 mlir::dyn_cast_or_null<hlfir::ExprType>(resultType)) {
672 // Result should only be in hlfir.expr form if it is an array
673 if (maskShape.size() > 1 && dim != nullptr) {
674 if (!resultExpr.isArray())
675 return reductionOp->emitOpError("result must be an array");
676
677 if ((resultExpr.getEleTy() != logicalTy) && useStrictIntrinsicVerifier)
678 return reductionOp->emitOpError(
679 "result must have the same element type as MASK argument");
680
681 llvm::ArrayRef<int64_t> resultShape = resultExpr.getShape();
682 // Result has rank n-1
683 if (resultShape.size() != (maskShape.size() - 1))
684 return reductionOp->emitOpError(
685 "result rank must be one less than MASK");
686 } else {
687 return reductionOp->emitOpError("result must be of logical type");
688 }
689 } else {
690 return reductionOp->emitOpError("result must be of logical type");
691 }
692 return mlir::success();
693}
694
695//===----------------------------------------------------------------------===//
696// AllOp
697//===----------------------------------------------------------------------===//
698
699llvm::LogicalResult hlfir::AllOp::verify() {
700 return verifyLogicalReductionOp<hlfir::AllOp *>(this);
701}
702
703void hlfir::AllOp::getEffects(
704 llvm::SmallVectorImpl<
705 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
706 &effects) {
707 getIntrinsicEffects(getOperation(), effects);
708}
709
710//===----------------------------------------------------------------------===//
711// AnyOp
712//===----------------------------------------------------------------------===//
713
714llvm::LogicalResult hlfir::AnyOp::verify() {
715 return verifyLogicalReductionOp<hlfir::AnyOp *>(this);
716}
717
718void hlfir::AnyOp::getEffects(
719 llvm::SmallVectorImpl<
720 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
721 &effects) {
722 getIntrinsicEffects(getOperation(), effects);
723}
724
725//===----------------------------------------------------------------------===//
726// CountOp
727//===----------------------------------------------------------------------===//
728
729llvm::LogicalResult hlfir::CountOp::verify() {
730 mlir::Operation *op = getOperation();
731
732 auto results = op->getResultTypes();
733 assert(results.size() == 1);
734 mlir::Value mask = getMask();
735 mlir::Value dim = getDim();
736
737 fir::SequenceType maskTy = mlir::cast<fir::SequenceType>(
738 hlfir::getFortranElementOrSequenceType(mask.getType()));
739 llvm::ArrayRef<int64_t> maskShape = maskTy.getShape();
740
741 mlir::Type resultType = results[0];
742 if (auto resultExpr = mlir::dyn_cast_or_null<hlfir::ExprType>(resultType)) {
743 if (maskShape.size() > 1 && dim != nullptr) {
744 if (!resultExpr.isArray())
745 return emitOpError("result must be an array");
746
747 llvm::ArrayRef<int64_t> resultShape = resultExpr.getShape();
748 // Result has rank n-1
749 if (resultShape.size() != (maskShape.size() - 1))
750 return emitOpError("result rank must be one less than MASK");
751 } else {
752 return emitOpError("result must be of numerical array type");
753 }
754 } else if (!hlfir::isFortranScalarNumericalType(resultType)) {
755 return emitOpError("result must be of numerical scalar type");
756 }
757
758 return mlir::success();
759}
760
761void hlfir::CountOp::getEffects(
762 llvm::SmallVectorImpl<
763 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
764 &effects) {
765 getIntrinsicEffects(getOperation(), effects);
766}
767
768//===----------------------------------------------------------------------===//
769// ConcatOp
770//===----------------------------------------------------------------------===//
771
772static unsigned getCharacterKind(mlir::Type t) {
773 return mlir::cast<fir::CharacterType>(hlfir::getFortranElementType(t))
774 .getFKind();
775}
776
777static std::optional<fir::CharacterType::LenType>
778getCharacterLengthIfStatic(mlir::Type t) {
779 if (auto charType =
780 mlir::dyn_cast<fir::CharacterType>(hlfir::getFortranElementType(t)))
781 if (charType.hasConstantLen())
782 return charType.getLen();
783 return std::nullopt;
784}
785
786llvm::LogicalResult hlfir::ConcatOp::verify() {
787 if (getStrings().size() < 2)
788 return emitOpError("must be provided at least two string operands");
789 unsigned kind = getCharacterKind(getResult().getType());
790 for (auto string : getStrings())
791 if (kind != getCharacterKind(string.getType()))
792 return emitOpError("strings must have the same KIND as the result type");
793 return mlir::success();
794}
795
796void hlfir::ConcatOp::build(mlir::OpBuilder &builder,
797 mlir::OperationState &result,
798 mlir::ValueRange strings, mlir::Value len) {
799 fir::CharacterType::LenType resultTypeLen = 0;
800 assert(!strings.empty() && "must contain operands");
801 unsigned kind = getCharacterKind(strings[0].getType());
802 for (auto string : strings)
803 if (auto cstLen = getCharacterLengthIfStatic(string.getType())) {
804 resultTypeLen += *cstLen;
805 } else {
806 resultTypeLen = fir::CharacterType::unknownLen();
807 break;
808 }
809 auto resultType = hlfir::ExprType::get(
810 builder.getContext(), hlfir::ExprType::Shape{},
811 fir::CharacterType::get(builder.getContext(), kind, resultTypeLen),
812 false);
813 build(builder, result, resultType, strings, len);
814}
815
816void hlfir::ConcatOp::getEffects(
817 llvm::SmallVectorImpl<
818 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
819 &effects) {
820 getIntrinsicEffects(getOperation(), effects);
821}
822
823//===----------------------------------------------------------------------===//
824// NumericalReductionOp
825//===----------------------------------------------------------------------===//
826
827template <typename NumericalReductionOp>
828static llvm::LogicalResult
829verifyArrayAndMaskForReductionOp(NumericalReductionOp reductionOp) {
830 mlir::Value array = reductionOp->getArray();
831 mlir::Value mask = reductionOp->getMask();
832
833 fir::SequenceType arrayTy = mlir::cast<fir::SequenceType>(
834 hlfir::getFortranElementOrSequenceType(array.getType()));
835 llvm::ArrayRef<int64_t> arrayShape = arrayTy.getShape();
836
837 if (mask) {
838 fir::SequenceType maskSeq = mlir::dyn_cast<fir::SequenceType>(
839 hlfir::getFortranElementOrSequenceType(mask.getType()));
840 llvm::ArrayRef<int64_t> maskShape;
841
842 if (maskSeq)
843 maskShape = maskSeq.getShape();
844
845 if (!maskShape.empty()) {
846 if (maskShape.size() != arrayShape.size())
847 return reductionOp->emitWarning("MASK must be conformable to ARRAY");
848 if (useStrictIntrinsicVerifier) {
849 static_assert(fir::SequenceType::getUnknownExtent() ==
850 hlfir::ExprType::getUnknownExtent());
851 constexpr int64_t unknownExtent = fir::SequenceType::getUnknownExtent();
852 for (std::size_t i = 0; i < arrayShape.size(); ++i) {
853 int64_t arrayExtent = arrayShape[i];
854 int64_t maskExtent = maskShape[i];
855 if ((arrayExtent != maskExtent) && (arrayExtent != unknownExtent) &&
856 (maskExtent != unknownExtent))
857 return reductionOp->emitWarning(
858 "MASK must be conformable to ARRAY");
859 }
860 }
861 }
862 }
863 return mlir::success();
864}
865
866template <typename NumericalReductionOp>
867static llvm::LogicalResult
868verifyNumericalReductionOp(NumericalReductionOp reductionOp) {
869 mlir::Operation *op = reductionOp->getOperation();
870 auto results = op->getResultTypes();
871 assert(results.size() == 1);
872
873 auto res = verifyArrayAndMaskForReductionOp(reductionOp);
874 if (failed(res))
875 return res;
876
877 mlir::Value array = reductionOp->getArray();
878 mlir::Value dim = reductionOp->getDim();
879 fir::SequenceType arrayTy = mlir::cast<fir::SequenceType>(
880 hlfir::getFortranElementOrSequenceType(array.getType()));
881 mlir::Type numTy = arrayTy.getEleTy();
882 llvm::ArrayRef<int64_t> arrayShape = arrayTy.getShape();
883
884 mlir::Type resultType = results[0];
885 if (hlfir::isFortranScalarNumericalType(resultType)) {
886 // Result is of the same type as ARRAY
887 if ((resultType != numTy) && useStrictIntrinsicVerifier)
888 return reductionOp->emitOpError(
889 "result must have the same element type as ARRAY argument");
890
891 } else if (auto resultExpr =
892 mlir::dyn_cast_or_null<hlfir::ExprType>(resultType)) {
893 if (arrayShape.size() > 1 && dim != nullptr) {
894 if (!resultExpr.isArray())
895 return reductionOp->emitOpError("result must be an array");
896
897 if ((resultExpr.getEleTy() != numTy) && useStrictIntrinsicVerifier)
898 return reductionOp->emitOpError(
899 "result must have the same element type as ARRAY argument");
900
901 llvm::ArrayRef<int64_t> resultShape = resultExpr.getShape();
902 // Result has rank n-1
903 if (resultShape.size() != (arrayShape.size() - 1))
904 return reductionOp->emitOpError(
905 "result rank must be one less than ARRAY");
906 } else {
907 return reductionOp->emitOpError(
908 "result must be of numerical scalar type");
909 }
910 } else {
911 return reductionOp->emitOpError("result must be of numerical scalar type");
912 }
913 return mlir::success();
914}
915
916//===----------------------------------------------------------------------===//
917// ProductOp
918//===----------------------------------------------------------------------===//
919
920llvm::LogicalResult hlfir::ProductOp::verify() {
921 return verifyNumericalReductionOp<hlfir::ProductOp *>(this);
922}
923
924void hlfir::ProductOp::getEffects(
925 llvm::SmallVectorImpl<
926 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
927 &effects) {
928 getIntrinsicEffects(getOperation(), effects);
929}
930
931//===----------------------------------------------------------------------===//
932// CharacterReductionOp
933//===----------------------------------------------------------------------===//
934
935template <typename CharacterReductionOp>
936static llvm::LogicalResult
937verifyCharacterReductionOp(CharacterReductionOp reductionOp) {
938 mlir::Operation *op = reductionOp->getOperation();
939 auto results = op->getResultTypes();
940 assert(results.size() == 1);
941
942 auto res = verifyArrayAndMaskForReductionOp(reductionOp);
943 if (failed(res))
944 return res;
945
946 mlir::Value array = reductionOp->getArray();
947 mlir::Value dim = reductionOp->getDim();
948 fir::SequenceType arrayTy = mlir::cast<fir::SequenceType>(
949 hlfir::getFortranElementOrSequenceType(array.getType()));
950 mlir::Type numTy = arrayTy.getEleTy();
951 llvm::ArrayRef<int64_t> arrayShape = arrayTy.getShape();
952
953 auto resultExpr = mlir::cast<hlfir::ExprType>(results[0]);
954 mlir::Type resultType = resultExpr.getEleTy();
955 assert(mlir::isa<fir::CharacterType>(resultType) &&
956 "result must be character");
957
958 // Result is of the same type as ARRAY
959 if ((resultType != numTy) && useStrictIntrinsicVerifier)
960 return reductionOp->emitOpError(
961 "result must have the same element type as ARRAY argument");
962
963 if (arrayShape.size() > 1 && dim != nullptr) {
964 if (!resultExpr.isArray())
965 return reductionOp->emitOpError("result must be an array");
966 llvm::ArrayRef<int64_t> resultShape = resultExpr.getShape();
967 // Result has rank n-1
968 if (resultShape.size() != (arrayShape.size() - 1))
969 return reductionOp->emitOpError(
970 "result rank must be one less than ARRAY");
971 } else if (!resultExpr.isScalar()) {
972 return reductionOp->emitOpError("result must be scalar character");
973 }
974 return mlir::success();
975}
976
977//===----------------------------------------------------------------------===//
978// MaxvalOp
979//===----------------------------------------------------------------------===//
980
981llvm::LogicalResult hlfir::MaxvalOp::verify() {
982 mlir::Operation *op = getOperation();
983
984 auto results = op->getResultTypes();
985 assert(results.size() == 1);
986
987 auto resultExpr = mlir::dyn_cast<hlfir::ExprType>(results[0]);
988 if (resultExpr && mlir::isa<fir::CharacterType>(resultExpr.getEleTy())) {
989 return verifyCharacterReductionOp<hlfir::MaxvalOp *>(this);
990 }
991 return verifyNumericalReductionOp<hlfir::MaxvalOp *>(this);
992}
993
994void hlfir::MaxvalOp::getEffects(
995 llvm::SmallVectorImpl<
996 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
997 &effects) {
998 getIntrinsicEffects(getOperation(), effects);
999}
1000
1001//===----------------------------------------------------------------------===//
1002// MinvalOp
1003//===----------------------------------------------------------------------===//
1004
1005llvm::LogicalResult hlfir::MinvalOp::verify() {
1006 mlir::Operation *op = getOperation();
1007
1008 auto results = op->getResultTypes();
1009 assert(results.size() == 1);
1010
1011 auto resultExpr = mlir::dyn_cast<hlfir::ExprType>(results[0]);
1012 if (resultExpr && mlir::isa<fir::CharacterType>(resultExpr.getEleTy())) {
1013 return verifyCharacterReductionOp<hlfir::MinvalOp *>(this);
1014 }
1015 return verifyNumericalReductionOp<hlfir::MinvalOp *>(this);
1016}
1017
1018void hlfir::MinvalOp::getEffects(
1019 llvm::SmallVectorImpl<
1020 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
1021 &effects) {
1022 getIntrinsicEffects(getOperation(), effects);
1023}
1024
1025//===----------------------------------------------------------------------===//
1026// MinlocOp
1027//===----------------------------------------------------------------------===//
1028
1029template <typename NumericalReductionOp>
1030static llvm::LogicalResult
1031verifyResultForMinMaxLoc(NumericalReductionOp reductionOp) {
1032 mlir::Operation *op = reductionOp->getOperation();
1033 auto results = op->getResultTypes();
1034 assert(results.size() == 1);
1035
1036 mlir::Value array = reductionOp->getArray();
1037 mlir::Value dim = reductionOp->getDim();
1038 fir::SequenceType arrayTy = mlir::cast<fir::SequenceType>(
1039 hlfir::getFortranElementOrSequenceType(array.getType()));
1040 llvm::ArrayRef<int64_t> arrayShape = arrayTy.getShape();
1041
1042 mlir::Type resultType = results[0];
1043 if (dim && arrayShape.size() == 1) {
1044 if (!fir::isa_integer(resultType))
1045 return reductionOp->emitOpError("result must be scalar integer");
1046 } else if (auto resultExpr =
1047 mlir::dyn_cast_or_null<hlfir::ExprType>(resultType)) {
1048 if (!resultExpr.isArray())
1049 return reductionOp->emitOpError("result must be an array");
1050
1051 if (!fir::isa_integer(resultExpr.getEleTy()))
1052 return reductionOp->emitOpError("result must have integer elements");
1053
1054 llvm::ArrayRef<int64_t> resultShape = resultExpr.getShape();
1055 // With dim the result has rank n-1
1056 if (dim && resultShape.size() != (arrayShape.size() - 1))
1057 return reductionOp->emitOpError(
1058 "result rank must be one less than ARRAY");
1059 // With dim the result has rank n
1060 if (!dim && resultShape.size() != 1)
1061 return reductionOp->emitOpError("result rank must be 1");
1062 } else {
1063 return reductionOp->emitOpError("result must be of numerical expr type");
1064 }
1065 return mlir::success();
1066}
1067
1068llvm::LogicalResult hlfir::MinlocOp::verify() {
1069 auto res = verifyArrayAndMaskForReductionOp(this);
1070 if (failed(res))
1071 return res;
1072
1073 return verifyResultForMinMaxLoc(this);
1074}
1075
1076void hlfir::MinlocOp::getEffects(
1077 llvm::SmallVectorImpl<
1078 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
1079 &effects) {
1080 getIntrinsicEffects(getOperation(), effects);
1081}
1082
1083//===----------------------------------------------------------------------===//
1084// MaxlocOp
1085//===----------------------------------------------------------------------===//
1086
1087llvm::LogicalResult hlfir::MaxlocOp::verify() {
1088 auto res = verifyArrayAndMaskForReductionOp(this);
1089 if (failed(res))
1090 return res;
1091
1092 return verifyResultForMinMaxLoc(this);
1093}
1094
1095void hlfir::MaxlocOp::getEffects(
1096 llvm::SmallVectorImpl<
1097 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
1098 &effects) {
1099 getIntrinsicEffects(getOperation(), effects);
1100}
1101
1102//===----------------------------------------------------------------------===//
1103// SetLengthOp
1104//===----------------------------------------------------------------------===//
1105
1106void hlfir::SetLengthOp::build(mlir::OpBuilder &builder,
1107 mlir::OperationState &result, mlir::Value string,
1108 mlir::Value len) {
1109 fir::CharacterType::LenType resultTypeLen = fir::CharacterType::unknownLen();
1110 if (auto cstLen = fir::getIntIfConstant(len))
1111 resultTypeLen = *cstLen;
1112 unsigned kind = getCharacterKind(string.getType());
1113 auto resultType = hlfir::ExprType::get(
1114 builder.getContext(), hlfir::ExprType::Shape{},
1115 fir::CharacterType::get(builder.getContext(), kind, resultTypeLen),
1116 false);
1117 build(builder, result, resultType, string, len);
1118}
1119
1120void hlfir::SetLengthOp::getEffects(
1121 llvm::SmallVectorImpl<
1122 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
1123 &effects) {
1124 getIntrinsicEffects(getOperation(), effects);
1125}
1126
1127//===----------------------------------------------------------------------===//
1128// SumOp
1129//===----------------------------------------------------------------------===//
1130
1131llvm::LogicalResult hlfir::SumOp::verify() {
1132 return verifyNumericalReductionOp<hlfir::SumOp *>(this);
1133}
1134
1135void hlfir::SumOp::getEffects(
1136 llvm::SmallVectorImpl<
1137 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
1138 &effects) {
1139 getIntrinsicEffects(getOperation(), effects);
1140}
1141
1142//===----------------------------------------------------------------------===//
1143// DotProductOp
1144//===----------------------------------------------------------------------===//
1145
1146llvm::LogicalResult hlfir::DotProductOp::verify() {
1147 mlir::Value lhs = getLhs();
1148 mlir::Value rhs = getRhs();
1149 fir::SequenceType lhsTy = mlir::cast<fir::SequenceType>(
1150 hlfir::getFortranElementOrSequenceType(lhs.getType()));
1151 fir::SequenceType rhsTy = mlir::cast<fir::SequenceType>(
1152 hlfir::getFortranElementOrSequenceType(rhs.getType()));
1153 llvm::ArrayRef<int64_t> lhsShape = lhsTy.getShape();
1154 llvm::ArrayRef<int64_t> rhsShape = rhsTy.getShape();
1155 std::size_t lhsRank = lhsShape.size();
1156 std::size_t rhsRank = rhsShape.size();
1157 mlir::Type lhsEleTy = lhsTy.getEleTy();
1158 mlir::Type rhsEleTy = rhsTy.getEleTy();
1159 mlir::Type resultTy = getResult().getType();
1160
1161 if ((lhsRank != 1) || (rhsRank != 1))
1162 return emitOpError("both arrays must have rank 1");
1163
1164 int64_t lhsSize = lhsShape[0];
1165 int64_t rhsSize = rhsShape[0];
1166
1167 constexpr int64_t unknownExtent = fir::SequenceType::getUnknownExtent();
1168 if ((lhsSize != unknownExtent) && (rhsSize != unknownExtent) &&
1169 (lhsSize != rhsSize) && useStrictIntrinsicVerifier)
1170 return emitOpError("both arrays must have the same size");
1171
1172 if (useStrictIntrinsicVerifier) {
1173 if (mlir::isa<fir::LogicalType>(lhsEleTy) !=
1174 mlir::isa<fir::LogicalType>(rhsEleTy))
1175 return emitOpError("if one array is logical, so should the other be");
1176
1177 if (mlir::isa<fir::LogicalType>(lhsEleTy) !=
1178 mlir::isa<fir::LogicalType>(resultTy))
1179 return emitOpError("the result type should be a logical only if the "
1180 "argument types are logical");
1181 }
1182
1183 if (!hlfir::isFortranScalarNumericalType(resultTy) &&
1184 !mlir::isa<fir::LogicalType>(resultTy))
1185 return emitOpError(
1186 "the result must be of scalar numerical or logical type");
1187
1188 return mlir::success();
1189}
1190
1191void hlfir::DotProductOp::getEffects(
1192 llvm::SmallVectorImpl<
1193 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
1194 &effects) {
1195 getIntrinsicEffects(getOperation(), effects);
1196}
1197
1198//===----------------------------------------------------------------------===//
1199// MatmulOp
1200//===----------------------------------------------------------------------===//
1201
1202llvm::LogicalResult hlfir::MatmulOp::verify() {
1203 mlir::Value lhs = getLhs();
1204 mlir::Value rhs = getRhs();
1205 fir::SequenceType lhsTy = mlir::cast<fir::SequenceType>(
1206 hlfir::getFortranElementOrSequenceType(lhs.getType()));
1207 fir::SequenceType rhsTy = mlir::cast<fir::SequenceType>(
1208 hlfir::getFortranElementOrSequenceType(rhs.getType()));
1209 llvm::ArrayRef<int64_t> lhsShape = lhsTy.getShape();
1210 llvm::ArrayRef<int64_t> rhsShape = rhsTy.getShape();
1211 std::size_t lhsRank = lhsShape.size();
1212 std::size_t rhsRank = rhsShape.size();
1213 mlir::Type lhsEleTy = lhsTy.getEleTy();
1214 mlir::Type rhsEleTy = rhsTy.getEleTy();
1215 hlfir::ExprType resultTy = mlir::cast<hlfir::ExprType>(getResult().getType());
1216 llvm::ArrayRef<int64_t> resultShape = resultTy.getShape();
1217 mlir::Type resultEleTy = resultTy.getEleTy();
1218
1219 if (((lhsRank != 1) && (lhsRank != 2)) || ((rhsRank != 1) && (rhsRank != 2)))
1220 return emitOpError("array must have either rank 1 or rank 2");
1221
1222 if ((lhsRank == 1) && (rhsRank == 1))
1223 return emitOpError("at least one array must have rank 2");
1224
1225 if (mlir::isa<fir::LogicalType>(lhsEleTy) !=
1226 mlir::isa<fir::LogicalType>(rhsEleTy))
1227 return emitOpError("if one array is logical, so should the other be");
1228
1229 if (!useStrictIntrinsicVerifier)
1230 return mlir::success();
1231
1232 int64_t lastLhsDim = lhsShape[lhsRank - 1];
1233 int64_t firstRhsDim = rhsShape[0];
1234 constexpr int64_t unknownExtent = fir::SequenceType::getUnknownExtent();
1235 if (lastLhsDim != firstRhsDim)
1236 if ((lastLhsDim != unknownExtent) && (firstRhsDim != unknownExtent))
1237 return emitOpError(
1238 "the last dimension of LHS should match the first dimension of RHS");
1239
1240 if (mlir::isa<fir::LogicalType>(lhsEleTy) !=
1241 mlir::isa<fir::LogicalType>(resultEleTy))
1242 return emitOpError("the result type should be a logical only if the "
1243 "argument types are logical");
1244
1245 llvm::SmallVector<int64_t, 2> expectedResultShape;
1246 if (lhsRank == 2) {
1247 if (rhsRank == 2) {
1248 expectedResultShape.push_back(lhsShape[0]);
1249 expectedResultShape.push_back(rhsShape[1]);
1250 } else {
1251 // rhsRank == 1
1252 expectedResultShape.push_back(lhsShape[0]);
1253 }
1254 } else {
1255 // lhsRank == 1
1256 // rhsRank == 2
1257 expectedResultShape.push_back(rhsShape[1]);
1258 }
1259 if (resultShape.size() != expectedResultShape.size())
1260 return emitOpError("incorrect result shape");
1261 if (resultShape[0] != expectedResultShape[0] &&
1262 expectedResultShape[0] != unknownExtent)
1263 return emitOpError("incorrect result shape");
1264 if (resultShape.size() == 2 && resultShape[1] != expectedResultShape[1] &&
1265 expectedResultShape[1] != unknownExtent)
1266 return emitOpError("incorrect result shape");
1267
1268 return mlir::success();
1269}
1270
1271llvm::LogicalResult
1272hlfir::MatmulOp::canonicalize(MatmulOp matmulOp,
1273 mlir::PatternRewriter &rewriter) {
1274 // the only two uses of the transposed matrix should be for the hlfir.matmul
1275 // and hlfir.destroy
1276 auto isOtherwiseUnused = [&](hlfir::TransposeOp transposeOp) -> bool {
1277 std::size_t numUses = 0;
1278 for (mlir::Operation *user : transposeOp.getResult().getUsers()) {
1279 ++numUses;
1280 if (user == matmulOp)
1281 continue;
1282 if (mlir::dyn_cast_or_null<hlfir::DestroyOp>(user))
1283 continue;
1284 // some other use!
1285 return false;
1286 }
1287 return numUses <= 2;
1288 };
1289
1290 mlir::Value lhs = matmulOp.getLhs();
1291 // Rewrite MATMUL(TRANSPOSE(lhs), rhs) => hlfir.matmul_transpose lhs, rhs
1292 if (auto transposeOp = lhs.getDefiningOp<hlfir::TransposeOp>()) {
1293 if (isOtherwiseUnused(transposeOp)) {
1294 mlir::Location loc = matmulOp.getLoc();
1295 mlir::Type resultTy = matmulOp.getResult().getType();
1296 auto matmulTransposeOp = rewriter.create<hlfir::MatmulTransposeOp>(
1297 loc, resultTy, transposeOp.getArray(), matmulOp.getRhs(),
1298 matmulOp.getFastmathAttr());
1299
1300 // we don't need to remove any hlfir.destroy because it will be needed for
1301 // the new intrinsic result anyway
1302 rewriter.replaceOp(matmulOp, matmulTransposeOp.getResult());
1303
1304 // but we do need to get rid of the hlfir.destroy for the hlfir.transpose
1305 // result (which is entirely removed)
1306 llvm::SmallVector<mlir::Operation *> users(
1307 transposeOp->getResult(0).getUsers());
1308 for (mlir::Operation *user : users)
1309 if (auto destroyOp = mlir::dyn_cast_or_null<hlfir::DestroyOp>(user))
1310 rewriter.eraseOp(destroyOp);
1311 rewriter.eraseOp(transposeOp);
1312
1313 return mlir::success();
1314 }
1315 }
1316
1317 return mlir::failure();
1318}
1319
1320void hlfir::MatmulOp::getEffects(
1321 llvm::SmallVectorImpl<
1322 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
1323 &effects) {
1324 getIntrinsicEffects(getOperation(), effects);
1325}
1326
1327//===----------------------------------------------------------------------===//
1328// TransposeOp
1329//===----------------------------------------------------------------------===//
1330
1331llvm::LogicalResult hlfir::TransposeOp::verify() {
1332 mlir::Value array = getArray();
1333 fir::SequenceType arrayTy = mlir::cast<fir::SequenceType>(
1334 hlfir::getFortranElementOrSequenceType(array.getType()));
1335 llvm::ArrayRef<int64_t> inShape = arrayTy.getShape();
1336 std::size_t rank = inShape.size();
1337 mlir::Type eleTy = arrayTy.getEleTy();
1338 hlfir::ExprType resultTy = mlir::cast<hlfir::ExprType>(getResult().getType());
1339 llvm::ArrayRef<int64_t> resultShape = resultTy.getShape();
1340 std::size_t resultRank = resultShape.size();
1341 mlir::Type resultEleTy = resultTy.getEleTy();
1342
1343 if (rank != 2 || resultRank != 2)
1344 return emitOpError("input and output arrays should have rank 2");
1345
1346 if (!useStrictIntrinsicVerifier)
1347 return mlir::success();
1348
1349 constexpr int64_t unknownExtent = fir::SequenceType::getUnknownExtent();
1350 if ((inShape[0] != resultShape[1]) && (inShape[0] != unknownExtent))
1351 return emitOpError("output shape does not match input array");
1352 if ((inShape[1] != resultShape[0]) && (inShape[1] != unknownExtent))
1353 return emitOpError("output shape does not match input array");
1354
1355 if (eleTy != resultEleTy)
1356 return emitOpError(
1357 "input and output arrays should have the same element type");
1358
1359 return mlir::success();
1360}
1361
1362void hlfir::TransposeOp::getEffects(
1363 llvm::SmallVectorImpl<
1364 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
1365 &effects) {
1366 getIntrinsicEffects(getOperation(), effects);
1367}
1368
1369//===----------------------------------------------------------------------===//
1370// MatmulTransposeOp
1371//===----------------------------------------------------------------------===//
1372
1373llvm::LogicalResult hlfir::MatmulTransposeOp::verify() {
1374 mlir::Value lhs = getLhs();
1375 mlir::Value rhs = getRhs();
1376 fir::SequenceType lhsTy = mlir::cast<fir::SequenceType>(
1377 hlfir::getFortranElementOrSequenceType(lhs.getType()));
1378 fir::SequenceType rhsTy = mlir::cast<fir::SequenceType>(
1379 hlfir::getFortranElementOrSequenceType(rhs.getType()));
1380 llvm::ArrayRef<int64_t> lhsShape = lhsTy.getShape();
1381 llvm::ArrayRef<int64_t> rhsShape = rhsTy.getShape();
1382 std::size_t lhsRank = lhsShape.size();
1383 std::size_t rhsRank = rhsShape.size();
1384 mlir::Type lhsEleTy = lhsTy.getEleTy();
1385 mlir::Type rhsEleTy = rhsTy.getEleTy();
1386 hlfir::ExprType resultTy = mlir::cast<hlfir::ExprType>(getResult().getType());
1387 llvm::ArrayRef<int64_t> resultShape = resultTy.getShape();
1388 mlir::Type resultEleTy = resultTy.getEleTy();
1389
1390 // lhs must have rank 2 for the transpose to be valid
1391 if ((lhsRank != 2) || ((rhsRank != 1) && (rhsRank != 2)))
1392 return emitOpError("array must have either rank 1 or rank 2");
1393
1394 if (!useStrictIntrinsicVerifier)
1395 return mlir::success();
1396
1397 if (mlir::isa<fir::LogicalType>(lhsEleTy) !=
1398 mlir::isa<fir::LogicalType>(rhsEleTy))
1399 return emitOpError("if one array is logical, so should the other be");
1400
1401 // for matmul we compare the last dimension of lhs with the first dimension of
1402 // rhs, but for MatmulTranspose, dimensions of lhs are inverted by the
1403 // transpose
1404 int64_t firstLhsDim = lhsShape[0];
1405 int64_t firstRhsDim = rhsShape[0];
1406 constexpr int64_t unknownExtent = fir::SequenceType::getUnknownExtent();
1407 if (firstLhsDim != firstRhsDim)
1408 if ((firstLhsDim != unknownExtent) && (firstRhsDim != unknownExtent))
1409 return emitOpError(
1410 "the first dimension of LHS should match the first dimension of RHS");
1411
1412 if (mlir::isa<fir::LogicalType>(lhsEleTy) !=
1413 mlir::isa<fir::LogicalType>(resultEleTy))
1414 return emitOpError("the result type should be a logical only if the "
1415 "argument types are logical");
1416
1417 llvm::SmallVector<int64_t, 2> expectedResultShape;
1418 if (rhsRank == 2) {
1419 expectedResultShape.push_back(lhsShape[1]);
1420 expectedResultShape.push_back(rhsShape[1]);
1421 } else {
1422 // rhsRank == 1
1423 expectedResultShape.push_back(lhsShape[1]);
1424 }
1425 if (resultShape.size() != expectedResultShape.size())
1426 return emitOpError("incorrect result shape");
1427 if (resultShape[0] != expectedResultShape[0])
1428 return emitOpError("incorrect result shape");
1429 if (resultShape.size() == 2 && resultShape[1] != expectedResultShape[1])
1430 return emitOpError("incorrect result shape");
1431
1432 return mlir::success();
1433}
1434
1435void hlfir::MatmulTransposeOp::getEffects(
1436 llvm::SmallVectorImpl<
1437 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
1438 &effects) {
1439 getIntrinsicEffects(getOperation(), effects);
1440}
1441
1442//===----------------------------------------------------------------------===//
1443// CShiftOp
1444//===----------------------------------------------------------------------===//
1445
1446llvm::LogicalResult hlfir::CShiftOp::verify() {
1447 mlir::Value array = getArray();
1448 fir::SequenceType arrayTy = mlir::cast<fir::SequenceType>(
1449 hlfir::getFortranElementOrSequenceType(array.getType()));
1450 llvm::ArrayRef<int64_t> inShape = arrayTy.getShape();
1451 std::size_t arrayRank = inShape.size();
1452 mlir::Type eleTy = arrayTy.getEleTy();
1453 hlfir::ExprType resultTy = mlir::cast<hlfir::ExprType>(getResult().getType());
1454 llvm::ArrayRef<int64_t> resultShape = resultTy.getShape();
1455 std::size_t resultRank = resultShape.size();
1456 mlir::Type resultEleTy = resultTy.getEleTy();
1457 mlir::Value shift = getShift();
1458 mlir::Type shiftTy = hlfir::getFortranElementOrSequenceType(shift.getType());
1459
1460 // TODO: turn allowCharacterLenMismatch into true.
1461 if (auto match = areMatchingTypes(*this, eleTy, resultEleTy,
1462 /*allowCharacterLenMismatch=*/false);
1463 match.failed())
1464 return emitOpError(
1465 "input and output arrays should have the same element type");
1466
1467 if (arrayRank != resultRank)
1468 return emitOpError("input and output arrays should have the same rank");
1469
1470 constexpr int64_t unknownExtent = fir::SequenceType::getUnknownExtent();
1471 for (auto [inDim, resultDim] : llvm::zip(inShape, resultShape))
1472 if (inDim != unknownExtent && resultDim != unknownExtent &&
1473 inDim != resultDim)
1474 return emitOpError(
1475 "output array's shape conflicts with the input array's shape");
1476
1477 int64_t dimVal = -1;
1478 if (!getDim())
1479 dimVal = 1;
1480 else if (auto dim = fir::getIntIfConstant(getDim()))
1481 dimVal = *dim;
1482
1483 // The DIM argument may be statically invalid (e.g. exceed the
1484 // input array rank) in dead code after constant propagation,
1485 // so avoid some checks unless useStrictIntrinsicVerifier is true.
1486 if (useStrictIntrinsicVerifier && dimVal != -1) {
1487 if (dimVal < 1)
1488 return emitOpError("DIM must be >= 1");
1489 if (dimVal > static_cast<int64_t>(arrayRank))
1490 return emitOpError("DIM must be <= input array's rank");
1491 }
1492
1493 if (auto shiftSeqTy = mlir::dyn_cast<fir::SequenceType>(shiftTy)) {
1494 // SHIFT is an array. Verify the rank and the shape (if DIM is constant).
1495 llvm::ArrayRef<int64_t> shiftShape = shiftSeqTy.getShape();
1496 std::size_t shiftRank = shiftShape.size();
1497 if (shiftRank != arrayRank - 1)
1498 return emitOpError(
1499 "SHIFT's rank must be 1 less than the input array's rank");
1500
1501 if (useStrictIntrinsicVerifier && dimVal != -1) {
1502 // SHIFT's shape must be [d(1), d(2), ..., d(DIM-1), d(DIM+1), ..., d(n)],
1503 // where [d(1), d(2), ..., d(n)] is the shape of the ARRAY.
1504 int64_t arrayDimIdx = 0;
1505 int64_t shiftDimIdx = 0;
1506 for (auto shiftDim : shiftShape) {
1507 if (arrayDimIdx == dimVal - 1)
1508 ++arrayDimIdx;
1509
1510 if (inShape[arrayDimIdx] != unknownExtent &&
1511 shiftDim != unknownExtent && inShape[arrayDimIdx] != shiftDim)
1512 return emitOpError("SHAPE(ARRAY)(" + llvm::Twine(arrayDimIdx + 1) +
1513 ") must be equal to SHAPE(SHIFT)(" +
1514 llvm::Twine(shiftDimIdx + 1) +
1515 "): " + llvm::Twine(inShape[arrayDimIdx]) +
1516 " != " + llvm::Twine(shiftDim));
1517 ++arrayDimIdx;
1518 ++shiftDimIdx;
1519 }
1520 }
1521 }
1522
1523 return mlir::success();
1524}
1525
1526void hlfir::CShiftOp::getEffects(
1527 llvm::SmallVectorImpl<
1528 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
1529 &effects) {
1530 getIntrinsicEffects(getOperation(), effects);
1531}
1532
1533//===----------------------------------------------------------------------===//
1534// ReshapeOp
1535//===----------------------------------------------------------------------===//
1536
1537llvm::LogicalResult hlfir::ReshapeOp::verify() {
1538 auto results = getOperation()->getResultTypes();
1539 assert(results.size() == 1);
1540 hlfir::ExprType resultType = mlir::cast<hlfir::ExprType>(results[0]);
1541 mlir::Value array = getArray();
1542 auto arrayType = mlir::cast<fir::SequenceType>(
1543 hlfir::getFortranElementOrSequenceType(array.getType()));
1544 if (auto match = areMatchingTypes(
1545 *this, hlfir::getFortranElementType(resultType),
1546 arrayType.getElementType(), /*allowCharacterLenMismatch=*/true);
1547 match.failed())
1548 return emitOpError("ARRAY and the result must have the same element type");
1549 if (hlfir::isPolymorphicType(resultType) !=
1550 hlfir::isPolymorphicType(array.getType()))
1551 return emitOpError("ARRAY must be polymorphic iff result is polymorphic");
1552
1553 mlir::Value shape = getShape();
1554 auto shapeArrayType = mlir::cast<fir::SequenceType>(
1555 hlfir::getFortranElementOrSequenceType(shape.getType()));
1556 if (shapeArrayType.getDimension() != 1)
1557 return emitOpError("SHAPE must be an array of rank 1");
1558 if (!mlir::isa<mlir::IntegerType>(shapeArrayType.getElementType()))
1559 return emitOpError("SHAPE must be an integer array");
1560 if (shapeArrayType.hasDynamicExtents())
1561 return emitOpError("SHAPE must have known size");
1562 if (shapeArrayType.getConstantArraySize() != resultType.getRank())
1563 return emitOpError("SHAPE's extent must match the result rank");
1564
1565 if (mlir::Value pad = getPad()) {
1566 auto padArrayType = mlir::cast<fir::SequenceType>(
1567 hlfir::getFortranElementOrSequenceType(pad.getType()));
1568 if (auto match = areMatchingTypes(*this, arrayType.getElementType(),
1569 padArrayType.getElementType(),
1570 /*allowCharacterLenMismatch=*/true);
1571 match.failed())
1572 return emitOpError("ARRAY and PAD must be of the same type");
1573 }
1574
1575 if (mlir::Value order = getOrder()) {
1576 auto orderArrayType = mlir::cast<fir::SequenceType>(
1577 hlfir::getFortranElementOrSequenceType(order.getType()));
1578 if (orderArrayType.getDimension() != 1)
1579 return emitOpError("ORDER must be an array of rank 1");
1580 if (!mlir::isa<mlir::IntegerType>(orderArrayType.getElementType()))
1581 return emitOpError("ORDER must be an integer array");
1582 }
1583
1584 return mlir::success();
1585}
1586
1587void hlfir::ReshapeOp::getEffects(
1588 llvm::SmallVectorImpl<
1589 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
1590 &effects) {
1591 getIntrinsicEffects(getOperation(), effects);
1592}
1593
1594//===----------------------------------------------------------------------===//
1595// AssociateOp
1596//===----------------------------------------------------------------------===//
1597
1598void hlfir::AssociateOp::build(mlir::OpBuilder &builder,
1599 mlir::OperationState &result, mlir::Value source,
1600 llvm::StringRef uniq_name, mlir::Value shape,
1601 mlir::ValueRange typeparams,
1602 fir::FortranVariableFlagsAttr fortran_attrs) {
1603 auto nameAttr = builder.getStringAttr(uniq_name);
1604 mlir::Type dataType = getFortranElementOrSequenceType(source.getType());
1605
1606 // Preserve polymorphism of polymorphic expr.
1607 mlir::Type firVarType;
1608 auto sourceExprType = mlir::dyn_cast<hlfir::ExprType>(source.getType());
1609 if (sourceExprType && sourceExprType.isPolymorphic())
1610 firVarType = fir::ClassType::get(dataType);
1611 else
1612 firVarType = fir::ReferenceType::get(dataType);
1613
1614 mlir::Type hlfirVariableType =
1615 DeclareOp::getHLFIRVariableType(firVarType, /*hasExplicitLbs=*/false);
1616 mlir::Type i1Type = builder.getI1Type();
1617 build(builder, result, {hlfirVariableType, firVarType, i1Type}, source, shape,
1618 typeparams, nameAttr, fortran_attrs);
1619}
1620
1621void hlfir::AssociateOp::build(
1622 mlir::OpBuilder &builder, mlir::OperationState &result, mlir::Value source,
1623 mlir::Value shape, mlir::ValueRange typeparams,
1624 fir::FortranVariableFlagsAttr fortran_attrs,
1625 llvm::ArrayRef<mlir::NamedAttribute> attributes) {
1626 mlir::Type dataType = getFortranElementOrSequenceType(source.getType());
1627
1628 // Preserve polymorphism of polymorphic expr.
1629 mlir::Type firVarType;
1630 auto sourceExprType = mlir::dyn_cast<hlfir::ExprType>(source.getType());
1631 if (sourceExprType && sourceExprType.isPolymorphic())
1632 firVarType = fir::ClassType::get(dataType);
1633 else
1634 firVarType = fir::ReferenceType::get(dataType);
1635
1636 mlir::Type hlfirVariableType =
1637 DeclareOp::getHLFIRVariableType(firVarType, /*hasExplicitLbs=*/false);
1638 mlir::Type i1Type = builder.getI1Type();
1639 build(builder, result, {hlfirVariableType, firVarType, i1Type}, source, shape,
1640 typeparams, {}, fortran_attrs);
1641 result.addAttributes(attributes);
1642}
1643
1644//===----------------------------------------------------------------------===//
1645// EndAssociateOp
1646//===----------------------------------------------------------------------===//
1647
1648void hlfir::EndAssociateOp::build(mlir::OpBuilder &builder,
1649 mlir::OperationState &result,
1650 hlfir::AssociateOp associate) {
1651 mlir::Value hlfirBase = associate.getBase();
1652 mlir::Value firBase = associate.getFirBase();
1653 // If EndAssociateOp may need to initiate the deallocation
1654 // of allocatable components, it has to have access to the variable
1655 // definition, so we cannot use the FIR base as the operand.
1656 return build(builder, result,
1657 hlfir::mayHaveAllocatableComponent(hlfirBase.getType())
1658 ? hlfirBase
1659 : firBase,
1660 associate.getMustFreeStrorageFlag());
1661}
1662
1663llvm::LogicalResult hlfir::EndAssociateOp::verify() {
1664 mlir::Value var = getVar();
1665 if (hlfir::mayHaveAllocatableComponent(var.getType()) &&
1666 !hlfir::isFortranEntity(var))
1667 return emitOpError("that requires components deallocation must have var "
1668 "operand that is a Fortran entity");
1669
1670 return mlir::success();
1671}
1672
1673//===----------------------------------------------------------------------===//
1674// AsExprOp
1675//===----------------------------------------------------------------------===//
1676
1677void hlfir::AsExprOp::build(mlir::OpBuilder &builder,
1678 mlir::OperationState &result, mlir::Value var,
1679 mlir::Value mustFree) {
1680 mlir::Type resultType = hlfir::getExprType(var.getType());
1681 return build(builder, result, resultType, var, mustFree);
1682}
1683
1684void hlfir::AsExprOp::getEffects(
1685 llvm::SmallVectorImpl<
1686 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
1687 &effects) {
1688 // this isn't a transformational intrinsic but follows the same pattern: it
1689 // creates a hlfir.expr and so needs to have an allocation effect, plus it
1690 // might have a pointer-like argument, in which case it has a read effect
1691 // upon those
1692 getIntrinsicEffects(getOperation(), effects);
1693}
1694
1695//===----------------------------------------------------------------------===//
1696// ElementalOp
1697//===----------------------------------------------------------------------===//
1698
1699/// Common builder for ElementalOp and ElementalAddrOp to add the arguments and
1700/// create the elemental body. Result and clean-up body must be handled in
1701/// specific builders.
1702template <typename Op>
1703static void buildElemental(mlir::OpBuilder &builder,
1704 mlir::OperationState &odsState, mlir::Value shape,
1705 mlir::Value mold, mlir::ValueRange typeparams,
1706 bool isUnordered) {
1707 odsState.addOperands(shape);
1708 if (mold)
1709 odsState.addOperands(mold);
1710 odsState.addOperands(typeparams);
1711 odsState.addAttribute(
1712 Op::getOperandSegmentSizesAttrName(odsState.name),
1713 builder.getDenseI32ArrayAttr({/*shape=*/1, (mold ? 1 : 0),
1714 static_cast<int32_t>(typeparams.size())}));
1715 if (isUnordered)
1716 odsState.addAttribute(Op::getUnorderedAttrName(odsState.name),
1717 isUnordered ? builder.getUnitAttr() : nullptr);
1718 mlir::Region *bodyRegion = odsState.addRegion();
1719 bodyRegion->push_back(new mlir::Block{});
1720 if (auto shapeType = mlir::dyn_cast<fir::ShapeType>(shape.getType())) {
1721 unsigned dim = shapeType.getRank();
1722 mlir::Type indexType = builder.getIndexType();
1723 for (unsigned d = 0; d < dim; ++d)
1724 bodyRegion->front().addArgument(indexType, odsState.location);
1725 }
1726}
1727
1728void hlfir::ElementalOp::build(mlir::OpBuilder &builder,
1729 mlir::OperationState &odsState,
1730 mlir::Type resultType, mlir::Value shape,
1731 mlir::Value mold, mlir::ValueRange typeparams,
1732 bool isUnordered) {
1733 odsState.addTypes(resultType);
1734 buildElemental<hlfir::ElementalOp>(builder, odsState, shape, mold, typeparams,
1735 isUnordered);
1736}
1737
1738mlir::Value hlfir::ElementalOp::getElementEntity() {
1739 return mlir::cast<hlfir::YieldElementOp>(getBody()->back()).getElementValue();
1740}
1741
1742llvm::LogicalResult hlfir::ElementalOp::verify() {
1743 mlir::Value mold = getMold();
1744 hlfir::ExprType resultType = mlir::cast<hlfir::ExprType>(getType());
1745 if (!!mold != resultType.isPolymorphic())
1746 return emitOpError("result must be polymorphic when mold is present "
1747 "and vice versa");
1748
1749 return mlir::success();
1750}
1751
1752//===----------------------------------------------------------------------===//
1753// ApplyOp
1754//===----------------------------------------------------------------------===//
1755
1756void hlfir::ApplyOp::build(mlir::OpBuilder &builder,
1757 mlir::OperationState &odsState, mlir::Value expr,
1758 mlir::ValueRange indices,
1759 mlir::ValueRange typeparams) {
1760 mlir::Type resultType = expr.getType();
1761 if (auto exprType = mlir::dyn_cast<hlfir::ExprType>(resultType))
1762 resultType = exprType.getElementExprType();
1763 build(builder, odsState, resultType, expr, indices, typeparams);
1764}
1765
1766//===----------------------------------------------------------------------===//
1767// NullOp
1768//===----------------------------------------------------------------------===//
1769
1770void hlfir::NullOp::build(mlir::OpBuilder &builder,
1771 mlir::OperationState &odsState) {
1772 return build(builder, odsState,
1773 fir::ReferenceType::get(builder.getNoneType()));
1774}
1775
1776//===----------------------------------------------------------------------===//
1777// DestroyOp
1778//===----------------------------------------------------------------------===//
1779
1780llvm::LogicalResult hlfir::DestroyOp::verify() {
1781 if (mustFinalizeExpr()) {
1782 mlir::Value expr = getExpr();
1783 hlfir::ExprType exprTy = mlir::cast<hlfir::ExprType>(expr.getType());
1784 mlir::Type elemTy = hlfir::getFortranElementType(exprTy);
1785 if (!mlir::isa<fir::RecordType>(elemTy))
1786 return emitOpError(
1787 "the element type must be finalizable, when 'finalize' is set");
1788 }
1789
1790 return mlir::success();
1791}
1792
1793//===----------------------------------------------------------------------===//
1794// CopyInOp
1795//===----------------------------------------------------------------------===//
1796
1797void hlfir::CopyInOp::build(mlir::OpBuilder &builder,
1798 mlir::OperationState &odsState, mlir::Value var,
1799 mlir::Value tempBox, mlir::Value var_is_present) {
1800 return build(builder, odsState, {var.getType(), builder.getI1Type()}, var,
1801 tempBox, var_is_present);
1802}
1803
1804//===----------------------------------------------------------------------===//
1805// ShapeOfOp
1806//===----------------------------------------------------------------------===//
1807
1808void hlfir::ShapeOfOp::build(mlir::OpBuilder &builder,
1809 mlir::OperationState &result, mlir::Value expr) {
1810 hlfir::ExprType exprTy = mlir::cast<hlfir::ExprType>(expr.getType());
1811 mlir::Type type = fir::ShapeType::get(builder.getContext(), exprTy.getRank());
1812 build(builder, result, type, expr);
1813}
1814
1815std::size_t hlfir::ShapeOfOp::getRank() {
1816 mlir::Type resTy = getResult().getType();
1817 fir::ShapeType shape = mlir::cast<fir::ShapeType>(resTy);
1818 return shape.getRank();
1819}
1820
1821llvm::LogicalResult hlfir::ShapeOfOp::verify() {
1822 mlir::Value expr = getExpr();
1823 hlfir::ExprType exprTy = mlir::cast<hlfir::ExprType>(expr.getType());
1824 std::size_t exprRank = exprTy.getShape().size();
1825
1826 if (exprRank == 0)
1827 return emitOpError("cannot get the shape of a shape-less expression");
1828
1829 std::size_t shapeRank = getRank();
1830 if (shapeRank != exprRank)
1831 return emitOpError("result rank and expr rank do not match");
1832
1833 return mlir::success();
1834}
1835
1836llvm::LogicalResult
1837hlfir::ShapeOfOp::canonicalize(ShapeOfOp shapeOf,
1838 mlir::PatternRewriter &rewriter) {
1839 // if extent information is available at compile time, immediately fold the
1840 // hlfir.shape_of into a fir.shape
1841 mlir::Location loc = shapeOf.getLoc();
1842 hlfir::ExprType expr =
1843 mlir::cast<hlfir::ExprType>(shapeOf.getExpr().getType());
1844
1845 mlir::Value shape = hlfir::genExprShape(rewriter, loc, expr);
1846 if (!shape)
1847 // shape information is not available at compile time
1848 return llvm::LogicalResult::failure();
1849
1850 rewriter.replaceAllUsesWith(shapeOf.getResult(), shape);
1851 rewriter.eraseOp(shapeOf);
1852 return llvm::LogicalResult::success();
1853}
1854
1855mlir::OpFoldResult hlfir::ShapeOfOp::fold(FoldAdaptor adaptor) {
1856 if (matchPattern(getExpr(), mlir::m_Op<hlfir::ElementalOp>())) {
1857 auto elementalOp =
1858 mlir::cast<hlfir::ElementalOp>(getExpr().getDefiningOp());
1859 return elementalOp.getShape();
1860 }
1861 return {};
1862}
1863
1864//===----------------------------------------------------------------------===//
1865// GetExtent
1866//===----------------------------------------------------------------------===//
1867
1868void hlfir::GetExtentOp::build(mlir::OpBuilder &builder,
1869 mlir::OperationState &result, mlir::Value shape,
1870 unsigned dim) {
1871 mlir::Type indexTy = builder.getIndexType();
1872 mlir::IntegerAttr dimAttr = mlir::IntegerAttr::get(indexTy, dim);
1873 build(builder, result, indexTy, shape, dimAttr);
1874}
1875
1876llvm::LogicalResult hlfir::GetExtentOp::verify() {
1877 fir::ShapeType shapeTy = mlir::cast<fir::ShapeType>(getShape().getType());
1878 std::uint64_t rank = shapeTy.getRank();
1879 llvm::APInt dim = getDim();
1880 if (dim.sge(rank))
1881 return emitOpError("dimension index out of bounds");
1882 return mlir::success();
1883}
1884
1885//===----------------------------------------------------------------------===//
1886// RegionAssignOp
1887//===----------------------------------------------------------------------===//
1888
1889/// Add a fir.end terminator to a parsed region if it does not already has a
1890/// terminator.
1891static void ensureTerminator(mlir::Region &region, mlir::Builder &builder,
1892 mlir::Location loc) {
1893 // Borrow YielOp::ensureTerminator MLIR generated implementation to add a
1894 // fir.end if there is no terminator. This has nothing to do with YielOp,
1895 // other than the fact that yieldOp has the
1896 // SingleBlocklicitTerminator<"fir::FirEndOp"> interface that
1897 // cannot be added on other HLFIR operations with several regions which are
1898 // not all terminated the same way.
1899 hlfir::YieldOp::ensureTerminator(region, builder, loc);
1900}
1901
1902mlir::ParseResult hlfir::RegionAssignOp::parse(mlir::OpAsmParser &parser,
1903 mlir::OperationState &result) {
1904 mlir::Region &rhsRegion = *result.addRegion();
1905 if (parser.parseRegion(rhsRegion))
1906 return mlir::failure();
1907 mlir::Region &lhsRegion = *result.addRegion();
1908 if (parser.parseKeyword("to") || parser.parseRegion(lhsRegion))
1909 return mlir::failure();
1910 mlir::Region &userDefinedAssignmentRegion = *result.addRegion();
1911 if (succeeded(parser.parseOptionalKeyword("user_defined_assign"))) {
1912 mlir::OpAsmParser::Argument rhsArg, lhsArg;
1913 if (parser.parseLParen() || parser.parseArgument(rhsArg) ||
1914 parser.parseColon() || parser.parseType(rhsArg.type) ||
1915 parser.parseRParen() || parser.parseKeyword("to") ||
1916 parser.parseLParen() || parser.parseArgument(lhsArg) ||
1917 parser.parseColon() || parser.parseType(lhsArg.type) ||
1918 parser.parseRParen())
1919 return mlir::failure();
1920 if (parser.parseRegion(userDefinedAssignmentRegion, {rhsArg, lhsArg}))
1921 return mlir::failure();
1922 ensureTerminator(userDefinedAssignmentRegion, parser.getBuilder(),
1923 result.location);
1924 }
1925 return mlir::success();
1926}
1927
1928void hlfir::RegionAssignOp::print(mlir::OpAsmPrinter &p) {
1929 p << " ";
1930 p.printRegion(getRhsRegion(), /*printEntryBlockArgs=*/false,
1931 /*printBlockTerminators=*/true);
1932 p << " to ";
1933 p.printRegion(getLhsRegion(), /*printEntryBlockArgs=*/false,
1934 /*printBlockTerminators=*/true);
1935 if (!getUserDefinedAssignment().empty()) {
1936 p << " user_defined_assign ";
1937 mlir::Value userAssignmentRhs = getUserAssignmentRhs();
1938 mlir::Value userAssignmentLhs = getUserAssignmentLhs();
1939 p << " (" << userAssignmentRhs << ": " << userAssignmentRhs.getType()
1940 << ") to (";
1941 p << userAssignmentLhs << ": " << userAssignmentLhs.getType() << ") ";
1942 p.printRegion(getUserDefinedAssignment(), /*printEntryBlockArgs=*/false,
1943 /*printBlockTerminators=*/false);
1944 }
1945}
1946
1947static mlir::Operation *getTerminator(mlir::Region &region) {
1948 if (region.empty() || region.back().empty())
1949 return nullptr;
1950 return &region.back().back();
1951}
1952
1953llvm::LogicalResult hlfir::RegionAssignOp::verify() {
1954 if (!mlir::isa_and_nonnull<hlfir::YieldOp>(getTerminator(getRhsRegion())))
1955 return emitOpError(
1956 "right-hand side region must be terminated by an hlfir.yield");
1957 if (!mlir::isa_and_nonnull<hlfir::YieldOp, hlfir::ElementalAddrOp>(
1958 getTerminator(getLhsRegion())))
1959 return emitOpError("left-hand side region must be terminated by an "
1960 "hlfir.yield or hlfir.elemental_addr");
1961 return mlir::success();
1962}
1963
1964static mlir::Type
1965getNonVectorSubscriptedLhsType(hlfir::RegionAssignOp regionAssign) {
1966 hlfir::YieldOp yieldOp = mlir::dyn_cast_or_null<hlfir::YieldOp>(
1967 getTerminator(regionAssign.getLhsRegion()));
1968 return yieldOp ? yieldOp.getEntity().getType() : mlir::Type{};
1969}
1970
1971bool hlfir::RegionAssignOp::isPointerObjectAssignment() {
1972 if (!getUserDefinedAssignment().empty())
1973 return false;
1974 mlir::Type lhsType = getNonVectorSubscriptedLhsType(*this);
1975 return lhsType && hlfir::isFortranPointerObjectType(lhsType);
1976}
1977
1978bool hlfir::RegionAssignOp::isProcedurePointerAssignment() {
1979 if (!getUserDefinedAssignment().empty())
1980 return false;
1981 mlir::Type lhsType = getNonVectorSubscriptedLhsType(*this);
1982 return lhsType && hlfir::isFortranProcedurePointerType(lhsType);
1983}
1984
1985bool hlfir::RegionAssignOp::isPointerAssignment() {
1986 if (!getUserDefinedAssignment().empty())
1987 return false;
1988 mlir::Type lhsType = getNonVectorSubscriptedLhsType(*this);
1989 return lhsType && (hlfir::isFortranPointerObjectType(lhsType) ||
1990 hlfir::isFortranProcedurePointerType(lhsType));
1991}
1992
1993//===----------------------------------------------------------------------===//
1994// YieldOp
1995//===----------------------------------------------------------------------===//
1996
1997static mlir::ParseResult parseYieldOpCleanup(mlir::OpAsmParser &parser,
1998 mlir::Region &cleanup) {
1999 if (succeeded(parser.parseOptionalKeyword("cleanup"))) {
2000 if (parser.parseRegion(cleanup, /*arguments=*/{},
2001 /*argTypes=*/{}))
2002 return mlir::failure();
2003 hlfir::YieldOp::ensureTerminator(cleanup, parser.getBuilder(),
2004 parser.getBuilder().getUnknownLoc());
2005 }
2006 return mlir::success();
2007}
2008
2009template <typename YieldOp>
2010static void printYieldOpCleanup(mlir::OpAsmPrinter &p, YieldOp yieldOp,
2011 mlir::Region &cleanup) {
2012 if (!cleanup.empty()) {
2013 p << "cleanup ";
2014 p.printRegion(cleanup, /*printEntryBlockArgs=*/false,
2015 /*printBlockTerminators=*/false);
2016 }
2017}
2018
2019//===----------------------------------------------------------------------===//
2020// ElementalAddrOp
2021//===----------------------------------------------------------------------===//
2022
2023void hlfir::ElementalAddrOp::build(mlir::OpBuilder &builder,
2024 mlir::OperationState &odsState,
2025 mlir::Value shape, mlir::Value mold,
2026 mlir::ValueRange typeparams,
2027 bool isUnordered) {
2028 buildElemental<hlfir::ElementalAddrOp>(builder, odsState, shape, mold,
2029 typeparams, isUnordered);
2030 // Push cleanUp region.
2031 odsState.addRegion();
2032}
2033
2034llvm::LogicalResult hlfir::ElementalAddrOp::verify() {
2035 hlfir::YieldOp yieldOp =
2036 mlir::dyn_cast_or_null<hlfir::YieldOp>(getTerminator(getBody()));
2037 if (!yieldOp)
2038 return emitOpError("body region must be terminated by an hlfir.yield");
2039 mlir::Type elementAddrType = yieldOp.getEntity().getType();
2040 if (!hlfir::isFortranVariableType(elementAddrType) ||
2041 mlir::isa<fir::SequenceType>(
2042 hlfir::getFortranElementOrSequenceType(elementAddrType)))
2043 return emitOpError("body must compute the address of a scalar entity");
2044 unsigned shapeRank =
2045 mlir::cast<fir::ShapeType>(getShape().getType()).getRank();
2046 if (shapeRank != getIndices().size())
2047 return emitOpError("body number of indices must match shape rank");
2048 return mlir::success();
2049}
2050
2051hlfir::YieldOp hlfir::ElementalAddrOp::getYieldOp() {
2052 hlfir::YieldOp yieldOp =
2053 mlir::dyn_cast_or_null<hlfir::YieldOp>(getTerminator(getBody()));
2054 assert(yieldOp && "element_addr is ill-formed");
2055 return yieldOp;
2056}
2057
2058mlir::Value hlfir::ElementalAddrOp::getElementEntity() {
2059 return getYieldOp().getEntity();
2060}
2061
2062mlir::Region *hlfir::ElementalAddrOp::getElementCleanup() {
2063 mlir::Region *cleanup = &getYieldOp().getCleanup();
2064 return cleanup->empty() ? nullptr : cleanup;
2065}
2066
2067//===----------------------------------------------------------------------===//
2068// OrderedAssignmentTreeOpInterface
2069//===----------------------------------------------------------------------===//
2070
2071llvm::LogicalResult hlfir::OrderedAssignmentTreeOpInterface::verifyImpl() {
2072 if (mlir::Region *body = getSubTreeRegion())
2073 if (!body->empty())
2074 for (mlir::Operation &op : body->front())
2075 if (!mlir::isa<hlfir::OrderedAssignmentTreeOpInterface, fir::FirEndOp>(
2076 op))
2077 return emitOpError(
2078 "body region must only contain OrderedAssignmentTreeOpInterface "
2079 "operations or fir.end");
2080 return mlir::success();
2081}
2082
2083//===----------------------------------------------------------------------===//
2084// ForallOp
2085//===----------------------------------------------------------------------===//
2086
2087static mlir::ParseResult parseForallOpBody(mlir::OpAsmParser &parser,
2088 mlir::Region &body) {
2089 mlir::OpAsmParser::Argument bodyArg;
2090 if (parser.parseLParen() || parser.parseArgument(bodyArg) ||
2091 parser.parseColon() || parser.parseType(bodyArg.type) ||
2092 parser.parseRParen())
2093 return mlir::failure();
2094 if (parser.parseRegion(body, {bodyArg}))
2095 return mlir::failure();
2096 ensureTerminator(body, parser.getBuilder(),
2097 parser.getBuilder().getUnknownLoc());
2098 return mlir::success();
2099}
2100
2101static void printForallOpBody(mlir::OpAsmPrinter &p, hlfir::ForallOp forall,
2102 mlir::Region &body) {
2103 mlir::Value forallIndex = forall.getForallIndexValue();
2104 p << " (" << forallIndex << ": " << forallIndex.getType() << ") ";
2105 p.printRegion(body, /*printEntryBlockArgs=*/false,
2106 /*printBlockTerminators=*/false);
2107}
2108
2109/// Predicate implementation of YieldIntegerOrEmpty.
2110static bool yieldsIntegerOrEmpty(mlir::Region &region) {
2111 if (region.empty())
2112 return true;
2113 auto yield = mlir::dyn_cast_or_null<hlfir::YieldOp>(getTerminator(region));
2114 return yield && fir::isa_integer(yield.getEntity().getType());
2115}
2116
2117//===----------------------------------------------------------------------===//
2118// ForallMaskOp
2119//===----------------------------------------------------------------------===//
2120
2121static mlir::ParseResult parseAssignmentMaskOpBody(mlir::OpAsmParser &parser,
2122 mlir::Region &body) {
2123 if (parser.parseRegion(body))
2124 return mlir::failure();
2125 ensureTerminator(body, parser.getBuilder(),
2126 parser.getBuilder().getUnknownLoc());
2127 return mlir::success();
2128}
2129
2130template <typename ConcreteOp>
2131static void printAssignmentMaskOpBody(mlir::OpAsmPrinter &p, ConcreteOp,
2132 mlir::Region &body) {
2133 // ElseWhereOp is a WhereOp/ElseWhereOp terminator that should be printed.
2134 bool printBlockTerminators =
2135 !body.empty() &&
2136 mlir::isa_and_nonnull<hlfir::ElseWhereOp>(body.back().getTerminator());
2137 p.printRegion(body, /*printEntryBlockArgs=*/false, printBlockTerminators);
2138}
2139
2140static bool yieldsLogical(mlir::Region &region, bool mustBeScalarI1) {
2141 if (region.empty())
2142 return false;
2143 auto yield = mlir::dyn_cast_or_null<hlfir::YieldOp>(getTerminator(region));
2144 if (!yield)
2145 return false;
2146 mlir::Type yieldType = yield.getEntity().getType();
2147 if (mustBeScalarI1)
2148 return hlfir::isI1Type(yieldType);
2149 return hlfir::isMaskArgument(yieldType) &&
2150 mlir::isa<fir::SequenceType>(
2151 hlfir::getFortranElementOrSequenceType(yieldType));
2152}
2153
2154llvm::LogicalResult hlfir::ForallMaskOp::verify() {
2155 if (!yieldsLogical(getMaskRegion(), /*mustBeScalarI1=*/true))
2156 return emitOpError("mask region must yield a scalar i1");
2157 mlir::Operation *op = getOperation();
2158 hlfir::ForallOp forallOp =
2159 mlir::dyn_cast_or_null<hlfir::ForallOp>(op->getParentOp());
2160 if (!forallOp || op->getParentRegion() != &forallOp.getBody())
2161 return emitOpError("must be inside the body region of an hlfir.forall");
2162 return mlir::success();
2163}
2164
2165//===----------------------------------------------------------------------===//
2166// WhereOp and ElseWhereOp
2167//===----------------------------------------------------------------------===//
2168
2169template <typename ConcreteOp>
2170static llvm::LogicalResult verifyWhereAndElseWhereBody(ConcreteOp &concreteOp) {
2171 for (mlir::Operation &op : concreteOp.getBody().front())
2172 if (mlir::isa<hlfir::ForallOp>(op))
2173 return concreteOp.emitOpError(
2174 "body region must not contain hlfir.forall");
2175 return mlir::success();
2176}
2177
2178llvm::LogicalResult hlfir::WhereOp::verify() {
2179 if (!yieldsLogical(getMaskRegion(), /*mustBeScalarI1=*/false))
2180 return emitOpError("mask region must yield a logical array");
2181 return verifyWhereAndElseWhereBody(*this);
2182}
2183
2184llvm::LogicalResult hlfir::ElseWhereOp::verify() {
2185 if (!getMaskRegion().empty())
2186 if (!yieldsLogical(getMaskRegion(), /*mustBeScalarI1=*/false))
2187 return emitOpError(
2188 "mask region must yield a logical array when provided");
2189 return verifyWhereAndElseWhereBody(*this);
2190}
2191
2192//===----------------------------------------------------------------------===//
2193// ForallIndexOp
2194//===----------------------------------------------------------------------===//
2195
2196llvm::LogicalResult
2197hlfir::ForallIndexOp::canonicalize(hlfir::ForallIndexOp indexOp,
2198 mlir::PatternRewriter &rewriter) {
2199 for (mlir::Operation *user : indexOp->getResult(0).getUsers())
2200 if (!mlir::isa<fir::LoadOp>(user))
2201 return mlir::failure();
2202
2203 auto insertPt = rewriter.saveInsertionPoint();
2204 llvm::SmallVector<mlir::Operation *> users(indexOp->getResult(0).getUsers());
2205 for (mlir::Operation *user : users)
2206 if (auto loadOp = mlir::dyn_cast<fir::LoadOp>(user)) {
2207 rewriter.setInsertionPoint(loadOp);
2208 rewriter.replaceOpWithNewOp<fir::ConvertOp>(
2209 user, loadOp.getResult().getType(), indexOp.getIndex());
2210 }
2211 rewriter.restoreInsertionPoint(insertPt);
2212 rewriter.eraseOp(indexOp);
2213 return mlir::success();
2214}
2215
2216//===----------------------------------------------------------------------===//
2217// CharExtremumOp
2218//===----------------------------------------------------------------------===//
2219
2220llvm::LogicalResult hlfir::CharExtremumOp::verify() {
2221 if (getStrings().size() < 2)
2222 return emitOpError("must be provided at least two string operands");
2223 unsigned kind = getCharacterKind(getResult().getType());
2224 for (auto string : getStrings())
2225 if (kind != getCharacterKind(string.getType()))
2226 return emitOpError("strings must have the same KIND as the result type");
2227 return mlir::success();
2228}
2229
2230void hlfir::CharExtremumOp::build(mlir::OpBuilder &builder,
2231 mlir::OperationState &result,
2232 hlfir::CharExtremumPredicate predicate,
2233 mlir::ValueRange strings) {
2234
2235 fir::CharacterType::LenType resultTypeLen = 0;
2236 assert(!strings.empty() && "must contain operands");
2237 unsigned kind = getCharacterKind(strings[0].getType());
2238 for (auto string : strings)
2239 if (auto cstLen = getCharacterLengthIfStatic(string.getType())) {
2240 resultTypeLen = std::max(resultTypeLen, *cstLen);
2241 } else {
2242 resultTypeLen = fir::CharacterType::unknownLen();
2243 break;
2244 }
2245 auto resultType = hlfir::ExprType::get(
2246 builder.getContext(), hlfir::ExprType::Shape{},
2247 fir::CharacterType::get(builder.getContext(), kind, resultTypeLen),
2248 false);
2249
2250 build(builder, result, resultType, predicate, strings);
2251}
2252
2253void hlfir::CharExtremumOp::getEffects(
2254 llvm::SmallVectorImpl<
2255 mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>
2256 &effects) {
2257 getIntrinsicEffects(getOperation(), effects);
2258}
2259
2260//===----------------------------------------------------------------------===//
2261// GetLength
2262//===----------------------------------------------------------------------===//
2263
2264llvm::LogicalResult
2265hlfir::GetLengthOp::canonicalize(GetLengthOp getLength,
2266 mlir::PatternRewriter &rewriter) {
2267 mlir::Location loc = getLength.getLoc();
2268 auto exprTy = mlir::cast<hlfir::ExprType>(getLength.getExpr().getType());
2269 auto charTy = mlir::cast<fir::CharacterType>(exprTy.getElementType());
2270 if (!charTy.hasConstantLen())
2271 return mlir::failure();
2272
2273 mlir::Type indexTy = rewriter.getIndexType();
2274 auto cstLen = rewriter.create<mlir::arith::ConstantOp>(
2275 loc, indexTy, mlir::IntegerAttr::get(indexTy, charTy.getLen()));
2276 rewriter.replaceOp(getLength, cstLen);
2277 return mlir::success();
2278}
2279
2280//===----------------------------------------------------------------------===//
2281// EvaluateInMemoryOp
2282//===----------------------------------------------------------------------===//
2283
2284void hlfir::EvaluateInMemoryOp::build(mlir::OpBuilder &builder,
2285 mlir::OperationState &odsState,
2286 mlir::Type resultType, mlir::Value shape,
2287 mlir::ValueRange typeparams) {
2288 odsState.addTypes(resultType);
2289 if (shape)
2290 odsState.addOperands(shape);
2291 odsState.addOperands(typeparams);
2292 odsState.addAttribute(
2293 getOperandSegmentSizeAttr(),
2294 builder.getDenseI32ArrayAttr(
2295 {shape ? 1 : 0, static_cast<int32_t>(typeparams.size())}));
2296 mlir::Region *bodyRegion = odsState.addRegion();
2297 bodyRegion->push_back(new mlir::Block{});
2298 mlir::Type memType = fir::ReferenceType::get(
2299 hlfir::getFortranElementOrSequenceType(resultType));
2300 bodyRegion->front().addArgument(memType, odsState.location);
2301 EvaluateInMemoryOp::ensureTerminator(*bodyRegion, builder, odsState.location);
2302}
2303
2304llvm::LogicalResult hlfir::EvaluateInMemoryOp::verify() {
2305 unsigned shapeRank = 0;
2306 if (mlir::Value shape = getShape())
2307 if (auto shapeTy = mlir::dyn_cast<fir::ShapeType>(shape.getType()))
2308 shapeRank = shapeTy.getRank();
2309 auto exprType = mlir::cast<hlfir::ExprType>(getResult().getType());
2310 if (shapeRank != exprType.getRank())
2311 return emitOpError("`shape` rank must match the result rank");
2312 mlir::Type elementType = exprType.getElementType();
2313 if (auto res = verifyTypeparams(*this, elementType, getTypeparams().size());
2314 failed(res))
2315 return res;
2316 return mlir::success();
2317}
2318
2319#include "flang/Optimizer/HLFIR/HLFIROpInterfaces.cpp.inc"
2320#define GET_OP_CLASSES
2321#include "flang/Optimizer/HLFIR/HLFIREnums.cpp.inc"
2322#include "flang/Optimizer/HLFIR/HLFIROps.cpp.inc"
2323

source code of flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp