common::CombineVariants<TypelessExpression, CategoryExpression> u;
};
-// An assignment is either intrinsic (with lhs and rhs) or user-defined,
-// represented as a ProcedureRef. A pointer assignment optionally also has
-// a bounds-spec or bounds-remapping.
+// An assignment is either intrinsic, user-defined (with a ProcedureRef to
+// specify the procedure to call), or pointer assignment (with possibly empty
+// BoundsSpec or non-empty BoundsRemapping). In all cases there are Exprs
+// representing the LHS and RHS of the assignment.
class Assignment {
public:
- UNION_CONSTRUCTORS(Assignment)
- struct IntrinsicAssignment {
- Expr<SomeType> lhs;
- Expr<SomeType> rhs;
- };
- 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;
- };
+ Assignment(Expr<SomeType> &&lhs, Expr<SomeType> &&rhs)
+ : lhs(std::move(lhs)), rhs(std::move(rhs)) {}
+
+ struct Intrinsic {};
+ using BoundsSpec = std::vector<Expr<SubscriptInteger>>;
+ using BoundsRemapping =
+ std::vector<std::pair<Expr<SubscriptInteger>, Expr<SubscriptInteger>>>;
std::ostream &AsFortran(std::ostream &) const;
- std::variant<IntrinsicAssignment, ProcedureRef, PointerAssignment> u;
+
+ Expr<SomeType> lhs;
+ Expr<SomeType> rhs;
+ std::variant<Intrinsic, ProcedureRef, BoundsSpec, BoundsRemapping> u;
};
// This wrapper class is used, by means of a forward reference with
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 Assignment::Intrinsic &) {
+ rhs.AsFortran(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 << " => ");
+ [&](const ProcedureRef &proc) { proc.AsFortran(o << "CALL "); },
+ [&](const BoundsSpec &bounds) {
+ lhs.AsFortran(o);
+ if (!bounds.empty()) {
+ char sep{'('};
+ for (const auto &bound : bounds) {
+ bound.AsFortran(o << sep) << ':';
+ sep = ',';
+ }
+ o << ')';
+ }
+ },
+ [&](const BoundsRemapping &bounds) {
+ lhs.AsFortran(o);
+ if (!bounds.empty()) {
+ char sep{'('};
+ for (const auto &bound : bounds) {
+ bound.first.AsFortran(o << sep) << ':';
+ bound.second.AsFortran(o);
+ sep = ',';
+ }
+ o << ')';
+ }
+ rhs.AsFortran(o << " => ");
},
},
u);
void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
// Assignment statement analysis is in expression.cpp where user-defined
// assignments can be recognized and replaced.
- if (const evaluate::Assignment * asst{GetAssignment(stmt)}) {
- if (const auto *intrinsicAsst{
- std::get_if<evaluate::Assignment::IntrinsicAssignment>(&asst->u)}) {
- CheckForImpureCall(intrinsicAsst->lhs);
- CheckForImpureCall(intrinsicAsst->rhs);
- if (forall_) {
- // TODO: Warn if some name in forall_->activeNames or its outer
- // contexts does not appear on LHS
- }
- CheckForPureContext(intrinsicAsst->lhs, intrinsicAsst->rhs,
- std::get<parser::Expr>(stmt.t).source, false /* not => */);
+ if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) {
+ CheckForImpureCall(assignment->lhs);
+ CheckForImpureCall(assignment->rhs);
+ if (forall_) {
+ // TODO: Warn if some name in forall_->activeNames or its outer
+ // contexts does not appear on LHS
}
+ CheckForPureContext(assignment->lhs, assignment->rhs,
+ std::get<parser::Expr>(stmt.t).source, false /* not => */);
}
// TODO: Fortran 2003 ALLOCATABLE assignment semantics (automatic
// (re)allocation of LHS array when unallocated or nonconformable)
}
void AssignmentContext::Analyze(const parser::PointerAssignmentStmt &stmt) {
- using PointerAssignment = evaluate::Assignment::PointerAssignment;
CHECK(!where_);
- const evaluate::Assignment *assign{GetAssignment(stmt)};
- if (!assign) {
+ const evaluate::Assignment *assignment{GetAssignment(stmt)};
+ if (!assignment) {
return;
}
- const auto &ptrAssign{std::get<PointerAssignment>(assign->u)};
- const SomeExpr &lhs{ptrAssign.lhs};
- const SomeExpr &rhs{ptrAssign.rhs};
+ const SomeExpr &lhs{assignment->lhs};
+ const SomeExpr &rhs{assignment->rhs};
CheckForImpureCall(lhs);
CheckForImpureCall(rhs);
std::visit(
- common::visitors{
- [&](const PointerAssignment::BoundsSpec &bounds) {
- for (const auto &bound : bounds) {
- CheckForImpureCall(SomeExpr{bound});
- }
- },
- [&](const PointerAssignment::BoundsRemapping &bounds) {
+ common::visitors{[&](const evaluate::Assignment::BoundsSpec &bounds) {
+ for (const auto &bound : bounds) {
+ CheckForImpureCall(SomeExpr{bound});
+ }
+ },
+ [&](const evaluate::Assignment::BoundsRemapping &bounds) {
for (const auto &bound : bounds) {
CheckForImpureCall(SomeExpr{bound.first});
CheckForImpureCall(SomeExpr{bound.second});
}
},
- },
- ptrAssign.bounds);
+ [](const auto &) { DIE("not valid for pointer assignment"); }},
+ assignment->u);
if (forall_) {
// TODO: Warn if some name in forall_->activeNames or its outer
// contexts does not appear on LHS
true /* isPointerAssignment */);
auto restorer{context_.foldingContext().messages().SetLocation(
context_.location().value())};
- CheckPointerAssignment(context_.foldingContext(), ptrAssign);
+ CheckPointerAssignment(context_.foldingContext(), *assignment);
}
void AssignmentContext::Analyze(const parser::WhereStmt &stmt) {
x.typedAssignment.reset(new GenericAssignmentWrapper{});
} else {
std::optional<ProcedureRef> procRef{analyzer.TryDefinedAssignment()};
- x.typedAssignment.reset(new GenericAssignmentWrapper{procRef
- ? Assignment{std::move(*procRef)}
- : Assignment{Assignment::IntrinsicAssignment{
- Fold(analyzer.MoveExpr(0)), Fold(analyzer.MoveExpr(1))}}});
+ Assignment assignment{
+ Fold(analyzer.MoveExpr(0)), Fold(analyzer.MoveExpr(1))};
+ if (procRef) {
+ assignment.u = std::move(*procRef);
+ }
+ x.typedAssignment.reset(
+ new GenericAssignmentWrapper{std::move(assignment)});
}
}
return common::GetPtrFromOptional(x.typedAssignment->v);
if (!x.typedAssignment) {
MaybeExpr lhs{Analyze(std::get<parser::DataRef>(x.t))};
MaybeExpr rhs{Analyze(std::get<parser::Expr>(x.t))};
- decltype(Assignment::PointerAssignment::bounds) pointerBounds;
- std::visit(
- common::visitors{
- [&](const std::list<parser::BoundsRemapping> &list) {
- if (!list.empty()) {
- Assignment::PointerAssignment::BoundsRemapping bounds;
+ if (!lhs || !rhs) {
+ x.typedAssignment.reset(new GenericAssignmentWrapper{});
+ } else {
+ Assignment assignment{std::move(*lhs), std::move(*rhs)};
+ std::visit(
+ common::visitors{
+ [&](const std::list<parser::BoundsRemapping> &list) {
+ Assignment::BoundsRemapping bounds;
for (const auto &elem : list) {
auto lower{AsSubscript(Analyze(std::get<0>(elem.t)))};
auto upper{AsSubscript(Analyze(std::get<1>(elem.t)))};
Fold(std::move(*lower)), Fold(std::move(*upper)));
}
}
- pointerBounds = bounds;
- }
- },
- [&](const std::list<parser::BoundsSpec> &list) {
- if (!list.empty()) {
- Assignment::PointerAssignment::BoundsSpec bounds;
+ assignment.u = std::move(bounds);
+ },
+ [&](const std::list<parser::BoundsSpec> &list) {
+ Assignment::BoundsSpec bounds;
for (const auto &bound : list) {
if (auto lower{AsSubscript(Analyze(bound.v))}) {
bounds.emplace_back(Fold(std::move(*lower)));
}
}
- pointerBounds = bounds;
- }
- },
- },
- std::get<parser::PointerAssignmentStmt::Bounds>(x.t).u);
- if (!lhs || !rhs) {
- x.typedAssignment.reset(new GenericAssignmentWrapper{});
- } else {
- Assignment::PointerAssignment assignment{
- Fold(std::move(*lhs)), Fold(std::move(*rhs))};
- assignment.bounds = pointerBounds;
+ assignment.u = std::move(bounds);
+ },
+ },
+ std::get<parser::PointerAssignmentStmt::Bounds>(x.t).u);
x.typedAssignment.reset(
- new GenericAssignmentWrapper{Assignment{std::move(assignment)}});
+ new GenericAssignmentWrapper{std::move(assignment)});
}
}
return common::GetPtrFromOptional(x.typedAssignment->v);
}
}
if (proc) {
- actuals_[1]->Parenthesize();
- return ProcedureRef{ProcedureDesignator{*proc}, std::move(actuals_)};
+ ActualArguments actualsCopy{actuals_};
+ actualsCopy[1]->Parenthesize();
+ return ProcedureRef{ProcedureDesignator{*proc}, std::move(actualsCopy)};
} else {
return std::nullopt;
}
using evaluate::characteristics::TypeAndShape;
using parser::MessageFixedText;
using parser::MessageFormattedText;
-using PointerAssignment = evaluate::Assignment::PointerAssignment;
class PointerAssignmentChecker {
public:
// Verify that any bounds on the LHS of a pointer assignment are valid.
// Return true if it is a bound-remapping so we can perform further checks.
static bool CheckPointerBounds(
- evaluate::FoldingContext &context, const PointerAssignment &assignment) {
+ evaluate::FoldingContext &context, const evaluate::Assignment &assignment) {
auto &messages{context.messages()};
const SomeExpr &lhs{assignment.lhs};
const SomeExpr &rhs{assignment.rhs};
bool isBoundsRemapping{false};
std::size_t numBounds{std::visit(
common::visitors{
- [&](const PointerAssignment::BoundsSpec &bounds) {
+ [&](const evaluate::Assignment::BoundsSpec &bounds) {
return bounds.size();
},
- [&](const PointerAssignment::BoundsRemapping &bounds) {
+ [&](const evaluate::Assignment::BoundsRemapping &bounds) {
isBoundsRemapping = true;
evaluate::ExtentExpr lhsSizeExpr{1};
for (const auto &bound : bounds) {
}
return bounds.size();
},
+ [](const auto &) -> std::size_t {
+ DIE("not valid for pointer assignment");
+ },
},
- assignment.bounds)};
+ assignment.u)};
if (numBounds > 0) {
if (lhs.Rank() != static_cast<int>(numBounds)) {
messages.Say("Pointer '%s' has rank %d but the number of bounds specified"
}
void CheckPointerAssignment(
- evaluate::FoldingContext &context, const PointerAssignment &assignment) {
+ evaluate::FoldingContext &context, const evaluate::Assignment &assignment) {
const SomeExpr &lhs{assignment.lhs};
const SomeExpr &rhs{assignment.rhs};
const Symbol *pointer{GetLastSymbol(lhs)};
class Symbol;
-void CheckPointerAssignment(evaluate::FoldingContext &,
- const evaluate::Assignment::PointerAssignment &);
+void CheckPointerAssignment(
+ evaluate::FoldingContext &, const evaluate::Assignment &);
void CheckPointerAssignment(
evaluate::FoldingContext &, const Symbol &lhs, const SomeExpr &rhs);
void CheckPointerAssignment(evaluate::FoldingContext &,
projects / platform / upstream / llvm.git / commitdiff