brintos

brintos / llvm-project-archived public Read only

0
0
Text · 98.1 KiB · e42c064 Raw
2468 lines · cpp
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-exception6//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(false),35    llvm::cl::desc("use stricter verifier for HLFIR intrinsic operations"));36 37/// generic implementation of the memory side effects interface for hlfir38/// transformational intrinsic operations39static void40getIntrinsicEffects(mlir::Operation *self,41                    llvm::SmallVectorImpl<mlir::SideEffects::EffectInstance<42                        mlir::MemoryEffects::Effect>> &effects) {43  // allocation effect if we return an expr44  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 type52  // or a box who'se pointer is read from inside of the intrinsic so that53  // loop conflicts can be detected in code like54  // 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 types73/// 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 lengths85      // 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// AssignOp100//===----------------------------------------------------------------------===//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 it131    // is not known here if user defined finalization is needed, and also132    // because allocatable components may lead to "deeper" read/write effects133    // 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 effect143        // 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 data155      //  write cannot be described in this API (and the descriptor may be156      //  written to in case of realloc, which is covered by the unknown write157      //  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// DeclareOp181//===----------------------------------------------------------------------===//182 183static std::pair<mlir::Type, mlir::Type>184getDeclareOutputTypes(mlir::Type inputType, bool hasExplicitLowerBounds) {185  // Drop pointer/allocatable attribute of descriptor values. Only descriptor186  // addresses are ALLOCATABLE/POINTER. The HLFIR box result of an hlfir.declare187  // 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, get219/// 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      fir::VolatileCastOp::create(builder, memref.getLoc(), inputType, memref);261  return std::make_pair(inputType, memref);262}263 264void hlfir::DeclareOp::build(265    mlir::OpBuilder &builder, mlir::OperationState &result, mlir::Value memref,266    llvm::StringRef uniq_name, mlir::Value shape, mlir::ValueRange typeparams,267    mlir::Value dummy_scope, mlir::Value storage, std::uint64_t storage_offset,268    fir::FortranVariableFlagsAttr fortran_attrs,269    cuf::DataAttributeAttr data_attr, unsigned dummy_arg_no) {270  auto nameAttr = builder.getStringAttr(uniq_name);271  mlir::Type inputType = memref.getType();272  bool hasExplicitLbs = hasExplicitLowerBounds(shape);273  if (fortran_attrs) {274    const auto flags = fortran_attrs.getFlags();275    std::tie(inputType, memref) = updateDeclaredInputTypeWithVolatility(276        inputType, memref, builder, flags);277  }278  auto [hlfirVariableType, firVarType] =279      getDeclareOutputTypes(inputType, hasExplicitLbs);280  mlir::IntegerAttr argNoAttr;281  if (dummy_arg_no > 0)282    argNoAttr = builder.getUI32IntegerAttr(dummy_arg_no);283  build(builder, result, {hlfirVariableType, firVarType}, memref, shape,284        typeparams, dummy_scope, storage, storage_offset, nameAttr,285        fortran_attrs, data_attr, /*skip_rebox=*/mlir::UnitAttr{}, argNoAttr);286}287 288llvm::LogicalResult hlfir::DeclareOp::verify() {289  auto [hlfirVariableType, firVarType] = getDeclareOutputTypes(290      getMemref().getType(), hasExplicitLowerBounds(getShape()));291  if (firVarType != getResult(1).getType())292    return emitOpError("second result type must match input memref type, "293                       "unless it is a box with heap or pointer attribute");294  if (hlfirVariableType != getResult(0).getType())295    return emitOpError("first result type is inconsistent with variable "296                       "properties: expected ")297           << hlfirVariableType;298  if (getSkipRebox() && !llvm::isa<fir::BaseBoxType>(getMemref().getType()))299    return emitOpError(300        "skip_rebox attribute must only be set when the input is a box");301  // The rest of the argument verification is done by the302  // FortranVariableInterface verifier.303  auto fortranVar =304      mlir::cast<fir::FortranVariableOpInterface>(this->getOperation());305  return fortranVar.verifyDeclareLikeOpImpl(getMemref());306}307 308//===----------------------------------------------------------------------===//309// DesignateOp310//===----------------------------------------------------------------------===//311 312void hlfir::DesignateOp::build(313    mlir::OpBuilder &builder, mlir::OperationState &result,314    mlir::Type result_type, mlir::Value memref, llvm::StringRef component,315    mlir::Value component_shape, llvm::ArrayRef<Subscript> subscripts,316    mlir::ValueRange substring, std::optional<bool> complex_part,317    mlir::Value shape, mlir::ValueRange typeparams,318    fir::FortranVariableFlagsAttr fortran_attrs) {319  auto componentAttr =320      component.empty() ? mlir::StringAttr{} : builder.getStringAttr(component);321  llvm::SmallVector<mlir::Value> indices;322  llvm::SmallVector<bool> isTriplet;323  for (auto subscript : subscripts) {324    if (auto *triplet = std::get_if<Triplet>(&subscript)) {325      isTriplet.push_back(true);326      indices.push_back(std::get<0>(*triplet));327      indices.push_back(std::get<1>(*triplet));328      indices.push_back(std::get<2>(*triplet));329    } else {330      isTriplet.push_back(false);331      indices.push_back(std::get<mlir::Value>(subscript));332    }333  }334  auto isTripletAttr =335      mlir::DenseBoolArrayAttr::get(builder.getContext(), isTriplet);336  auto complexPartAttr =337      complex_part.has_value()338          ? mlir::BoolAttr::get(builder.getContext(), *complex_part)339          : mlir::BoolAttr{};340  build(builder, result, result_type, memref, componentAttr, component_shape,341        indices, isTripletAttr, substring, complexPartAttr, shape, typeparams,342        fortran_attrs);343}344 345void hlfir::DesignateOp::build(mlir::OpBuilder &builder,346                               mlir::OperationState &result,347                               mlir::Type result_type, mlir::Value memref,348                               mlir::ValueRange indices,349                               mlir::ValueRange typeparams,350                               fir::FortranVariableFlagsAttr fortran_attrs) {351  llvm::SmallVector<bool> isTriplet(indices.size(), false);352  auto isTripletAttr =353      mlir::DenseBoolArrayAttr::get(builder.getContext(), isTriplet);354  build(builder, result, result_type, memref,355        /*componentAttr=*/mlir::StringAttr{}, /*component_shape=*/mlir::Value{},356        indices, isTripletAttr, /*substring*/ mlir::ValueRange{},357        /*complexPartAttr=*/mlir::BoolAttr{}, /*shape=*/mlir::Value{},358        typeparams, fortran_attrs);359}360 361static mlir::ParseResult parseDesignatorIndices(362    mlir::OpAsmParser &parser,363    llvm::SmallVectorImpl<mlir::OpAsmParser::UnresolvedOperand> &indices,364    mlir::DenseBoolArrayAttr &isTripletAttr) {365  llvm::SmallVector<bool> isTriplet;366  if (mlir::succeeded(parser.parseOptionalLParen())) {367    do {368      mlir::OpAsmParser::UnresolvedOperand i1, i2, i3;369      if (parser.parseOperand(i1))370        return mlir::failure();371      indices.push_back(i1);372      if (mlir::succeeded(parser.parseOptionalColon())) {373        if (parser.parseOperand(i2) || parser.parseColon() ||374            parser.parseOperand(i3))375          return mlir::failure();376        indices.push_back(i2);377        indices.push_back(i3);378        isTriplet.push_back(true);379      } else {380        isTriplet.push_back(false);381      }382    } while (mlir::succeeded(parser.parseOptionalComma()));383    if (parser.parseRParen())384      return mlir::failure();385  }386  isTripletAttr = mlir::DenseBoolArrayAttr::get(parser.getContext(), isTriplet);387  return mlir::success();388}389 390static void391printDesignatorIndices(mlir::OpAsmPrinter &p, hlfir::DesignateOp designateOp,392                       mlir::OperandRange indices,393                       const mlir::DenseBoolArrayAttr &isTripletAttr) {394  if (!indices.empty()) {395    p << '(';396    unsigned i = 0;397    for (auto isTriplet : isTripletAttr.asArrayRef()) {398      if (isTriplet) {399        assert(i + 2 < indices.size() && "ill-formed indices");400        p << indices[i] << ":" << indices[i + 1] << ":" << indices[i + 2];401        i += 3;402      } else {403        p << indices[i++];404      }405      if (i != indices.size())406        p << ", ";407    }408    p << ')';409  }410}411 412static mlir::ParseResult413parseDesignatorComplexPart(mlir::OpAsmParser &parser,414                           mlir::BoolAttr &complexPart) {415  if (mlir::succeeded(parser.parseOptionalKeyword("imag")))416    complexPart = mlir::BoolAttr::get(parser.getContext(), true);417  else if (mlir::succeeded(parser.parseOptionalKeyword("real")))418    complexPart = mlir::BoolAttr::get(parser.getContext(), false);419  return mlir::success();420}421 422static void printDesignatorComplexPart(mlir::OpAsmPrinter &p,423                                       hlfir::DesignateOp designateOp,424                                       mlir::BoolAttr complexPartAttr) {425  if (complexPartAttr) {426    if (complexPartAttr.getValue())427      p << "imag";428    else429      p << "real";430  }431}432template <typename Op>433static llvm::LogicalResult verifyTypeparams(Op &op, mlir::Type elementType,434                                            unsigned numLenParam) {435  if (mlir::isa<fir::CharacterType>(elementType)) {436    if (numLenParam != 1)437      return op.emitOpError("must be provided one length parameter when the "438                            "result is a character");439  } else if (fir::isRecordWithTypeParameters(elementType)) {440    if (numLenParam !=441        mlir::cast<fir::RecordType>(elementType).getNumLenParams())442      return op.emitOpError("must be provided the same number of length "443                            "parameters as in the result derived type");444  } else if (numLenParam != 0) {445    return op.emitOpError(446        "must not be provided length parameters if the result "447        "type does not have length parameters");448  }449  return mlir::success();450}451 452llvm::LogicalResult hlfir::DesignateOp::verify() {453  mlir::Type memrefType = getMemref().getType();454  mlir::Type baseType = getFortranElementOrSequenceType(memrefType);455  mlir::Type baseElementType = fir::unwrapSequenceType(baseType);456  unsigned numSubscripts = getIsTriplet().size();457  unsigned subscriptsRank =458      llvm::count_if(getIsTriplet(), [](bool isTriplet) { return isTriplet; });459  unsigned outputRank = 0;460  mlir::Type outputElementType;461  bool hasBoxComponent;462  if (fir::useStrictVolatileVerification() &&463      fir::isa_volatile_type(memrefType) !=464          fir::isa_volatile_type(getResult().getType())) {465    return emitOpError("volatility mismatch between memref and result type")466           << " memref type: " << memrefType467           << " result type: " << getResult().getType();468  }469  if (getComponent()) {470    auto component = getComponent().value();471    auto recType = mlir::dyn_cast<fir::RecordType>(baseElementType);472    if (!recType)473      return emitOpError(474          "component must be provided only when the memref is a derived type");475    unsigned fieldIdx = recType.getFieldIndex(component);476    if (fieldIdx > recType.getNumFields()) {477      return emitOpError("component ")478             << component << " is not a component of memref element type "479             << recType;480    }481    mlir::Type fieldType = recType.getType(fieldIdx);482    mlir::Type componentBaseType = getFortranElementOrSequenceType(fieldType);483    hasBoxComponent = mlir::isa<fir::BaseBoxType>(fieldType);484    if (mlir::isa<fir::SequenceType>(componentBaseType) &&485        mlir::isa<fir::SequenceType>(baseType) &&486        (numSubscripts == 0 || subscriptsRank > 0))487      return emitOpError("indices must be provided and must not contain "488                         "triplets when both memref and component are arrays");489    if (numSubscripts != 0) {490      if (!mlir::isa<fir::SequenceType>(componentBaseType))491        return emitOpError("indices must not be provided if component appears "492                           "and is not an array component");493      if (!getComponentShape())494        return emitOpError(495            "component_shape must be provided when indexing a component");496      mlir::Type compShapeType = getComponentShape().getType();497      unsigned componentRank =498          mlir::cast<fir::SequenceType>(componentBaseType).getDimension();499      auto shapeType = mlir::dyn_cast<fir::ShapeType>(compShapeType);500      auto shapeShiftType = mlir::dyn_cast<fir::ShapeShiftType>(compShapeType);501      if (!((shapeType && shapeType.getRank() == componentRank) ||502            (shapeShiftType && shapeShiftType.getRank() == componentRank)))503        return emitOpError("component_shape must be a fir.shape or "504                           "fir.shapeshift with the rank of the component");505      if (numSubscripts > componentRank)506        return emitOpError("indices number must match array component rank");507    }508    if (auto baseSeqType = mlir::dyn_cast<fir::SequenceType>(baseType))509      // This case must come first to cover "array%array_comp(i, j)" that has510      // subscripts for the component but whose rank come from the base.511      outputRank = baseSeqType.getDimension();512    else if (numSubscripts != 0)513      outputRank = subscriptsRank;514    else if (auto componentSeqType =515                 mlir::dyn_cast<fir::SequenceType>(componentBaseType))516      outputRank = componentSeqType.getDimension();517    outputElementType = fir::unwrapSequenceType(componentBaseType);518  } else {519    outputElementType = baseElementType;520    unsigned baseTypeRank =521        mlir::isa<fir::SequenceType>(baseType)522            ? mlir::cast<fir::SequenceType>(baseType).getDimension()523            : 0;524    if (numSubscripts != 0) {525      if (baseTypeRank != numSubscripts)526        return emitOpError("indices number must match memref rank");527      outputRank = subscriptsRank;528    } else if (auto baseSeqType = mlir::dyn_cast<fir::SequenceType>(baseType)) {529      outputRank = baseSeqType.getDimension();530    }531  }532 533  if (!getSubstring().empty()) {534    if (!mlir::isa<fir::CharacterType>(outputElementType))535      return emitOpError("memref or component must have character type if "536                         "substring indices are provided");537    if (getSubstring().size() != 2)538      return emitOpError("substring must contain 2 indices when provided");539  }540  if (getComplexPart()) {541    if (auto cplx = mlir::dyn_cast<mlir::ComplexType>(outputElementType))542      outputElementType = cplx.getElementType();543    else544      return emitOpError("memref or component must have complex type if "545                         "complex_part is provided");546  }547  mlir::Type resultBaseType =548      getFortranElementOrSequenceType(getResult().getType());549  unsigned resultRank = 0;550  if (auto resultSeqType = mlir::dyn_cast<fir::SequenceType>(resultBaseType))551    resultRank = resultSeqType.getDimension();552  if (resultRank != outputRank)553    return emitOpError("result type rank is not consistent with operands, "554                       "expected rank ")555           << outputRank;556  mlir::Type resultElementType = fir::unwrapSequenceType(resultBaseType);557  // result type must match the one that was inferred here, except the character558  // length may differ because of substrings.559  if (resultElementType != outputElementType &&560      !(mlir::isa<fir::CharacterType>(resultElementType) &&561        mlir::isa<fir::CharacterType>(outputElementType)))562    return emitOpError(563               "result element type is not consistent with operands, expected ")564           << outputElementType;565 566  if (isBoxAddressType(getResult().getType())) {567    if (!hasBoxComponent || numSubscripts != 0 || !getSubstring().empty() ||568        getComplexPart())569      return emitOpError(570          "result type must only be a box address type if it designates a "571          "component that is a fir.box or fir.class and if there are no "572          "indices, substrings, and complex part");573 574  } else {575    if ((resultRank == 0) != !getShape())576      return emitOpError("shape must be provided if and only if the result is "577                         "an array that is not a box address");578    if (resultRank != 0) {579      auto shapeType = mlir::dyn_cast<fir::ShapeType>(getShape().getType());580      auto shapeShiftType =581          mlir::dyn_cast<fir::ShapeShiftType>(getShape().getType());582      if (!((shapeType && shapeType.getRank() == resultRank) ||583            (shapeShiftType && shapeShiftType.getRank() == resultRank)))584        return emitOpError("shape must be a fir.shape or fir.shapeshift with "585                           "the rank of the result");586    }587    if (auto res =588            verifyTypeparams(*this, outputElementType, getTypeparams().size());589        failed(res))590      return res;591  }592  return mlir::success();593}594 595std::optional<std::int64_t> hlfir::DesignateOp::getViewOffset(mlir::OpResult) {596  // TODO: we can compute the constant offset597  // based on the component/indices/etc.598  return std::nullopt;599}600 601//===----------------------------------------------------------------------===//602// ParentComponentOp603//===----------------------------------------------------------------------===//604 605llvm::LogicalResult hlfir::ParentComponentOp::verify() {606  mlir::Type baseType =607      hlfir::getFortranElementOrSequenceType(getMemref().getType());608  auto maybeInputSeqType = mlir::dyn_cast<fir::SequenceType>(baseType);609  unsigned inputTypeRank =610      maybeInputSeqType ? maybeInputSeqType.getDimension() : 0;611  unsigned shapeRank = 0;612  if (mlir::Value shape = getShape())613    if (auto shapeType = mlir::dyn_cast<fir::ShapeType>(shape.getType()))614      shapeRank = shapeType.getRank();615  if (inputTypeRank != shapeRank)616    return emitOpError(617        "must be provided a shape if and only if the base is an array");618  mlir::Type outputBaseType = hlfir::getFortranElementOrSequenceType(getType());619  auto maybeOutputSeqType = mlir::dyn_cast<fir::SequenceType>(outputBaseType);620  unsigned outputTypeRank =621      maybeOutputSeqType ? maybeOutputSeqType.getDimension() : 0;622  if (inputTypeRank != outputTypeRank)623    return emitOpError("result type rank must match input type rank");624  if (maybeOutputSeqType && maybeInputSeqType)625    for (auto [inputDim, outputDim] :626         llvm::zip(maybeInputSeqType.getShape(), maybeOutputSeqType.getShape()))627      if (inputDim != fir::SequenceType::getUnknownExtent() &&628          outputDim != fir::SequenceType::getUnknownExtent())629        if (inputDim != outputDim)630          return emitOpError(631              "result type extents are inconsistent with memref type");632  fir::RecordType baseRecType =633      mlir::dyn_cast<fir::RecordType>(hlfir::getFortranElementType(baseType));634  fir::RecordType outRecType = mlir::dyn_cast<fir::RecordType>(635      hlfir::getFortranElementType(outputBaseType));636  if (!baseRecType || !outRecType)637    return emitOpError("result type and input type must be derived types");638 639  // Note: result should not be a fir.class: its dynamic type is being set to640  // the parent type and allowing fir.class would break the operation codegen:641  // it would keep the input dynamic type.642  if (mlir::isa<fir::ClassType>(getType()))643    return emitOpError("result type must not be polymorphic");644 645  // The array results are known to not be dis-contiguous in most cases (the646  // exception being if the parent type was extended by a type without any647  // components): require a fir.box to be used for the result to carry the648  // strides.649  if (!mlir::isa<fir::BoxType>(getType()) &&650      (outputTypeRank != 0 || fir::isRecordWithTypeParameters(outRecType)))651    return emitOpError("result type must be a fir.box if the result is an "652                       "array or has length parameters");653  return mlir::success();654}655 656//===----------------------------------------------------------------------===//657// LogicalReductionOp658//===----------------------------------------------------------------------===//659template <typename LogicalReductionOp>660static llvm::LogicalResult661verifyLogicalReductionOp(LogicalReductionOp reductionOp) {662  mlir::Operation *op = reductionOp->getOperation();663 664  auto results = op->getResultTypes();665  assert(results.size() == 1);666 667  mlir::Value mask = reductionOp->getMask();668  mlir::Value dim = reductionOp->getDim();669 670  fir::SequenceType maskTy = mlir::cast<fir::SequenceType>(671      hlfir::getFortranElementOrSequenceType(mask.getType()));672  mlir::Type logicalTy = maskTy.getEleTy();673  llvm::ArrayRef<int64_t> maskShape = maskTy.getShape();674 675  mlir::Type resultType = results[0];676  if (mlir::isa<fir::LogicalType>(resultType)) {677    // Result is of the same type as MASK678    if ((resultType != logicalTy) && useStrictIntrinsicVerifier)679      return reductionOp->emitOpError(680          "result must have the same element type as MASK argument");681 682  } else if (auto resultExpr =683                 mlir::dyn_cast_or_null<hlfir::ExprType>(resultType)) {684    // Result should only be in hlfir.expr form if it is an array685    if (maskShape.size() > 1 && dim != nullptr) {686      if (!resultExpr.isArray())687        return reductionOp->emitOpError("result must be an array");688 689      if ((resultExpr.getEleTy() != logicalTy) && useStrictIntrinsicVerifier)690        return reductionOp->emitOpError(691            "result must have the same element type as MASK argument");692 693      llvm::ArrayRef<int64_t> resultShape = resultExpr.getShape();694      // Result has rank n-1695      if (resultShape.size() != (maskShape.size() - 1))696        return reductionOp->emitOpError(697            "result rank must be one less than MASK");698    } else {699      return reductionOp->emitOpError("result must be of logical type");700    }701  } else {702    return reductionOp->emitOpError("result must be of logical type");703  }704  return mlir::success();705}706 707//===----------------------------------------------------------------------===//708// AllOp709//===----------------------------------------------------------------------===//710 711llvm::LogicalResult hlfir::AllOp::verify() {712  return verifyLogicalReductionOp<hlfir::AllOp *>(this);713}714 715void hlfir::AllOp::getEffects(716    llvm::SmallVectorImpl<717        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>718        &effects) {719  getIntrinsicEffects(getOperation(), effects);720}721 722//===----------------------------------------------------------------------===//723// AnyOp724//===----------------------------------------------------------------------===//725 726llvm::LogicalResult hlfir::AnyOp::verify() {727  return verifyLogicalReductionOp<hlfir::AnyOp *>(this);728}729 730void hlfir::AnyOp::getEffects(731    llvm::SmallVectorImpl<732        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>733        &effects) {734  getIntrinsicEffects(getOperation(), effects);735}736 737//===----------------------------------------------------------------------===//738// CountOp739//===----------------------------------------------------------------------===//740 741llvm::LogicalResult hlfir::CountOp::verify() {742  mlir::Operation *op = getOperation();743 744  auto results = op->getResultTypes();745  assert(results.size() == 1);746  mlir::Value mask = getMask();747  mlir::Value dim = getDim();748 749  fir::SequenceType maskTy = mlir::cast<fir::SequenceType>(750      hlfir::getFortranElementOrSequenceType(mask.getType()));751  llvm::ArrayRef<int64_t> maskShape = maskTy.getShape();752 753  mlir::Type resultType = results[0];754  if (auto resultExpr = mlir::dyn_cast_or_null<hlfir::ExprType>(resultType)) {755    if (maskShape.size() > 1 && dim != nullptr) {756      if (!resultExpr.isArray())757        return emitOpError("result must be an array");758 759      llvm::ArrayRef<int64_t> resultShape = resultExpr.getShape();760      // Result has rank n-1761      if (resultShape.size() != (maskShape.size() - 1))762        return emitOpError("result rank must be one less than MASK");763    } else {764      return emitOpError("result must be of numerical array type");765    }766  } else if (!hlfir::isFortranScalarNumericalType(resultType)) {767    return emitOpError("result must be of numerical scalar type");768  }769 770  return mlir::success();771}772 773void hlfir::CountOp::getEffects(774    llvm::SmallVectorImpl<775        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>776        &effects) {777  getIntrinsicEffects(getOperation(), effects);778}779 780//===----------------------------------------------------------------------===//781// ConcatOp782//===----------------------------------------------------------------------===//783 784static unsigned getCharacterKind(mlir::Type t) {785  return mlir::cast<fir::CharacterType>(hlfir::getFortranElementType(t))786      .getFKind();787}788 789static std::optional<fir::CharacterType::LenType>790getCharacterLengthIfStatic(mlir::Type t) {791  if (auto charType =792          mlir::dyn_cast<fir::CharacterType>(hlfir::getFortranElementType(t)))793    if (charType.hasConstantLen())794      return charType.getLen();795  return std::nullopt;796}797 798llvm::LogicalResult hlfir::ConcatOp::verify() {799  if (getStrings().size() < 2)800    return emitOpError("must be provided at least two string operands");801  unsigned kind = getCharacterKind(getResult().getType());802  for (auto string : getStrings())803    if (kind != getCharacterKind(string.getType()))804      return emitOpError("strings must have the same KIND as the result type");805  return mlir::success();806}807 808void hlfir::ConcatOp::build(mlir::OpBuilder &builder,809                            mlir::OperationState &result,810                            mlir::ValueRange strings, mlir::Value len) {811  fir::CharacterType::LenType resultTypeLen = 0;812  assert(!strings.empty() && "must contain operands");813  unsigned kind = getCharacterKind(strings[0].getType());814  for (auto string : strings)815    if (auto cstLen = getCharacterLengthIfStatic(string.getType())) {816      resultTypeLen += *cstLen;817    } else {818      resultTypeLen = fir::CharacterType::unknownLen();819      break;820    }821  auto resultType = hlfir::ExprType::get(822      builder.getContext(), hlfir::ExprType::Shape{},823      fir::CharacterType::get(builder.getContext(), kind, resultTypeLen),824      false);825  build(builder, result, resultType, strings, len);826}827 828void hlfir::ConcatOp::getEffects(829    llvm::SmallVectorImpl<830        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>831        &effects) {832  getIntrinsicEffects(getOperation(), effects);833}834 835//===----------------------------------------------------------------------===//836// CmpCharOp837//===----------------------------------------------------------------------===//838 839llvm::LogicalResult hlfir::CmpCharOp::verify() {840  mlir::Value lchr = getLchr();841  mlir::Value rchr = getRchr();842 843  unsigned kind = getCharacterKind(lchr.getType());844  if (kind != getCharacterKind(rchr.getType()))845    return emitOpError("character arguments must have the same KIND");846 847  switch (getPredicate()) {848  case mlir::arith::CmpIPredicate::slt:849  case mlir::arith::CmpIPredicate::sle:850  case mlir::arith::CmpIPredicate::eq:851  case mlir::arith::CmpIPredicate::ne:852  case mlir::arith::CmpIPredicate::sgt:853  case mlir::arith::CmpIPredicate::sge:854    break;855  default:856    return emitOpError("expected signed predicate");857  }858 859  return mlir::success();860}861 862void hlfir::CmpCharOp::getEffects(863    llvm::SmallVectorImpl<864        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>865        &effects) {866  getIntrinsicEffects(getOperation(), effects);867}868 869//===----------------------------------------------------------------------===//870// CharTrimOp871//===----------------------------------------------------------------------===//872 873void hlfir::CharTrimOp::build(mlir::OpBuilder &builder,874                              mlir::OperationState &result, mlir::Value chr) {875  unsigned kind = getCharacterKind(chr.getType());876  auto resultType = hlfir::ExprType::get(877      builder.getContext(), hlfir::ExprType::Shape{},878      fir::CharacterType::get(builder.getContext(), kind,879                              fir::CharacterType::unknownLen()),880      /*polymorphic=*/false);881  build(builder, result, resultType, chr);882}883 884void hlfir::CharTrimOp::getEffects(885    llvm::SmallVectorImpl<886        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>887        &effects) {888  getIntrinsicEffects(getOperation(), effects);889}890 891//===----------------------------------------------------------------------===//892// IndexOp893//===----------------------------------------------------------------------===//894 895llvm::LogicalResult hlfir::IndexOp::verify() {896  mlir::Value substr = getSubstr();897  mlir::Value str = getStr();898 899  unsigned charKind = getCharacterKind(substr.getType());900  if (charKind != getCharacterKind(str.getType()))901    return emitOpError("character arguments must have the same KIND");902 903  return mlir::success();904}905 906void hlfir::IndexOp::getEffects(907    llvm::SmallVectorImpl<908        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>909        &effects) {910  getIntrinsicEffects(getOperation(), effects);911}912 913//===----------------------------------------------------------------------===//914// NumericalReductionOp915//===----------------------------------------------------------------------===//916 917template <typename NumericalReductionOp>918static llvm::LogicalResult919verifyArrayAndMaskForReductionOp(NumericalReductionOp reductionOp) {920  mlir::Value array = reductionOp->getArray();921  mlir::Value mask = reductionOp->getMask();922 923  fir::SequenceType arrayTy = mlir::cast<fir::SequenceType>(924      hlfir::getFortranElementOrSequenceType(array.getType()));925  llvm::ArrayRef<int64_t> arrayShape = arrayTy.getShape();926 927  if (mask) {928    fir::SequenceType maskSeq = mlir::dyn_cast<fir::SequenceType>(929        hlfir::getFortranElementOrSequenceType(mask.getType()));930    llvm::ArrayRef<int64_t> maskShape;931 932    if (maskSeq)933      maskShape = maskSeq.getShape();934 935    if (!maskShape.empty()) {936      if (maskShape.size() != arrayShape.size())937        return reductionOp->emitWarning("MASK must be conformable to ARRAY");938      if (useStrictIntrinsicVerifier) {939        static_assert(fir::SequenceType::getUnknownExtent() ==940                      hlfir::ExprType::getUnknownExtent());941        constexpr int64_t unknownExtent = fir::SequenceType::getUnknownExtent();942        for (std::size_t i = 0; i < arrayShape.size(); ++i) {943          int64_t arrayExtent = arrayShape[i];944          int64_t maskExtent = maskShape[i];945          if ((arrayExtent != maskExtent) && (arrayExtent != unknownExtent) &&946              (maskExtent != unknownExtent))947            return reductionOp->emitWarning(948                "MASK must be conformable to ARRAY");949        }950      }951    }952  }953  return mlir::success();954}955 956template <typename NumericalReductionOp>957static llvm::LogicalResult958verifyNumericalReductionOp(NumericalReductionOp reductionOp) {959  mlir::Operation *op = reductionOp->getOperation();960  auto results = op->getResultTypes();961  assert(results.size() == 1);962 963  auto res = verifyArrayAndMaskForReductionOp(reductionOp);964  if (failed(res))965    return res;966 967  mlir::Value array = reductionOp->getArray();968  mlir::Value dim = reductionOp->getDim();969  fir::SequenceType arrayTy = mlir::cast<fir::SequenceType>(970      hlfir::getFortranElementOrSequenceType(array.getType()));971  mlir::Type numTy = arrayTy.getEleTy();972  llvm::ArrayRef<int64_t> arrayShape = arrayTy.getShape();973 974  mlir::Type resultType = results[0];975  if (hlfir::isFortranScalarNumericalType(resultType)) {976    // Result is of the same type as ARRAY977    if ((resultType != numTy) && useStrictIntrinsicVerifier)978      return reductionOp->emitOpError(979          "result must have the same element type as ARRAY argument");980 981  } else if (auto resultExpr =982                 mlir::dyn_cast_or_null<hlfir::ExprType>(resultType)) {983    if (arrayShape.size() > 1 && dim != nullptr) {984      if (!resultExpr.isArray())985        return reductionOp->emitOpError("result must be an array");986 987      if ((resultExpr.getEleTy() != numTy) && useStrictIntrinsicVerifier)988        return reductionOp->emitOpError(989            "result must have the same element type as ARRAY argument");990 991      llvm::ArrayRef<int64_t> resultShape = resultExpr.getShape();992      // Result has rank n-1993      if (resultShape.size() != (arrayShape.size() - 1))994        return reductionOp->emitOpError(995            "result rank must be one less than ARRAY");996    } else {997      return reductionOp->emitOpError(998          "result must be of numerical scalar type");999    }1000  } else {1001    return reductionOp->emitOpError("result must be of numerical scalar type");1002  }1003  return mlir::success();1004}1005 1006//===----------------------------------------------------------------------===//1007// ProductOp1008//===----------------------------------------------------------------------===//1009 1010llvm::LogicalResult hlfir::ProductOp::verify() {1011  return verifyNumericalReductionOp<hlfir::ProductOp *>(this);1012}1013 1014void hlfir::ProductOp::getEffects(1015    llvm::SmallVectorImpl<1016        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1017        &effects) {1018  getIntrinsicEffects(getOperation(), effects);1019}1020 1021//===----------------------------------------------------------------------===//1022// CharacterReductionOp1023//===----------------------------------------------------------------------===//1024 1025template <typename CharacterReductionOp>1026static llvm::LogicalResult1027verifyCharacterReductionOp(CharacterReductionOp reductionOp) {1028  mlir::Operation *op = reductionOp->getOperation();1029  auto results = op->getResultTypes();1030  assert(results.size() == 1);1031 1032  auto res = verifyArrayAndMaskForReductionOp(reductionOp);1033  if (failed(res))1034    return res;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  mlir::Type numTy = arrayTy.getEleTy();1041  llvm::ArrayRef<int64_t> arrayShape = arrayTy.getShape();1042 1043  auto resultExpr = mlir::cast<hlfir::ExprType>(results[0]);1044  mlir::Type resultType = resultExpr.getEleTy();1045  assert(mlir::isa<fir::CharacterType>(resultType) &&1046         "result must be character");1047 1048  // Result is of the same type as ARRAY1049  if ((resultType != numTy) && useStrictIntrinsicVerifier)1050    return reductionOp->emitOpError(1051        "result must have the same element type as ARRAY argument");1052 1053  if (arrayShape.size() > 1 && dim != nullptr) {1054    if (!resultExpr.isArray())1055      return reductionOp->emitOpError("result must be an array");1056    llvm::ArrayRef<int64_t> resultShape = resultExpr.getShape();1057    // Result has rank n-11058    if (resultShape.size() != (arrayShape.size() - 1))1059      return reductionOp->emitOpError(1060          "result rank must be one less than ARRAY");1061  } else if (!resultExpr.isScalar()) {1062    return reductionOp->emitOpError("result must be scalar character");1063  }1064  return mlir::success();1065}1066 1067//===----------------------------------------------------------------------===//1068// MaxvalOp1069//===----------------------------------------------------------------------===//1070 1071llvm::LogicalResult hlfir::MaxvalOp::verify() {1072  mlir::Operation *op = getOperation();1073 1074  auto results = op->getResultTypes();1075  assert(results.size() == 1);1076 1077  auto resultExpr = mlir::dyn_cast<hlfir::ExprType>(results[0]);1078  if (resultExpr && mlir::isa<fir::CharacterType>(resultExpr.getEleTy())) {1079    return verifyCharacterReductionOp<hlfir::MaxvalOp *>(this);1080  }1081  return verifyNumericalReductionOp<hlfir::MaxvalOp *>(this);1082}1083 1084void hlfir::MaxvalOp::getEffects(1085    llvm::SmallVectorImpl<1086        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1087        &effects) {1088  getIntrinsicEffects(getOperation(), effects);1089}1090 1091//===----------------------------------------------------------------------===//1092// MinvalOp1093//===----------------------------------------------------------------------===//1094 1095llvm::LogicalResult hlfir::MinvalOp::verify() {1096  mlir::Operation *op = getOperation();1097 1098  auto results = op->getResultTypes();1099  assert(results.size() == 1);1100 1101  auto resultExpr = mlir::dyn_cast<hlfir::ExprType>(results[0]);1102  if (resultExpr && mlir::isa<fir::CharacterType>(resultExpr.getEleTy())) {1103    return verifyCharacterReductionOp<hlfir::MinvalOp *>(this);1104  }1105  return verifyNumericalReductionOp<hlfir::MinvalOp *>(this);1106}1107 1108void hlfir::MinvalOp::getEffects(1109    llvm::SmallVectorImpl<1110        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1111        &effects) {1112  getIntrinsicEffects(getOperation(), effects);1113}1114 1115//===----------------------------------------------------------------------===//1116// MinlocOp1117//===----------------------------------------------------------------------===//1118 1119template <typename NumericalReductionOp>1120static llvm::LogicalResult1121verifyResultForMinMaxLoc(NumericalReductionOp reductionOp) {1122  mlir::Operation *op = reductionOp->getOperation();1123  auto results = op->getResultTypes();1124  assert(results.size() == 1);1125 1126  mlir::Value array = reductionOp->getArray();1127  mlir::Value dim = reductionOp->getDim();1128  fir::SequenceType arrayTy = mlir::cast<fir::SequenceType>(1129      hlfir::getFortranElementOrSequenceType(array.getType()));1130  llvm::ArrayRef<int64_t> arrayShape = arrayTy.getShape();1131 1132  mlir::Type resultType = results[0];1133  if (dim && arrayShape.size() == 1) {1134    if (!fir::isa_integer(resultType))1135      return reductionOp->emitOpError("result must be scalar integer");1136  } else if (auto resultExpr =1137                 mlir::dyn_cast_or_null<hlfir::ExprType>(resultType)) {1138    if (!resultExpr.isArray())1139      return reductionOp->emitOpError("result must be an array");1140 1141    if (!fir::isa_integer(resultExpr.getEleTy()))1142      return reductionOp->emitOpError("result must have integer elements");1143 1144    llvm::ArrayRef<int64_t> resultShape = resultExpr.getShape();1145    // With dim the result has rank n-11146    if (dim && resultShape.size() != (arrayShape.size() - 1))1147      return reductionOp->emitOpError(1148          "result rank must be one less than ARRAY");1149    // With dim the result has rank n1150    if (!dim && resultShape.size() != 1)1151      return reductionOp->emitOpError("result rank must be 1");1152  } else {1153    return reductionOp->emitOpError("result must be of numerical expr type");1154  }1155  return mlir::success();1156}1157 1158llvm::LogicalResult hlfir::MinlocOp::verify() {1159  auto res = verifyArrayAndMaskForReductionOp(this);1160  if (failed(res))1161    return res;1162 1163  return verifyResultForMinMaxLoc(this);1164}1165 1166void hlfir::MinlocOp::getEffects(1167    llvm::SmallVectorImpl<1168        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1169        &effects) {1170  getIntrinsicEffects(getOperation(), effects);1171}1172 1173//===----------------------------------------------------------------------===//1174// MaxlocOp1175//===----------------------------------------------------------------------===//1176 1177llvm::LogicalResult hlfir::MaxlocOp::verify() {1178  auto res = verifyArrayAndMaskForReductionOp(this);1179  if (failed(res))1180    return res;1181 1182  return verifyResultForMinMaxLoc(this);1183}1184 1185void hlfir::MaxlocOp::getEffects(1186    llvm::SmallVectorImpl<1187        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1188        &effects) {1189  getIntrinsicEffects(getOperation(), effects);1190}1191 1192//===----------------------------------------------------------------------===//1193// SetLengthOp1194//===----------------------------------------------------------------------===//1195 1196void hlfir::SetLengthOp::build(mlir::OpBuilder &builder,1197                               mlir::OperationState &result, mlir::Value string,1198                               mlir::Value len) {1199  fir::CharacterType::LenType resultTypeLen = fir::CharacterType::unknownLen();1200  if (auto cstLen = fir::getIntIfConstant(len))1201    resultTypeLen = *cstLen;1202  unsigned kind = getCharacterKind(string.getType());1203  auto resultType = hlfir::ExprType::get(1204      builder.getContext(), hlfir::ExprType::Shape{},1205      fir::CharacterType::get(builder.getContext(), kind, resultTypeLen),1206      false);1207  build(builder, result, resultType, string, len);1208}1209 1210void hlfir::SetLengthOp::getEffects(1211    llvm::SmallVectorImpl<1212        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1213        &effects) {1214  getIntrinsicEffects(getOperation(), effects);1215}1216 1217//===----------------------------------------------------------------------===//1218// SumOp1219//===----------------------------------------------------------------------===//1220 1221llvm::LogicalResult hlfir::SumOp::verify() {1222  return verifyNumericalReductionOp<hlfir::SumOp *>(this);1223}1224 1225void hlfir::SumOp::getEffects(1226    llvm::SmallVectorImpl<1227        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1228        &effects) {1229  getIntrinsicEffects(getOperation(), effects);1230}1231 1232//===----------------------------------------------------------------------===//1233// DotProductOp1234//===----------------------------------------------------------------------===//1235 1236llvm::LogicalResult hlfir::DotProductOp::verify() {1237  mlir::Value lhs = getLhs();1238  mlir::Value rhs = getRhs();1239  fir::SequenceType lhsTy = mlir::cast<fir::SequenceType>(1240      hlfir::getFortranElementOrSequenceType(lhs.getType()));1241  fir::SequenceType rhsTy = mlir::cast<fir::SequenceType>(1242      hlfir::getFortranElementOrSequenceType(rhs.getType()));1243  llvm::ArrayRef<int64_t> lhsShape = lhsTy.getShape();1244  llvm::ArrayRef<int64_t> rhsShape = rhsTy.getShape();1245  std::size_t lhsRank = lhsShape.size();1246  std::size_t rhsRank = rhsShape.size();1247  mlir::Type lhsEleTy = lhsTy.getEleTy();1248  mlir::Type rhsEleTy = rhsTy.getEleTy();1249  mlir::Type resultTy = getResult().getType();1250 1251  if ((lhsRank != 1) || (rhsRank != 1))1252    return emitOpError("both arrays must have rank 1");1253 1254  int64_t lhsSize = lhsShape[0];1255  int64_t rhsSize = rhsShape[0];1256 1257  constexpr int64_t unknownExtent = fir::SequenceType::getUnknownExtent();1258  if ((lhsSize != unknownExtent) && (rhsSize != unknownExtent) &&1259      (lhsSize != rhsSize) && useStrictIntrinsicVerifier)1260    return emitOpError("both arrays must have the same size");1261 1262  if (useStrictIntrinsicVerifier) {1263    if (mlir::isa<fir::LogicalType>(lhsEleTy) !=1264        mlir::isa<fir::LogicalType>(rhsEleTy))1265      return emitOpError("if one array is logical, so should the other be");1266 1267    if (mlir::isa<fir::LogicalType>(lhsEleTy) !=1268        mlir::isa<fir::LogicalType>(resultTy))1269      return emitOpError("the result type should be a logical only if the "1270                         "argument types are logical");1271  }1272 1273  if (!hlfir::isFortranScalarNumericalType(resultTy) &&1274      !mlir::isa<fir::LogicalType>(resultTy))1275    return emitOpError(1276        "the result must be of scalar numerical or logical type");1277 1278  return mlir::success();1279}1280 1281void hlfir::DotProductOp::getEffects(1282    llvm::SmallVectorImpl<1283        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1284        &effects) {1285  getIntrinsicEffects(getOperation(), effects);1286}1287 1288//===----------------------------------------------------------------------===//1289// MatmulOp1290//===----------------------------------------------------------------------===//1291 1292llvm::LogicalResult hlfir::MatmulOp::verify() {1293  mlir::Value lhs = getLhs();1294  mlir::Value rhs = getRhs();1295  fir::SequenceType lhsTy = mlir::cast<fir::SequenceType>(1296      hlfir::getFortranElementOrSequenceType(lhs.getType()));1297  fir::SequenceType rhsTy = mlir::cast<fir::SequenceType>(1298      hlfir::getFortranElementOrSequenceType(rhs.getType()));1299  llvm::ArrayRef<int64_t> lhsShape = lhsTy.getShape();1300  llvm::ArrayRef<int64_t> rhsShape = rhsTy.getShape();1301  std::size_t lhsRank = lhsShape.size();1302  std::size_t rhsRank = rhsShape.size();1303  mlir::Type lhsEleTy = lhsTy.getEleTy();1304  mlir::Type rhsEleTy = rhsTy.getEleTy();1305  hlfir::ExprType resultTy = mlir::cast<hlfir::ExprType>(getResult().getType());1306  llvm::ArrayRef<int64_t> resultShape = resultTy.getShape();1307  mlir::Type resultEleTy = resultTy.getEleTy();1308 1309  if (((lhsRank != 1) && (lhsRank != 2)) || ((rhsRank != 1) && (rhsRank != 2)))1310    return emitOpError("array must have either rank 1 or rank 2");1311 1312  if ((lhsRank == 1) && (rhsRank == 1))1313    return emitOpError("at least one array must have rank 2");1314 1315  if (mlir::isa<fir::LogicalType>(lhsEleTy) !=1316      mlir::isa<fir::LogicalType>(rhsEleTy))1317    return emitOpError("if one array is logical, so should the other be");1318 1319  if (!useStrictIntrinsicVerifier)1320    return mlir::success();1321 1322  int64_t lastLhsDim = lhsShape[lhsRank - 1];1323  int64_t firstRhsDim = rhsShape[0];1324  constexpr int64_t unknownExtent = fir::SequenceType::getUnknownExtent();1325  if (lastLhsDim != firstRhsDim)1326    if ((lastLhsDim != unknownExtent) && (firstRhsDim != unknownExtent))1327      return emitOpError(1328          "the last dimension of LHS should match the first dimension of RHS");1329 1330  if (mlir::isa<fir::LogicalType>(lhsEleTy) !=1331      mlir::isa<fir::LogicalType>(resultEleTy))1332    return emitOpError("the result type should be a logical only if the "1333                       "argument types are logical");1334 1335  llvm::SmallVector<int64_t, 2> expectedResultShape;1336  if (lhsRank == 2) {1337    if (rhsRank == 2) {1338      expectedResultShape.push_back(lhsShape[0]);1339      expectedResultShape.push_back(rhsShape[1]);1340    } else {1341      // rhsRank == 11342      expectedResultShape.push_back(lhsShape[0]);1343    }1344  } else {1345    // lhsRank == 11346    // rhsRank == 21347    expectedResultShape.push_back(rhsShape[1]);1348  }1349  if (resultShape.size() != expectedResultShape.size())1350    return emitOpError("incorrect result shape");1351  if (resultShape[0] != expectedResultShape[0] &&1352      expectedResultShape[0] != unknownExtent)1353    return emitOpError("incorrect result shape");1354  if (resultShape.size() == 2 && resultShape[1] != expectedResultShape[1] &&1355      expectedResultShape[1] != unknownExtent)1356    return emitOpError("incorrect result shape");1357 1358  return mlir::success();1359}1360 1361llvm::LogicalResult1362hlfir::MatmulOp::canonicalize(MatmulOp matmulOp,1363                              mlir::PatternRewriter &rewriter) {1364  // the only two uses of the transposed matrix should be for the hlfir.matmul1365  // and hlfir.destroy1366  auto isOtherwiseUnused = [&](hlfir::TransposeOp transposeOp) -> bool {1367    std::size_t numUses = 0;1368    for (mlir::Operation *user : transposeOp.getResult().getUsers()) {1369      ++numUses;1370      if (user == matmulOp)1371        continue;1372      if (mlir::dyn_cast_or_null<hlfir::DestroyOp>(user))1373        continue;1374      // some other use!1375      return false;1376    }1377    return numUses <= 2;1378  };1379 1380  mlir::Value lhs = matmulOp.getLhs();1381  // Rewrite MATMUL(TRANSPOSE(lhs), rhs) => hlfir.matmul_transpose lhs, rhs1382  if (auto transposeOp = lhs.getDefiningOp<hlfir::TransposeOp>()) {1383    if (isOtherwiseUnused(transposeOp)) {1384      mlir::Location loc = matmulOp.getLoc();1385      mlir::Type resultTy = matmulOp.getResult().getType();1386      auto matmulTransposeOp = hlfir::MatmulTransposeOp::create(1387          rewriter, loc, resultTy, transposeOp.getArray(), matmulOp.getRhs(),1388          matmulOp.getFastmathAttr());1389 1390      // we don't need to remove any hlfir.destroy because it will be needed for1391      // the new intrinsic result anyway1392      rewriter.replaceOp(matmulOp, matmulTransposeOp.getResult());1393 1394      // but we do need to get rid of the hlfir.destroy for the hlfir.transpose1395      // result (which is entirely removed)1396      llvm::SmallVector<mlir::Operation *> users(1397          transposeOp->getResult(0).getUsers());1398      for (mlir::Operation *user : users)1399        if (auto destroyOp = mlir::dyn_cast_or_null<hlfir::DestroyOp>(user))1400          rewriter.eraseOp(destroyOp);1401      rewriter.eraseOp(transposeOp);1402 1403      return mlir::success();1404    }1405  }1406 1407  return mlir::failure();1408}1409 1410void hlfir::MatmulOp::getEffects(1411    llvm::SmallVectorImpl<1412        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1413        &effects) {1414  getIntrinsicEffects(getOperation(), effects);1415}1416 1417//===----------------------------------------------------------------------===//1418// TransposeOp1419//===----------------------------------------------------------------------===//1420 1421llvm::LogicalResult hlfir::TransposeOp::verify() {1422  mlir::Value array = getArray();1423  fir::SequenceType arrayTy = mlir::cast<fir::SequenceType>(1424      hlfir::getFortranElementOrSequenceType(array.getType()));1425  llvm::ArrayRef<int64_t> inShape = arrayTy.getShape();1426  std::size_t rank = inShape.size();1427  mlir::Type eleTy = arrayTy.getEleTy();1428  hlfir::ExprType resultTy = mlir::cast<hlfir::ExprType>(getResult().getType());1429  llvm::ArrayRef<int64_t> resultShape = resultTy.getShape();1430  std::size_t resultRank = resultShape.size();1431  mlir::Type resultEleTy = resultTy.getEleTy();1432 1433  if (rank != 2 || resultRank != 2)1434    return emitOpError("input and output arrays should have rank 2");1435 1436  if (!useStrictIntrinsicVerifier)1437    return mlir::success();1438 1439  constexpr int64_t unknownExtent = fir::SequenceType::getUnknownExtent();1440  if ((inShape[0] != resultShape[1]) && (inShape[0] != unknownExtent))1441    return emitOpError("output shape does not match input array");1442  if ((inShape[1] != resultShape[0]) && (inShape[1] != unknownExtent))1443    return emitOpError("output shape does not match input array");1444 1445  if (eleTy != resultEleTy)1446    return emitOpError(1447        "input and output arrays should have the same element type");1448 1449  return mlir::success();1450}1451 1452void hlfir::TransposeOp::getEffects(1453    llvm::SmallVectorImpl<1454        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1455        &effects) {1456  getIntrinsicEffects(getOperation(), effects);1457}1458 1459//===----------------------------------------------------------------------===//1460// MatmulTransposeOp1461//===----------------------------------------------------------------------===//1462 1463llvm::LogicalResult hlfir::MatmulTransposeOp::verify() {1464  mlir::Value lhs = getLhs();1465  mlir::Value rhs = getRhs();1466  fir::SequenceType lhsTy = mlir::cast<fir::SequenceType>(1467      hlfir::getFortranElementOrSequenceType(lhs.getType()));1468  fir::SequenceType rhsTy = mlir::cast<fir::SequenceType>(1469      hlfir::getFortranElementOrSequenceType(rhs.getType()));1470  llvm::ArrayRef<int64_t> lhsShape = lhsTy.getShape();1471  llvm::ArrayRef<int64_t> rhsShape = rhsTy.getShape();1472  std::size_t lhsRank = lhsShape.size();1473  std::size_t rhsRank = rhsShape.size();1474  mlir::Type lhsEleTy = lhsTy.getEleTy();1475  mlir::Type rhsEleTy = rhsTy.getEleTy();1476  hlfir::ExprType resultTy = mlir::cast<hlfir::ExprType>(getResult().getType());1477  llvm::ArrayRef<int64_t> resultShape = resultTy.getShape();1478  mlir::Type resultEleTy = resultTy.getEleTy();1479 1480  // lhs must have rank 2 for the transpose to be valid1481  if ((lhsRank != 2) || ((rhsRank != 1) && (rhsRank != 2)))1482    return emitOpError("array must have either rank 1 or rank 2");1483 1484  if (!useStrictIntrinsicVerifier)1485    return mlir::success();1486 1487  if (mlir::isa<fir::LogicalType>(lhsEleTy) !=1488      mlir::isa<fir::LogicalType>(rhsEleTy))1489    return emitOpError("if one array is logical, so should the other be");1490 1491  // for matmul we compare the last dimension of lhs with the first dimension of1492  // rhs, but for MatmulTranspose, dimensions of lhs are inverted by the1493  // transpose1494  int64_t firstLhsDim = lhsShape[0];1495  int64_t firstRhsDim = rhsShape[0];1496  constexpr int64_t unknownExtent = fir::SequenceType::getUnknownExtent();1497  if (firstLhsDim != firstRhsDim)1498    if ((firstLhsDim != unknownExtent) && (firstRhsDim != unknownExtent))1499      return emitOpError(1500          "the first dimension of LHS should match the first dimension of RHS");1501 1502  if (mlir::isa<fir::LogicalType>(lhsEleTy) !=1503      mlir::isa<fir::LogicalType>(resultEleTy))1504    return emitOpError("the result type should be a logical only if the "1505                       "argument types are logical");1506 1507  llvm::SmallVector<int64_t, 2> expectedResultShape;1508  if (rhsRank == 2) {1509    expectedResultShape.push_back(lhsShape[1]);1510    expectedResultShape.push_back(rhsShape[1]);1511  } else {1512    // rhsRank == 11513    expectedResultShape.push_back(lhsShape[1]);1514  }1515  if (resultShape.size() != expectedResultShape.size())1516    return emitOpError("incorrect result shape");1517  if (resultShape[0] != expectedResultShape[0])1518    return emitOpError("incorrect result shape");1519  if (resultShape.size() == 2 && resultShape[1] != expectedResultShape[1])1520    return emitOpError("incorrect result shape");1521 1522  return mlir::success();1523}1524 1525void hlfir::MatmulTransposeOp::getEffects(1526    llvm::SmallVectorImpl<1527        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1528        &effects) {1529  getIntrinsicEffects(getOperation(), effects);1530}1531 1532//===----------------------------------------------------------------------===//1533// Array shifts: CShiftOp/EOShiftOp1534//===----------------------------------------------------------------------===//1535 1536template <typename Op>1537static llvm::LogicalResult verifyArrayShift(Op op) {1538  mlir::Value array = op.getArray();1539  fir::SequenceType arrayTy = mlir::cast<fir::SequenceType>(1540      hlfir::getFortranElementOrSequenceType(array.getType()));1541  llvm::ArrayRef<int64_t> inShape = arrayTy.getShape();1542  std::size_t arrayRank = inShape.size();1543  mlir::Type eleTy = arrayTy.getEleTy();1544  hlfir::ExprType resultTy =1545      mlir::cast<hlfir::ExprType>(op.getResult().getType());1546  llvm::ArrayRef<int64_t> resultShape = resultTy.getShape();1547  std::size_t resultRank = resultShape.size();1548  mlir::Type resultEleTy = resultTy.getEleTy();1549  mlir::Value shift = op.getShift();1550  mlir::Type shiftTy = hlfir::getFortranElementOrSequenceType(shift.getType());1551 1552  if (auto match = areMatchingTypes(1553          op, eleTy, resultEleTy,1554          /*allowCharacterLenMismatch=*/!useStrictIntrinsicVerifier);1555      match.failed())1556    return op.emitOpError(1557        "input and output arrays should have the same element type");1558 1559  if (arrayRank != resultRank)1560    return op.emitOpError("input and output arrays should have the same rank");1561 1562  constexpr int64_t unknownExtent = fir::SequenceType::getUnknownExtent();1563  for (auto [inDim, resultDim] : llvm::zip(inShape, resultShape))1564    if (inDim != unknownExtent && resultDim != unknownExtent &&1565        inDim != resultDim)1566      return op.emitOpError(1567          "output array's shape conflicts with the input array's shape");1568 1569  int64_t dimVal = -1;1570  if (!op.getDim())1571    dimVal = 1;1572  else if (auto dim = fir::getIntIfConstant(op.getDim()))1573    dimVal = *dim;1574 1575  // The DIM argument may be statically invalid (e.g. exceed the1576  // input array rank) in dead code after constant propagation,1577  // so avoid some checks unless useStrictIntrinsicVerifier is true.1578  if (useStrictIntrinsicVerifier && dimVal != -1) {1579    if (dimVal < 1)1580      return op.emitOpError("DIM must be >= 1");1581    if (dimVal > static_cast<int64_t>(arrayRank))1582      return op.emitOpError("DIM must be <= input array's rank");1583  }1584 1585  // A helper lambda to verify the shape of the array types of1586  // certain operands of the array shift (e.g. the SHIFT and BOUNDARY operands).1587  auto verifyOperandTypeShape = [&](mlir::Type type,1588                                    llvm::Twine name) -> llvm::LogicalResult {1589    if (auto opndSeqTy = mlir::dyn_cast<fir::SequenceType>(type)) {1590      // The operand is an array. Verify the rank and the shape (if DIM is1591      // constant).1592      llvm::ArrayRef<int64_t> opndShape = opndSeqTy.getShape();1593      std::size_t opndRank = opndShape.size();1594      if (opndRank != arrayRank - 1)1595        return op.emitOpError(1596            name + "'s rank must be 1 less than the input array's rank");1597 1598      if (useStrictIntrinsicVerifier && dimVal != -1) {1599        // The operand's shape must be1600        // [d(1), d(2), ..., d(DIM-1), d(DIM+1), ..., d(n)],1601        // where [d(1), d(2), ..., d(n)] is the shape of the ARRAY.1602        int64_t arrayDimIdx = 0;1603        int64_t opndDimIdx = 0;1604        for (auto opndDim : opndShape) {1605          if (arrayDimIdx == dimVal - 1)1606            ++arrayDimIdx;1607 1608          if (inShape[arrayDimIdx] != unknownExtent &&1609              opndDim != unknownExtent && inShape[arrayDimIdx] != opndDim)1610            return op.emitOpError("SHAPE(ARRAY)(" +1611                                  llvm::Twine(arrayDimIdx + 1) +1612                                  ") must be equal to SHAPE(" + name + ")(" +1613                                  llvm::Twine(opndDimIdx + 1) +1614                                  "): " + llvm::Twine(inShape[arrayDimIdx]) +1615                                  " != " + llvm::Twine(opndDim));1616          ++arrayDimIdx;1617          ++opndDimIdx;1618        }1619      }1620    }1621    return mlir::success();1622  };1623 1624  if (failed(verifyOperandTypeShape(shiftTy, "SHIFT")))1625    return mlir::failure();1626 1627  if constexpr (std::is_same_v<Op, hlfir::EOShiftOp>) {1628    if (mlir::Value boundary = op.getBoundary()) {1629      mlir::Type boundaryTy =1630          hlfir::getFortranElementOrSequenceType(boundary.getType());1631      // In case of polymorphic ARRAY type, the BOUNDARY's element type1632      // may not match the ARRAY's element type.1633      if (!hlfir::isPolymorphicType(array.getType()))1634        if (auto match = areMatchingTypes(1635                op, eleTy, hlfir::getFortranElementType(boundaryTy),1636                /*allowCharacterLenMismatch=*/!useStrictIntrinsicVerifier);1637            match.failed())1638          return op.emitOpError(1639              "ARRAY and BOUNDARY operands must have the same element type");1640      if (failed(verifyOperandTypeShape(boundaryTy, "BOUNDARY")))1641        return mlir::failure();1642    }1643  }1644 1645  return mlir::success();1646}1647 1648//===----------------------------------------------------------------------===//1649// CShiftOp1650//===----------------------------------------------------------------------===//1651 1652llvm::LogicalResult hlfir::CShiftOp::verify() {1653  return verifyArrayShift(*this);1654}1655 1656void hlfir::CShiftOp::getEffects(1657    llvm::SmallVectorImpl<1658        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1659        &effects) {1660  getIntrinsicEffects(getOperation(), effects);1661}1662 1663//===----------------------------------------------------------------------===//1664// EOShiftOp1665//===----------------------------------------------------------------------===//1666 1667llvm::LogicalResult hlfir::EOShiftOp::verify() {1668  return verifyArrayShift(*this);1669}1670 1671void hlfir::EOShiftOp::getEffects(1672    llvm::SmallVectorImpl<1673        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1674        &effects) {1675  getIntrinsicEffects(getOperation(), effects);1676}1677 1678//===----------------------------------------------------------------------===//1679// ReshapeOp1680//===----------------------------------------------------------------------===//1681 1682llvm::LogicalResult hlfir::ReshapeOp::verify() {1683  auto results = getOperation()->getResultTypes();1684  assert(results.size() == 1);1685  hlfir::ExprType resultType = mlir::cast<hlfir::ExprType>(results[0]);1686  mlir::Value array = getArray();1687  auto arrayType = mlir::cast<fir::SequenceType>(1688      hlfir::getFortranElementOrSequenceType(array.getType()));1689  if (auto match = areMatchingTypes(1690          *this, hlfir::getFortranElementType(resultType),1691          arrayType.getElementType(),1692          /*allowCharacterLenMismatch=*/!useStrictIntrinsicVerifier);1693      match.failed())1694    return emitOpError("ARRAY and the result must have the same element type");1695  if (hlfir::isPolymorphicType(resultType) !=1696      hlfir::isPolymorphicType(array.getType()))1697    return emitOpError("ARRAY must be polymorphic iff result is polymorphic");1698 1699  mlir::Value shape = getShape();1700  auto shapeArrayType = mlir::cast<fir::SequenceType>(1701      hlfir::getFortranElementOrSequenceType(shape.getType()));1702  if (shapeArrayType.getDimension() != 1)1703    return emitOpError("SHAPE must be an array of rank 1");1704  if (!mlir::isa<mlir::IntegerType>(shapeArrayType.getElementType()))1705    return emitOpError("SHAPE must be an integer array");1706  if (shapeArrayType.hasDynamicExtents())1707    return emitOpError("SHAPE must have known size");1708  if (shapeArrayType.getConstantArraySize() != resultType.getRank())1709    return emitOpError("SHAPE's extent must match the result rank");1710 1711  if (mlir::Value pad = getPad()) {1712    auto padArrayType = mlir::cast<fir::SequenceType>(1713        hlfir::getFortranElementOrSequenceType(pad.getType()));1714    if (auto match = areMatchingTypes(1715            *this, arrayType.getElementType(), padArrayType.getElementType(),1716            /*allowCharacterLenMismatch=*/!useStrictIntrinsicVerifier);1717        match.failed())1718      return emitOpError("ARRAY and PAD must be of the same type");1719  }1720 1721  if (mlir::Value order = getOrder()) {1722    auto orderArrayType = mlir::cast<fir::SequenceType>(1723        hlfir::getFortranElementOrSequenceType(order.getType()));1724    if (orderArrayType.getDimension() != 1)1725      return emitOpError("ORDER must be an array of rank 1");1726    if (!mlir::isa<mlir::IntegerType>(orderArrayType.getElementType()))1727      return emitOpError("ORDER must be an integer array");1728  }1729 1730  return mlir::success();1731}1732 1733void hlfir::ReshapeOp::getEffects(1734    llvm::SmallVectorImpl<1735        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1736        &effects) {1737  getIntrinsicEffects(getOperation(), effects);1738}1739 1740//===----------------------------------------------------------------------===//1741// AssociateOp1742//===----------------------------------------------------------------------===//1743 1744void hlfir::AssociateOp::build(mlir::OpBuilder &builder,1745                               mlir::OperationState &result, mlir::Value source,1746                               llvm::StringRef uniq_name, mlir::Value shape,1747                               mlir::ValueRange typeparams,1748                               fir::FortranVariableFlagsAttr fortran_attrs) {1749  auto nameAttr = builder.getStringAttr(uniq_name);1750  mlir::Type dataType = getFortranElementOrSequenceType(source.getType());1751 1752  // Preserve polymorphism of polymorphic expr.1753  mlir::Type firVarType;1754  auto sourceExprType = mlir::dyn_cast<hlfir::ExprType>(source.getType());1755  if (sourceExprType && sourceExprType.isPolymorphic())1756    firVarType = fir::ClassType::get(dataType);1757  else1758    firVarType = fir::ReferenceType::get(dataType);1759 1760  mlir::Type hlfirVariableType =1761      DeclareOp::getHLFIRVariableType(firVarType, /*hasExplicitLbs=*/false);1762  mlir::Type i1Type = builder.getI1Type();1763  build(builder, result, {hlfirVariableType, firVarType, i1Type}, source, shape,1764        typeparams, nameAttr, fortran_attrs);1765}1766 1767void hlfir::AssociateOp::build(1768    mlir::OpBuilder &builder, mlir::OperationState &result, mlir::Value source,1769    mlir::Value shape, mlir::ValueRange typeparams,1770    fir::FortranVariableFlagsAttr fortran_attrs,1771    llvm::ArrayRef<mlir::NamedAttribute> attributes) {1772  mlir::Type dataType = getFortranElementOrSequenceType(source.getType());1773 1774  // Preserve polymorphism of polymorphic expr.1775  mlir::Type firVarType;1776  auto sourceExprType = mlir::dyn_cast<hlfir::ExprType>(source.getType());1777  if (sourceExprType && sourceExprType.isPolymorphic())1778    firVarType = fir::ClassType::get(dataType);1779  else1780    firVarType = fir::ReferenceType::get(dataType);1781 1782  mlir::Type hlfirVariableType =1783      DeclareOp::getHLFIRVariableType(firVarType, /*hasExplicitLbs=*/false);1784  mlir::Type i1Type = builder.getI1Type();1785  build(builder, result, {hlfirVariableType, firVarType, i1Type}, source, shape,1786        typeparams, {}, fortran_attrs);1787  result.addAttributes(attributes);1788}1789 1790//===----------------------------------------------------------------------===//1791// EndAssociateOp1792//===----------------------------------------------------------------------===//1793 1794void hlfir::EndAssociateOp::build(mlir::OpBuilder &builder,1795                                  mlir::OperationState &result,1796                                  hlfir::AssociateOp associate) {1797  mlir::Value hlfirBase = associate.getBase();1798  mlir::Value firBase = associate.getFirBase();1799  // If EndAssociateOp may need to initiate the deallocation1800  // of allocatable components, it has to have access to the variable1801  // definition, so we cannot use the FIR base as the operand.1802  return build(builder, result,1803               hlfir::mayHaveAllocatableComponent(hlfirBase.getType())1804                   ? hlfirBase1805                   : firBase,1806               associate.getMustFreeStrorageFlag());1807}1808 1809llvm::LogicalResult hlfir::EndAssociateOp::verify() {1810  mlir::Value var = getVar();1811  if (hlfir::mayHaveAllocatableComponent(var.getType()) &&1812      !hlfir::isFortranEntity(var))1813    return emitOpError("that requires components deallocation must have var "1814                       "operand that is a Fortran entity");1815 1816  return mlir::success();1817}1818 1819//===----------------------------------------------------------------------===//1820// AsExprOp1821//===----------------------------------------------------------------------===//1822 1823void hlfir::AsExprOp::build(mlir::OpBuilder &builder,1824                            mlir::OperationState &result, mlir::Value var,1825                            mlir::Value mustFree) {1826  mlir::Type resultType = hlfir::getExprType(var.getType());1827  return build(builder, result, resultType, var, mustFree);1828}1829 1830void hlfir::AsExprOp::getEffects(1831    llvm::SmallVectorImpl<1832        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>1833        &effects) {1834  // this isn't a transformational intrinsic but follows the same pattern: it1835  // creates a hlfir.expr and so needs to have an allocation effect, plus it1836  // might have a pointer-like argument, in which case it has a read effect1837  // upon those1838  getIntrinsicEffects(getOperation(), effects);1839}1840 1841//===----------------------------------------------------------------------===//1842// ElementalOp1843//===----------------------------------------------------------------------===//1844 1845/// Common builder for ElementalOp and ElementalAddrOp to add the arguments and1846/// create the elemental body. Result and clean-up body must be handled in1847/// specific builders.1848template <typename Op>1849static void buildElemental(mlir::OpBuilder &builder,1850                           mlir::OperationState &odsState, mlir::Value shape,1851                           mlir::Value mold, mlir::ValueRange typeparams,1852                           bool isUnordered) {1853  odsState.addOperands(shape);1854  if (mold)1855    odsState.addOperands(mold);1856  odsState.addOperands(typeparams);1857  odsState.addAttribute(1858      Op::getOperandSegmentSizesAttrName(odsState.name),1859      builder.getDenseI32ArrayAttr({/*shape=*/1, (mold ? 1 : 0),1860                                    static_cast<int32_t>(typeparams.size())}));1861  if (isUnordered)1862    odsState.addAttribute(Op::getUnorderedAttrName(odsState.name),1863                          isUnordered ? builder.getUnitAttr() : nullptr);1864  mlir::Region *bodyRegion = odsState.addRegion();1865  bodyRegion->push_back(new mlir::Block{});1866  if (auto shapeType = mlir::dyn_cast<fir::ShapeType>(shape.getType())) {1867    unsigned dim = shapeType.getRank();1868    mlir::Type indexType = builder.getIndexType();1869    for (unsigned d = 0; d < dim; ++d)1870      bodyRegion->front().addArgument(indexType, odsState.location);1871  }1872}1873 1874void hlfir::ElementalOp::build(mlir::OpBuilder &builder,1875                               mlir::OperationState &odsState,1876                               mlir::Type resultType, mlir::Value shape,1877                               mlir::Value mold, mlir::ValueRange typeparams,1878                               bool isUnordered) {1879  odsState.addTypes(resultType);1880  buildElemental<hlfir::ElementalOp>(builder, odsState, shape, mold, typeparams,1881                                     isUnordered);1882}1883 1884mlir::Value hlfir::ElementalOp::getElementEntity() {1885  return mlir::cast<hlfir::YieldElementOp>(getBody()->back()).getElementValue();1886}1887 1888llvm::LogicalResult hlfir::ElementalOp::verify() {1889  mlir::Value mold = getMold();1890  hlfir::ExprType resultType = mlir::cast<hlfir::ExprType>(getType());1891  if (!!mold != resultType.isPolymorphic())1892    return emitOpError("result must be polymorphic when mold is present "1893                       "and vice versa");1894 1895  return mlir::success();1896}1897 1898//===----------------------------------------------------------------------===//1899// ApplyOp1900//===----------------------------------------------------------------------===//1901 1902void hlfir::ApplyOp::build(mlir::OpBuilder &builder,1903                           mlir::OperationState &odsState, mlir::Value expr,1904                           mlir::ValueRange indices,1905                           mlir::ValueRange typeparams) {1906  mlir::Type resultType = expr.getType();1907  if (auto exprType = mlir::dyn_cast<hlfir::ExprType>(resultType))1908    resultType = exprType.getElementExprType();1909  build(builder, odsState, resultType, expr, indices, typeparams);1910}1911 1912//===----------------------------------------------------------------------===//1913// NullOp1914//===----------------------------------------------------------------------===//1915 1916void hlfir::NullOp::build(mlir::OpBuilder &builder,1917                          mlir::OperationState &odsState) {1918  return build(builder, odsState,1919               fir::ReferenceType::get(builder.getNoneType()));1920}1921 1922//===----------------------------------------------------------------------===//1923// DestroyOp1924//===----------------------------------------------------------------------===//1925 1926llvm::LogicalResult hlfir::DestroyOp::verify() {1927  if (mustFinalizeExpr()) {1928    mlir::Value expr = getExpr();1929    hlfir::ExprType exprTy = mlir::cast<hlfir::ExprType>(expr.getType());1930    mlir::Type elemTy = hlfir::getFortranElementType(exprTy);1931    if (!mlir::isa<fir::RecordType>(elemTy))1932      return emitOpError(1933          "the element type must be finalizable, when 'finalize' is set");1934  }1935 1936  return mlir::success();1937}1938 1939//===----------------------------------------------------------------------===//1940// CopyInOp1941//===----------------------------------------------------------------------===//1942 1943void hlfir::CopyInOp::build(mlir::OpBuilder &builder,1944                            mlir::OperationState &odsState, mlir::Value var,1945                            mlir::Value tempBox, mlir::Value var_is_present) {1946  return build(builder, odsState, {var.getType(), builder.getI1Type()}, var,1947               tempBox, var_is_present);1948}1949 1950//===----------------------------------------------------------------------===//1951// ShapeOfOp1952//===----------------------------------------------------------------------===//1953 1954void hlfir::ShapeOfOp::build(mlir::OpBuilder &builder,1955                             mlir::OperationState &result, mlir::Value expr) {1956  hlfir::ExprType exprTy = mlir::cast<hlfir::ExprType>(expr.getType());1957  mlir::Type type = fir::ShapeType::get(builder.getContext(), exprTy.getRank());1958  build(builder, result, type, expr);1959}1960 1961std::size_t hlfir::ShapeOfOp::getRank() {1962  mlir::Type resTy = getResult().getType();1963  fir::ShapeType shape = mlir::cast<fir::ShapeType>(resTy);1964  return shape.getRank();1965}1966 1967llvm::LogicalResult hlfir::ShapeOfOp::verify() {1968  mlir::Value expr = getExpr();1969  hlfir::ExprType exprTy = mlir::cast<hlfir::ExprType>(expr.getType());1970  std::size_t exprRank = exprTy.getShape().size();1971 1972  if (exprRank == 0)1973    return emitOpError("cannot get the shape of a shape-less expression");1974 1975  std::size_t shapeRank = getRank();1976  if (shapeRank != exprRank)1977    return emitOpError("result rank and expr rank do not match");1978 1979  return mlir::success();1980}1981 1982llvm::LogicalResult1983hlfir::ShapeOfOp::canonicalize(ShapeOfOp shapeOf,1984                               mlir::PatternRewriter &rewriter) {1985  // if extent information is available at compile time, immediately fold the1986  // hlfir.shape_of into a fir.shape1987  mlir::Location loc = shapeOf.getLoc();1988  hlfir::ExprType expr =1989      mlir::cast<hlfir::ExprType>(shapeOf.getExpr().getType());1990 1991  mlir::Value shape = hlfir::genExprShape(rewriter, loc, expr);1992  if (!shape)1993    // shape information is not available at compile time1994    return llvm::LogicalResult::failure();1995 1996  rewriter.replaceOp(shapeOf, shape);1997  return llvm::LogicalResult::success();1998}1999 2000mlir::OpFoldResult hlfir::ShapeOfOp::fold(FoldAdaptor adaptor) {2001  if (matchPattern(getExpr(), mlir::m_Op<hlfir::ElementalOp>())) {2002    auto elementalOp =2003        mlir::cast<hlfir::ElementalOp>(getExpr().getDefiningOp());2004    return elementalOp.getShape();2005  }2006  return {};2007}2008 2009//===----------------------------------------------------------------------===//2010// GetExtent2011//===----------------------------------------------------------------------===//2012 2013void hlfir::GetExtentOp::build(mlir::OpBuilder &builder,2014                               mlir::OperationState &result, mlir::Value shape,2015                               unsigned dim) {2016  mlir::Type indexTy = builder.getIndexType();2017  mlir::IntegerAttr dimAttr = mlir::IntegerAttr::get(indexTy, dim);2018  build(builder, result, indexTy, shape, dimAttr);2019}2020 2021llvm::LogicalResult hlfir::GetExtentOp::verify() {2022  fir::ShapeType shapeTy = mlir::cast<fir::ShapeType>(getShape().getType());2023  std::uint64_t rank = shapeTy.getRank();2024  llvm::APInt dim = getDim();2025  if (dim.sge(rank))2026    return emitOpError("dimension index out of bounds");2027  return mlir::success();2028}2029 2030//===----------------------------------------------------------------------===//2031// RegionAssignOp2032//===----------------------------------------------------------------------===//2033 2034/// Add a fir.end terminator to a parsed region if it does not already has a2035/// terminator.2036static void ensureTerminator(mlir::Region &region, mlir::Builder &builder,2037                             mlir::Location loc) {2038  // Borrow YielOp::ensureTerminator MLIR generated implementation to add a2039  // fir.end if there is no terminator. This has nothing to do with YielOp,2040  // other than the fact that yieldOp has the2041  // SingleBlocklicitTerminator<"fir::FirEndOp"> interface that2042  // cannot be added on other HLFIR operations with several regions which are2043  // not all terminated the same way.2044  hlfir::YieldOp::ensureTerminator(region, builder, loc);2045}2046 2047mlir::ParseResult hlfir::RegionAssignOp::parse(mlir::OpAsmParser &parser,2048                                               mlir::OperationState &result) {2049  mlir::Region &rhsRegion = *result.addRegion();2050  if (parser.parseRegion(rhsRegion))2051    return mlir::failure();2052  mlir::Region &lhsRegion = *result.addRegion();2053  if (parser.parseKeyword("to") || parser.parseRegion(lhsRegion))2054    return mlir::failure();2055  mlir::Region &userDefinedAssignmentRegion = *result.addRegion();2056  if (succeeded(parser.parseOptionalKeyword("user_defined_assign"))) {2057    mlir::OpAsmParser::Argument rhsArg, lhsArg;2058    if (parser.parseLParen() || parser.parseArgument(rhsArg) ||2059        parser.parseColon() || parser.parseType(rhsArg.type) ||2060        parser.parseRParen() || parser.parseKeyword("to") ||2061        parser.parseLParen() || parser.parseArgument(lhsArg) ||2062        parser.parseColon() || parser.parseType(lhsArg.type) ||2063        parser.parseRParen())2064      return mlir::failure();2065    if (parser.parseRegion(userDefinedAssignmentRegion, {rhsArg, lhsArg}))2066      return mlir::failure();2067    ensureTerminator(userDefinedAssignmentRegion, parser.getBuilder(),2068                     result.location);2069  }2070  return mlir::success();2071}2072 2073void hlfir::RegionAssignOp::print(mlir::OpAsmPrinter &p) {2074  p << " ";2075  p.printRegion(getRhsRegion(), /*printEntryBlockArgs=*/false,2076                /*printBlockTerminators=*/true);2077  p << " to ";2078  p.printRegion(getLhsRegion(), /*printEntryBlockArgs=*/false,2079                /*printBlockTerminators=*/true);2080  if (!getUserDefinedAssignment().empty()) {2081    p << " user_defined_assign ";2082    mlir::Value userAssignmentRhs = getUserAssignmentRhs();2083    mlir::Value userAssignmentLhs = getUserAssignmentLhs();2084    p << " (" << userAssignmentRhs << ": " << userAssignmentRhs.getType()2085      << ") to (";2086    p << userAssignmentLhs << ": " << userAssignmentLhs.getType() << ") ";2087    p.printRegion(getUserDefinedAssignment(), /*printEntryBlockArgs=*/false,2088                  /*printBlockTerminators=*/false);2089  }2090}2091 2092static mlir::Operation *getTerminator(mlir::Region &region) {2093  if (region.empty() || region.back().empty())2094    return nullptr;2095  return &region.back().back();2096}2097 2098llvm::LogicalResult hlfir::RegionAssignOp::verify() {2099  if (!mlir::isa_and_nonnull<hlfir::YieldOp>(getTerminator(getRhsRegion())))2100    return emitOpError(2101        "right-hand side region must be terminated by an hlfir.yield");2102  if (!mlir::isa_and_nonnull<hlfir::YieldOp, hlfir::ElementalAddrOp>(2103          getTerminator(getLhsRegion())))2104    return emitOpError("left-hand side region must be terminated by an "2105                       "hlfir.yield or hlfir.elemental_addr");2106  return mlir::success();2107}2108 2109static mlir::Type2110getNonVectorSubscriptedLhsType(hlfir::RegionAssignOp regionAssign) {2111  hlfir::YieldOp yieldOp = mlir::dyn_cast_or_null<hlfir::YieldOp>(2112      getTerminator(regionAssign.getLhsRegion()));2113  return yieldOp ? yieldOp.getEntity().getType() : mlir::Type{};2114}2115 2116bool hlfir::RegionAssignOp::isPointerObjectAssignment() {2117  if (!getUserDefinedAssignment().empty())2118    return false;2119  mlir::Type lhsType = getNonVectorSubscriptedLhsType(*this);2120  return lhsType && hlfir::isFortranPointerObjectType(lhsType);2121}2122 2123bool hlfir::RegionAssignOp::isProcedurePointerAssignment() {2124  if (!getUserDefinedAssignment().empty())2125    return false;2126  mlir::Type lhsType = getNonVectorSubscriptedLhsType(*this);2127  return lhsType && hlfir::isFortranProcedurePointerType(lhsType);2128}2129 2130bool hlfir::RegionAssignOp::isPointerAssignment() {2131  if (!getUserDefinedAssignment().empty())2132    return false;2133  mlir::Type lhsType = getNonVectorSubscriptedLhsType(*this);2134  return lhsType && (hlfir::isFortranPointerObjectType(lhsType) ||2135                     hlfir::isFortranProcedurePointerType(lhsType));2136}2137 2138//===----------------------------------------------------------------------===//2139// YieldOp2140//===----------------------------------------------------------------------===//2141 2142static mlir::ParseResult parseYieldOpCleanup(mlir::OpAsmParser &parser,2143                                             mlir::Region &cleanup) {2144  if (succeeded(parser.parseOptionalKeyword("cleanup"))) {2145    if (parser.parseRegion(cleanup, /*arguments=*/{},2146                           /*argTypes=*/{}))2147      return mlir::failure();2148    hlfir::YieldOp::ensureTerminator(cleanup, parser.getBuilder(),2149                                     parser.getBuilder().getUnknownLoc());2150  }2151  return mlir::success();2152}2153 2154template <typename YieldOp>2155static void printYieldOpCleanup(mlir::OpAsmPrinter &p, YieldOp yieldOp,2156                                mlir::Region &cleanup) {2157  if (!cleanup.empty()) {2158    p << "cleanup ";2159    p.printRegion(cleanup, /*printEntryBlockArgs=*/false,2160                  /*printBlockTerminators=*/false);2161  }2162}2163 2164//===----------------------------------------------------------------------===//2165// ElementalAddrOp2166//===----------------------------------------------------------------------===//2167 2168void hlfir::ElementalAddrOp::build(mlir::OpBuilder &builder,2169                                   mlir::OperationState &odsState,2170                                   mlir::Value shape, mlir::Value mold,2171                                   mlir::ValueRange typeparams,2172                                   bool isUnordered) {2173  buildElemental<hlfir::ElementalAddrOp>(builder, odsState, shape, mold,2174                                         typeparams, isUnordered);2175  // Push cleanUp region.2176  odsState.addRegion();2177}2178 2179llvm::LogicalResult hlfir::ElementalAddrOp::verify() {2180  hlfir::YieldOp yieldOp =2181      mlir::dyn_cast_or_null<hlfir::YieldOp>(getTerminator(getBody()));2182  if (!yieldOp)2183    return emitOpError("body region must be terminated by an hlfir.yield");2184  mlir::Type elementAddrType = yieldOp.getEntity().getType();2185  if (!hlfir::isFortranVariableType(elementAddrType) ||2186      mlir::isa<fir::SequenceType>(2187          hlfir::getFortranElementOrSequenceType(elementAddrType)))2188    return emitOpError("body must compute the address of a scalar entity");2189  unsigned shapeRank =2190      mlir::cast<fir::ShapeType>(getShape().getType()).getRank();2191  if (shapeRank != getIndices().size())2192    return emitOpError("body number of indices must match shape rank");2193  return mlir::success();2194}2195 2196hlfir::YieldOp hlfir::ElementalAddrOp::getYieldOp() {2197  hlfir::YieldOp yieldOp =2198      mlir::dyn_cast_or_null<hlfir::YieldOp>(getTerminator(getBody()));2199  assert(yieldOp && "element_addr is ill-formed");2200  return yieldOp;2201}2202 2203mlir::Value hlfir::ElementalAddrOp::getElementEntity() {2204  return getYieldOp().getEntity();2205}2206 2207mlir::Region *hlfir::ElementalAddrOp::getElementCleanup() {2208  mlir::Region *cleanup = &getYieldOp().getCleanup();2209  return cleanup->empty() ? nullptr : cleanup;2210}2211 2212//===----------------------------------------------------------------------===//2213// OrderedAssignmentTreeOpInterface2214//===----------------------------------------------------------------------===//2215 2216llvm::LogicalResult hlfir::OrderedAssignmentTreeOpInterface::verifyImpl() {2217  if (mlir::Region *body = getSubTreeRegion())2218    if (!body->empty())2219      for (mlir::Operation &op : body->front())2220        if (!mlir::isa<hlfir::OrderedAssignmentTreeOpInterface, fir::FirEndOp>(2221                op))2222          return emitOpError(2223              "body region must only contain OrderedAssignmentTreeOpInterface "2224              "operations or fir.end");2225  return mlir::success();2226}2227 2228//===----------------------------------------------------------------------===//2229// ForallOp2230//===----------------------------------------------------------------------===//2231 2232static mlir::ParseResult parseForallOpBody(mlir::OpAsmParser &parser,2233                                           mlir::Region &body) {2234  mlir::OpAsmParser::Argument bodyArg;2235  if (parser.parseLParen() || parser.parseArgument(bodyArg) ||2236      parser.parseColon() || parser.parseType(bodyArg.type) ||2237      parser.parseRParen())2238    return mlir::failure();2239  if (parser.parseRegion(body, {bodyArg}))2240    return mlir::failure();2241  ensureTerminator(body, parser.getBuilder(),2242                   parser.getBuilder().getUnknownLoc());2243  return mlir::success();2244}2245 2246static void printForallOpBody(mlir::OpAsmPrinter &p, hlfir::ForallOp forall,2247                              mlir::Region &body) {2248  mlir::Value forallIndex = forall.getForallIndexValue();2249  p << " (" << forallIndex << ": " << forallIndex.getType() << ") ";2250  p.printRegion(body, /*printEntryBlockArgs=*/false,2251                /*printBlockTerminators=*/false);2252}2253 2254/// Predicate implementation of YieldIntegerOrEmpty.2255static bool yieldsIntegerOrEmpty(mlir::Region &region) {2256  if (region.empty())2257    return true;2258  auto yield = mlir::dyn_cast_or_null<hlfir::YieldOp>(getTerminator(region));2259  return yield && fir::isa_integer(yield.getEntity().getType());2260}2261 2262//===----------------------------------------------------------------------===//2263// ForallMaskOp2264//===----------------------------------------------------------------------===//2265 2266static mlir::ParseResult parseAssignmentMaskOpBody(mlir::OpAsmParser &parser,2267                                                   mlir::Region &body) {2268  if (parser.parseRegion(body))2269    return mlir::failure();2270  ensureTerminator(body, parser.getBuilder(),2271                   parser.getBuilder().getUnknownLoc());2272  return mlir::success();2273}2274 2275template <typename ConcreteOp>2276static void printAssignmentMaskOpBody(mlir::OpAsmPrinter &p, ConcreteOp,2277                                      mlir::Region &body) {2278  // ElseWhereOp is a WhereOp/ElseWhereOp terminator that should be printed.2279  bool printBlockTerminators =2280      !body.empty() &&2281      mlir::isa_and_nonnull<hlfir::ElseWhereOp>(body.back().getTerminator());2282  p.printRegion(body, /*printEntryBlockArgs=*/false, printBlockTerminators);2283}2284 2285static bool yieldsLogical(mlir::Region &region, bool mustBeScalarI1) {2286  if (region.empty())2287    return false;2288  auto yield = mlir::dyn_cast_or_null<hlfir::YieldOp>(getTerminator(region));2289  if (!yield)2290    return false;2291  mlir::Type yieldType = yield.getEntity().getType();2292  if (mustBeScalarI1)2293    return hlfir::isI1Type(yieldType);2294  return hlfir::isMaskArgument(yieldType) &&2295         mlir::isa<fir::SequenceType>(2296             hlfir::getFortranElementOrSequenceType(yieldType));2297}2298 2299llvm::LogicalResult hlfir::ForallMaskOp::verify() {2300  if (!yieldsLogical(getMaskRegion(), /*mustBeScalarI1=*/true))2301    return emitOpError("mask region must yield a scalar i1");2302  mlir::Operation *op = getOperation();2303  hlfir::ForallOp forallOp =2304      mlir::dyn_cast_or_null<hlfir::ForallOp>(op->getParentOp());2305  if (!forallOp || op->getParentRegion() != &forallOp.getBody())2306    return emitOpError("must be inside the body region of an hlfir.forall");2307  return mlir::success();2308}2309 2310//===----------------------------------------------------------------------===//2311// WhereOp and ElseWhereOp2312//===----------------------------------------------------------------------===//2313 2314template <typename ConcreteOp>2315static llvm::LogicalResult verifyWhereAndElseWhereBody(ConcreteOp &concreteOp) {2316  for (mlir::Operation &op : concreteOp.getBody().front())2317    if (mlir::isa<hlfir::ForallOp>(op))2318      return concreteOp.emitOpError(2319          "body region must not contain hlfir.forall");2320  return mlir::success();2321}2322 2323llvm::LogicalResult hlfir::WhereOp::verify() {2324  if (!yieldsLogical(getMaskRegion(), /*mustBeScalarI1=*/false))2325    return emitOpError("mask region must yield a logical array");2326  return verifyWhereAndElseWhereBody(*this);2327}2328 2329llvm::LogicalResult hlfir::ElseWhereOp::verify() {2330  if (!getMaskRegion().empty())2331    if (!yieldsLogical(getMaskRegion(), /*mustBeScalarI1=*/false))2332      return emitOpError(2333          "mask region must yield a logical array when provided");2334  return verifyWhereAndElseWhereBody(*this);2335}2336 2337//===----------------------------------------------------------------------===//2338// ForallIndexOp2339//===----------------------------------------------------------------------===//2340 2341llvm::LogicalResult2342hlfir::ForallIndexOp::canonicalize(hlfir::ForallIndexOp indexOp,2343                                   mlir::PatternRewriter &rewriter) {2344  for (mlir::Operation *user : indexOp->getResult(0).getUsers())2345    if (!mlir::isa<fir::LoadOp>(user))2346      return mlir::failure();2347 2348  auto insertPt = rewriter.saveInsertionPoint();2349  llvm::SmallVector<mlir::Operation *> users(indexOp->getResult(0).getUsers());2350  for (mlir::Operation *user : users)2351    if (auto loadOp = mlir::dyn_cast<fir::LoadOp>(user)) {2352      rewriter.setInsertionPoint(loadOp);2353      rewriter.replaceOpWithNewOp<fir::ConvertOp>(2354          user, loadOp.getResult().getType(), indexOp.getIndex());2355    }2356  rewriter.restoreInsertionPoint(insertPt);2357  rewriter.eraseOp(indexOp);2358  return mlir::success();2359}2360 2361//===----------------------------------------------------------------------===//2362// CharExtremumOp2363//===----------------------------------------------------------------------===//2364 2365llvm::LogicalResult hlfir::CharExtremumOp::verify() {2366  if (getStrings().size() < 2)2367    return emitOpError("must be provided at least two string operands");2368  unsigned kind = getCharacterKind(getResult().getType());2369  for (auto string : getStrings())2370    if (kind != getCharacterKind(string.getType()))2371      return emitOpError("strings must have the same KIND as the result type");2372  return mlir::success();2373}2374 2375void hlfir::CharExtremumOp::build(mlir::OpBuilder &builder,2376                                  mlir::OperationState &result,2377                                  hlfir::CharExtremumPredicate predicate,2378                                  mlir::ValueRange strings) {2379 2380  fir::CharacterType::LenType resultTypeLen = 0;2381  assert(!strings.empty() && "must contain operands");2382  unsigned kind = getCharacterKind(strings[0].getType());2383  for (auto string : strings)2384    if (auto cstLen = getCharacterLengthIfStatic(string.getType())) {2385      resultTypeLen = std::max(resultTypeLen, *cstLen);2386    } else {2387      resultTypeLen = fir::CharacterType::unknownLen();2388      break;2389    }2390  auto resultType = hlfir::ExprType::get(2391      builder.getContext(), hlfir::ExprType::Shape{},2392      fir::CharacterType::get(builder.getContext(), kind, resultTypeLen),2393      false);2394 2395  build(builder, result, resultType, predicate, strings);2396}2397 2398void hlfir::CharExtremumOp::getEffects(2399    llvm::SmallVectorImpl<2400        mlir::SideEffects::EffectInstance<mlir::MemoryEffects::Effect>>2401        &effects) {2402  getIntrinsicEffects(getOperation(), effects);2403}2404 2405//===----------------------------------------------------------------------===//2406// GetLength2407//===----------------------------------------------------------------------===//2408 2409llvm::LogicalResult2410hlfir::GetLengthOp::canonicalize(GetLengthOp getLength,2411                                 mlir::PatternRewriter &rewriter) {2412  mlir::Location loc = getLength.getLoc();2413  auto exprTy = mlir::cast<hlfir::ExprType>(getLength.getExpr().getType());2414  auto charTy = mlir::cast<fir::CharacterType>(exprTy.getElementType());2415  if (!charTy.hasConstantLen())2416    return mlir::failure();2417 2418  mlir::Type indexTy = rewriter.getIndexType();2419  auto cstLen = mlir::arith::ConstantOp::create(2420      rewriter, loc, indexTy, mlir::IntegerAttr::get(indexTy, charTy.getLen()));2421  rewriter.replaceOp(getLength, cstLen);2422  return mlir::success();2423}2424 2425//===----------------------------------------------------------------------===//2426// EvaluateInMemoryOp2427//===----------------------------------------------------------------------===//2428 2429void hlfir::EvaluateInMemoryOp::build(mlir::OpBuilder &builder,2430                                      mlir::OperationState &odsState,2431                                      mlir::Type resultType, mlir::Value shape,2432                                      mlir::ValueRange typeparams) {2433  odsState.addTypes(resultType);2434  if (shape)2435    odsState.addOperands(shape);2436  odsState.addOperands(typeparams);2437  odsState.addAttribute(2438      getOperandSegmentSizeAttr(),2439      builder.getDenseI32ArrayAttr(2440          {shape ? 1 : 0, static_cast<int32_t>(typeparams.size())}));2441  mlir::Region *bodyRegion = odsState.addRegion();2442  bodyRegion->push_back(new mlir::Block{});2443  mlir::Type memType = fir::ReferenceType::get(2444      hlfir::getFortranElementOrSequenceType(resultType));2445  bodyRegion->front().addArgument(memType, odsState.location);2446  EvaluateInMemoryOp::ensureTerminator(*bodyRegion, builder, odsState.location);2447}2448 2449llvm::LogicalResult hlfir::EvaluateInMemoryOp::verify() {2450  unsigned shapeRank = 0;2451  if (mlir::Value shape = getShape())2452    if (auto shapeTy = mlir::dyn_cast<fir::ShapeType>(shape.getType()))2453      shapeRank = shapeTy.getRank();2454  auto exprType = mlir::cast<hlfir::ExprType>(getResult().getType());2455  if (shapeRank != exprType.getRank())2456    return emitOpError("`shape` rank must match the result rank");2457  mlir::Type elementType = exprType.getElementType();2458  if (auto res = verifyTypeparams(*this, elementType, getTypeparams().size());2459      failed(res))2460    return res;2461  return mlir::success();2462}2463 2464#include "flang/Optimizer/HLFIR/HLFIROpInterfaces.cpp.inc"2465#define GET_OP_CLASSES2466#include "flang/Optimizer/HLFIR/HLFIREnums.cpp.inc"2467#include "flang/Optimizer/HLFIR/HLFIROps.cpp.inc"2468