CallInterface.h

//===-- Lower/CallInterface.h -- Procedure call interface -------*- 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/
//
//===----------------------------------------------------------------------===//
//
// Utility that defines fir call interface for procedure both on caller and
// and callee side and get the related FuncOp.
// It does not emit any FIR code but for the created mlir::func::FuncOp, instead
// it provides back a container of Symbol (callee side)/ActualArgument (caller
// side) with additional information for each element describing how it must be
// plugged with the mlir::func::FuncOp.
// It handles the fact that hidden arguments may be inserted for the result.
// while lowering.
//
// This utility uses the characteristic of Fortran procedures to operate, which
// is a term and concept used in Fortran to refer to the signature of a function
// or subroutine.
//===----------------------------------------------------------------------===//
 
#ifndef FORTRAN_LOWER_CALLINTERFACE_H
#define FORTRAN_LOWER_CALLINTERFACE_H
 
#include "flang/Common/reference.h"
#include "flang/Evaluate/characteristics.h"
#include "mlir/Dialect/Func/IR/FuncOps.h"
#include <optional>
 
namespace Fortran::semantics {
class Symbol;
}
 
namespace mlir {
class Location;
}
 
namespace fir {
class FortranProcedureFlagsEnumAttr;
}
 
namespace Fortran::lower {
class AbstractConverter;
class SymMap;
class HostAssociations;
namespace pft {
struct FunctionLikeUnit;
}

class CallerInterface;
class CalleeInterface;
template <typename T>
struct PassedEntityTypes {};
template <>
struct PassedEntityTypes<CallerInterface> {
  using FortranEntity = const Fortran::evaluate::ActualArgument *;
  using FirValue = int;
};
template <>
struct PassedEntityTypes<CalleeInterface> {
  using FortranEntity =
      std::optional<common::Reference<const semantics::Symbol>>;
  using FirValue = mlir::Value;
};

template <typename T>
class CallInterfaceImpl;

template <typename T>
class CallInterface {
  friend CallInterfaceImpl<T>;
 
public:
  enum class PassEntityBy {
    BaseAddress,
    BoxChar,
    // passing a read-only descriptor
    Box,
    // passing a writable descriptor
    MutableBox,
    AddressAndLength,
    Value,
    BaseAddressValueAttribute,
    CharBoxValueAttribute, // BoxChar with VALUE
    // Passing a character procedure as a <procedure address, result length>
    // tuple.
    CharProcTuple,
    BoxProcRef
  };

  enum class Property {
    BaseAddress,
    BoxChar,
    CharAddress,
    CharLength,
    CharProcTuple,
    Box,
    MutableBox,
    Value,
    BoxProcRef
  };
 
  using FortranEntity = typename PassedEntityTypes<T>::FortranEntity;
  using FirValue = typename PassedEntityTypes<T>::FirValue;

  struct FirPlaceHolder {
    FirPlaceHolder(mlir::Type t, int passedPosition, Property p,
                   llvm::ArrayRef<mlir::NamedAttribute> attrs)
        : type{t}, passedEntityPosition{passedPosition}, property{p},
          attributes{attrs} {}
    mlir::Type type;
    int passedEntityPosition;
    static constexpr int resultEntityPosition = -1;
    Property property;
    llvm::SmallVector<mlir::NamedAttribute> attributes;
  };

  struct PassedEntity {
    bool isOptional() const;
    bool mayBeModifiedByCall() const;
    bool mayBeReadByCall() const;
    bool testTKR(Fortran::common::IgnoreTKR flag) const;
    bool isIntentOut() const;
    bool mustBeMadeContiguous() const;
    bool hasValueAttribute() const;
    bool hasAllocatableAttribute() const;
    bool mayRequireIntentoutFinalization() const;
    bool isSequenceAssociatedDescriptor() const;
    PassEntityBy passBy;
    FortranEntity entity;
    FirValue firArgument;
    FirValue firLength; /* only for AddressAndLength */

    const Fortran::evaluate::characteristics::DummyArgument *characteristics =
        nullptr;
  };

  mlir::func::FuncOp getFuncOp() const { return func; }
  std::size_t getNumFIRArguments() const { return inputs.size(); }
  std::size_t getNumFIRResults() const { return outputs.size(); }
  llvm::ArrayRef<mlir::NamedAttribute>
  getFIRArgumentAttributes(std::size_t index) const {
    return inputs[index].attributes;
  }

  llvm::SmallVector<mlir::Type> getResultType() const;

  llvm::ArrayRef<PassedEntity> getPassedArguments() const {
    return passedArguments;
  }

  std::optional<PassedEntity> getPassedResult() const { return passedResult; }
  mlir::FunctionType genFunctionType();

  void
  determineInterface(bool isImplicit,
                     const Fortran::evaluate::characteristics::Procedure &);

  bool callerAllocateResult() const {
    return mustPassResult() || mustSaveResult();
  }

  bool mustPassResult() const { return passedResult.has_value(); }
  bool mustSaveResult() const { return saveResult; }

  bool canBeCalledViaImplicitInterface() const {
    return characteristic && characteristic->CanBeCalledViaImplicitInterface();
  }

  fir::FortranProcedureFlagsEnumAttr
  getProcedureAttrs(mlir::MLIRContext *) const;
 
protected:
  CallInterface(Fortran::lower::AbstractConverter &c) : converter{c} {}
  T &side() { return *static_cast<T *>(this); }
  const T &side() const { return *static_cast<const T *>(this); }
  void declare();
  void mapPassedEntities();
  void mapBackInputToPassedEntity(const FirPlaceHolder &, FirValue);
 
  llvm::SmallVector<FirPlaceHolder> outputs;
  llvm::SmallVector<FirPlaceHolder> inputs;
  mlir::func::FuncOp func;
  llvm::SmallVector<PassedEntity> passedArguments;
  std::optional<PassedEntity> passedResult;
  bool saveResult = false;
 
  Fortran::lower::AbstractConverter &converter;
  std::optional<Fortran::evaluate::characteristics::Procedure> characteristic =
      std::nullopt;
};
 
//===----------------------------------------------------------------------===//
// Caller side interface
//===----------------------------------------------------------------------===//

class CallerInterface : public CallInterface<CallerInterface> {
public:
  CallerInterface(const Fortran::evaluate::ProcedureRef &p,
                  Fortran::lower::AbstractConverter &c)
      : CallInterface{c}, procRef{p} {
    declare();
    mapPassedEntities();
    actualInputs.resize(getNumFIRArguments());
  }

  bool hasAlternateReturns() const;
  std::string getMangledName() const;
  mlir::Location getCalleeLocation() const;
  Fortran::evaluate::characteristics::Procedure characterize() const;
 
  const Fortran::evaluate::ProcedureRef &getCallDescription() const {
    return procRef;
  }

  const Fortran::semantics::SubprogramDetails *getInterfaceDetails() const;
 
  bool isMainProgram() const { return false; }

  bool isIndirectCall() const;

  bool requireDispatchCall() const;

  std::optional<unsigned> getPassArgIndex() const;

  mlir::Value getIfPassedArg() const;

  const Fortran::semantics::Symbol *getProcedureSymbol() const;

  const Fortran::semantics::Symbol *
  getDummySymbol(const PassedEntity &entity) const;

  void placeInput(const PassedEntity &passedEntity, mlir::Value arg);
  void placeAddressAndLengthInput(const PassedEntity &passedEntity,
                                  mlir::Value addr, mlir::Value len);

  mlir::Value getInput(const PassedEntity &passedEntity);

  const Fortran::evaluate::ProcedureDesignator *getIfIndirectCall() const;

  llvm::ArrayRef<mlir::Value> getInputs() const {
    if (!verifyActualInputs())
      llvm::report_fatal_error("lowered arguments are incomplete");
    return actualInputs;
  }

  bool mustMapInterfaceSymbolsForResult() const;
  bool mustMapInterfaceSymbolsForDummyArgument(const PassedEntity &) const;

  using ExprVisitor =
      std::function<void(evaluate::Expr<evaluate::SomeType>, bool)>;

  void walkResultExtents(const ExprVisitor &) const;

  void walkResultLengths(const ExprVisitor &) const;
  void walkDummyArgumentExtents(const PassedEntity &,
                                const ExprVisitor &) const;
  void walkDummyArgumentLengths(const PassedEntity &,
                                const ExprVisitor &) const;

  mlir::Value getArgumentValue(const semantics::Symbol &sym) const;

  const Fortran::semantics::Symbol &getResultSymbol() const;

  mlir::Type getResultStorageType() const;

  mlir::Type getDummyArgumentType(const PassedEntity &) const;
 
  // Copy of base implementation.
  static constexpr bool hasHostAssociated() { return false; }
  mlir::Type getHostAssociatedTy() const {
    llvm_unreachable("getting host associated type in CallerInterface");
  }
 
  std::optional<mlir::Value> getOriginalPassArg() const {
    return originalPassArg;
  }
  void setOriginalPassArg(mlir::Value x) { originalPassArg = x; }
 
private:
  bool verifyActualInputs() const;
  const Fortran::evaluate::ProcedureRef &procRef;
  llvm::SmallVector<mlir::Value> actualInputs;
  std::optional<mlir::Value> originalPassArg;
};
 
//===----------------------------------------------------------------------===//
// Callee side interface
//===----------------------------------------------------------------------===//

class CalleeInterface : public CallInterface<CalleeInterface> {
public:
  CalleeInterface(Fortran::lower::pft::FunctionLikeUnit &f,
                  Fortran::lower::AbstractConverter &c)
      : CallInterface{c}, funit{f} {
    declare();
  }
 
  bool hasAlternateReturns() const;
  std::string getMangledName() const;
  mlir::Location getCalleeLocation() const;
  Fortran::evaluate::characteristics::Procedure characterize() const;
  bool isMainProgram() const;
 
  Fortran::lower::pft::FunctionLikeUnit &getCallDescription() const {
    return funit;
  }

  bool isIndirectCall() const { return false; }

  bool requireDispatchCall() const { return false; };

  const Fortran::semantics::Symbol *getProcedureSymbol() const;

  mlir::func::FuncOp addEntryBlockAndMapArguments();
 
  bool hasHostAssociated() const;
  mlir::Type getHostAssociatedTy() const;
  mlir::Value getHostAssociatedTuple() const;
 
private:
  Fortran::lower::pft::FunctionLikeUnit &funit;
};

mlir::FunctionType
translateSignature(const Fortran::evaluate::ProcedureDesignator &,
                   Fortran::lower::AbstractConverter &);

mlir::func::FuncOp
getOrDeclareFunction(const Fortran::evaluate::ProcedureDesignator &,
                     Fortran::lower::AbstractConverter &);

mlir::Type getDummyProcedureType(const Fortran::semantics::Symbol &dummyProc,
                                 Fortran::lower::AbstractConverter &);

mlir::Type
getDummyProcedurePointerType(const Fortran::semantics::Symbol &dummyProcPtr,
                             Fortran::lower::AbstractConverter &);

mlir::Type getUntypedBoxProcType(mlir::MLIRContext *context);

bool isCPtrArgByValueType(mlir::Type ty);

// This is required to convey  the length of character functions passed as dummy
// procedures.
bool mustPassLengthWithDummyProcedure(
    const Fortran::evaluate::ProcedureDesignator &proc,
    Fortran::lower::AbstractConverter &);
 
} // namespace Fortran::lower
 
#endif // FORTRAN_LOWER_FIRBUILDER_H