[flang-commits] [flang] e641c29 - [flang] Lower simple scalar assignment
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Thu Feb 17 09:24:38 PST 2022
Author: Valentin Clement
Date: 2022-02-17T18:24:30+01:00
New Revision: e641c29f41971597dbe190f98784f0e4cfc220cc
URL: https://github.com/llvm/llvm-project/commit/e641c29f41971597dbe190f98784f0e4cfc220cc
DIFF: https://github.com/llvm/llvm-project/commit/e641c29f41971597dbe190f98784f0e4cfc220cc.diff
LOG: [flang] Lower simple scalar assignment
This patch hanlde lowering of simple scalar assignment.
This patch is part of the upstreaming effort from fir-dev branch.
Reviewed By: PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D120058
Co-authored-by: Jean Perier <jperier at nvidia.com>
Added:
flang/test/Lower/assignment.f90
Modified:
flang/include/flang/Lower/ConvertExpr.h
flang/include/flang/Lower/ConvertType.h
flang/include/flang/Lower/Support/Utils.h
flang/include/flang/Optimizer/Dialect/FIROps.h
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/ConvertExpr.cpp
flang/lib/Lower/ConvertType.cpp
flang/lib/Lower/Mangler.cpp
Removed:
flang/include/flang/Lower/Utils.h
################################################################################
diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h
index fde3d612f33a1..459ab71074a0f 100644
--- a/flang/include/flang/Lower/ConvertExpr.h
+++ b/flang/include/flang/Lower/ConvertExpr.h
@@ -43,6 +43,21 @@ fir::ExtendedValue createSomeExtendedExpression(mlir::Location loc,
const SomeExpr &expr,
SymMap &symMap);
+/// Create an extended expression address.
+fir::ExtendedValue createSomeExtendedAddress(mlir::Location loc,
+ AbstractConverter &converter,
+ const SomeExpr &expr,
+ SymMap &symMap);
+
+// Attribute for an alloca that is a trivial adaptor for converting a value to
+// pass-by-ref semantics for a VALUE parameter. The optimizer may be able to
+// eliminate these.
+inline mlir::NamedAttribute getAdaptToByRefAttr(fir::FirOpBuilder &builder) {
+ return {mlir::StringAttr::get(builder.getContext(),
+ fir::getAdaptToByRefAttrName()),
+ builder.getUnitAttr()};
+}
+
} // namespace Fortran::lower
#endif // FORTRAN_LOWER_CONVERTEXPR_H
diff --git a/flang/include/flang/Lower/ConvertType.h b/flang/include/flang/Lower/ConvertType.h
index 6a815f5affc2e..ea931e28cb3fb 100644
--- a/flang/include/flang/Lower/ConvertType.h
+++ b/flang/include/flang/Lower/ConvertType.h
@@ -61,6 +61,9 @@ struct Variable;
using SomeExpr = evaluate::Expr<evaluate::SomeType>;
using SymbolRef = common::Reference<const semantics::Symbol>;
+// Type for compile time constant length type parameters.
+using LenParameterTy = std::int64_t;
+
/// Get a FIR type based on a category and kind.
mlir::Type getFIRType(mlir::MLIRContext *ctxt, common::TypeCategory tc,
int kind);
@@ -75,7 +78,7 @@ mlir::Type translateDataRefToFIRType(Fortran::lower::AbstractConverter &,
/// Translate a SomeExpr to an mlir::Type.
mlir::Type translateSomeExprToFIRType(Fortran::lower::AbstractConverter &,
- const SomeExpr *expr);
+ const SomeExpr &expr);
/// Translate a Fortran::semantics::Symbol to an mlir::Type.
mlir::Type translateSymbolToFIRType(Fortran::lower::AbstractConverter &,
diff --git a/flang/include/flang/Lower/Support/Utils.h b/flang/include/flang/Lower/Support/Utils.h
index 63b614098fbba..0acd6076ca30c 100644
--- a/flang/include/flang/Lower/Support/Utils.h
+++ b/flang/include/flang/Lower/Support/Utils.h
@@ -15,11 +15,16 @@
#include "flang/Common/indirection.h"
#include "flang/Parser/char-block.h"
+#include "flang/Semantics/tools.h"
#include "mlir/Dialect/StandardOps/IR/Ops.h"
#include "mlir/IR/BuiltinAttributes.h"
#include "llvm/ADT/StringRef.h"
#include <cstdint>
+namespace Fortran::lower {
+using SomeExpr = Fortran::evaluate::Expr<Fortran::evaluate::SomeType>;
+}
+
//===----------------------------------------------------------------------===//
// Small inline helper functions to deal with repetitive, clumsy conversions.
//===----------------------------------------------------------------------===//
@@ -46,4 +51,10 @@ const A &removeIndirection(const Fortran::common::Indirection<A> &a) {
return a.value();
}
+/// Clone subexpression and wrap it as a generic `Fortran::evaluate::Expr`.
+template <typename A>
+static Fortran::lower::SomeExpr toEvExpr(const A &x) {
+ return Fortran::evaluate::AsGenericExpr(Fortran::common::Clone(x));
+}
+
#endif // FORTRAN_LOWER_SUPPORT_UTILS_H
diff --git a/flang/include/flang/Lower/Utils.h b/flang/include/flang/Lower/Utils.h
deleted file mode 100644
index d7c7b565dbc6a..0000000000000
--- a/flang/include/flang/Lower/Utils.h
+++ /dev/null
@@ -1,31 +0,0 @@
-//===-- Lower/Utils.h -- utilities ------------------------------*- 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
-//
-//===----------------------------------------------------------------------===//
-
-#ifndef FORTRAN_LOWER_UTILS_H
-#define FORTRAN_LOWER_UTILS_H
-
-#include "flang/Common/indirection.h"
-#include "flang/Parser/char-block.h"
-#include "llvm/ADT/StringRef.h"
-
-/// Convert an F18 CharBlock to an LLVM StringRef
-inline llvm::StringRef toStringRef(const Fortran::parser::CharBlock &cb) {
- return {cb.begin(), cb.size()};
-}
-
-/// Template helper to remove Fortran::common::Indirection wrappers.
-template <typename A>
-const A &removeIndirection(const A &a) {
- return a;
-}
-template <typename A>
-const A &removeIndirection(const Fortran::common::Indirection<A> &a) {
- return a.value();
-}
-
-#endif // FORTRAN_LOWER_UTILS_H
diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.h b/flang/include/flang/Optimizer/Dialect/FIROps.h
index c6d60c0099847..3a67577d1c9a8 100644
--- a/flang/include/flang/Optimizer/Dialect/FIROps.h
+++ b/flang/include/flang/Optimizer/Dialect/FIROps.h
@@ -38,6 +38,10 @@ mlir::ParseResult parseSelector(mlir::OpAsmParser &parser,
mlir::OpAsmParser::OperandType &selector,
mlir::Type &type);
+static constexpr llvm::StringRef getAdaptToByRefAttrName() {
+ return "adapt.valuebyref";
+}
+
} // namespace fir
#define GET_OP_CLASSES
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index cfb326c3af483..bf346ec6f80b2 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -22,6 +22,7 @@
#include "flang/Lower/SymbolMap.h"
#include "flang/Lower/Todo.h"
#include "flang/Optimizer/Support/FIRContext.h"
+#include "flang/Semantics/tools.h"
#include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h"
#include "mlir/IR/PatternMatch.h"
#include "mlir/Transforms/RegionUtils.h"
@@ -77,8 +78,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
fir::ExtendedValue genExprAddr(const Fortran::lower::SomeExpr &expr,
mlir::Location *loc = nullptr) override final {
- TODO_NOLOC("Not implemented genExprAddr. Needed for more complex "
- "expression lowering");
+ return createSomeExtendedAddress(loc ? *loc : toLocation(), *this, expr,
+ localSymbols);
}
fir::ExtendedValue
genExprValue(const Fortran::lower::SomeExpr &expr,
@@ -95,9 +96,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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 genType SomeExpr. Needed for more complex "
- "expression lowering");
+ mlir::Type genType(const Fortran::lower::SomeExpr &expr) override final {
+ return Fortran::lower::translateSomeExprToFIRType(*this, expr);
}
mlir::Type genType(Fortran::lower::SymbolRef sym) override final {
return Fortran::lower::translateSymbolToFIRType(*this, sym);
@@ -385,6 +385,19 @@ class FirConverter : public Fortran::lower::AbstractConverter {
return true;
}
+ bool isNumericScalarCategory(Fortran::common::TypeCategory cat) {
+ return cat == Fortran::common::TypeCategory::Integer ||
+ cat == Fortran::common::TypeCategory::Real ||
+ cat == Fortran::common::TypeCategory::Complex ||
+ cat == Fortran::common::TypeCategory::Logical;
+ }
+ bool isCharacterCategory(Fortran::common::TypeCategory cat) {
+ return cat == Fortran::common::TypeCategory::Character;
+ }
+ bool isDerivedCategory(Fortran::common::TypeCategory cat) {
+ return cat == Fortran::common::TypeCategory::Derived;
+ }
+
void genFIRBranch(mlir::Block *targetBlock) {
assert(targetBlock && "missing unconditional target block");
builder->create<cf::BranchOp>(toLocation(), targetBlock);
@@ -449,6 +462,112 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
}
+ [[maybe_unused]] static bool
+ isFuncResultDesignator(const Fortran::lower::SomeExpr &expr) {
+ const Fortran::semantics::Symbol *sym =
+ Fortran::evaluate::GetFirstSymbol(expr);
+ return sym && sym->IsFuncResult();
+ }
+
+ static bool isWholeAllocatable(const Fortran::lower::SomeExpr &expr) {
+ const Fortran::semantics::Symbol *sym =
+ Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(expr);
+ return sym && Fortran::semantics::IsAllocatable(*sym);
+ }
+
+ void genAssignment(const Fortran::evaluate::Assignment &assign) {
+ mlir::Location loc = toLocation();
+
+ std::visit(
+ Fortran::common::visitors{
+ // [1] Plain old assignment.
+ [&](const Fortran::evaluate::Assignment::Intrinsic &) {
+ const Fortran::semantics::Symbol *sym =
+ Fortran::evaluate::GetLastSymbol(assign.lhs);
+
+ if (!sym)
+ TODO(loc, "assignment to pointer result of function reference");
+
+ std::optional<Fortran::evaluate::DynamicType> lhsType =
+ assign.lhs.GetType();
+ assert(lhsType && "lhs cannot be typeless");
+ // Assignment to polymorphic allocatables may require changing the
+ // variable dynamic type (See Fortran 2018 10.2.1.3 p3).
+ if (lhsType->IsPolymorphic() && isWholeAllocatable(assign.lhs))
+ TODO(loc, "assignment to polymorphic allocatable");
+
+ // Note: No ad-hoc handling for pointers is required here. The
+ // target will be assigned as per 2018 10.2.1.3 p2. genExprAddr
+ // on a pointer returns the target address and not the address of
+ // the pointer variable.
+
+ if (assign.lhs.Rank() > 0) {
+ // Array assignment
+ // See Fortran 2018 10.2.1.3 p5, p6, and p7
+ TODO(toLocation(), "Array assignment");
+ return;
+ }
+
+ // Scalar assignment
+ const bool isNumericScalar =
+ isNumericScalarCategory(lhsType->category());
+ fir::ExtendedValue rhs = isNumericScalar
+ ? genExprValue(assign.rhs)
+ : genExprAddr(assign.rhs);
+
+ if (isNumericScalar) {
+ // Fortran 2018 10.2.1.3 p8 and p9
+ // Conversions should have been inserted by semantic analysis,
+ // but they can be incorrect between the rhs and lhs. Correct
+ // that here.
+ mlir::Value addr = fir::getBase(genExprAddr(assign.lhs));
+ mlir::Value val = fir::getBase(rhs);
+ // A function with multiple entry points returning
diff erent
+ // types tags all result variables with one of the largest
+ // types to allow them to share the same storage. Assignment
+ // to a result variable of one of the other types requires
+ // conversion to the actual type.
+ mlir::Type toTy = genType(assign.lhs);
+ mlir::Value cast =
+ builder->convertWithSemantics(loc, toTy, val);
+ if (fir::dyn_cast_ptrEleTy(addr.getType()) != toTy) {
+ assert(isFuncResultDesignator(assign.lhs) && "type mismatch");
+ addr = builder->createConvert(
+ toLocation(), builder->getRefType(toTy), addr);
+ }
+ builder->create<fir::StoreOp>(loc, cast, addr);
+ } else if (isCharacterCategory(lhsType->category())) {
+ TODO(toLocation(), "Character assignment");
+ } else if (isDerivedCategory(lhsType->category())) {
+ TODO(toLocation(), "Derived type assignment");
+ } else {
+ llvm_unreachable("unknown category");
+ }
+ },
+
+ // [2] User defined assignment. If the context is a scalar
+ // expression then call the procedure.
+ [&](const Fortran::evaluate::ProcedureRef &procRef) {
+ TODO(toLocation(), "User defined assignment");
+ },
+
+ // [3] Pointer assignment with possibly empty bounds-spec. R1035: a
+ // bounds-spec is a lower bound value.
+ [&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
+ TODO(toLocation(),
+ "Pointer assignment with possibly empty bounds-spec");
+ },
+
+ // [4] Pointer assignment with bounds-remapping. R1036: a
+ // bounds-remapping is a pair, lower bound and upper bound.
+ [&](const Fortran::evaluate::Assignment::BoundsRemapping
+ &boundExprs) {
+ TODO(toLocation(), "Pointer assignment with bounds-remapping");
+ },
+ },
+ assign.u);
+ }
+
void genFIR(const Fortran::parser::CallStmt &stmt) {
TODO(toLocation(), "CallStmt lowering");
}
@@ -712,7 +831,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
void genFIR(const Fortran::parser::AssignmentStmt &stmt) {
- TODO(toLocation(), "AssignmentStmt lowering");
+ genAssignment(*stmt.typedAssignment->v);
}
void genFIR(const Fortran::parser::SyncAllStmt &stmt) {
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index f97e4409aae93..497d1eaf06a0b 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -37,6 +37,33 @@
// to the correct FIR representation in SSA form.
//===----------------------------------------------------------------------===//
+/// Place \p exv in memory if it is not already a memory reference. If
+/// \p forceValueType is provided, the value is first casted to the provided
+/// type before being stored (this is mainly intended for logicals whose value
+/// may be `i1` but needed to be stored as Fortran logicals).
+static fir::ExtendedValue
+placeScalarValueInMemory(fir::FirOpBuilder &builder, mlir::Location loc,
+ const fir::ExtendedValue &exv,
+ mlir::Type storageType) {
+ mlir::Value valBase = fir::getBase(exv);
+ if (fir::conformsWithPassByRef(valBase.getType()))
+ return exv;
+
+ assert(!fir::hasDynamicSize(storageType) &&
+ "only expect statically sized scalars to be by value");
+
+ // Since `a` is not itself a valid referent, determine its value and
+ // create a temporary location at the beginning of the function for
+ // referencing.
+ mlir::Value val = builder.createConvert(loc, storageType, valBase);
+ mlir::Value temp = builder.createTemporary(
+ loc, storageType,
+ llvm::ArrayRef<mlir::NamedAttribute>{
+ Fortran::lower::getAdaptToByRefAttr(builder)});
+ builder.create<fir::StoreOp>(loc, val, temp);
+ return fir::substBase(exv, temp);
+}
+
/// Generate a load of a value from an address. Beware that this will lose
/// any dynamic type information for polymorphic entities (note that unlimited
/// polymorphic cannot be loaded and must not be provided here).
@@ -78,6 +105,14 @@ class ScalarExprLowering {
mlir::Location getLoc() { return location; }
+ template <typename A>
+ mlir::Value genunbox(const A &expr) {
+ ExtValue e = genval(expr);
+ if (const fir::UnboxedValue *r = e.getUnboxed())
+ return *r;
+ fir::emitFatalError(getLoc(), "unboxed expression expected");
+ }
+
/// Generate an integral constant of `value`
template <int KIND>
mlir::Value genIntegerConstant(mlir::MLIRContext *context,
@@ -256,7 +291,9 @@ class ScalarExprLowering {
ExtValue
genval(const Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>,
TC2> &convert) {
- TODO(getLoc(), "genval convert<TC1, KIND, TC2>");
+ mlir::Type ty = converter.genType(TC1, KIND);
+ mlir::Value operand = genunbox(convert.left());
+ return builder.convertWithSemantics(getLoc(), ty, operand);
}
template <typename A>
@@ -330,10 +367,16 @@ class ScalarExprLowering {
TODO(getLoc(), "genval ArrayConstructor<A>");
}
+ ExtValue gen(const Fortran::evaluate::ComplexPart &x) {
+ TODO(getLoc(), "gen ComplexPart");
+ }
ExtValue genval(const Fortran::evaluate::ComplexPart &x) {
TODO(getLoc(), "genval ComplexPart");
}
+ ExtValue gen(const Fortran::evaluate::Substring &s) {
+ TODO(getLoc(), "gen Substring");
+ }
ExtValue genval(const Fortran::evaluate::Substring &ss) {
TODO(getLoc(), "genval Substring");
}
@@ -342,10 +385,16 @@ class ScalarExprLowering {
TODO(getLoc(), "genval Subscript");
}
+ ExtValue gen(const Fortran::evaluate::DataRef &dref) {
+ TODO(getLoc(), "gen DataRef");
+ }
ExtValue genval(const Fortran::evaluate::DataRef &dref) {
TODO(getLoc(), "genval DataRef");
}
+ ExtValue gen(const Fortran::evaluate::Component &cmpt) {
+ TODO(getLoc(), "gen Component");
+ }
ExtValue genval(const Fortran::evaluate::Component &cmpt) {
TODO(getLoc(), "genval Component");
}
@@ -354,19 +403,34 @@ class ScalarExprLowering {
TODO(getLoc(), "genval Bound");
}
+ ExtValue gen(const Fortran::evaluate::ArrayRef &aref) {
+ TODO(getLoc(), "gen ArrayRef");
+ }
ExtValue genval(const Fortran::evaluate::ArrayRef &aref) {
TODO(getLoc(), "genval ArrayRef");
}
+ ExtValue gen(const Fortran::evaluate::CoarrayRef &coref) {
+ TODO(getLoc(), "gen CoarrayRef");
+ }
ExtValue genval(const Fortran::evaluate::CoarrayRef &coref) {
TODO(getLoc(), "genval CoarrayRef");
}
+ template <typename A>
+ ExtValue gen(const Fortran::evaluate::Designator<A> &des) {
+ return std::visit([&](const auto &x) { return gen(x); }, des.u);
+ }
template <typename A>
ExtValue genval(const Fortran::evaluate::Designator<A> &des) {
return std::visit([&](const auto &x) { return genval(x); }, des.u);
}
+ template <typename A>
+ ExtValue gen(const Fortran::evaluate::FunctionRef<A> &funcRef) {
+ TODO(getLoc(), "gen FunctionRef<A>");
+ }
+
template <typename A>
ExtValue genval(const Fortran::evaluate::FunctionRef<A> &funcRef) {
TODO(getLoc(), "genval FunctionRef<A>");
@@ -376,11 +440,6 @@ class ScalarExprLowering {
TODO(getLoc(), "genval ProcedureRef");
}
- template <typename A>
- bool isScalar(const A &x) {
- return x.Rank() == 0;
- }
-
template <typename A>
ExtValue genval(const Fortran::evaluate::Expr<A> &x) {
if (isScalar(x))
@@ -388,12 +447,73 @@ class ScalarExprLowering {
TODO(getLoc(), "genval Expr<A> arrays");
}
+ /// Helper to detect Transformational function reference.
+ template <typename T>
+ bool isTransformationalRef(const T &) {
+ return false;
+ }
+ template <typename T>
+ bool isTransformationalRef(const Fortran::evaluate::FunctionRef<T> &funcRef) {
+ return !funcRef.IsElemental() && funcRef.Rank();
+ }
+ template <typename T>
+ bool isTransformationalRef(Fortran::evaluate::Expr<T> expr) {
+ return std::visit([&](const auto &e) { return isTransformationalRef(e); },
+ expr.u);
+ }
+
+ template <typename A>
+ ExtValue gen(const Fortran::evaluate::Expr<A> &x) {
+ // Whole array symbols or components, and results of transformational
+ // functions already have a storage and the scalar expression lowering path
+ // is used to not create a new temporary storage.
+ if (isScalar(x) ||
+ Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(x) ||
+ isTransformationalRef(x))
+ return std::visit([&](const auto &e) { return genref(e); }, x.u);
+ TODO(getLoc(), "gen Expr non-scalar");
+ }
+
+ template <typename A>
+ bool isScalar(const A &x) {
+ return x.Rank() == 0;
+ }
+
template <int KIND>
ExtValue genval(const Fortran::evaluate::Expr<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Logical, KIND>> &exp) {
return std::visit([&](const auto &e) { return genval(e); }, exp.u);
}
+ using RefSet =
+ std::tuple<Fortran::evaluate::ComplexPart, Fortran::evaluate::Substring,
+ Fortran::evaluate::DataRef, Fortran::evaluate::Component,
+ Fortran::evaluate::ArrayRef, Fortran::evaluate::CoarrayRef,
+ Fortran::semantics::SymbolRef>;
+ template <typename A>
+ static constexpr bool inRefSet = Fortran::common::HasMember<A, RefSet>;
+
+ template <typename A, typename = std::enable_if_t<inRefSet<A>>>
+ ExtValue genref(const A &a) {
+ return gen(a);
+ }
+ template <typename A>
+ ExtValue genref(const A &a) {
+ mlir::Type storageType = converter.genType(toEvExpr(a));
+ return placeScalarValueInMemory(builder, getLoc(), genval(a), storageType);
+ }
+
+ template <typename A, template <typename> typename T,
+ typename B = std::decay_t<T<A>>,
+ std::enable_if_t<
+ std::is_same_v<B, Fortran::evaluate::Expr<A>> ||
+ std::is_same_v<B, Fortran::evaluate::Designator<A>> ||
+ std::is_same_v<B, Fortran::evaluate::FunctionRef<A>>,
+ bool> = true>
+ ExtValue genref(const T<A> &x) {
+ return gen(x);
+ }
+
private:
mlir::Location location;
Fortran::lower::AbstractConverter &converter;
@@ -408,3 +528,10 @@ fir::ExtendedValue Fortran::lower::createSomeExtendedExpression(
LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "expr: ") << '\n');
return ScalarExprLowering{loc, converter, symMap}.genval(expr);
}
+
+fir::ExtendedValue Fortran::lower::createSomeExtendedAddress(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap) {
+ LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "address: ") << '\n');
+ return ScalarExprLowering{loc, converter, symMap}.gen(expr);
+}
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 848f38b389cc0..39424d3ff0b0a 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -9,8 +9,8 @@
#include "flang/Lower/ConvertType.h"
#include "flang/Lower/AbstractConverter.h"
#include "flang/Lower/PFTBuilder.h"
+#include "flang/Lower/Support/Utils.h"
#include "flang/Lower/Todo.h"
-#include "flang/Lower/Utils.h"
#include "flang/Optimizer/Dialect/FIRType.h"
#include "flang/Semantics/tools.h"
#include "flang/Semantics/type.h"
@@ -154,6 +154,39 @@ class TypeBuilder {
TypeBuilder(Fortran::lower::AbstractConverter &converter)
: converter{converter}, context{&converter.getMLIRContext()} {}
+ mlir::Type genExprType(const Fortran::lower::SomeExpr &expr) {
+ std::optional<Fortran::evaluate::DynamicType> dynamicType = expr.GetType();
+ if (!dynamicType)
+ return genTypelessExprType(expr);
+ Fortran::common::TypeCategory category = dynamicType->category();
+
+ mlir::Type baseType;
+ if (category == Fortran::common::TypeCategory::Derived) {
+ TODO(converter.getCurrentLocation(), "genExprType derived");
+ } else {
+ // LOGICAL, INTEGER, REAL, COMPLEX, CHARACTER
+ baseType = genFIRType(context, category, dynamicType->kind());
+ }
+ std::optional<Fortran::evaluate::Shape> shapeExpr =
+ Fortran::evaluate::GetShape(converter.getFoldingContext(), expr);
+ fir::SequenceType::Shape shape;
+ if (shapeExpr) {
+ translateShape(shape, std::move(*shapeExpr));
+ } else {
+ // Shape static analysis cannot return something useful for the shape.
+ // Use unknown extents.
+ int rank = expr.Rank();
+ if (rank < 0)
+ TODO(converter.getCurrentLocation(),
+ "Assumed rank expression type lowering");
+ for (int dim = 0; dim < rank; ++dim)
+ shape.emplace_back(fir::SequenceType::getUnknownExtent());
+ }
+ if (!shape.empty())
+ return fir::SequenceType::get(shape, baseType);
+ return baseType;
+ }
+
template <typename A>
void translateShape(A &shape, Fortran::evaluate::Shape &&shapeExpr) {
for (Fortran::evaluate::MaybeExtentExpr extentExpr : shapeExpr) {
@@ -171,6 +204,34 @@ class TypeBuilder {
converter.getFoldingContext(), std::move(expr)));
}
+ mlir::Type genTypelessExprType(const Fortran::lower::SomeExpr &expr) {
+ return std::visit(
+ Fortran::common::visitors{
+ [&](const Fortran::evaluate::BOZLiteralConstant &) -> mlir::Type {
+ return mlir::NoneType::get(context);
+ },
+ [&](const Fortran::evaluate::NullPointer &) -> mlir::Type {
+ return fir::ReferenceType::get(mlir::NoneType::get(context));
+ },
+ [&](const Fortran::evaluate::ProcedureDesignator &proc)
+ -> mlir::Type {
+ TODO(converter.getCurrentLocation(),
+ "genTypelessExprType ProcedureDesignator");
+ },
+ [&](const Fortran::evaluate::ProcedureRef &) -> mlir::Type {
+ return mlir::NoneType::get(context);
+ },
+ [](const auto &x) -> mlir::Type {
+ using T = std::decay_t<decltype(x)>;
+ static_assert(!Fortran::common::HasMember<
+ T, Fortran::evaluate::TypelessExpression>,
+ "missing typeless expr handling in type lowering");
+ llvm::report_fatal_error("not a typeless expression");
+ },
+ },
+ expr.u);
+ }
+
mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol,
bool isAlloc = false, bool isPtr = false) {
mlir::Location loc = converter.genLocation(symbol.name());
@@ -443,8 +504,8 @@ mlir::Type Fortran::lower::translateDataRefToFIRType(
}
mlir::Type Fortran::lower::translateSomeExprToFIRType(
- Fortran::lower::AbstractConverter &converter, const SomeExpr *expr) {
- return TypeBuilder{converter}.gen(*expr);
+ Fortran::lower::AbstractConverter &converter, const SomeExpr &expr) {
+ return TypeBuilder{converter}.genExprType(expr);
}
mlir::Type Fortran::lower::translateSymbolToFIRType(
diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp
index bc3252b018c83..e58b4d61a71e4 100644
--- a/flang/lib/Lower/Mangler.cpp
+++ b/flang/lib/Lower/Mangler.cpp
@@ -8,8 +8,8 @@
#include "flang/Lower/Mangler.h"
#include "flang/Common/reference.h"
+#include "flang/Lower/Support/Utils.h"
#include "flang/Lower/Todo.h"
-#include "flang/Lower/Utils.h"
#include "flang/Optimizer/Dialect/FIRType.h"
#include "flang/Optimizer/Support/InternalNames.h"
#include "flang/Semantics/tools.h"
diff --git a/flang/test/Lower/assignment.f90 b/flang/test/Lower/assignment.f90
new file mode 100644
index 0000000000000..6cb2e32095cee
--- /dev/null
+++ b/flang/test/Lower/assignment.f90
@@ -0,0 +1,24 @@
+! RUN: bbc %s -o "-" -emit-fir | FileCheck %s
+
+subroutine sub1(a)
+ integer :: a
+ a = 1
+end
+
+! CHECK-LABEL: func @_QPsub1(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<i32>
+! CHECK: %[[C1:.*]] = arith.constant 1 : i32
+! CHECK: fir.store %[[C1]] to %[[ARG0]] : !fir.ref<i32>
+
+subroutine sub2(a, b)
+ integer(4) :: a
+ integer(8) :: b
+ a = b
+end
+
+! CHECK-LABEL: func @_QPsub2(
+! CHECK: %[[A:.*]]: !fir.ref<i32> {fir.bindc_name = "a"}
+! CHECK: %[[B:.*]]: !fir.ref<i64> {fir.bindc_name = "b"}
+! CHECK: %[[B_VAL:.*]] = fir.load %arg1 : !fir.ref<i64>
+! CHECK: %[[B_CONV:.*]] = fir.convert %[[B_VAL]] : (i64) -> i32
+! CHECK: fir.store %[[B_CONV]] to %[[A]] : !fir.ref<i32>
More information about the flang-commits
mailing list