diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -0,0 +1,48 @@ +//===-- Lower/ConvertExpr.h -- lowering of expressions ----------*- 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/ +// +//===----------------------------------------------------------------------===// +/// +/// Implements the conversion from Fortran::evaluate::Expr trees to FIR. +/// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_CONVERTEXPR_H +#define FORTRAN_LOWER_CONVERTEXPR_H + +#include "flang/Lower/Support/Utils.h" +#include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" + +namespace mlir { +class Location; +} + +namespace Fortran::evaluate { +template +class Expr; +struct SomeType; +} // namespace Fortran::evaluate + +namespace Fortran::lower { + +class AbstractConverter; +class SymMap; +using SomeExpr = Fortran::evaluate::Expr; + +/// Create an extended expression value. +fir::ExtendedValue createSomeExtendedExpression(mlir::Location loc, + AbstractConverter &converter, + const SomeExpr &expr, + SymMap &symMap); + +} // namespace Fortran::lower + +#endif // FORTRAN_LOWER_CONVERTEXPR_H diff --git a/flang/include/flang/Lower/ConvertType.h b/flang/include/flang/Lower/ConvertType.h --- a/flang/include/flang/Lower/ConvertType.h +++ b/flang/include/flang/Lower/ConvertType.h @@ -61,9 +61,8 @@ using SymbolRef = common::Reference; /// Get a FIR type based on a category and kind. -mlir::Type getFIRType(mlir::MLIRContext *ctxt, - common::IntrinsicTypeDefaultKinds const &defaults, - common::TypeCategory tc, int kind); +mlir::Type getFIRType(mlir::MLIRContext *ctxt, common::TypeCategory tc, + int kind); /// Get a FIR type based on a category. mlir::Type getFIRType(mlir::MLIRContext *ctxt, @@ -76,22 +75,6 @@ common::IntrinsicTypeDefaultKinds const &defaults, const evaluate::DataRef &dataRef); -/// Translate a Fortran::evaluate::Designator<> to an mlir::Type. -template -inline mlir::Type translateDesignatorToFIRType( - mlir::MLIRContext *ctxt, common::IntrinsicTypeDefaultKinds const &defaults, - const evaluate::Designator> &) { - return getFIRType(ctxt, defaults, TC, KIND); -} - -/// Translate a Fortran::evaluate::Designator<> to an mlir::Type. -template -inline mlir::Type translateDesignatorToFIRType( - mlir::MLIRContext *ctxt, common::IntrinsicTypeDefaultKinds const &defaults, - const evaluate::Designator> &) { - return getFIRType(ctxt, defaults, TC); -} - /// Translate a SomeExpr to an mlir::Type. mlir::Type translateSomeExprToFIRType(mlir::MLIRContext *ctxt, diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -13,6 +13,8 @@ #include "flang/Lower/Bridge.h" #include "flang/Evaluate/tools.h" #include "flang/Lower/CallInterface.h" +#include "flang/Lower/ConvertExpr.h" +#include "flang/Lower/ConvertType.h" #include "flang/Lower/Mangler.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Runtime.h" @@ -73,12 +75,14 @@ fir::ExtendedValue genExprAddr(const Fortran::lower::SomeExpr &expr, mlir::Location *loc = nullptr) override final { - TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + TODO_NOLOC("Not implemented genExprAddr. Needed for more complex " + "expression lowering"); } fir::ExtendedValue genExprValue(const Fortran::lower::SomeExpr &expr, mlir::Location *loc = nullptr) override final { - TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + return createSomeExtendedExpression(loc ? *loc : toLocation(), *this, expr, + localSymbols); } Fortran::evaluate::FoldingContext &getFoldingContext() override final { @@ -86,23 +90,28 @@ } mlir::Type genType(const Fortran::evaluate::DataRef &) override final { - TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + TODO_NOLOC("Not implemented genType DataRef. Needed for more complex " + "expression lowering"); } mlir::Type genType(const Fortran::lower::SomeExpr &) override final { - TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + TODO_NOLOC("Not implemented genType SomeExpr. Needed for more complex " + "expression lowering"); } mlir::Type genType(Fortran::lower::SymbolRef) override final { - TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + TODO_NOLOC("Not implemented genType SymbolRef. Needed for more complex " + "expression lowering"); } mlir::Type genType(Fortran::common::TypeCategory tc) override final { - TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + TODO_NOLOC("Not implemented genType TypeCategory. Needed for more complex " + "expression lowering"); } mlir::Type genType(Fortran::common::TypeCategory tc, int kind) override final { - TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + return Fortran::lower::getFIRType(&getMLIRContext(), tc, kind); } mlir::Type genType(const Fortran::lower::pft::Variable &) override final { - TODO_NOLOC("Not implemented. Needed for more complex expression lowering"); + TODO_NOLOC("Not implemented genType Variable. Needed for more complex " + "expression lowering"); } void setCurrentPosition(const Fortran::parser::CharBlock &position) { 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 @@ -4,6 +4,7 @@ Bridge.cpp CallInterface.cpp Coarray.cpp + ConvertExpr.cpp ConvertType.cpp Mangler.cpp OpenACC.cpp diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -0,0 +1,348 @@ +//===-- ConvertExpr.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 +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/ConvertExpr.h" +#include "flang/Evaluate/fold.h" +#include "flang/Evaluate/real.h" +#include "flang/Evaluate/traverse.h" +#include "flang/Lower/AbstractConverter.h" +#include "flang/Lower/Todo.h" +#include "flang/Semantics/expression.h" +#include "flang/Semantics/symbol.h" +#include "flang/Semantics/tools.h" +#include "flang/Semantics/type.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" +#include "llvm/Support/Debug.h" + +#define DEBUG_TYPE "flang-lower-expr" + +//===----------------------------------------------------------------------===// +// The composition and structure of Fortran::evaluate::Expr is defined in +// the various header files in include/flang/Evaluate. You are referred +// there for more information on these data structures. Generally speaking, +// these data structures are a strongly typed family of abstract data types +// that, composed as trees, describe the syntax of Fortran expressions. +// +// This part of the bridge can traverse these tree structures and lower them +// to the correct FIR representation in SSA form. +//===----------------------------------------------------------------------===// + +namespace { + +/// Lowering of Fortran::evaluate::Expr expressions +class ScalarExprLowering { +public: + using ExtValue = fir::ExtendedValue; + + explicit ScalarExprLowering(mlir::Location loc, + Fortran::lower::AbstractConverter &converter, + Fortran::lower::SymMap &symMap) + : location{loc}, converter{converter}, + builder{converter.getFirOpBuilder()}, symMap{symMap} {} + + mlir::Location getLoc() { return location; } + + /// Generate an integral constant of `value` + template + mlir::Value genIntegerConstant(mlir::MLIRContext *context, + std::int64_t value) { + mlir::Type type = + converter.genType(Fortran::common::TypeCategory::Integer, KIND); + return builder.createIntegerConstant(getLoc(), type, value); + } + + ExtValue genval(Fortran::semantics::SymbolRef sym) { + TODO(getLoc(), "genval SymbolRef"); + } + + ExtValue genval(const Fortran::evaluate::BOZLiteralConstant &) { + TODO(getLoc(), "genval BOZ"); + } + + /// Return indirection to function designated in ProcedureDesignator. + /// The type of the function indirection is not guaranteed to match the one + /// of the ProcedureDesignator due to Fortran implicit typing rules. + ExtValue genval(const Fortran::evaluate::ProcedureDesignator &proc) { + TODO(getLoc(), "genval ProcedureDesignator"); + } + + ExtValue genval(const Fortran::evaluate::NullPointer &) { + TODO(getLoc(), "genval NullPointer"); + } + + ExtValue genval(const Fortran::evaluate::StructureConstructor &ctor) { + TODO(getLoc(), "genval StructureConstructor"); + } + + /// Lowering of an ac-do-variable, which is not a Symbol. + ExtValue genval(const Fortran::evaluate::ImpliedDoIndex &var) { + TODO(getLoc(), "genval ImpliedDoIndex"); + } + + ExtValue genval(const Fortran::evaluate::DescriptorInquiry &desc) { + TODO(getLoc(), "genval DescriptorInquiry"); + } + + ExtValue genval(const Fortran::evaluate::TypeParamInquiry &) { + TODO(getLoc(), "genval TypeParamInquiry"); + } + + template + ExtValue genval(const Fortran::evaluate::ComplexComponent &part) { + TODO(getLoc(), "genval ComplexComponent"); + } + + template + ExtValue genval(const Fortran::evaluate::Negate> &op) { + TODO(getLoc(), "genval Negate integer"); + } + + template + ExtValue genval(const Fortran::evaluate::Negate> &op) { + TODO(getLoc(), "genval Negate real"); + } + template + ExtValue genval(const Fortran::evaluate::Negate> &op) { + TODO(getLoc(), "genval Negate complex"); + } + +#undef GENBIN +#define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp) \ + template \ + ExtValue genval(const Fortran::evaluate::GenBinEvOp> &x) { \ + TODO(getLoc(), "genval GenBinEvOp"); \ + } + + GENBIN(Add, Integer, mlir::arith::AddIOp) + GENBIN(Add, Real, mlir::arith::AddFOp) + GENBIN(Add, Complex, fir::AddcOp) + GENBIN(Subtract, Integer, mlir::arith::SubIOp) + GENBIN(Subtract, Real, mlir::arith::SubFOp) + GENBIN(Subtract, Complex, fir::SubcOp) + GENBIN(Multiply, Integer, mlir::arith::MulIOp) + GENBIN(Multiply, Real, mlir::arith::MulFOp) + GENBIN(Multiply, Complex, fir::MulcOp) + GENBIN(Divide, Integer, mlir::arith::DivSIOp) + GENBIN(Divide, Real, mlir::arith::DivFOp) + GENBIN(Divide, Complex, fir::DivcOp) + + template + ExtValue genval( + const Fortran::evaluate::Power> &op) { + TODO(getLoc(), "genval Power"); + } + + template + ExtValue genval( + const Fortran::evaluate::RealToIntPower> + &op) { + TODO(getLoc(), "genval RealToInt"); + } + + template + ExtValue genval(const Fortran::evaluate::ComplexConstructor &op) { + TODO(getLoc(), "genval ComplexConstructor"); + } + + template + ExtValue genval(const Fortran::evaluate::Concat &op) { + TODO(getLoc(), "genval Concat"); + } + + /// MIN and MAX operations + template + ExtValue + genval(const Fortran::evaluate::Extremum> + &op) { + TODO(getLoc(), "genval Extremum"); + } + + template + ExtValue genval(const Fortran::evaluate::SetLength &x) { + TODO(getLoc(), "genval SetLength"); + } + + template + ExtValue genval(const Fortran::evaluate::Relational> &op) { + TODO(getLoc(), "genval integer comparison"); + } + template + ExtValue genval(const Fortran::evaluate::Relational> &op) { + TODO(getLoc(), "genval real comparison"); + } + template + ExtValue genval(const Fortran::evaluate::Relational> &op) { + TODO(getLoc(), "genval complex comparison"); + } + template + ExtValue genval(const Fortran::evaluate::Relational> &op) { + TODO(getLoc(), "genval char comparison"); + } + + ExtValue + genval(const Fortran::evaluate::Relational &op) { + TODO(getLoc(), "genval comparison"); + } + + template + ExtValue + genval(const Fortran::evaluate::Convert, + TC2> &convert) { + TODO(getLoc(), "genval convert"); + } + + template + ExtValue genval(const Fortran::evaluate::Parentheses &op) { + TODO(getLoc(), "genval parentheses"); + } + + template + ExtValue genval(const Fortran::evaluate::Not &op) { + TODO(getLoc(), "genval Not"); + } + + template + ExtValue genval(const Fortran::evaluate::LogicalOperation &op) { + TODO(getLoc(), "genval LogicalOperation"); + } + + /// Convert a scalar literal constant to IR. + template + ExtValue genScalarLit( + const Fortran::evaluate::Scalar> + &value) { + if constexpr (TC == Fortran::common::TypeCategory::Integer) { + return genIntegerConstant(builder.getContext(), value.ToInt64()); + } else if constexpr (TC == Fortran::common::TypeCategory::Logical) { + TODO(getLoc(), "genval bool constant"); + } else if constexpr (TC == Fortran::common::TypeCategory::Real) { + TODO(getLoc(), "genval real constant"); + } else if constexpr (TC == Fortran::common::TypeCategory::Complex) { + TODO(getLoc(), "genval complex constant"); + } else /*constexpr*/ { + llvm_unreachable("unhandled constant"); + } + } + + template + ExtValue + genval(const Fortran::evaluate::Constant> + &con) { + if (con.Rank() > 0) + TODO(getLoc(), "genval array constant"); + std::optional>> + opt = con.GetScalarValue(); + assert(opt.has_value() && "constant has no value"); + if constexpr (TC == Fortran::common::TypeCategory::Character) { + TODO(getLoc(), "genval char constant"); + } else { + return genScalarLit(opt.value()); + } + } + + fir::ExtendedValue genval( + const Fortran::evaluate::Constant &con) { + TODO(getLoc(), "genval constant derived"); + } + + template + ExtValue genval(const Fortran::evaluate::ArrayConstructor &) { + TODO(getLoc(), "genval ArrayConstructor"); + } + + ExtValue genval(const Fortran::evaluate::ComplexPart &x) { + TODO(getLoc(), "genval ComplexPart"); + } + + ExtValue genval(const Fortran::evaluate::Substring &ss) { + TODO(getLoc(), "genval Substring"); + } + + ExtValue genval(const Fortran::evaluate::Subscript &subs) { + TODO(getLoc(), "genval Subscript"); + } + + ExtValue genval(const Fortran::evaluate::DataRef &dref) { + TODO(getLoc(), "genval DataRef"); + } + + ExtValue genval(const Fortran::evaluate::Component &cmpt) { + TODO(getLoc(), "genval Component"); + } + + ExtValue genval(const Fortran::semantics::Bound &bound) { + TODO(getLoc(), "genval Bound"); + } + + ExtValue genval(const Fortran::evaluate::ArrayRef &aref) { + TODO(getLoc(), "genval ArrayRef"); + } + + ExtValue genval(const Fortran::evaluate::CoarrayRef &coref) { + TODO(getLoc(), "genval CoarrayRef"); + } + + template + ExtValue genval(const Fortran::evaluate::Designator &des) { + TODO(getLoc(), "genval Designator"); + } + + template + ExtValue genval(const Fortran::evaluate::FunctionRef &funcRef) { + TODO(getLoc(), "genval FunctionRef"); + } + + ExtValue genval(const Fortran::evaluate::ProcedureRef &procRef) { + TODO(getLoc(), "genval ProcedureRef"); + } + + template + bool isScalar(const A &x) { + return x.Rank() == 0; + } + + template + ExtValue genval(const Fortran::evaluate::Expr &x) { + if (isScalar(x)) + return std::visit([&](const auto &e) { return genval(e); }, x.u); + TODO(getLoc(), "genval Expr arrays"); + } + + template + ExtValue genval(const Fortran::evaluate::Expr> &exp) { + return std::visit([&](const auto &e) { return genval(e); }, exp.u); + } + +private: + mlir::Location location; + Fortran::lower::AbstractConverter &converter; + fir::FirOpBuilder &builder; + Fortran::lower::SymMap &symMap; +}; +} // namespace + +fir::ExtendedValue Fortran::lower::createSomeExtendedExpression( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap) { + LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "expr: ") << '\n'); + return ScalarExprLowering{loc, converter, symMap}.genval(expr); +} diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -475,11 +475,49 @@ } // namespace -mlir::Type Fortran::lower::getFIRType( - mlir::MLIRContext *context, - const Fortran::common::IntrinsicTypeDefaultKinds &defaults, - Fortran::common::TypeCategory tc, int kind) { - return TypeBuilder{context, defaults}.genFIRTy(tc, kind); +template +int getIntegerBits() { + return Fortran::evaluate::Type::Scalar::bits; +} +static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind) { + if (Fortran::evaluate::IsValidKindOfIntrinsicType( + Fortran::common::TypeCategory::Integer, kind)) { + switch (kind) { + case 1: + return mlir::IntegerType::get(context, getIntegerBits<1>()); + case 2: + return mlir::IntegerType::get(context, getIntegerBits<2>()); + case 4: + return mlir::IntegerType::get(context, getIntegerBits<4>()); + case 8: + return mlir::IntegerType::get(context, getIntegerBits<8>()); + case 16: + return mlir::IntegerType::get(context, getIntegerBits<16>()); + } + } + llvm_unreachable("INTEGER kind not translated"); +} + +static mlir::Type genFIRType(mlir::MLIRContext *context, + Fortran::common::TypeCategory tc, int kind) { + switch (tc) { + case Fortran::common::TypeCategory::Integer: + return genIntegerType(context, kind); + case Fortran::common::TypeCategory::Real: + case Fortran::common::TypeCategory::Complex: + case Fortran::common::TypeCategory::Logical: + case Fortran::common::TypeCategory::Character: + default: + break; + } + llvm_unreachable("unhandled type category"); +} + +mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context, + Fortran::common::TypeCategory tc, + int kind) { + return genFIRType(context, tc, kind); } mlir::Type Fortran::lower::getFIRType(