Skip to content

Fix evaluation semantics of FORALL constructs per 10.2.4.2.4. #1063

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Sep 16, 2021
Merged

Fix evaluation semantics of FORALL constructs per 10.2.4.2.4. #1063

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions flang/include/flang/Lower/ConvertExpr.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -176,8 +176,8 @@ createSomeArrayTempValue(AbstractConverter &converter,
fir::ExtendedValue
createLazyArrayTempValue(AbstractConverter &converter,
const evaluate::Expr<evaluate::SomeType> &expr,
mlir::Value var, SymMap &symMap,
StatementContext &stmtCtx);
mlir::Value var, mlir::Value shapeBuffer,
SymMap &symMap, StatementContext &stmtCtx);

/// Lower an array expression to a value of type box. The expression must be a
/// variable.
Expand Down
6 changes: 3 additions & 3 deletions flang/include/flang/Optimizer/Builder/FIRBuilder.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -248,10 +248,10 @@ class FirOpBuilder : public mlir::OpBuilder {
}

/// Construct one of the two forms of shape op from an array box.
mlir::Value consShape(mlir::Location loc, const fir::AbstractArrayBox &arr);
mlir::Value consShape(mlir::Location loc, llvm::ArrayRef<mlir::Value> shift,
mlir::Value genShape(mlir::Location loc, const fir::AbstractArrayBox &arr);
mlir::Value genShape(mlir::Location loc, llvm::ArrayRef<mlir::Value> shift,
llvm::ArrayRef<mlir::Value> exts);
mlir::Value consShape(mlir::Location loc, llvm::ArrayRef<mlir::Value> exts);
mlir::Value genShape(mlir::Location loc, llvm::ArrayRef<mlir::Value> exts);

/// Create one of the shape ops given an extended value. For a boxed value,
/// this may create a `fir.shift` op.
Expand Down
173 changes: 115 additions & 58 deletions flang/lib/Lower/Bridge.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1211,80 +1211,123 @@ class FirConverter : public Fortran::lower::AbstractConverter {
/// Process a concurrent header for a FORALL. (Concurrent headers for DO
/// CONCURRENT loops are lowered elsewhere.)
void genFIR(const Fortran::parser::ConcurrentHeader &header) {
// Create our iteration space from the header spec.
localSymbols.pushScope();
auto idxTy = builder->getIndexType();
auto loc = toLocation();
llvm::SmallVector<fir::DoLoopOp> loops;
for (auto &ctrl :
std::get<std::list<Fortran::parser::ConcurrentControl>>(header.t)) {
const auto *ctrlVar = std::get<Fortran::parser::Name>(ctrl.t).symbol;
const auto *lo = Fortran::semantics::GetExpr(std::get<1>(ctrl.t));
const auto *hi = Fortran::semantics::GetExpr(std::get<2>(ctrl.t));
auto &optStep =
std::get<std::optional<Fortran::parser::ScalarIntExpr>>(ctrl.t);
auto lb = builder->createConvert(
loc, idxTy,
fir::getBase(genExprValue(*lo, explicitIterSpace.stmtContext())));
auto ub = builder->createConvert(
loc, idxTy,
fir::getBase(genExprValue(*hi, explicitIterSpace.stmtContext())));
auto by = optStep.has_value()
? builder->createConvert(
loc, idxTy,
fir::getBase(genExprValue(
*Fortran::semantics::GetExpr(*optStep),
explicitIterSpace.stmtContext())))
: builder->createIntegerConstant(loc, idxTy, 1);
auto lp = builder->create<fir::DoLoopOp>(
loc, lb, ub, by, /*unordered=*/true,
/*finalCount=*/false, explicitIterSpace.getInnerArgs());
if (!loops.empty())
builder->create<fir::ResultOp>(loc, lp.getResults());
explicitIterSpace.setInnerArgs(lp.getRegionIterArgs());
builder->setInsertionPointToStart(lp.getBody());
forceControlVariableBinding(ctrlVar, lp.getInductionVar());
loops.push_back(lp);
}
explicitIterSpace.setOuterLoop(loops[0]);
if (const auto &mask =
std::get<std::optional<Fortran::parser::ScalarLogicalExpr>>(
header.t);
mask.has_value()) {
auto i1Ty = builder->getI1Type();
auto maskExv = genExprValue(*Fortran::semantics::GetExpr(mask.value()),
explicitIterSpace.stmtContext());
auto cond = builder->createConvert(loc, i1Ty, fir::getBase(maskExv));
auto ifOp = builder->create<fir::IfOp>(
loc, explicitIterSpace.innerArgTypes(), cond,
/*withElseRegion=*/true);
builder->create<fir::ResultOp>(loc, ifOp.getResults());
builder->setInsertionPointToStart(&ifOp.elseRegion().front());
builder->create<fir::ResultOp>(loc, explicitIterSpace.getInnerArgs());
builder->setInsertionPointToStart(&ifOp.thenRegion().front());
llvm::SmallVector<mlir::Value> lows;
llvm::SmallVector<mlir::Value> highs;
llvm::SmallVector<mlir::Value> steps;
if (explicitIterSpace.isOutermostForall()) {
// For the outermost forall, we evaluate the bounds expressions once.
// Contrastingly, if this forall is nested, the bounds expressions are
// assumed to be pure, possibly dependent on outer concurrent control
// variables, possibly variant with respect to arguments, and will be
// re-evaluated.
auto loc = toLocation();
auto idxTy = builder->getIndexType();
auto &stmtCtx = explicitIterSpace.stmtContext();
auto lowerExpr = [&](auto &e) {
return fir::getBase(genExprValue(e, stmtCtx));
};
for (auto &ctrl :
std::get<std::list<Fortran::parser::ConcurrentControl>>(header.t)) {
const auto *lo = Fortran::semantics::GetExpr(std::get<1>(ctrl.t));
const auto *hi = Fortran::semantics::GetExpr(std::get<2>(ctrl.t));
auto &optStep =
std::get<std::optional<Fortran::parser::ScalarIntExpr>>(ctrl.t);
lows.push_back(builder->createConvert(loc, idxTy, lowerExpr(*lo)));
highs.push_back(builder->createConvert(loc, idxTy, lowerExpr(*hi)));
steps.push_back(
optStep.has_value()
? builder->createConvert(
loc, idxTy,
lowerExpr(*Fortran::semantics::GetExpr(*optStep)))
: builder->createIntegerConstant(loc, idxTy, 1));
}
}
auto lambda = [&, lows, highs, steps]() {
// Create our iteration space from the header spec.
auto loc = toLocation();
auto idxTy = builder->getIndexType();
llvm::SmallVector<fir::DoLoopOp> loops;
auto &stmtCtx = explicitIterSpace.stmtContext();
auto lowerExpr = [&](auto &e) {
return fir::getBase(genExprValue(e, stmtCtx));
};
const auto outermost = !lows.empty();
std::size_t headerIndex = 0;
for (auto &ctrl :
std::get<std::list<Fortran::parser::ConcurrentControl>>(header.t)) {
const auto *ctrlVar = std::get<Fortran::parser::Name>(ctrl.t).symbol;
mlir::Value lb;
mlir::Value ub;
mlir::Value by;
if (outermost) {
assert(headerIndex < lows.size());
lb = lows[headerIndex];
ub = highs[headerIndex];
by = steps[headerIndex++];
} else {
const auto *lo = Fortran::semantics::GetExpr(std::get<1>(ctrl.t));
const auto *hi = Fortran::semantics::GetExpr(std::get<2>(ctrl.t));
auto &optStep =
std::get<std::optional<Fortran::parser::ScalarIntExpr>>(ctrl.t);
lb = builder->createConvert(loc, idxTy, lowerExpr(*lo));
ub = builder->createConvert(loc, idxTy, lowerExpr(*hi));
by = optStep.has_value()
? builder->createConvert(
loc, idxTy,
lowerExpr(*Fortran::semantics::GetExpr(*optStep)))
: builder->createIntegerConstant(loc, idxTy, 1);
}
auto lp = builder->create<fir::DoLoopOp>(
loc, lb, ub, by, /*unordered=*/true,
/*finalCount=*/false, explicitIterSpace.getInnerArgs());
if (!loops.empty() || !outermost)
builder->create<fir::ResultOp>(loc, lp.getResults());
explicitIterSpace.setInnerArgs(lp.getRegionIterArgs());
builder->setInsertionPointToStart(lp.getBody());
forceControlVariableBinding(ctrlVar, lp.getInductionVar());
loops.push_back(lp);
}
explicitIterSpace.setOuterLoop(loops[0]);
if (const auto &mask =
std::get<std::optional<Fortran::parser::ScalarLogicalExpr>>(
header.t);
mask.has_value()) {
auto i1Ty = builder->getI1Type();
auto maskExv =
genExprValue(*Fortran::semantics::GetExpr(mask.value()), stmtCtx);
auto cond = builder->createConvert(loc, i1Ty, fir::getBase(maskExv));
auto ifOp = builder->create<fir::IfOp>(
loc, explicitIterSpace.innerArgTypes(), cond,
/*withElseRegion=*/true);
builder->create<fir::ResultOp>(loc, ifOp.getResults());
builder->setInsertionPointToStart(&ifOp.elseRegion().front());
builder->create<fir::ResultOp>(loc, explicitIterSpace.getInnerArgs());
builder->setInsertionPointToStart(&ifOp.thenRegion().front());
}
};
// Push the lambda to gen the loop nest context.
explicitIterSpace.pushLoopNest(lambda);
}

void genFIR(const Fortran::parser::ForallAssignmentStmt &stmt) {
std::visit([&](const auto &x) { genFIR(x); }, stmt.u);
}

void genFIR(const Fortran::parser::EndForallStmt &) {
explicitIterSpace.finalize();
cleanupExplicitSpace();
}

template <typename A>
void prepareExplicitSpace(const A &forall) {
analyzeExplicitSpace(forall);
if (!explicitIterSpace.isActive())
analyzeExplicitSpace(forall);
localSymbols.pushScope();
explicitIterSpace.enter();
Fortran::lower::createArrayLoads(*this, explicitIterSpace, localSymbols);
}

/// Cleanup all the FORALL context information when we exit.
void cleanupExplicitSpace() {
Fortran::lower::createArrayMergeStores(*this, explicitIterSpace);
explicitIterSpace.conditionalCleanup();
explicitIterSpace.leave();
localSymbols.popScope();
}

Expand Down Expand Up @@ -1824,6 +1867,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
void genAssignment(const Fortran::evaluate::Assignment &assign) {
Fortran::lower::StatementContext stmtCtx;
auto loc = toLocation();
if (explicitIterationSpace()) {
Fortran::lower::createArrayLoads(*this, explicitIterSpace, localSymbols);
explicitIterSpace.genLoopNest();
}
std::visit(
Fortran::common::visitors{
// [1] Plain old assignment.
Expand Down Expand Up @@ -1920,7 +1967,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
if (implicitIterationSpace())
TODO(loc, "user defined assignment within WHERE");
Fortran::semantics::SomeExpr expr{procRef};
createFIRExpr(toLocation(), &expr, stmtCtx);
createFIRExpr(toLocation(), &expr,
explicitIterationSpace()
? explicitIterSpace.stmtContext()
: stmtCtx);
},

// [3] Pointer assignment with possibly empty bounds-spec. R1035: a
Expand Down Expand Up @@ -1981,6 +2031,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
},
},
assign.u);
if (explicitIterationSpace())
Fortran::lower::createArrayMergeStores(*this, explicitIterSpace);
}

void genFIR(const Fortran::parser::WhereConstruct &c) {
Expand Down Expand Up @@ -2563,6 +2615,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
void analyzeExplicitSpace(const Fortran::evaluate::Assignment *assign) {
analyzeExplicitSpace</*LHS=*/true>(assign->lhs);
analyzeExplicitSpace(assign->rhs);
explicitIterSpace.endAssign();
}
void analyzeExplicitSpace(const Fortran::parser::ForallAssignmentStmt &stmt) {
std::visit([&](const auto &s) { analyzeExplicitSpace(s); }, stmt.u);
Expand Down Expand Up @@ -2693,7 +2746,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
auto var = builder->createTemporary(loc, ty);
auto nil = builder->createNullConstant(loc, ty);
builder->create<fir::StoreOp>(loc, nil, var);
implicitIterSpace.addMaskVariable(exp, var);
auto shTy = fir::HeapType::get(builder->getIndexType());
auto shape = builder->createTemporary(loc, shTy);
auto nilSh = builder->createNullConstant(loc, shTy);
builder->create<fir::StoreOp>(loc, nilSh, shape);
implicitIterSpace.addMaskVariable(exp, var, shape);
explicitIterSpace.outermostContext().attachCleanup([=]() {
auto load = builder->create<fir::LoadOp>(loc, var);
auto cmp = builder->genIsNotNull(loc, load);
Expand Down
Loading