[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@nvidia.com>
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index cfb326c..bf346ec 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 @@
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 @@
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 @@
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 @@
}
}
+ [[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 different
+ // 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 @@
}
void genFIR(const Fortran::parser::AssignmentStmt &stmt) {
- TODO(toLocation(), "AssignmentStmt lowering");
+ genAssignment(*stmt.typedAssignment->v);
}
void genFIR(const Fortran::parser::SyncAllStmt &stmt) {
