HLFIRTools.h

//===-- HLFIRTools.h -- HLFIR tools       -----------------------*- C++ -*-===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
//
// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
//
//===----------------------------------------------------------------------===//
 
#ifndef FORTRAN_OPTIMIZER_BUILDER_HLFIRTOOLS_H
#define FORTRAN_OPTIMIZER_BUILDER_HLFIRTOOLS_H
 
#include "flang/Optimizer/Builder/BoxValue.h"
#include "flang/Optimizer/Dialect/FIROps.h"
#include "flang/Optimizer/Dialect/FortranVariableInterface.h"
#include "flang/Optimizer/HLFIR/HLFIRDialect.h"
#include "flang/Optimizer/HLFIR/HLFIROps.h"
#include <optional>
 
namespace fir {
class FirOpBuilder;
}
 
namespace mlir {
class IRMapping;
}
 
namespace hlfir {
 
class AssociateOp;
class ElementalOp;
class ElementalOpInterface;
class ElementalAddrOp;
class EvaluateInMemoryOp;
class YieldElementOp;

inline bool isFortranVariableWithAttributes(mlir::Value value) {
  return value.getDefiningOp<fir::FortranVariableOpInterface>();
}

inline bool isFortranEntityWithAttributes(mlir::Value value) {
  return isFortranValue(value) || isFortranVariableWithAttributes(value);
}
 
class Entity : public mlir::Value {
public:
  explicit Entity(mlir::Value value) : mlir::Value(value) {
    assert(isFortranEntity(value) &&
           "must be a value representing a Fortran value or variable like");
  }
  Entity(fir::FortranVariableOpInterface variable)
      : mlir::Value(variable.getBase()) {}
  bool isValue() const { return isFortranValue(*this); }
  bool isVariable() const { return !isValue(); }
  bool isMutableBox() const { return hlfir::isBoxAddressType(getType()); }
  bool isProcedurePointer() const {
    return hlfir::isFortranProcedurePointerType(getType());
  }
  bool isBoxAddressOrValue() const {
    return hlfir::isBoxAddressOrValueType(getType());
  }

  bool isProcedure() const { return isFortranProcedureValue(getType()); }

  bool isArray() const { return getRank() != 0; }

  bool isAssumedRank() const { return getRank() == -1; }

  int getRank() const {
    mlir::Type type = fir::unwrapPassByRefType(fir::unwrapRefType(getType()));
    if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(type)) {
      if (seqTy.hasUnknownShape())
        return -1;
      return seqTy.getDimension();
    }
    if (auto exprType = mlir::dyn_cast<hlfir::ExprType>(type))
      return exprType.getRank();
    return 0;
  }
  bool isScalar() const { return !isArray(); }
 
  bool isPolymorphic() const { return hlfir::isPolymorphicType(getType()); }
 
  mlir::Type getFortranElementType() const {
    return hlfir::getFortranElementType(getType());
  }
  mlir::Type getElementOrSequenceType() const {
    return hlfir::getFortranElementOrSequenceType(getType());
  }
  fir::BaseBoxType getBoxType() const {
    if (isBoxAddressOrValue())
      return llvm::cast<fir::BaseBoxType>(fir::unwrapRefType(getType()));
    const bool isVolatile = fir::isa_volatile_type(getType());
    return fir::BoxType::get(getElementOrSequenceType(), isVolatile);
  }
 
  bool hasLengthParameters() const {
    mlir::Type eleTy = getFortranElementType();
    return mlir::isa<fir::CharacterType>(eleTy) ||
           fir::isRecordWithTypeParameters(eleTy);
  }
 
  bool isCharacter() const {
    return mlir::isa<fir::CharacterType>(getFortranElementType());
  }
 
  bool hasIntrinsicType() const {
    mlir::Type eleTy = getFortranElementType();
    return fir::isa_trivial(eleTy) || mlir::isa<fir::CharacterType>(eleTy);
  }
 
  bool isDerivedWithLengthParameters() const {
    return fir::isRecordWithTypeParameters(getFortranElementType());
  }
 
  bool mayHaveNonDefaultLowerBounds() const;
 
  // Is this entity known to be contiguous at compile time?
  // Note that when this returns false, the entity may still
  // turn-out to be contiguous at runtime.
  bool isSimplyContiguous() const {
    // If this can be described without a fir.box in FIR, this must
    // be contiguous.
    if (!hlfir::isBoxAddressOrValueType(getFirBase().getType()) || isScalar())
      return true;
    // Otherwise, if this entity has a visible declaration in FIR,
    // or is the dereference of an allocatable or contiguous pointer
    // it is simply contiguous.
    if (auto varIface = getMaybeDereferencedVariableInterface())
      return varIface.isAllocatable() || varIface.hasContiguousAttr();
    return false;
  }
 
  fir::FortranVariableOpInterface getIfVariableInterface() const {
    return this->getDefiningOp<fir::FortranVariableOpInterface>();
  }
 
  // Return a "declaration" operation for this variable if visible,
  // or the "declaration" operation of the allocatable/pointer this
  // variable was dereferenced from (if it is visible).
  fir::FortranVariableOpInterface
  getMaybeDereferencedVariableInterface() const {
    mlir::Value base = *this;
    if (auto loadOp = base.getDefiningOp<fir::LoadOp>())
      base = loadOp.getMemref();
    return base.getDefiningOp<fir::FortranVariableOpInterface>();
  }
 
  bool mayBeOptional() const;
 
  bool isParameter() const {
    auto varIface = getIfVariableInterface();
    return varIface ? varIface.isParameter() : false;
  }
 
  bool isAllocatable() const {
    auto varIface = getIfVariableInterface();
    return varIface ? varIface.isAllocatable() : false;
  }
 
  bool isPointer() const {
    auto varIface = getIfVariableInterface();
    return varIface ? varIface.isPointer() : false;
  }
 
  // Get the entity as an mlir SSA value containing all the shape, type
  // parameters and dynamic shape information.
  mlir::Value getBase() const { return *this; }
 
  // Get the entity as a FIR base. This may not carry the shape and type
  // parameters information, and even when it is a box with shape information.
  // it will not contain the local lower bounds of the entity. This should
  // be used with care when generating FIR code that does not need this
  // information, or has access to it in other ways. Its advantage is that
  // it will never be a fir.box for explicit shape arrays, leading to simpler
  // FIR code generation.
  mlir::Value getFirBase() const;
};

class EntityWithAttributes : public Entity {
public:
  explicit EntityWithAttributes(mlir::Value value) : Entity(value) {
    assert(isFortranEntityWithAttributes(value) &&
           "must be a value representing a Fortran value or variable");
  }
  EntityWithAttributes(fir::FortranVariableOpInterface variable)
      : Entity(variable) {}
  fir::FortranVariableOpInterface getIfVariable() const {
    return getIfVariableInterface();
  }
};

using CleanupFunction = std::function<void()>;
std::pair<fir::ExtendedValue, std::optional<CleanupFunction>>
translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
                         Entity entity, bool contiguousHint = false,
                         bool keepScalarOptionalBoxed = false);

fir::ExtendedValue
translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
                         fir::FortranVariableOpInterface fortranVariable,
                         bool forceHlfirBase = false);

fir::FortranVariableOpInterface
genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
           const fir::ExtendedValue &exv, llvm::StringRef name,
           fir::FortranVariableFlagsAttr flags,
           mlir::Value dummyScope = nullptr, mlir::Value storage = nullptr,
           std::uint64_t storageOffset = 0,
           cuf::DataAttributeAttr dataAttr = {});

hlfir::AssociateOp
genAssociateExpr(mlir::Location loc, fir::FirOpBuilder &builder,
                 hlfir::Entity value, mlir::Type variableType,
                 llvm::StringRef name,
                 std::optional<mlir::NamedAttribute> attr = std::nullopt);

mlir::Value genVariableRawAddress(mlir::Location loc,
                                  fir::FirOpBuilder &builder,
                                  hlfir::Entity var);

mlir::Value genVariableBoxChar(mlir::Location loc, fir::FirOpBuilder &builder,
                               hlfir::Entity var);

hlfir::Entity genVariableBox(mlir::Location loc, fir::FirOpBuilder &builder,
                             hlfir::Entity var,
                             fir::BaseBoxType forceBoxType = {});

Entity loadTrivialScalar(mlir::Location loc, fir::FirOpBuilder &builder,
                         Entity entity);

hlfir::Entity derefPointersAndAllocatables(mlir::Location loc,
                                           fir::FirOpBuilder &builder,
                                           Entity entity);

hlfir::Entity getElementAt(mlir::Location loc, fir::FirOpBuilder &builder,
                           Entity entity, mlir::ValueRange oneBasedIndices);
llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>
genBounds(mlir::Location loc, fir::FirOpBuilder &builder, Entity entity);
llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>
genBounds(mlir::Location loc, fir::FirOpBuilder &builder, mlir::Value shape);

llvm::SmallVector<mlir::Value> genLowerbounds(mlir::Location loc,
                                              fir::FirOpBuilder &builder,
                                              mlir::Value shape, unsigned rank);

mlir::Value genShape(mlir::Location loc, fir::FirOpBuilder &builder,
                     Entity entity);

mlir::Value genExtent(mlir::Location loc, fir::FirOpBuilder &builder,
                      hlfir::Entity entity, unsigned dim);

mlir::Value genLBound(mlir::Location loc, fir::FirOpBuilder &builder,
                      hlfir::Entity entity, unsigned dim);

llvm::SmallVector<mlir::Value> getIndexExtents(mlir::Location loc,
                                               fir::FirOpBuilder &builder,
                                               mlir::Value shape);

llvm::SmallVector<mlir::Value>
getExplicitExtentsFromShape(mlir::Value shape, fir::FirOpBuilder &builder);

void genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder,
                         Entity entity,
                         llvm::SmallVectorImpl<mlir::Value> &result);

mlir::Value genCharLength(mlir::Location loc, fir::FirOpBuilder &builder,
                          Entity entity);

std::optional<std::int64_t> getCharLengthIfConst(Entity entity);
 
mlir::Value genRank(mlir::Location loc, fir::FirOpBuilder &builder,
                    Entity entity, mlir::Type resultType);

std::pair<mlir::Value, mlir::Value> genVariableFirBaseShapeAndParams(
    mlir::Location loc, fir::FirOpBuilder &builder, Entity entity,
    llvm::SmallVectorImpl<mlir::Value> &typeParams);

mlir::Type getVariableElementType(hlfir::Entity variable);
mlir::Type getEntityElementType(hlfir::Entity entity);
 
using ElementalKernelGenerator = std::function<hlfir::Entity(
    mlir::Location, fir::FirOpBuilder &, mlir::ValueRange)>;
hlfir::ElementalOp genElementalOp(
    mlir::Location loc, fir::FirOpBuilder &builder, mlir::Type elementType,
    mlir::Value shape, mlir::ValueRange typeParams,
    const ElementalKernelGenerator &genKernel, bool isUnordered = false,
    mlir::Value polymorphicMold = {}, mlir::Type exprType = mlir::Type{});

struct LoopNest {
  mlir::Operation *outerOp = nullptr;
  mlir::Block *body = nullptr;
  llvm::SmallVector<mlir::Value> oneBasedIndices;
};

LoopNest genLoopNest(mlir::Location loc, fir::FirOpBuilder &builder,
                     mlir::ValueRange extents, bool isUnordered = false,
                     bool emitWorkshareLoop = false,
                     bool couldVectorize = true);
inline LoopNest genLoopNest(mlir::Location loc, fir::FirOpBuilder &builder,
                            mlir::Value shape, bool isUnordered = false,
                            bool emitWorkshareLoop = false,
                            bool couldVectorize = true) {
  return genLoopNest(loc, builder, getIndexExtents(loc, builder, shape),
                     isUnordered, emitWorkshareLoop, couldVectorize);
}

using ReductionLoopBodyGenerator = std::function<llvm::SmallVector<mlir::Value>(
    mlir::Location, fir::FirOpBuilder &, mlir::ValueRange, mlir::ValueRange)>;

llvm::SmallVector<mlir::Value> genLoopNestWithReductions(
    mlir::Location loc, fir::FirOpBuilder &builder, mlir::ValueRange extents,
    mlir::ValueRange reductionInits, const ReductionLoopBodyGenerator &genBody,
    bool isUnordered = false);

hlfir::YieldElementOp inlineElementalOp(mlir::Location loc,
                                        fir::FirOpBuilder &builder,
                                        hlfir::ElementalOp elemental,
                                        mlir::ValueRange oneBasedIndices);

mlir::Value inlineElementalOp(
    mlir::Location loc, fir::FirOpBuilder &builder,
    hlfir::ElementalOpInterface elemental, mlir::ValueRange oneBasedIndices,
    mlir::IRMapping &mapper,
    const std::function<bool(hlfir::ElementalOp)> &mustRecursivelyInline);

std::pair<hlfir::Entity, bool>
computeEvaluateOpInNewTemp(mlir::Location, fir::FirOpBuilder &,
                           hlfir::EvaluateInMemoryOp evalInMem,
                           mlir::Value shape, mlir::ValueRange typeParams);
 
// Clone the body of the hlfir.eval_in_mem operating on this the provided
// storage.  The provided storage must be a contiguous "raw" memory reference
// (not a fir.box) big enough to hold the value computed by hlfir.eval_in_mem.
// No runtime check is inserted by this utility to enforce that. It is also
// usually invalid to provide some storage that is already addressed directly
// or indirectly inside the hlfir.eval_in_mem body.
void computeEvaluateOpIn(mlir::Location, fir::FirOpBuilder &,
                         hlfir::EvaluateInMemoryOp, mlir::Value storage);
 
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
convertToValue(mlir::Location loc, fir::FirOpBuilder &builder,
               hlfir::Entity entity);
 
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
convertToAddress(mlir::Location loc, fir::FirOpBuilder &builder,
                 hlfir::Entity entity, mlir::Type targetType);
 
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
             hlfir::Entity entity, mlir::Type targetType);

hlfir::ElementalOp cloneToElementalOp(mlir::Location loc,
                                      fir::FirOpBuilder &builder,
                                      hlfir::ElementalAddrOp elementalAddrOp);

bool elementalOpMustProduceTemp(hlfir::ElementalOp elemental);

std::pair<hlfir::Entity, bool> createTempFromMold(mlir::Location loc,
                                                  fir::FirOpBuilder &builder,
                                                  hlfir::Entity mold);
 
// TODO: this does not support polymorphic molds
hlfir::Entity createStackTempFromMold(mlir::Location loc,
                                      fir::FirOpBuilder &builder,
                                      hlfir::Entity mold);
 
hlfir::EntityWithAttributes convertCharacterKind(mlir::Location loc,
                                                 fir::FirOpBuilder &builder,
                                                 hlfir::Entity scalarChar,
                                                 int toKind);

std::pair<hlfir::Entity, std::optional<hlfir::CleanupFunction>>
genTypeAndKindConvert(mlir::Location loc, fir::FirOpBuilder &builder,
                      hlfir::Entity source, mlir::Type toType,
                      bool preserveLowerBounds);

Entity loadElementAt(mlir::Location loc, fir::FirOpBuilder &builder,
                     Entity entity, mlir::ValueRange oneBasedIndices);

llvm::SmallVector<mlir::Value, Fortran::common::maxRank>
genExtentsVector(mlir::Location loc, fir::FirOpBuilder &builder, Entity entity);

Entity gen1DSection(mlir::Location loc, fir::FirOpBuilder &builder,
                    Entity array, int64_t dim,
                    mlir::ArrayRef<mlir::Value> lbounds,
                    mlir::ArrayRef<mlir::Value> extents,
                    mlir::ValueRange oneBasedIndices,
                    mlir::ArrayRef<mlir::Value> typeParams);

bool designatePreservesContinuity(hlfir::DesignateOp op);

bool isSimplyContiguous(mlir::Value base, bool checkWhole = true);
 
} // namespace hlfir
 
#endif // FORTRAN_OPTIMIZER_BUILDER_HLFIRTOOLS_H