target_link_libraries(FortranEvaluate
FortranCommon
+ FortranSemantics
)
// IsFoldableTrait.
CLASS_TRAIT(IsFoldableTrait)
struct FoldingContext {
- explicit FoldingContext(parser::ContextualMessages &m,
+ explicit FoldingContext(const parser::ContextualMessages &m,
Rounding round = defaultRounding, bool flush = false)
: messages{m}, rounding{round}, flushDenormalsToZero{flush} {}
- FoldingContext(parser::ContextualMessages &m, const FoldingContext &c)
+ FoldingContext(const parser::ContextualMessages &m, const FoldingContext &c)
: messages{m}, rounding{c.rounding}, flushDenormalsToZero{
c.flushDenormalsToZero} {}
- parser::ContextualMessages &messages;
+ // For narrowed contexts
+ FoldingContext(const FoldingContext &c, const parser::ContextualMessages &m)
+ : messages{m}, rounding{c.rounding}, flushDenormalsToZero{
+ c.flushDenormalsToZero} {}
+
+ parser::ContextualMessages messages;
Rounding rounding{defaultRounding};
bool flushDenormalsToZero{false};
};
Expr<SomeType>::~Expr() {}
+// Rank()
+template<typename A> int ExpressionBase<A>::Rank() const {
+ return std::visit(
+ common::visitors{[](const BOZLiteralConstant &) { return 0; },
+ [](const auto &x) { return x.Rank(); }},
+ derived().u);
+}
+
// Template instantiations to resolve the "extern template" declarations
// that appear in expression.h.
// Wraps a constant value in a class with its resolved type.
template<typename T> struct Constant {
using Result = T;
- using Value = Scalar<Result>; // TODO rank > 0
+ using Value = Scalar<Result>;
CLASS_BOILERPLATE(Constant)
template<typename A> Constant(const A &x) : value{x} {}
template<typename A>
Constant(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
: value(std::move(x)) {}
+ int Rank() const { return 0; }
std::ostream &Dump(std::ostream &) const;
Value value;
};
template<typename T> struct FunctionReference {
using Result = T;
static_assert(Result::isSpecificType);
+ int Rank() const { return reference->Rank(); }
CopyableIndirection<FunctionRef> reference;
};
}
}
+ int Rank() const {
+ int rank{left().Rank()};
+ if constexpr (operands > 1) {
+ int rightRank{right().Rank()};
+ if (rightRank > rank) {
+ rank = rightRank;
+ }
+ }
+ return rank;
+ }
+
std::ostream &Dump(std::ostream &) const;
std::optional<Constant<Result>> Fold(FoldingContext &);
Derived &derived() { return *static_cast<Derived *>(this); }
const Derived &derived() const { return *static_cast<const Derived *>(this); }
- int Rank() const { return 0; } // TODO
-
template<typename A> Derived &operator=(const A &x) {
Derived &d{derived()};
d.u = x;
return d;
}
+ int Rank() const;
std::ostream &Dump(std::ostream &) const;
std::optional<Constant<Result>> Fold(FoldingContext &c);
std::optional<Scalar<Result>> ScalarValue() const;
public:
using Result = LogicalResult;
EVALUATE_UNION_CLASS_BOILERPLATE(Relational)
+ int Rank() const {
+ return std::visit([](const auto &x) { return x.Rank(); }, u);
+ }
std::ostream &Dump(std::ostream &o) const;
common::MapTemplate<Relational, DirectlyComparableTypes> u;
};
u);
}
+// Rank()
+int Component::Rank() const { return symbol_->Rank(); }
+int Subscript::Rank() const {
+ return std::visit(common::visitors{[](const IndirectSubscriptIntegerExpr &x) {
+ int rank{x->Rank()};
+ CHECK(rank <= 1);
+ return rank;
+ },
+ [](const Triplet &) { return 1; }},
+ u);
+}
+int ArrayRef::Rank() const {
+ int rank{0};
+ for (std::size_t j{0}; j < subscript.size(); ++j) {
+ rank += subscript[j].Rank();
+ }
+ return rank;
+}
+int CoarrayRef::Rank() const {
+ int rank{0};
+ for (std::size_t j{0}; j < subscript_.size(); ++j) {
+ rank += subscript_[j].Rank();
+ }
+ return rank;
+}
+int DataRef::Rank() const {
+ return std::visit(
+ common::visitors{[](const Symbol *sym) { return sym->Rank(); },
+ [](const auto &x) { return x.Rank(); }},
+ u);
+}
+int Substring::Rank() const {
+ return std::visit(common::visitors{[](const std::string &) { return 0; },
+ [](const auto &x) { return x.Rank(); }},
+ u_);
+}
+int ComplexPart::Rank() const { return complex_.Rank(); }
+template<> int FunctionRef::Rank() const {
+ // TODO: Rank of elemental function reference depends on actual arguments
+ return std::visit(
+ common::visitors{[](IntrinsicProcedure) { return 0 /*TODO!!*/; },
+ [](const Symbol *sym) { return sym->Rank(); },
+ [](const Component &c) { return c.symbol().Rank(); }},
+ proc().u);
+}
+int Variable::Rank() const {
+ return std::visit([](const auto &x) { return x.Rank(); }, u);
+}
+int ActualFunctionArg::Rank() const {
+ return std::visit(
+ common::visitors{[](const CopyableIndirection<Expr<SomeType>> &x) {
+ return x->Rank();
+ },
+ [](const auto &x) { return x.Rank(); }},
+ u);
+}
+int ActualSubroutineArg::Rank() const {
+ return std::visit(
+ common::visitors{[](const CopyableIndirection<Expr<SomeType>> &x) {
+ return x->Rank();
+ },
+ [](const Label *) { return 0; },
+ [](const auto &x) { return x.Rank(); }},
+ u);
+}
+
template class Designator<Type<TypeCategory::Character, 1>>;
template class Designator<Type<TypeCategory::Character, 2>>;
template class Designator<Type<TypeCategory::Character, 4>>;
// R913 structure-component & C920: Defined to be a multi-part
// data-ref whose last part has no subscripts (or image-selector, although
// that isn't explicit in the document). Pointer and allocatable components
-// are not explicitly indirected in this representation.
+// are not explicitly indirected in this representation (TODO: yet?)
// Complex components (%RE, %IM) are isolated below in ComplexPart.
class Component {
public:
const DataRef &base() const { return *base_; }
DataRef &base() { return *base_; }
const Symbol &symbol() const { return *symbol_; }
+ int Rank() const;
Expr<SubscriptInteger> LEN() const;
std::ostream &Dump(std::ostream &) const;
EVALUATE_UNION_CLASS_BOILERPLATE(Subscript)
explicit Subscript(Expr<SubscriptInteger> &&s)
: u{IndirectSubscriptIntegerExpr::Make(std::move(s))} {}
+ int Rank() const;
std::ostream &Dump(std::ostream &) const;
std::variant<IndirectSubscriptIntegerExpr, Triplet> u;
};
: u{&n}, subscript(std::move(ss)) {}
ArrayRef(Component &&c, std::vector<Subscript> &&ss)
: u{std::move(c)}, subscript(std::move(ss)) {}
+
+ int Rank() const;
Expr<SubscriptInteger> LEN() const;
std::ostream &Dump(std::ostream &) const;
std::vector<Expr<SubscriptInteger>> &&); // TODO: stat & team?
CoarrayRef &setStat(Variable &&);
CoarrayRef &setTeam(Variable &&, bool isTeamNumber = false);
+ int Rank() const;
Expr<SubscriptInteger> LEN() const;
std::ostream &Dump(std::ostream &) const;
struct DataRef {
EVALUATE_UNION_CLASS_BOILERPLATE(DataRef)
explicit DataRef(const Symbol &n) : u{&n} {}
+
+ int Rank() const;
Expr<SubscriptInteger> LEN() const;
std::ostream &Dump(std::ostream &) const;
Expr<SubscriptInteger> first() const;
Expr<SubscriptInteger> last() const;
+ int Rank() const;
Expr<SubscriptInteger> LEN() const;
std::optional<std::string> Fold(FoldingContext &);
std::ostream &Dump(std::ostream &) const;
ComplexPart(DataRef &&z, Part p) : complex_{std::move(z)}, part_{p} {}
const DataRef &complex() const { return complex_; }
Part part() const { return part_; }
+ int Rank() const;
std::ostream &Dump(std::ostream &) const;
private:
return *this;
}
+ int Rank() const {
+ return std::visit(
+ common::visitors{[](const Symbol *sym) { return sym->Rank(); },
+ [](const auto &x) { return x.Rank(); }},
+ u);
+ }
+
Expr<SubscriptInteger> LEN() const;
+
std::ostream &Dump(std::ostream &o) const {
std::visit(common::visitors{[&](const Symbol *sym) {
o << sym->name().ToString();
Expr<SubscriptInteger> LEN() const;
std::ostream &Dump(std::ostream &) const;
-private:
std::variant<IntrinsicProcedure, const Symbol *, Component> u;
};
: proc_{std::move(p)}, argument_(std::move(a)) {}
const ProcedureDesignator &proc() const { return proc_; }
const std::vector<ArgumentType> &argument() const { return argument_; }
+ int Rank() const;
std::ostream &Dump(std::ostream &) const;
private:
struct Variable {
EVALUATE_UNION_CLASS_BOILERPLATE(Variable)
+ int Rank() const;
std::ostream &Dump(std::ostream &) const;
std::variant<DataRef, Substring, ComplexPart, FunctionRef> u;
};
struct ActualFunctionArg {
EVALUATE_UNION_CLASS_BOILERPLATE(ActualFunctionArg)
explicit ActualFunctionArg(Expr<SomeType> &&x) : u{std::move(x)} {}
+ int Rank() const;
std::ostream &Dump(std::ostream &) const;
// Subtlety: There is a distinction to be respected here between a variable
EVALUATE_UNION_CLASS_BOILERPLATE(ActualSubroutineArg)
explicit ActualSubroutineArg(Expr<SomeType> &&x) : u{std::move(x)} {}
explicit ActualSubroutineArg(const Label &l) : u{&l} {}
+ int Rank() const;
std::ostream &Dump(std::ostream &) const;
public:
// R1002 level-1-expr -> [defined-unary-op] primary
// TODO: Reasonable extension: permit multiple defined-unary-ops
-constexpr auto level1Expr{first(
+constexpr auto level1Expr{sourced(first(
construct<Expr>(construct<Expr::DefinedUnary>(definedOpName, primary)),
primary,
extension<LanguageFeature::SignedPrimary>(
construct<Expr>(construct<Expr::UnaryPlus>("+" >> primary))),
extension<LanguageFeature::SignedPrimary>(
- construct<Expr>(construct<Expr::Negate>("-" >> primary))))};
+ construct<Expr>(construct<Expr::Negate>("-" >> primary)))))};
// R1004 mult-operand -> level-1-expr [power-op mult-operand]
// R1007 power-op -> **
// Exponentiation (**) is Fortran's only right-associative binary operation.
-constexpr struct MultOperand {
+struct MultOperand {
using resultType = Expr;
constexpr MultOperand() {}
static inline std::optional<Expr> Parse(ParseState &);
-} multOperand;
+};
+
+static constexpr auto multOperand{sourced(MultOperand{})};
inline std::optional<Expr> MultOperand::Parse(ParseState &state) {
std::optional<Expr> result{level1Expr.Parse(state)};
std::function<Expr(Expr &&)> power{[&result](Expr &&right) {
return Expr{Expr::Power(std::move(result).value(), std::move(right))};
}};
- return applyLambda(power, multOperand).Parse(state); // right-recursive
+ return sourced(applyLambda(power, multOperand))
+ .Parse(state); // right-recursive
}
}
return result;
std::function<Expr(Expr &&)> multiply{[&result](Expr &&right) {
return Expr{
Expr::Multiply(std::move(result).value(), std::move(right))};
- }},
- divide{[&result](Expr &&right) {
- return Expr{
- Expr::Divide(std::move(result).value(), std::move(right))};
- }};
- auto more{"*" >> applyLambda(multiply, multOperand) ||
- "/" >> applyLambda(divide, multOperand)};
- while (std::optional<Expr> next{attempt(more).Parse(state)}) {
+ }};
+ std::function<Expr(Expr &&)> divide{[&result](Expr &&right) {
+ return Expr{Expr::Divide(std::move(result).value(), std::move(right))};
+ }};
+ auto more{attempt(sourced("*" >> applyLambda(multiply, multOperand) ||
+ "/" >> applyLambda(divide, multOperand)))};
+ while (std::optional<Expr> next{more.Parse(state)}) {
result = std::move(next);
}
}
constexpr Level2Expr() {}
static inline std::optional<Expr> Parse(ParseState &state) {
static constexpr auto unary{
- construct<Expr>(construct<Expr::UnaryPlus>("+" >> addOperand)) ||
- construct<Expr>(construct<Expr::Negate>("-" >> addOperand)) ||
+ sourced(
+ construct<Expr>(construct<Expr::UnaryPlus>("+" >> addOperand)) ||
+ construct<Expr>(construct<Expr::Negate>("-" >> addOperand))) ||
addOperand};
std::optional<Expr> result{unary.Parse(state)};
if (result) {
std::function<Expr(Expr &&)> add{[&result](Expr &&right) {
return Expr{Expr::Add(std::move(result).value(), std::move(right))};
- }},
- subtract{[&result](Expr &&right) {
- return Expr{
- Expr::Subtract(std::move(result).value(), std::move(right))};
- }};
- auto more{"+" >> applyLambda(add, addOperand) ||
- "-" >> applyLambda(subtract, addOperand)};
- while (std::optional<Expr> next{attempt(more).Parse(state)}) {
+ }};
+ std::function<Expr(Expr &&)> subtract{[&result](Expr &&right) {
+ return Expr{
+ Expr::Subtract(std::move(result).value(), std::move(right))};
+ }};
+ auto more{attempt(sourced("+" >> applyLambda(add, addOperand) ||
+ "-" >> applyLambda(subtract, addOperand)))};
+ while (std::optional<Expr> next{more.Parse(state)}) {
result = std::move(next);
}
}
std::function<Expr(Expr &&)> concat{[&result](Expr &&right) {
return Expr{Expr::Concat(std::move(result).value(), std::move(right))};
}};
- auto more{"//" >> applyLambda(concat, level2Expr)};
- while (std::optional<Expr> next{attempt(more).Parse(state)}) {
+ auto more{attempt(sourced("//" >> applyLambda(concat, level2Expr)))};
+ while (std::optional<Expr> next{more.Parse(state)}) {
result = std::move(next);
}
}
if (result) {
std::function<Expr(Expr &&)> lt{[&result](Expr &&right) {
return Expr{Expr::LT(std::move(result).value(), std::move(right))};
- }},
- le{[&result](Expr &&right) {
- return Expr{Expr::LE(std::move(result).value(), std::move(right))};
- }},
- eq{[&result](Expr &&right) {
- return Expr{Expr::EQ(std::move(result).value(), std::move(right))};
- }},
- ne{[&result](Expr &&right) {
- return Expr{Expr::NE(std::move(result).value(), std::move(right))};
- }},
- ge{[&result](Expr &&right) {
- return Expr{Expr::GE(std::move(result).value(), std::move(right))};
- }},
- gt{[&result](Expr &&right) {
- return Expr{Expr::GT(std::move(result).value(), std::move(right))};
- }};
- auto more{(".LT."_tok || "<"_tok) >> applyLambda(lt, level3Expr) ||
- (".LE."_tok || "<="_tok) >> applyLambda(le, level3Expr) ||
- (".EQ."_tok || "=="_tok) >> applyLambda(eq, level3Expr) ||
- (".NE."_tok || "/="_tok ||
- extension<LanguageFeature::AlternativeNE>(
- "<>"_tok /* PGI/Cray extension; Cray also has .LG. */)) >>
- applyLambda(ne, level3Expr) ||
- (".GE."_tok || ">="_tok) >> applyLambda(ge, level3Expr) ||
- (".GT."_tok || ">"_tok) >> applyLambda(gt, level3Expr)};
- if (std::optional<Expr> next{attempt(more).Parse(state)}) {
+ }};
+ std::function<Expr(Expr &&)> le{[&result](Expr &&right) {
+ return Expr{Expr::LE(std::move(result).value(), std::move(right))};
+ }};
+ std::function<Expr(Expr &&)> eq{[&result](Expr &&right) {
+ return Expr{Expr::EQ(std::move(result).value(), std::move(right))};
+ }};
+ std::function<Expr(Expr &&)> ne{[&result](Expr &&right) {
+ return Expr{Expr::NE(std::move(result).value(), std::move(right))};
+ }};
+ std::function<Expr(Expr &&)> ge{[&result](Expr &&right) {
+ return Expr{Expr::GE(std::move(result).value(), std::move(right))};
+ }};
+ std::function<Expr(Expr &&)> gt{[&result](Expr &&right) {
+ return Expr{Expr::GT(std::move(result).value(), std::move(right))};
+ }};
+ auto more{attempt(
+ sourced((".LT."_tok || "<"_tok) >> applyLambda(lt, level3Expr) ||
+ (".LE."_tok || "<="_tok) >> applyLambda(le, level3Expr) ||
+ (".EQ."_tok || "=="_tok) >> applyLambda(eq, level3Expr) ||
+ (".NE."_tok || "/="_tok ||
+ extension<LanguageFeature::AlternativeNE>(
+ "<>"_tok /* PGI/Cray extension; Cray also has .LG. */)) >>
+ applyLambda(ne, level3Expr) ||
+ (".GE."_tok || ">="_tok) >> applyLambda(ge, level3Expr) ||
+ (".GT."_tok || ">"_tok) >> applyLambda(gt, level3Expr)))};
+ if (std::optional<Expr> next{more.Parse(state)}) {
return next;
}
}
std::function<Expr(Expr &&)> logicalAnd{[&result](Expr &&right) {
return Expr{Expr::AND(std::move(result).value(), std::move(right))};
}};
- auto more{".AND." >> applyLambda(logicalAnd, andOperand)};
- while (std::optional<Expr> next{attempt(more).Parse(state)}) {
+ auto more{
+ attempt(sourced(".AND." >> applyLambda(logicalAnd, andOperand)))};
+ while (std::optional<Expr> next{more.Parse(state)}) {
result = std::move(next);
}
}
std::function<Expr(Expr &&)> logicalOr{[&result](Expr &&right) {
return Expr{Expr::OR(std::move(result).value(), std::move(right))};
}};
- auto more{".OR." >> applyLambda(logicalOr, orOperand)};
- while (std::optional<Expr> next{attempt(more).Parse(state)}) {
+ auto more{attempt(sourced(".OR." >> applyLambda(logicalOr, orOperand)))};
+ while (std::optional<Expr> next{more.Parse(state)}) {
result = std::move(next);
}
}
if (result) {
std::function<Expr(Expr &&)> eqv{[&result](Expr &&right) {
return Expr{Expr::EQV(std::move(result).value(), std::move(right))};
- }},
- neqv{[&result](Expr &&right) {
- return Expr{
- Expr::NEQV(std::move(result).value(), std::move(right))};
- }},
- logicalXor{[&result](Expr &&right) {
- return Expr{Expr::XOR(std::move(result).value(), std::move(right))};
- }};
- auto more{".EQV." >> applyLambda(eqv, equivOperand) ||
+ }};
+ std::function<Expr(Expr &&)> neqv{[&result](Expr &&right) {
+ return Expr{Expr::NEQV(std::move(result).value(), std::move(right))};
+ }};
+ std::function<Expr(Expr &&)> logicalXor{[&result](Expr &&right) {
+ return Expr{Expr::XOR(std::move(result).value(), std::move(right))};
+ }};
+ auto more{attempt(sourced(".EQV." >> applyLambda(eqv, equivOperand) ||
".NEQV." >> applyLambda(neqv, equivOperand) ||
extension<LanguageFeature::XOROperator>(
- ".XOR." >> applyLambda(logicalXor, equivOperand))};
- while (std::optional<Expr> next{attempt(more).Parse(state)}) {
+ ".XOR." >> applyLambda(logicalXor, equivOperand))))};
+ while (std::optional<Expr> next{more.Parse(state)}) {
result = std::move(next);
}
}
return Expr{Expr::DefinedBinary(
std::move(op), std::move(result).value(), std::move(right))};
}};
- auto more{applyLambda(defBinOp, definedOpName, level5Expr)};
- while (std::optional<Expr> next{attempt(more).Parse(state)}) {
+ auto more{
+ attempt(sourced(applyLambda(defBinOp, definedOpName, level5Expr)))};
+ while (std::optional<Expr> next{more.Parse(state)}) {
result = std::move(next);
}
}
explicit Expr(FunctionReference &&);
// Filled in later during semantic analysis of the expression.
+ // TODO: May be temporary; remove if caching no longer required.
common::OwningPointer<evaluate::GenericExprWrapper> typedExpr;
+ CharBlock source;
std::variant<common::Indirection<CharLiteralConstantSubstring>,
LiteralConstant, common::Indirection<Designator>, ArrayConstructor,
return std::nullopt;
}
+// If a generic expression simply wraps a DataRef, extract it.
+// TODO: put in tools.h?
+template<typename A> std::optional<DataRef> ExtractDataRef(A &&) {
+ return std::nullopt;
+}
+
+template<typename A> std::optional<DataRef> ExtractDataRef(Designator<A> &&d) {
+ return std::visit(
+ [](auto &&x) -> std::optional<DataRef> {
+ using Ty = std::decay_t<decltype(x)>;
+ if constexpr (common::HasMember<Ty, decltype(DataRef::u)>) {
+ return {DataRef{std::move(x)}};
+ }
+ return std::nullopt;
+ },
+ std::move(d.u));
+}
+
+template<TypeCategory CAT, int KIND>
+std::optional<DataRef> ExtractDataRef(Expr<Type<CAT, KIND>> &&expr) {
+ using Ty = ResultType<decltype(expr)>;
+ if (auto *designator{std::get_if<Designator<Ty>>(&expr.u)}) {
+ return ExtractDataRef(std::move(*designator));
+ } else {
+ return std::nullopt;
+ }
+}
+
+template<TypeCategory CAT>
+std::optional<DataRef> ExtractDataRef(Expr<SomeKind<CAT>> &&expr) {
+ return std::visit(
+ [](auto &&specificExpr) {
+ return ExtractDataRef(std::move(specificExpr));
+ },
+ std::move(expr.u));
+}
+
+template<> std::optional<DataRef> ExtractDataRef(Expr<SomeType> &&expr) {
+ return std::visit(
+ common::visitors{[](BOZLiteralConstant &&) -> std::optional<DataRef> {
+ return std::nullopt;
+ },
+ [](auto &&catExpr) { return ExtractDataRef(std::move(catExpr)); }},
+ std::move(expr.u));
+}
+
+template<typename A>
+std::optional<DataRef> ExtractDataRef(std::optional<A> &&x) {
+ if (x.has_value()) {
+ return ExtractDataRef(std::move(*x));
+ }
+ return std::nullopt;
+}
+
// This local class wraps some state and a highly overloaded Analyze()
// member function that converts parse trees into (usually) generic
// expressions.
FoldingContext &ctx, const semantics::IntrinsicTypeDefaultKinds &dfts)
: context{ctx}, defaults{dfts} {}
+ ExprAnalyzer(const ExprAnalyzer &that, const parser::CharBlock &source)
+ : context{that.context,
+ parser::ContextualMessages{source, that.context.messages}},
+ defaults{that.defaults} {}
+
MaybeExpr Analyze(const parser::Expr &);
MaybeExpr Analyze(const parser::CharLiteralConstantSubstring &);
MaybeExpr Analyze(const parser::LiteralConstant &);
const std::optional<parser::Subscript> &);
MaybeExpr Subscripts(const Symbol &, ArrayRef &&);
- FoldingContext &context;
+ void ComponentRankCheck(const Component &);
+
+ FoldingContext context;
const semantics::IntrinsicTypeDefaultKinds &defaults;
};
template<typename A>
MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const parser::Scalar<A> &x) {
- // TODO: check rank == 0
- return AnalyzeHelper(ea, x.thing);
+ if (MaybeExpr result{AnalyzeHelper(ea, x.thing)}) {
+ int rank{result->Rank()};
+ if (rank > 0) {
+ ea.context.messages.Say(
+ "expression must be scalar, but has rank %d"_err_en_US, rank);
+ }
+ }
+ return std::nullopt;
}
template<typename A>
return AnalyzeHelper(ea, *x);
}
+template<>
+MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const parser::Designator &d) {
+ // These check have to be deferred to these "top level" data-refs where
+ // we can be sure that there are no following subscripts.
+ if (MaybeExpr result{AnalyzeHelper(ea, d.u)}) {
+ if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(result))}) {
+ if (Component * component{std::get_if<Component>(&dataRef->u)}) {
+ ea.ComponentRankCheck(*component);
+ } else if (const Symbol **symbol{
+ std::get_if<const Symbol *>(&dataRef->u)}) {
+ // TODO: Whole array reference: append : subscripts, enforce C1002
+ // Possibly use EA::Subscripts() below.
+ }
+ }
+ return result;
+ }
+ return std::nullopt;
+}
+
+// Analyze something with source provenance
+template<typename A> MaybeExpr AnalyzeSourced(ExprAnalyzer &ea, const A &x) {
+ if (!x.source.empty()) {
+ ExprAnalyzer nestedAnalyzer{ea, x.source};
+ return AnalyzeHelper(nestedAnalyzer, x);
+ } else {
+ return AnalyzeHelper(ea, x);
+ }
+}
+
// Implementations of ExprAnalyzer::Analyze follow for various parse tree
// node types.
MaybeExpr ExprAnalyzer::Analyze(const parser::Expr &x) {
- return AnalyzeHelper(*this, x);
+ return AnalyzeSourced(*this, x);
}
int ExprAnalyzer::Analyze(const std::optional<parser::KindParam> &kindParam,
MaybeExpr ExprAnalyzer::Analyze(const parser::Substring &ss) {
context.messages.Say("TODO: Substring unimplemented"_err_en_US);
+ // TODO: be sure to run ComponentRankCheck() here on base of substring if
+ // it's a Component.
return std::nullopt;
}
if (expr.has_value()) {
if (auto *intExpr{std::get_if<Expr<SomeInteger>>(&expr->u)}) {
if (auto *ssIntExpr{std::get_if<Expr<SubscriptInteger>>(&intExpr->u)}) {
+ int rank{ssIntExpr->Rank()};
+ if (rank > 1) {
+ context.messages.Say(
+ "subscript expression has rank %d"_err_en_US, rank);
+ return std::nullopt;
+ }
return {std::move(*ssIntExpr)};
}
return {Expr<SubscriptInteger>{
std::vector<Subscript> ExprAnalyzer::Analyze(
const std::list<parser::SectionSubscript> &sss) {
+ // TODO: enforce restrictions on vector-valued subscripts
std::vector<Subscript> subscripts;
for (const auto &s : sss) {
if (auto subscript{Analyze(s)}) {
return subscripts;
}
-// If a generic expression represents a DataRef, convert it to one.
-// TODO: put in tools.h?
-template<typename A> std::optional<DataRef> AsDataRef(A &&) {
- return std::nullopt;
-}
-
-template<TypeCategory CAT, int KIND>
-std::optional<DataRef> AsDataRef(Expr<Type<CAT, KIND>> &&expr) {
- using Ty = ResultType<decltype(expr)>;
- if (auto *designator{std::get_if<Designator<Ty>>(&expr.u)}) {
- return std::visit(
- [](auto &&x) -> std::optional<DataRef> {
- using Ty = std::decay_t<decltype(x)>;
- if constexpr (common::HasMember<Ty, decltype(DataRef::u)>) {
- return {DataRef{std::move(x)}};
- }
- return std::nullopt;
- },
- std::move(designator->u));
- } else {
- return std::nullopt;
+MaybeExpr ExprAnalyzer::Subscripts(const Symbol &symbol, ArrayRef &&ref) {
+ int symbolRank{symbol.Rank()};
+ if (ref.subscript.empty()) {
+ // A -> A(:,:)
+ for (int j{0}; j < symbolRank; ++j) {
+ ref.subscript.emplace_back(Subscript{Triplet{}});
+ }
}
-}
-
-template<TypeCategory CAT>
-std::optional<DataRef> AsDataRef(Expr<SomeKind<CAT>> &&expr) {
- return std::visit(
- [](auto &&specificExpr) { return AsDataRef(std::move(specificExpr)); },
- std::move(expr.u));
-}
-
-template<> std::optional<DataRef> AsDataRef(Expr<SomeType> &&expr) {
- return std::visit(
- common::visitors{[](BOZLiteralConstant &&) -> std::optional<DataRef> {
- return std::nullopt;
- },
- [](auto &&catExpr) { return AsDataRef(std::move(catExpr)); }},
- std::move(expr.u));
-}
-
-template<typename A> std::optional<DataRef> AsDataRef(std::optional<A> &&x) {
- if (x.has_value()) {
- return AsDataRef(std::move(*x));
+ int subscripts = ref.subscript.size();
+ if (subscripts != symbolRank) {
+ context.messages.Say(
+ "reference to rank-%d object '%s' has %d subscripts"_err_en_US,
+ symbolRank, symbol.name().ToString().data(), subscripts);
}
- return std::nullopt;
-}
-
-MaybeExpr ExprAnalyzer::Subscripts(const Symbol &symbol, ArrayRef &&ref) {
- if (auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
- int symbolRank = details->shape().size();
- if (ref.subscript.empty()) {
- // A -> A(:,:)
- for (int j{0}; j < symbolRank; ++j) {
- ref.subscript.emplace_back(Subscript{Triplet{}});
+ // TODO: fill in bounds of triplets?
+ // TODO: subtract lowers bounds?
+ // TODO: enforce constraints, like lack of uppermost bound on assumed-size
+ if (Component * component{std::get_if<Component>(&ref.u)}) {
+ int baseRank{component->Rank()};
+ if (baseRank > 0) {
+ int rank{ref.Rank()};
+ if (rank > 0) {
+ context.messages.Say(
+ "subscripts of rank-%d component reference have rank %d, but must all be scalar"_err_en_US,
+ baseRank, rank);
}
}
- int subscripts = ref.subscript.size();
- if (subscripts != symbolRank) {
- context.messages.Say(
- "reference to rank-%d object '%s' has %d subscripts"_err_en_US,
- symbolRank, symbol.name().ToString().data(), subscripts);
- }
- // TODO: rank analysis, enforce vector-valued subscript constraints
- // fill in bounds of triplets?
- // subtract lowers bounds?
}
return Designate(symbol, DataRef{std::move(ref)});
}
MaybeExpr ExprAnalyzer::Analyze(const parser::ArrayElement &ae) {
std::vector<Subscript> subscripts{Analyze(ae.subscripts)};
if (MaybeExpr baseExpr{AnalyzeHelper(*this, ae.base)}) {
- if (std::optional<DataRef> dataRef{AsDataRef(std::move(*baseExpr))}) {
+ if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(*baseExpr))}) {
if (const Symbol **symbol{std::get_if<const Symbol *>(&dataRef->u)}) {
return Subscripts(**symbol, ArrayRef{**symbol, std::move(subscripts)});
} else if (Component * component{std::get_if<Component>(&dataRef->u)}) {
"component is not in scope of derived TYPE(%s)"_err_en_US,
dtExpr->result.spec().name().ToString().data());
} else if (std::optional<DataRef> dataRef{
- AsDataRef(std::move(*dtExpr))}) {
+ ExtractDataRef(std::move(*dtExpr))}) {
Component component{std::move(*dataRef), *sym};
return Designate(*sym, DataRef{std::move(component)});
} else {
"component of complex value must be %%RE or %%IM"_err_en_US);
return std::nullopt;
}
- if (std::optional<DataRef> dataRef{AsDataRef(std::move(*zExpr))}) {
+ if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(*zExpr))}) {
Expr<SomeReal> realExpr{std::visit(
[&](const auto &z) {
using PartType = typename ResultType<decltype(z)>::Part;
}
MaybeExpr ExprAnalyzer::Analyze(const parser::CoindexedNamedObject &co) {
+ // TODO: ComponentRankCheck or its equivalent
context.messages.Say("TODO: CoindexedNamedObject unimplemented"_err_en_US);
return std::nullopt;
}
MaybeExpr BinaryOperationHelper(ExprAnalyzer &ea, const PARSED &x) {
if (auto both{common::AllPresent(AnalyzeHelper(ea, *std::get<0>(x.t)),
AnalyzeHelper(ea, *std::get<1>(x.t)))}) {
+ int leftRank{std::get<0>(*both).Rank()};
+ int rightRank{std::get<1>(*both).Rank()};
+ if (leftRank > 0 && rightRank > 0 && leftRank != rightRank) {
+ ea.context.messages.Say(
+ "left operand has rank %d, right operand has rank %d"_err_en_US,
+ leftRank, rightRank);
+ }
return NumericOperation<OPR>(ea.context.messages,
std::move(std::get<0>(*both)), std::move(std::get<1>(*both)));
}
return std::nullopt;
}
+void ExprAnalyzer::ComponentRankCheck(const Component &component) {
+ int baseRank{component.base().Rank()};
+ int componentRank{component.symbol().Rank()};
+ if (baseRank > 0 && componentRank > 0) {
+ context.messages.Say(
+ "reference to rank-%d component '%%%s' of rank-%d array of derived type is not allowed"_err_en_US,
+ componentRank, component.symbol().name().ToString().data(), baseRank);
+ }
+}
+
} // namespace Fortran::evaluate
namespace Fortran::semantics {
details_);
}
+int Symbol::Rank() const {
+ return std::visit(
+ common::visitors{
+ [](const SubprogramDetails &sd) {
+ if (sd.isFunction()) {
+ return sd.result().Rank();
+ } else {
+ return 0;
+ }
+ },
+ [](const GenericDetails &) {
+ return 0; /*TODO*/
+ },
+ [](const UseDetails &x) { return x.symbol().Rank(); },
+ [](const ObjectEntityDetails &oed) {
+ return static_cast<int>(oed.shape().size());
+ },
+ [](const auto &) { return 0; },
+ },
+ details_);
+}
+
ObjectEntityDetails::ObjectEntityDetails(const EntityDetails &d)
: isDummy_{d.isDummy()}, type_{d.type()} {}
bool operator==(const Symbol &that) const { return this == &that; }
bool operator!=(const Symbol &that) const { return this != &that; }
+ int Rank() const;
+
private:
const Scope *owner_;
std::list<SourceName> occurrences_;
projects / platform / upstream / llvm.git / commitdiff