diff --git a/flang/include/flang/Lower/ConvertType.h b/flang/include/flang/Lower/ConvertType.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Lower/ConvertType.h @@ -0,0 +1,120 @@ +//===-- Lower/ConvertType.h -- lowering of types ----------------*- 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 +// +//----------------------------------------------------------------------------// +/// +/// Conversion of front-end TYPE, KIND, ATTRIBUTE (TKA) information to FIR/MLIR. +/// This is meant to be the single point of truth (SPOT) for all type +/// conversions when lowering to FIR. This implements all lowering of parse +/// tree TKA to the FIR type system. If one is converting front-end types and +/// not using one of the routines provided here, it's being done wrong. +/// +/// [Coding style](https://llvm.org/docs/CodingStandards.html) +/// +//----------------------------------------------------------------------------// + +#ifndef FORTRAN_LOWER_CONVERT_TYPE_H +#define FORTRAN_LOWER_CONVERT_TYPE_H + +#include "flang/Common/Fortran.h" +#include "mlir/IR/Types.h" + +namespace mlir { +class Location; +class MLIRContext; +class Type; +} // namespace mlir + +namespace Fortran { +namespace common { +class IntrinsicTypeDefaultKinds; +template +class Reference; +} // namespace common + +namespace evaluate { +struct DataRef; +template +class Designator; +template +class Expr; +template +struct SomeKind; +struct SomeType; +template +class Type; +} // namespace evaluate + +namespace parser { +class CharBlock; +class CookedSource; +} // namespace parser + +namespace semantics { +class Symbol; +} // namespace semantics + +namespace lower { +namespace pft { +struct Variable; +} + +using SomeExpr = evaluate::Expr; +using SymbolRef = common::Reference; + +mlir::Type getFIRType(mlir::MLIRContext *ctxt, + common::IntrinsicTypeDefaultKinds const &defaults, + common::TypeCategory tc, int kind); +mlir::Type getFIRType(mlir::MLIRContext *ctxt, + common::IntrinsicTypeDefaultKinds const &defaults, + common::TypeCategory tc); + +mlir::Type +translateDataRefToFIRType(mlir::MLIRContext *ctxt, + common::IntrinsicTypeDefaultKinds const &defaults, + const evaluate::DataRef &dataRef); + +template +inline mlir::Type translateDesignatorToFIRType( + mlir::MLIRContext *ctxt, common::IntrinsicTypeDefaultKinds const &defaults, + const evaluate::Designator> &) { + return getFIRType(ctxt, defaults, TC, KIND); +} + +template +inline mlir::Type translateDesignatorToFIRType( + mlir::MLIRContext *ctxt, common::IntrinsicTypeDefaultKinds const &defaults, + const evaluate::Designator> &) { + return getFIRType(ctxt, defaults, TC); +} + +mlir::Type +translateSomeExprToFIRType(mlir::MLIRContext *ctxt, + common::IntrinsicTypeDefaultKinds const &defaults, + const SomeExpr *expr); + +mlir::Type +translateSymbolToFIRType(mlir::MLIRContext *ctxt, + common::IntrinsicTypeDefaultKinds const &defaults, + const SymbolRef symbol); +mlir::Type +translateVariableToFIRType(mlir::MLIRContext *ctxt, + common::IntrinsicTypeDefaultKinds const &defaults, + const pft::Variable &variable); + +mlir::Type convertReal(mlir::MLIRContext *ctxt, int KIND); + +// Given a ReferenceType of a base type, returns the ReferenceType to +// the SequenceType of this base type. +// The created SequenceType has one dimension of unknown extent. +// This is useful to do pointer arithmetic using fir::CoordinateOp that requires +// a memory reference to a sequence type. +mlir::Type getSequenceRefType(mlir::Type referenceType); + +} // namespace lower +} // namespace Fortran + +#endif // FORTRAN_LOWER_CONVERT_TYPE_H diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -1,5 +1,6 @@ add_flang_library(FortranLower + ConvertType.cpp OpenMP.cpp PFTBuilder.cpp diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Lower/ConvertType.cpp @@ -0,0 +1,518 @@ +//===-- ConvertType.cpp ---------------------------------------------------===// +// +// 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 +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/ConvertType.h" +#include "flang/Lower/PFTBuilder.h" +#include "flang/Lower/Utils.h" +#include "flang/Optimizer/Dialect/FIRType.h" +#include "flang/Semantics/tools.h" +#include "flang/Semantics/type.h" +#include "mlir/IR/Builders.h" +#include "mlir/IR/StandardTypes.h" + +#undef QUOTE +#undef TODO +#define QUOTE(X) #X +#define TODO(S) \ + { \ + emitError(__FILE__ ":" QUOTE(__LINE__) ": type lowering of " S \ + " not implemented"); \ + exit(1); \ + } + +template +bool isConstant(const Fortran::evaluate::Expr &e) { + return Fortran::evaluate::IsConstantExpr(Fortran::lower::SomeExpr{e}); +} + +template +int64_t toConstant(const Fortran::evaluate::Expr &e) { + auto opt = Fortran::evaluate::ToInt64(e); + assert(opt.has_value() && "expression didn't resolve to a constant"); + return opt.value(); +} + +// one argument template, must be specialized +template +mlir::Type genFIRType(mlir::MLIRContext *, int) { + return {}; +} + +// two argument template +template +mlir::Type genFIRType(mlir::MLIRContext *context) { + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + auto bits{Fortran::evaluate::Type::Scalar::bits}; + return mlir::IntegerType::get(bits, context); + } else if constexpr (TC == Fortran::common::TypeCategory::Logical || + TC == Fortran::common::TypeCategory::Character || + TC == Fortran::common::TypeCategory::Complex) { + return genFIRType(context, KIND); + } else { + return {}; + } +} + +template <> +mlir::Type +genFIRType(mlir::MLIRContext *context) { + return mlir::FloatType::getF16(context); +} + +template <> +mlir::Type +genFIRType(mlir::MLIRContext *context) { + return mlir::FloatType::getBF16(context); +} + +template <> +mlir::Type +genFIRType(mlir::MLIRContext *context) { + return mlir::FloatType::getF32(context); +} + +template <> +mlir::Type +genFIRType(mlir::MLIRContext *context) { + return mlir::FloatType::getF64(context); +} + +template <> +mlir::Type genFIRType( + mlir::MLIRContext *context) { + return fir::RealType::get(context, 10); +} + +template <> +mlir::Type genFIRType( + mlir::MLIRContext *context) { + return fir::RealType::get(context, 16); +} + +template <> +mlir::Type +genFIRType(mlir::MLIRContext *context, + int kind) { + if (Fortran::evaluate::IsValidKindOfIntrinsicType( + Fortran::common::TypeCategory::Real, kind)) { + switch (kind) { + case 2: + return genFIRType(context); + case 3: + return genFIRType(context); + case 4: + return genFIRType(context); + case 8: + return genFIRType(context); + case 10: + return genFIRType(context); + case 16: + return genFIRType(context); + } + assert(false && "type translation not implemented"); + } + return {}; +} + +template <> +mlir::Type +genFIRType(mlir::MLIRContext *context, + int kind) { + if (Fortran::evaluate::IsValidKindOfIntrinsicType( + Fortran::common::TypeCategory::Integer, kind)) { + switch (kind) { + case 1: + return genFIRType(context); + case 2: + return genFIRType(context); + case 4: + return genFIRType(context); + case 8: + return genFIRType(context); + case 16: + return genFIRType(context); + } + assert(false && "type translation not implemented"); + } + return {}; +} + +template <> +mlir::Type +genFIRType(mlir::MLIRContext *context, + int KIND) { + if (Fortran::evaluate::IsValidKindOfIntrinsicType( + Fortran::common::TypeCategory::Logical, KIND)) + return fir::LogicalType::get(context, KIND); + return {}; +} + +template <> +mlir::Type +genFIRType(mlir::MLIRContext *context, + int KIND) { + if (Fortran::evaluate::IsValidKindOfIntrinsicType( + Fortran::common::TypeCategory::Character, KIND)) + return fir::CharacterType::get(context, KIND); + return {}; +} + +template <> +mlir::Type +genFIRType(mlir::MLIRContext *context, + int KIND) { + if (Fortran::evaluate::IsValidKindOfIntrinsicType( + Fortran::common::TypeCategory::Complex, KIND)) + return fir::CplxType::get(context, KIND); + return {}; +} + +namespace { + +/// Recover the type of an Fortran::evaluate::Expr and convert it to an +/// mlir::Type. The type returned can be a MLIR standard or FIR type. +class TypeBuilder { + mlir::MLIRContext *context; + const Fortran::common::IntrinsicTypeDefaultKinds &defaults; + + template + int defaultKind() { + return defaultKind(TC); + } + int defaultKind(Fortran::common::TypeCategory TC) { + return defaults.GetDefaultKind(TC); + } + + mlir::InFlightDiagnostic emitError(const llvm::Twine &message) { + return mlir::emitError(mlir::UnknownLoc::get(context), message); + } + + mlir::InFlightDiagnostic emitWarning(const llvm::Twine &message) { + return mlir::emitWarning(mlir::UnknownLoc::get(context), message); + } + + fir::SequenceType::Shape seqShapeHelper(Fortran::semantics::SymbolRef symbol, + fir::SequenceType::Shape &bounds) { + auto &details = symbol->get(); + const auto size = details.shape().size(); + for (auto &ss : details.shape()) { + auto lb = ss.lbound(); + auto ub = ss.ubound(); + if (lb.isAssumed() && ub.isAssumed() && size == 1) + return {}; + if (lb.isExplicit() && ub.isExplicit()) { + auto &lbv = lb.GetExplicit(); + auto &ubv = ub.GetExplicit(); + if (lbv.has_value() && ubv.has_value() && isConstant(lbv.value()) && + isConstant(ubv.value())) { + bounds.emplace_back(toConstant(ubv.value()) - + toConstant(lbv.value()) + 1); + } else { + bounds.emplace_back(fir::SequenceType::getUnknownExtent()); + } + } else { + bounds.emplace_back(fir::SequenceType::getUnknownExtent()); + } + } + return bounds; + } + +public: + explicit TypeBuilder( + mlir::MLIRContext *context, + const Fortran::common::IntrinsicTypeDefaultKinds &defaults) + : context{context}, defaults{defaults} {} + + // non-template, arguments are runtime values + mlir::Type genFIRTy(Fortran::common::TypeCategory tc, int kind) { + switch (tc) { + case Fortran::common::TypeCategory::Real: + return genFIRType(context, kind); + case Fortran::common::TypeCategory::Integer: + return genFIRType(context, kind); + case Fortran::common::TypeCategory::Complex: + return genFIRType(context, kind); + case Fortran::common::TypeCategory::Logical: + return genFIRType(context, kind); + case Fortran::common::TypeCategory::Character: + return genFIRType(context, + kind); + default: + break; + } + assert(false && "unhandled type category"); + return {}; + } + + // non-template, category is runtime values, kind is defaulted + mlir::Type genFIRTy(Fortran::common::TypeCategory tc) { + return genFIRTy(tc, defaultKind(tc)); + } + + mlir::Type gen(const Fortran::evaluate::ImpliedDoIndex &) { + return genFIRType( + context, defaultKind()); + } + + template