[flang] Add analyzed form of pointer assignment

Add `typedAssignment` to `PointerAssignmentStmt` parse tree node and
extend `evaluate::Assignment` to include pointer assignment, including
analyzed bounds. Analyze pointer assignments and fill those in.
Emit them in unparsed output and parse tree dump when present.

Change assignment checking to use analyzed expressions and assignments
rather than calling AnalyzeExpr. Check bounds in pointer assignments
for impure function calls in FORALL context.

Add `Fold` convenience function to `ExpressionAnalyzer`.

Original-commit: flang-compiler/f18@140c983423
Reviewed-on: https://github.com/flang-compiler/f18/pull/904
This commit is contained in:
Tim Keith 2020-01-03 10:38:51 -08:00
parent b58617b940
commit d42aaa81f2
12 changed files with 225 additions and 79 deletions

View File

@ -165,6 +165,49 @@ StructureConstructor &StructureConstructor::Add(
GenericExprWrapper::~GenericExprWrapper() {}
std::ostream &Assignment::AsFortran(std::ostream &o) const {
std::visit(
common::visitors{
[&](const evaluate::Assignment::IntrinsicAssignment &x) {
x.rhs.AsFortran(x.lhs.AsFortran(o) << '=');
},
[&](const evaluate::ProcedureRef &x) { x.AsFortran(o << "CALL "); },
[&](const evaluate::Assignment::PointerAssignment &x) {
x.lhs.AsFortran(o);
std::visit(
common::visitors{
[&](const evaluate::Assignment::PointerAssignment::
BoundsSpec &bounds) {
if (!bounds.empty()) {
char sep{'('};
for (const auto &bound : bounds) {
bound.AsFortran(o << sep) << ':';
sep = ',';
}
o << ')';
}
},
[&](const evaluate::Assignment::PointerAssignment::
BoundsRemapping &bounds) {
if (!bounds.empty()) {
char sep{'('};
for (const auto &bound : bounds) {
bound.first.AsFortran(o << sep) << ':';
bound.second.AsFortran(o);
sep = ',';
}
o << ')';
}
},
},
x.bounds);
x.rhs.AsFortran(o << " => ");
},
},
u);
return o;
}
GenericAssignmentWrapper::~GenericAssignmentWrapper() {}
template<TypeCategory CAT> int Expr<SomeKind<CAT>>::GetKind() const {

View File

@ -811,18 +811,27 @@ public:
};
// An assignment is either intrinsic (with lhs and rhs) or user-defined,
// represented as a ProcedureRef.
// represented as a ProcedureRef. A pointer assignment optionally also has
// a bounds-spec or bounds-remapping.
class Assignment {
public:
explicit Assignment(ProcedureRef &&x) : u{std::move(x)} {}
Assignment(Expr<SomeType> &&lhs, Expr<SomeType> &&rhs)
: u{IntrinsicAssignment{std::move(lhs), std::move(rhs)}} {}
UNION_CONSTRUCTORS(Assignment)
struct IntrinsicAssignment {
Expr<SomeType> lhs;
Expr<SomeType> rhs;
};
std::variant<IntrinsicAssignment, ProcedureRef> u;
struct PointerAssignment {
using BoundsSpec = std::vector<Expr<SubscriptInteger>>;
using BoundsRemapping =
std::vector<std::pair<Expr<SubscriptInteger>, Expr<SubscriptInteger>>>;
PointerAssignment(Expr<SomeType> &&lhs, Expr<SomeType> &&rhs)
: lhs{std::move(lhs)}, rhs{std::move(rhs)} {}
Expr<SomeType> lhs;
Expr<SomeType> rhs;
std::variant<BoundsSpec, BoundsRemapping> bounds;
};
std::ostream &AsFortran(std::ostream &) const;
std::variant<IntrinsicAssignment, ProcedureRef, PointerAssignment> u;
};
// This wrapper class is used, by means of a forward reference with

View File

@ -766,7 +766,8 @@ protected:
if (asFortran_ && x.typedExpr) {
asFortran_->expr(ss, *x.typedExpr);
}
} else if constexpr (std::is_same_v<T, AssignmentStmt>) {
} else if constexpr (std::is_same_v<T, AssignmentStmt> ||
std::is_same_v<T, PointerAssignmentStmt>) {
if (asFortran_ && x.typedAssignment) {
asFortran_->assignment(ss, *x.typedAssignment);
}

View File

@ -1942,6 +1942,7 @@ struct PointerAssignmentStmt {
std::variant<std::list<BoundsRemapping>, std::list<BoundsSpec>> u;
};
TUPLE_CLASS_BOILERPLATE(PointerAssignmentStmt);
mutable AssignmentStmt::TypedAssignment typedAssignment;
std::tuple<DataRef, Bounds, Expr> t;
};

View File

@ -849,16 +849,22 @@ public:
}
}
void Unparse(const PointerAssignmentStmt &x) { // R1033, R1034, R1038
Walk(std::get<DataRef>(x.t));
std::visit(
common::visitors{
[&](const std::list<BoundsRemapping> &y) {
Put('('), Walk(y), Put(')');
},
[&](const std::list<BoundsSpec> &y) { Walk("(", y, ", ", ")"); },
},
std::get<PointerAssignmentStmt::Bounds>(x.t).u);
Put(" => "), Walk(std::get<Expr>(x.t));
if (asFortran_ && x.typedAssignment.get()) {
Put(' ');
asFortran_->assignment(out_, *x.typedAssignment);
Put('\n');
} else {
Walk(std::get<DataRef>(x.t));
std::visit(
common::visitors{
[&](const std::list<BoundsRemapping> &y) {
Put('('), Walk(y), Put(')');
},
[&](const std::list<BoundsSpec> &y) { Walk("(", y, ", ", ")"); },
},
std::get<PointerAssignmentStmt::Bounds>(x.t).u);
Put(" => "), Walk(std::get<Expr>(x.t));
}
}
void Post(const BoundsSpec &) { // R1035
Put(':');

View File

@ -335,7 +335,7 @@ private:
int GetIntegerKind(const std::optional<parser::IntegerTypeSpec> &);
void CheckForImpureCall(const SomeExpr &);
void CheckForImpureCall(const std::optional<SomeExpr> &);
void CheckForImpureCall(const SomeExpr *);
void CheckForPureContext(const SomeExpr &lhs, const SomeExpr &rhs,
parser::CharBlock rhsSource, bool isPointerAssignment);
@ -355,8 +355,7 @@ private:
void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
// Assignment statement analysis is in expression.cc where user-defined
// assignments can be recognized and replaced.
if (const evaluate::Assignment *
asst{AnalyzeAssignmentStmt(context_, stmt)}) {
if (const evaluate::Assignment * asst{GetAssignment(stmt)}) {
if (const auto *intrinsicAsst{
std::get_if<evaluate::Assignment::IntrinsicAssignment>(&asst->u)}) {
CheckForImpureCall(intrinsicAsst->lhs);
@ -375,23 +374,50 @@ void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
void AssignmentContext::Analyze(const parser::PointerAssignmentStmt &stmt) {
CHECK(!where_);
const auto &lhs{std::get<parser::DataRef>(stmt.t)};
const auto &rhs{std::get<parser::Expr>(stmt.t)};
auto &foldingContext{context_.foldingContext()};
auto lhsExpr{evaluate::Fold(foldingContext, AnalyzeExpr(context_, lhs))};
auto rhsExpr{evaluate::Fold(foldingContext, AnalyzeExpr(context_, rhs))};
CheckForImpureCall(lhsExpr);
CheckForImpureCall(rhsExpr);
// TODO: CheckForImpureCall() in the bounds / bounds remappings
if (forall_) {
// TODO: Warn if some name in forall_->activeNames or its outer
// contexts does not appear on LHS
if (const evaluate::Assignment * asst{GetAssignment(stmt)}) {
auto [lhs, rhs]{std::visit(
common::visitors{
[&](const evaluate::Assignment::IntrinsicAssignment &x) {
return std::make_pair(&x.lhs, &x.rhs);
},
[&](const evaluate::ProcedureRef &x) {
return std::make_pair(x.arguments()[0]->UnwrapExpr(),
x.arguments()[1]->UnwrapExpr());
},
[&](const evaluate::Assignment::PointerAssignment &x) {
std::visit(
common::visitors{
[&](const evaluate::Assignment::PointerAssignment::
BoundsSpec &bounds) {
for (const auto &bound : bounds) {
CheckForImpureCall(SomeExpr{bound});
}
},
[&](const evaluate::Assignment::PointerAssignment::
BoundsRemapping &bounds) {
for (const auto &bound : bounds) {
CheckForImpureCall(SomeExpr{bound.first});
CheckForImpureCall(SomeExpr{bound.second});
}
},
},
x.bounds);
return std::make_pair(&x.lhs, &x.rhs);
},
},
asst->u)};
CheckForImpureCall(lhs);
CheckForImpureCall(rhs);
if (forall_) {
// TODO: Warn if some name in forall_->activeNames or its outer
// contexts does not appear on LHS
}
if (lhs && rhs) {
CheckForPureContext(
*lhs, *rhs, std::get<parser::Expr>(stmt.t).source, true /* => */);
}
// TODO continue here, using CheckPointerAssignment()
}
if (lhsExpr && rhsExpr) {
CheckForPureContext(*lhsExpr, *rhsExpr, rhs.source, true /* => */);
}
// TODO continue here, using CheckPointerAssignment()
// TODO: analyze the bounds / bounds remappings
}
void AssignmentContext::Analyze(const parser::WhereStmt &stmt) {
@ -510,15 +536,15 @@ void AssignmentContext::Analyze(const parser::ConcurrentHeader &header) {
const parser::Name &name{std::get<parser::Name>(control.t)};
bool inserted{forall_->activeNames.insert(name.source).second};
CHECK(inserted || context_.HasError(name));
CheckForImpureCall(AnalyzeExpr(context_, std::get<1>(control.t)));
CheckForImpureCall(AnalyzeExpr(context_, std::get<2>(control.t)));
CheckForImpureCall(GetExpr(std::get<1>(control.t)));
CheckForImpureCall(GetExpr(std::get<2>(control.t)));
if (const auto &stride{std::get<3>(control.t)}) {
CheckForImpureCall(AnalyzeExpr(context_, *stride));
CheckForImpureCall(GetExpr(*stride));
}
}
if (const auto &mask{
std::get<std::optional<parser::ScalarLogicalExpr>>(header.t)}) {
CheckForImpureCall(AnalyzeExpr(context_, *mask));
CheckForImpureCall(GetExpr(*mask));
}
}
@ -546,10 +572,9 @@ void AssignmentContext::CheckForImpureCall(const SomeExpr &expr) {
}
}
void AssignmentContext::CheckForImpureCall(
const std::optional<SomeExpr> &maybeExpr) {
if (maybeExpr) {
CheckForImpureCall(*maybeExpr);
void AssignmentContext::CheckForImpureCall(const SomeExpr *expr) {
if (expr) {
CheckForImpureCall(*expr);
}
}
@ -669,14 +694,12 @@ void AssignmentContext::CheckForPureContext(const SomeExpr &lhs,
}
MaskExpr AssignmentContext::GetMask(
const parser::LogicalExpr &expr, bool defaultValue) {
const parser::LogicalExpr &logicalExpr, bool defaultValue) {
MaskExpr mask{defaultValue};
if (auto maybeExpr{AnalyzeExpr(context_, expr)}) {
CheckForImpureCall(*maybeExpr);
auto *logical{
std::get_if<evaluate::Expr<evaluate::SomeLogical>>(&maybeExpr->u)};
CHECK(logical);
mask = evaluate::ConvertTo(mask, std::move(*logical));
if (const SomeExpr * expr{GetExpr(logicalExpr)}) {
CheckForImpureCall(*expr);
auto *logical{std::get_if<evaluate::Expr<evaluate::SomeLogical>>(&expr->u)};
mask = evaluate::ConvertTo(mask, common::Clone(DEREF(logical)));
}
return mask;
}

View File

@ -694,7 +694,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Name &n) {
MaybeExpr ExpressionAnalyzer::Analyze(const parser::NamedConstant &n) {
if (MaybeExpr value{Analyze(n.v)}) {
Expr<SomeType> folded{Fold(GetFoldingContext(), std::move(*value))};
Expr<SomeType> folded{Fold(std::move(*value))};
if (IsConstantExpr(folded)) {
return {folded};
}
@ -1459,7 +1459,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(
if (IsPointer(*symbol)) {
CheckPointerAssignment(
GetFoldingContext(), *symbol, *value); // C7104, C7105
result.Add(*symbol, Fold(GetFoldingContext(), std::move(*value)));
result.Add(*symbol, Fold(std::move(*value)));
} else if (MaybeExpr converted{
ConvertToType(*symbol, std::move(*value))}) {
result.Add(*symbol, std::move(*converted));
@ -1912,13 +1912,56 @@ const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
std::optional<ProcedureRef> procRef{analyzer.TryDefinedAssignment()};
x.typedAssignment.reset(new GenericAssignmentWrapper{procRef
? Assignment{std::move(*procRef)}
: Assignment{Fold(foldingContext_, analyzer.MoveExpr(0)),
Fold(foldingContext_, analyzer.MoveExpr(1))}});
: Assignment{Assignment::IntrinsicAssignment{
Fold(analyzer.MoveExpr(0)), Fold(analyzer.MoveExpr(1))}}});
}
}
return x.typedAssignment ? &x.typedAssignment->v : nullptr;
}
const Assignment *ExpressionAnalyzer::Analyze(
const parser::PointerAssignmentStmt &x) {
MaybeExpr lhs{Analyze(std::get<parser::DataRef>(x.t))};
MaybeExpr rhs{Analyze(std::get<parser::Expr>(x.t))};
if (!lhs || !rhs) {
return nullptr;
}
Assignment::PointerAssignment assignment{
Fold(std::move(*lhs)), Fold(std::move(*rhs))};
std::visit(
common::visitors{
[&](const std::list<parser::BoundsRemapping> &list) {
if (!list.empty()) {
Assignment::PointerAssignment::BoundsRemapping bounds;
for (const auto &elem : list) {
auto lower{AsSubscript(Analyze(std::get<0>(elem.t)))};
auto upper{AsSubscript(Analyze(std::get<0>(elem.t)))};
if (lower && upper) {
bounds.emplace_back(
Fold(std::move(*lower)), Fold(std::move(*upper)));
}
}
assignment.bounds = bounds;
}
},
[&](const std::list<parser::BoundsSpec> &list) {
if (!list.empty()) {
Assignment::PointerAssignment::BoundsSpec bounds;
for (const auto &bound : list) {
if (auto lower{AsSubscript(Analyze(bound.v))}) {
bounds.emplace_back(Fold(std::move(*lower)));
}
}
assignment.bounds = bounds;
}
},
},
std::get<parser::PointerAssignmentStmt::Bounds>(x.t).u);
x.typedAssignment.reset(
new GenericAssignmentWrapper{Assignment{std::move(assignment)}});
return &x.typedAssignment->v;
}
static bool IsExternalCalledImplicitly(
parser::CharBlock callSite, const ProcedureDesignator &proc) {
if (const auto *symbol{proc.GetSymbol()}) {
@ -2291,8 +2334,7 @@ MaybeExpr ExpressionAnalyzer::ExprOrVariable(const PARSED &x) {
// Analyze the expression in a specified source position context for
// better error reporting.
auto restorer{GetContextualMessages().SetLocation(x.source)};
result = Analyze(x.u);
result = Fold(GetFoldingContext(), std::move(result));
result = evaluate::Fold(foldingContext_, Analyze(x.u));
} else {
result = Analyze(x.u);
}
@ -2329,11 +2371,9 @@ Expr<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(
}
return std::visit(
common::visitors{
[&](const parser::ScalarIntConstantExpr &x)
-> Expr<SubscriptInteger> {
[&](const parser::ScalarIntConstantExpr &x) {
if (MaybeExpr kind{Analyze(x)}) {
Expr<SomeType> folded{
Fold(GetFoldingContext(), std::move(*kind))};
Expr<SomeType> folded{Fold(std::move(*kind))};
if (std::optional<std::int64_t> code{ToInt64(folded)}) {
if (CheckIntrinsicKind(category, *code)) {
return Expr<SubscriptInteger>{*code};
@ -2344,8 +2384,7 @@ Expr<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(
}
return Expr<SubscriptInteger>{defaultKind};
},
[&](const parser::KindSelector::StarSize &x)
-> Expr<SubscriptInteger> {
[&](const parser::KindSelector::StarSize &x) {
std::intmax_t size = x.v;
if (!CheckIntrinsicSize(category, size)) {
size = defaultKind;
@ -2740,8 +2779,7 @@ std::optional<ActualArgument> ArgumentAnalyzer::AnalyzeExpr(
if (const Symbol * assumedTypeDummy{AssumedTypeDummy(expr)}) {
return ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}};
} else if (MaybeExpr argExpr{context_.Analyze(expr)}) {
Expr<SomeType> x{Fold(context_.GetFoldingContext(), std::move(*argExpr))};
return ActualArgument{std::move(x)};
return ActualArgument{context_.Fold(std::move(*argExpr))};
} else {
return std::nullopt;
}
@ -2862,6 +2900,10 @@ const evaluate::Assignment *AnalyzeAssignmentStmt(
SemanticsContext &context, const parser::AssignmentStmt &stmt) {
return evaluate::ExpressionAnalyzer{context}.Analyze(stmt);
}
const evaluate::Assignment *AnalyzePointerAssignmentStmt(
SemanticsContext &context, const parser::PointerAssignmentStmt &stmt) {
return evaluate::ExpressionAnalyzer{context}.Analyze(stmt);
}
ExprChecker::ExprChecker(SemanticsContext &context) : context_{context} {}

View File

@ -185,7 +185,7 @@ public:
GetFoldingContext().messages().SetLocation(FindSourceLocation(x))};
auto result{Analyze(x.thing)};
if (result) {
*result = Fold(GetFoldingContext(), std::move(*result));
*result = Fold(std::move(*result));
if (!IsConstantExpr(*result)) {
SayAt(x, "Must be a constant value"_err_en_US);
ResetExpr(x);
@ -233,6 +233,7 @@ public:
void Analyze(const parser::CallStmt &);
const Assignment *Analyze(const parser::AssignmentStmt &);
const Assignment *Analyze(const parser::PointerAssignmentStmt &);
protected:
int IntegerTypeSpecKind(const parser::IntegerTypeSpec &);
@ -371,6 +372,9 @@ private:
MaybeExpr MakeFunctionRef(
parser::CharBlock, ProcedureDesignator &&, ActualArguments &&);
MaybeExpr MakeFunctionRef(parser::CharBlock intrinsic, ActualArguments &&);
template<typename T> T Fold(T &&expr) {
return evaluate::Fold(foldingContext_, std::move(expr));
}
semantics::SemanticsContext &context_;
FoldingContext &foldingContext_{context_.foldingContext()};
@ -415,6 +419,8 @@ evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
void AnalyzeCallStmt(SemanticsContext &, const parser::CallStmt &);
const evaluate::Assignment *AnalyzeAssignmentStmt(
SemanticsContext &, const parser::AssignmentStmt &);
const evaluate::Assignment *AnalyzePointerAssignmentStmt(
SemanticsContext &, const parser::PointerAssignmentStmt &);
// Semantic analysis of all expressions in a parse tree, which becomes
// decorated with typed representations for top-level expressions.
@ -442,6 +448,10 @@ public:
AnalyzeAssignmentStmt(context_, x);
return false;
}
bool Pre(const parser::PointerAssignmentStmt &x) {
AnalyzePointerAssignmentStmt(context_, x);
return false;
}
template<typename A> bool Pre(const parser::Scalar<A> &x) {
AnalyzeExpr(context_, x);

View File

@ -399,6 +399,11 @@ const evaluate::Assignment *GetAssignment(const parser::AssignmentStmt &x) {
const auto &typed{x.typedAssignment};
return typed ? &typed->v : nullptr;
}
const evaluate::Assignment *GetAssignment(
const parser::PointerAssignmentStmt &x) {
const auto &typed{x.typedAssignment};
return typed ? &typed->v : nullptr;
}
const Symbol *FindInterface(const Symbol &symbol) {
return std::visit(

View File

@ -251,6 +251,8 @@ template<typename T> const SomeExpr *GetExpr(const T &x) {
}
const evaluate::Assignment *GetAssignment(const parser::AssignmentStmt &);
const evaluate::Assignment *GetAssignment(
const parser::PointerAssignmentStmt &);
template<typename T> std::optional<std::int64_t> GetIntValue(const T &x) {
if (const auto *expr{GetExpr(x)}) {

View File

@ -1,10 +1,23 @@
subroutine forall
subroutine forall1
real :: a(9)
!ERROR: 'i' is already declared in this scoping unit
forall (i=1:8, i=1:9) a(i) = i
forall (j=1:8)
!ERROR: 'j' is already declared in this scoping unit
!ERROR: 'j' is already declared in this scoping unit
forall (j=1:9)
end forall
end forall
end subroutine forall
end
subroutine forall2
integer, pointer :: a(:)
integer, target :: b(10,10)
forall (i=1:10)
!ERROR: Impure procedure 'f_impure' may not be referenced in a FORALL
a(f_impure(i):) => b(i,:)
end forall
contains
impure integer function f_impure(i)
f_impure = i
end
end

View File

@ -172,16 +172,7 @@ static Fortran::parser::AnalyzedObjectsAsFortran asFortran{
}
},
[](std::ostream &o, const Fortran::evaluate::GenericAssignmentWrapper &x) {
std::visit(
Fortran::common::visitors{
[&](const Fortran::evaluate::Assignment::IntrinsicAssignment &y) {
y.rhs.AsFortran(y.lhs.AsFortran(o) << '=');
},
[&](const Fortran::evaluate::ProcedureRef &y) {
y.AsFortran(o << "CALL ");
},
},
x.v.u);
x.v.AsFortran(o);
},
[](std::ostream &o, const Fortran::evaluate::ProcedureRef &x) {
x.AsFortran(o << "CALL ");