Skip to content

Commit d13ef2b

Browse files
schweitzpgischweitzpgi
authored
Merge pull request #1002 from schweitzpgi/ch-forall5
Fix n2f.f90.
2 parents 9ec3a0e + 73b357f commit d13ef2b

File tree

3 files changed

+89
-35
lines changed

3 files changed

+89
-35
lines changed

‎flang/include/flang/Lower/ConvertExpr.h

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -60,9 +60,9 @@ createSomeExtendedAddress(mlir::Location loc, AbstractConverter &converter,
6060
/// Create the address of the box.
6161
/// \p expr must be the designator of an allocatable/pointer entity.
6262
fir::MutableBoxValue
63-
createSomeMutableBox(mlir::Location loc, AbstractConverter &converter,
64-
const evaluate::Expr<evaluate::SomeType> &expr,
65-
SymMap &symMap);
63+
createMutableBox(mlir::Location loc, AbstractConverter &converter,
64+
const evaluate::Expr<evaluate::SomeType> &expr,
65+
SymMap &symMap);
6666

6767
/// Lower an array assignment expression.
6868
///
@@ -138,7 +138,8 @@ void createAnyMaskedArrayAssignment(
138138
/// it is not allocated yet or reallocation it if it does not conform
139139
/// with the right hand side.
140140
void createAllocatableArrayAssignment(
141-
AbstractConverter &converter, const fir::MutableBoxValue &lhs,
141+
AbstractConverter &converter,
142+
const evaluate::Expr<evaluate::SomeType> &lhs,
142143
const evaluate::Expr<evaluate::SomeType> &rhs,
143144
ExplicitIterSpace &explicitIterSpace, ImplicitIterSpace &implicitIterSpace,
144145
SymMap &symMap, StatementContext &stmtCtx);

‎flang/lib/Lower/Bridge.cpp

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -315,7 +315,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
315315
fir::MutableBoxValue
316316
genExprMutableBox(mlir::Location loc,
317317
const Fortran::lower::SomeExpr &expr) override final {
318-
return createSomeMutableBox(loc, *this, expr, localSymbols);
318+
return createMutableBox(loc, *this, expr, localSymbols);
319319
}
320320
fir::ExtendedValue genExprBox(const Fortran::lower::SomeExpr &expr,
321321
Fortran::lower::StatementContext &context,
@@ -1700,9 +1700,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
17001700
if (isWholeAllocatable(assign.lhs)) {
17011701
// Assignment to allocatables may require the lhs to be
17021702
// deallocated/reallocated. See Fortran 2018 10.2.1.3 p3
1703-
auto lhs = genExprMutableBox(toLocation(), assign.lhs);
17041703
Fortran::lower::createAllocatableArrayAssignment(
1705-
*this, lhs, assign.rhs, explicitIterSpace, implicitIterSpace,
1704+
*this, assign.lhs, assign.rhs, explicitIterSpace, implicitIterSpace,
17061705
localSymbols, stmtCtx);
17071706
return;
17081707
}

‎flang/lib/Lower/ConvertExpr.cpp

Lines changed: 82 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -2411,6 +2411,19 @@ class ArrayExprLowering {
24112411
return result;
24122412
}
24132413

2414+
/// In an explicit space, the context may include an implicit subspace. The
2415+
/// RHS of the assignment does not necessarily have rank and can be promoted
2416+
/// from a scalar to an array. In that case, the implicit subscripts must be
2417+
/// removed.
2418+
void removeImplicit() {
2419+
llvm::SmallVector<AccessValue> newIndices;
2420+
const auto size = indices.size();
2421+
for (std::remove_const_t<decltype(size)> i = 0, j = 0; j < size; ++j)
2422+
if (indices[j].access() != AccessKind::Implicit)
2423+
newIndices[i++] = indices[j];
2424+
indices.swap(newIndices);
2425+
}
2426+
24142427
private:
24152428
mlir::Value inArg;
24162429
mlir::Value outRes;
@@ -2487,8 +2500,10 @@ class ArrayExprLowering {
24872500
auto lambda = [=](IterSpace iters) -> ExtValue {
24882501
auto innerArg = iters.innerArgument();
24892502
auto resTy = adjustedArrayElementType(innerArg.getType());
2503+
auto cast = builder.createConvert(loc, fir::unwrapSequenceType(resTy),
2504+
iters.getElement());
24902505
auto arrUpdate = builder.create<fir::ArrayUpdateOp>(
2491-
loc, resTy, innerArg, iters.getElement(), iters.iterVec(),
2506+
loc, resTy, innerArg, cast, iters.iterVec(),
24922507
destination.typeparams());
24932508
return abstractArrayExtValue(arrUpdate);
24942509
};
@@ -2537,7 +2552,7 @@ class ArrayExprLowering {
25372552
static void lowerAllocatableArrayAssignment(
25382553
Fortran::lower::AbstractConverter &converter,
25392554
Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
2540-
const fir::MutableBoxValue &lhs,
2555+
const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &lhs,
25412556
const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &rhs,
25422557
Fortran::lower::ExplicitIterSpace &explicitSpace,
25432558
Fortran::lower::ImplicitIterSpace &implicitSpace) {
@@ -2553,11 +2568,15 @@ class ArrayExprLowering {
25532568
/// defines the iteration space of the computation and the lhs is
25542569
/// resized/reallocated to fit if necessary.
25552570
void lowerAllocatableArrayAssignment(
2556-
const fir::MutableBoxValue &mutableBox,
2571+
const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &lhs,
25572572
const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &rhs) {
25582573
// With assignment to allocatable, we want to lower the rhs first and use
25592574
// its shape to determine if we need to reallocate, etc.
25602575
auto loc = getLoc();
2576+
// FIXME: If the lhs is in an explicit iteration space, the assignment may
2577+
// be to an array of allocatable arrays rather than a single allocatable
2578+
// array.
2579+
auto mutableBox = createMutableBox(loc, converter, lhs, symMap);
25612580
auto resultTy = converter.genType(rhs);
25622581
auto rhsCC = [&]() {
25632582
PushSemantics(ConstituentSemantics::RefTransparent);
@@ -2775,6 +2794,10 @@ class ArrayExprLowering {
27752794
ExtValue lowerArrayExpression(CC f, mlir::Type resultTy) {
27762795
auto loc = getLoc();
27772796
auto [iterSpace, insPt] = genIterSpace(resultTy);
2797+
#if 0
2798+
if (explicitScalar)
2799+
rhsIterSpace.removeImplicit();
2800+
#endif
27782801
auto innerArg = iterSpace.innerArgument();
27792802
auto exv = f(iterSpace);
27802803
mlir::Value upd;
@@ -3218,17 +3241,21 @@ class ArrayExprLowering {
32183241
const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &e) {
32193242
struct Filter : public Fortran::evaluate::AnyTraverse<
32203243
Filter, std::optional<llvm::SmallVector<mlir::Value>>> {
3221-
using Base = Fortran::evaluate::AnyTraverse<
3222-
Filter, std::optional<llvm::SmallVector<mlir::Value>>>;
3244+
using RT = std::optional<llvm::SmallVector<mlir::Value>>;
3245+
using Base = Fortran::evaluate::AnyTraverse<Filter, RT>;
32233246
using Base::operator();
32243247

3225-
Filter(const llvm::SmallVector<mlir::Value> init)
3226-
: Base(*this), bounds(init) {}
3248+
Filter(ArrayExprLowering *const ael) : Base(*this), ael(ael) {}
32273249

3228-
std::optional<llvm::SmallVector<mlir::Value>>
3229-
operator()(const Fortran::evaluate::ArrayRef &ref) {
3250+
RT operator()(const Fortran::evaluate::ArrayRef &ref) {
32303251
if ((ref.base().IsSymbol() || ref.base().Rank() == 0) &&
32313252
ref.Rank() > 0 && !ref.subscript().empty()) {
3253+
auto baseTy = ael->raiseBaseType(ref.base());
3254+
auto ty = ref.base().IsSymbol()
3255+
? baseTy
3256+
: baseTy.cast<fir::RecordType>().getType(
3257+
toStringRef(ref.GetLastSymbol().name()));
3258+
auto bounds = ael->getShape(ty);
32323259
assert(ref.subscript().size() == bounds.size());
32333260
llvm::SmallVector<mlir::Value> result;
32343261
auto bdIter = bounds.begin();
@@ -3248,15 +3275,24 @@ class ArrayExprLowering {
32483275
}
32493276
return {};
32503277
}
3278+
RT operator()(const Fortran::evaluate::Component &cpnt) {
3279+
if (cpnt.base().Rank() == 0 && cpnt.Rank() > 0)
3280+
return ael->getShape(ael->raiseBaseType(cpnt));
3281+
return {};
3282+
}
3283+
RT operator()(const Fortran::semantics::Symbol &sym) {
3284+
if (sym.Rank() > 0)
3285+
return ael->getShape(ael->raiseBaseType(sym));
3286+
return {};
3287+
}
32513288

3252-
llvm::SmallVector<mlir::Value> bounds;
3289+
ArrayExprLowering *const ael;
32533290
};
32543291

3255-
auto originalShape = getShape(converter.genType(e));
3256-
Filter filter(originalShape);
3292+
Filter filter(this);
32573293
if (auto res = filter(e))
32583294
return *res;
3259-
return originalShape;
3295+
return {};
32603296
}
32613297

32623298
void genMasks() {
@@ -4306,6 +4342,10 @@ class ArrayExprLowering {
43064342
return false;
43074343
}
43084344

4345+
/// Set of helper member functions for generating the type of a particular
4346+
/// component along a path. We cannot use the `converter` here because it is
4347+
/// not possible to uplift an arbitrary component list to a generic
4348+
/// `Fortran::evaluate::Expr`.
43094349
mlir::Type raiseBaseType(const Fortran::evaluate::Component &x) {
43104350
auto baseTy = raiseBaseType(x.base());
43114351
auto recTy = baseTy.cast<fir::RecordType>();
@@ -4318,10 +4358,13 @@ class ArrayExprLowering {
43184358
LLVM_DEBUG(llvm::dbgs() << "base type s " << rv << '\n');
43194359
return rv;
43204360
}
4361+
mlir::Type raiseBaseType(const Fortran::evaluate::NamedEntity &n) {
4362+
return n.IsSymbol() ? raiseBaseType(n.GetLastSymbol())
4363+
: raiseBaseType(n.GetComponent());
4364+
}
43214365
mlir::Type raiseBaseType(const Fortran::evaluate::ArrayRef &x) {
43224366
auto &base = x.base();
4323-
mlir::Type baseTy = base.IsSymbol() ? raiseBaseType(base.GetLastSymbol())
4324-
: raiseBaseType(base.GetComponent());
4367+
mlir::Type baseTy = raiseBaseType(base);
43254368
auto seqTy = baseTy.cast<fir::SequenceType>();
43264369
auto rv = seqTy.getEleTy();
43274370
LLVM_DEBUG(llvm::dbgs() << "base type a " << rv << '\n');
@@ -4387,7 +4430,8 @@ class ArrayExprLowering {
43874430

43884431
RaiseRT
43894432
raiseToArray(const Fortran::evaluate::DataRef &x,
4390-
llvm::ArrayRef<const Fortran::semantics::Symbol *> ctrlSet) {
4433+
llvm::ArrayRef<const Fortran::semantics::Symbol *> ctrlSet,
4434+
bool isScalar) {
43914435
return std::visit(
43924436
Fortran::common::visitors{
43934437
[&](const Fortran::semantics::SymbolRef &s) -> RaiseRT {
@@ -4401,13 +4445,16 @@ class ArrayExprLowering {
44014445
TODO(getLoc(), "coarray reference");
44024446
return {llvm::None, mlir::Type{}, false, false};
44034447
},
4404-
[&](const auto &y) -> RaiseRT { return raiseToArray(y, ctrlSet); }},
4448+
[&](const auto &y) -> RaiseRT {
4449+
return raiseToArray(y, ctrlSet, isScalar);
4450+
}},
44054451
x.u);
44064452
}
44074453
RaiseRT
44084454
raiseToArray(const Fortran::evaluate::Component &x,
4409-
llvm::ArrayRef<const Fortran::semantics::Symbol *> ctrlSet) {
4410-
auto [fopt, ty, inrank, ranked] = raiseToArray(x.base(), ctrlSet);
4455+
llvm::ArrayRef<const Fortran::semantics::Symbol *> ctrlSet,
4456+
bool isScalar) {
4457+
auto [fopt, ty, inrank, ranked] = raiseToArray(x.base(), ctrlSet, isScalar);
44114458
if (fopt.hasValue()) {
44124459
if (!ranked && x.Rank() > 0) {
44134460
auto [fopt2, ty2] = raiseRankedComponent(fopt, x, ty);
@@ -4424,7 +4471,8 @@ class ArrayExprLowering {
44244471
}
44254472
RaiseRT
44264473
raiseToArray(const Fortran::evaluate::ArrayRef &x,
4427-
llvm::ArrayRef<const Fortran::semantics::Symbol *> ctrlSet) {
4474+
llvm::ArrayRef<const Fortran::semantics::Symbol *> ctrlSet,
4475+
bool isScalar) {
44284476
const auto &base = x.base();
44294477
auto accessUsesControlVariable = [&]() {
44304478
for (const auto &subs : x.subscript())
@@ -4454,16 +4502,16 @@ class ArrayExprLowering {
44544502
}
44554503
// Otherwise, it's a component.
44564504
auto [fopt, ty, inrank, ranked] =
4457-
raiseToArray(base.GetComponent(), ctrlSet);
4505+
raiseToArray(base.GetComponent(), ctrlSet, isScalar);
44584506
if (fopt.hasValue())
4459-
return RaiseRT{fopt, ty, inrank, ranked};
4507+
return RaiseRT{fopt, ty, inrank, x.Rank() > 0};
44604508
if (x.Rank() > 0 || accessUsesControlVariable()) {
44614509
auto [fopt2, ty2] = raiseBase(base.GetComponent());
44624510
return RaiseRT{fopt2, ty2, inrank, x.Rank() > 0};
44634511
}
44644512
return RaiseRT{fopt, ty, inrank, ranked};
44654513
}(),
4466-
x);
4514+
x, isScalar);
44674515
}
44684516
static mlir::Type unwrapBoxEleTy(mlir::Type ty) {
44694517
if (auto boxTy = ty.dyn_cast<fir::BoxType>()) {
@@ -4508,7 +4556,7 @@ class ArrayExprLowering {
45084556
return {};
45094557
}
45104558
RaiseRT raiseSubscript(const RaiseRT &tup,
4511-
const Fortran::evaluate::ArrayRef &x) {
4559+
const Fortran::evaluate::ArrayRef &x, bool isScalar) {
45124560
auto fopt = std::get<llvm::Optional<CC>>(tup);
45134561
if (fopt.hasValue()) {
45144562
auto arrTy = std::get<mlir::Type>(tup);
@@ -4587,8 +4635,14 @@ class ArrayExprLowering {
45874635
}
45884636
}
45894637
auto one = builder.createIntegerConstant(loc, idxTy, 1);
4638+
llvm::errs() << "DBG: " << isScalar << ' ' << implicitArguments << ' '
4639+
<< x.GetFirstSymbol() << '\n';
45904640
auto pc = [=](IterSpace iters) {
45914641
IterationSpace newIters = iters;
4642+
if (isScalar) {
4643+
newIters.removeImplicit();
4644+
assert(!implicitArguments);
4645+
}
45924646
const auto firstImplicitIndex = iters.beginImplicitIndex();
45934647
auto implicitIndex = iters.endImplicitIndex();
45944648
assert(firstImplicitIndex <= implicitIndex);
@@ -4676,7 +4730,7 @@ class ArrayExprLowering {
46764730
/// variables, i.e. `array(func(i))`, are not.
46774731
template <typename A>
46784732
CC raiseToArray(const A &x) {
4679-
auto tup = raiseToArray(x, collectControlSymbols());
4733+
auto tup = raiseToArray(x, collectControlSymbols(), x.Rank() == 0);
46804734
auto fopt = std::get<llvm::Optional<CC>>(tup);
46814735
assert(fopt.hasValue() && "continuation must be returned");
46824736
return fopt.getValue();
@@ -5698,12 +5752,12 @@ void Fortran::lower::createAnyMaskedArrayAssignment(
56985752

56995753
void Fortran::lower::createAllocatableArrayAssignment(
57005754
Fortran::lower::AbstractConverter &converter,
5701-
const fir::MutableBoxValue &lhs,
5755+
const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &lhs,
57025756
const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &rhs,
57035757
Fortran::lower::ExplicitIterSpace &explicitSpace,
57045758
Fortran::lower::ImplicitIterSpace &implicitSpace,
57055759
Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
5706-
LLVM_DEBUG(llvm::dbgs() << "defining array: " << lhs << '\n';
5760+
LLVM_DEBUG(lhs.AsFortran(llvm::dbgs() << "defining array: ") << '\n';
57075761
rhs.AsFortran(llvm::dbgs() << "assign expression: ")
57085762
<< " given the explicit iteration space:\n"
57095763
<< explicitSpace << "\n and implied mask conditions:\n"
@@ -5731,7 +5785,7 @@ fir::ExtendedValue Fortran::lower::createSomeArrayBox(
57315785
stmtCtx, expr);
57325786
}
57335787

5734-
fir::MutableBoxValue Fortran::lower::createSomeMutableBox(
5788+
fir::MutableBoxValue Fortran::lower::createMutableBox(
57355789
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
57365790
const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &expr,
57375791
Fortran::lower::SymMap &symMap) {

0 commit comments

Comments
 (0)