template<typename RESULT>
std::ostream &ExpressionBase<RESULT>::Dump(std::ostream &o) const {
- std::visit(
- common::visitors{[&](const BOZLiteralConstant &x) {
- o << "Z'" << x.Hexadecimal() << "'";
- },
- [&](const CopyableIndirection<Substring> &s) { s->Dump(o); },
- [&](const auto &x) {
- if constexpr (Result::isSpecificType) {
- using Ty = std::decay_t<decltype(x)>;
- if constexpr (std::is_same_v<Ty, FunctionReference<Result>>) {
- x.reference->Dump(o);
- } else {
- x.Dump(o);
- }
- } else {
- x.Dump(o);
- }
- }},
+ std::visit(common::visitors{[&](const BOZLiteralConstant &x) {
+ o << "Z'" << x.Hexadecimal() << "'";
+ },
+ [&](const CopyableIndirection<Substring> &s) { s->Dump(o); },
+ [&](const auto &x) { x.Dump(o); }},
derived().u);
return o;
}
Extremum<SubscriptInteger>{c.left().LEN(), c.right().LEN()}};
},
[](const Designator<Result> &dr) { return dr.LEN(); },
- [](const FunctionReference<Result> &fr) {
- return fr.reference->proc().LEN();
- }},
+ [](const FunctionRef<Result> &fr) { return fr.LEN(); }},
u);
}
// Template instantiations to resolve the "extern template" declarations
// that appear in expression.h.
-template class Expr<Type<TypeCategory::Integer, 1>>;
-template class Expr<Type<TypeCategory::Integer, 2>>;
-template class Expr<Type<TypeCategory::Integer, 4>>;
-template class Expr<Type<TypeCategory::Integer, 8>>;
-template class Expr<Type<TypeCategory::Integer, 16>>;
-template class Expr<Type<TypeCategory::Real, 2>>;
-template class Expr<Type<TypeCategory::Real, 4>>;
-template class Expr<Type<TypeCategory::Real, 8>>;
-template class Expr<Type<TypeCategory::Real, 10>>;
-template class Expr<Type<TypeCategory::Real, 16>>;
-template class Expr<Type<TypeCategory::Complex, 2>>;
-template class Expr<Type<TypeCategory::Complex, 4>>;
-template class Expr<Type<TypeCategory::Complex, 8>>;
-template class Expr<Type<TypeCategory::Complex, 10>>;
-template class Expr<Type<TypeCategory::Complex, 16>>;
-template class Expr<Type<TypeCategory::Character, 1>>;
-template class Expr<Type<TypeCategory::Character, 2>>;
-template class Expr<Type<TypeCategory::Character, 4>>;
-template class Expr<Type<TypeCategory::Logical, 1>>;
-template class Expr<Type<TypeCategory::Logical, 2>>;
-template class Expr<Type<TypeCategory::Logical, 4>>;
-template class Expr<Type<TypeCategory::Logical, 8>>;
-template class Expr<SomeInteger>;
-template class Expr<SomeReal>;
-template class Expr<SomeComplex>;
-template class Expr<SomeCharacter>;
-template class Expr<SomeLogical>;
-template class Expr<SomeType>;
-
-template struct Relational<Type<TypeCategory::Integer, 1>>;
-template struct Relational<Type<TypeCategory::Integer, 2>>;
-template struct Relational<Type<TypeCategory::Integer, 4>>;
-template struct Relational<Type<TypeCategory::Integer, 8>>;
-template struct Relational<Type<TypeCategory::Integer, 16>>;
-template struct Relational<Type<TypeCategory::Real, 2>>;
-template struct Relational<Type<TypeCategory::Real, 4>>;
-template struct Relational<Type<TypeCategory::Real, 8>>;
-template struct Relational<Type<TypeCategory::Real, 10>>;
-template struct Relational<Type<TypeCategory::Real, 16>>;
-template struct Relational<Type<TypeCategory::Character, 1>>;
-template struct Relational<Type<TypeCategory::Character, 2>>;
-template struct Relational<Type<TypeCategory::Character, 4>>;
+FOR_EACH_TYPE_AND_KIND(template class Expr)
+FOR_EACH_INTEGER_KIND(template struct Relational)
+FOR_EACH_REAL_KIND(template struct Relational)
+FOR_EACH_CHARACTER_KIND(template struct Relational)
template struct Relational<SomeType>;
-
-template struct ExpressionBase<Type<TypeCategory::Integer, 1>>;
-template struct ExpressionBase<Type<TypeCategory::Integer, 2>>;
-template struct ExpressionBase<Type<TypeCategory::Integer, 4>>;
-template struct ExpressionBase<Type<TypeCategory::Integer, 8>>;
-template struct ExpressionBase<Type<TypeCategory::Integer, 16>>;
-template struct ExpressionBase<Type<TypeCategory::Real, 2>>;
-template struct ExpressionBase<Type<TypeCategory::Real, 4>>;
-template struct ExpressionBase<Type<TypeCategory::Real, 8>>;
-template struct ExpressionBase<Type<TypeCategory::Real, 10>>;
-template struct ExpressionBase<Type<TypeCategory::Real, 16>>;
-template struct ExpressionBase<Type<TypeCategory::Complex, 2>>;
-template struct ExpressionBase<Type<TypeCategory::Complex, 4>>;
-template struct ExpressionBase<Type<TypeCategory::Complex, 8>>;
-template struct ExpressionBase<Type<TypeCategory::Complex, 10>>;
-template struct ExpressionBase<Type<TypeCategory::Complex, 16>>;
-template struct ExpressionBase<Type<TypeCategory::Character, 1>>;
-template struct ExpressionBase<Type<TypeCategory::Character, 2>>;
-template struct ExpressionBase<Type<TypeCategory::Character, 4>>;
-template struct ExpressionBase<Type<TypeCategory::Logical, 1>>;
-template struct ExpressionBase<Type<TypeCategory::Logical, 2>>;
-template struct ExpressionBase<Type<TypeCategory::Logical, 4>>;
-template struct ExpressionBase<Type<TypeCategory::Logical, 8>>;
-template struct ExpressionBase<SomeInteger>;
-template struct ExpressionBase<SomeReal>;
-template struct ExpressionBase<SomeComplex>;
-template struct ExpressionBase<SomeCharacter>;
-template struct ExpressionBase<SomeLogical>;
-template struct ExpressionBase<SomeType>;
+FOR_EACH_INTRINSIC_KIND(template struct ExpressionBase)
+FOR_EACH_CATEGORY_TYPE(template struct ExpressionBase)
} // namespace Fortran::evaluate
// to be used in only a few situations.
using BOZLiteralConstant = typename LargestReal::Scalar::Word;
-template<typename T> struct FunctionReference {
- using Result = T;
- static_assert(Result::isSpecificType);
- int Rank() const { return reference->Rank(); }
- CopyableIndirection<FunctionRef> reference;
-};
-
// Operations always have specific Fortran result types (i.e., with known
// intrinsic type category and kind parameter value). The classes that
// represent the operations all inherit from this Operation<> base class
using Operations = std::variant<Parentheses<Result>, Negate<Result>,
Add<Result>, Subtract<Result>, Multiply<Result>, Divide<Result>,
Power<Result>, Extremum<Result>>;
- using Others = std::variant<Constant<Result>, Designator<Result>,
- FunctionReference<Result>>;
+ using Others =
+ std::variant<Constant<Result>, Designator<Result>, FunctionRef<Result>>;
public:
common::CombineVariants<Operations, Conversions, Others> u;
using Operations = std::variant<ComplexComponent<KIND>, Parentheses<Result>,
Negate<Result>, Add<Result>, Subtract<Result>, Multiply<Result>,
Divide<Result>, Power<Result>, RealToIntPower<Result>, Extremum<Result>>;
- using Others = std::variant<Constant<Result>, Designator<Result>,
- FunctionReference<Result>>;
+ using Others =
+ std::variant<Constant<Result>, Designator<Result>, FunctionRef<Result>>;
public:
common::CombineVariants<Operations, Conversions, Others> u;
using Operations =
std::variant<Parentheses<Result>, Multiply<Result>, Divide<Result>,
Power<Result>, RealToIntPower<Result>, ComplexConstructor<KIND>>;
- using Others = std::variant<Constant<Result>, Designator<Result>,
- FunctionReference<Result>>;
+ using Others =
+ std::variant<Constant<Result>, Designator<Result>, FunctionRef<Result>>;
public:
common::CombineVariants<Operations, Others> u;
};
-extern template class Expr<Type<TypeCategory::Integer, 1>>;
-extern template class Expr<Type<TypeCategory::Integer, 2>>;
-extern template class Expr<Type<TypeCategory::Integer, 4>>;
-extern template class Expr<Type<TypeCategory::Integer, 8>>;
-extern template class Expr<Type<TypeCategory::Integer, 16>>;
-extern template class Expr<Type<TypeCategory::Real, 2>>;
-extern template class Expr<Type<TypeCategory::Real, 4>>;
-extern template class Expr<Type<TypeCategory::Real, 8>>;
-extern template class Expr<Type<TypeCategory::Real, 10>>;
-extern template class Expr<Type<TypeCategory::Real, 16>>;
-extern template class Expr<Type<TypeCategory::Complex, 2>>;
-extern template class Expr<Type<TypeCategory::Complex, 4>>;
-extern template class Expr<Type<TypeCategory::Complex, 8>>;
-extern template class Expr<Type<TypeCategory::Complex, 10>>;
-extern template class Expr<Type<TypeCategory::Complex, 16>>;
+FOR_EACH_INTEGER_KIND(extern template class Expr)
+FOR_EACH_REAL_KIND(extern template class Expr)
+FOR_EACH_COMPLEX_KIND(extern template class Expr)
template<int KIND>
class Expr<Type<TypeCategory::Character, KIND>>
Expr<SubscriptInteger> LEN() const;
- std::variant<Constant<Result>, Designator<Result>, FunctionReference<Result>,
+ std::variant<Constant<Result>, Designator<Result>, FunctionRef<Result>,
Parentheses<Result>, Concat<KIND>, Extremum<Result>>
u;
};
-extern template class Expr<Type<TypeCategory::Character, 1>>;
-extern template class Expr<Type<TypeCategory::Character, 2>>;
-extern template class Expr<Type<TypeCategory::Character, 4>>;
+FOR_EACH_CHARACTER_KIND(extern template class Expr)
// The Relational class template is a helper for constructing logical
// expressions with polymorphism over the cross product of the possible
common::MapTemplate<Relational, DirectlyComparableTypes> u;
};
-extern template struct Relational<Type<TypeCategory::Integer, 1>>;
-extern template struct Relational<Type<TypeCategory::Integer, 2>>;
-extern template struct Relational<Type<TypeCategory::Integer, 4>>;
-extern template struct Relational<Type<TypeCategory::Integer, 8>>;
-extern template struct Relational<Type<TypeCategory::Integer, 16>>;
-extern template struct Relational<Type<TypeCategory::Real, 2>>;
-extern template struct Relational<Type<TypeCategory::Real, 4>>;
-extern template struct Relational<Type<TypeCategory::Real, 8>>;
-extern template struct Relational<Type<TypeCategory::Real, 10>>;
-extern template struct Relational<Type<TypeCategory::Real, 16>>;
-extern template struct Relational<Type<TypeCategory::Character, 1>>;
-extern template struct Relational<Type<TypeCategory::Character, 2>>;
-extern template struct Relational<Type<TypeCategory::Character, 4>>;
+FOR_EACH_INTEGER_KIND(extern template struct Relational)
+FOR_EACH_REAL_KIND(extern template struct Relational)
+FOR_EACH_CHARACTER_KIND(extern template struct Relational)
extern template struct Relational<SomeType>;
template<int KIND>
using Operations =
std::variant<Convert<Result, TypeCategory::Logical>, Parentheses<Result>,
Not<KIND>, LogicalOperation<KIND>, Relational<SomeType>>;
- using Others = std::variant<Constant<Result>, Designator<Result>,
- FunctionReference<Result>>;
+ using Others =
+ std::variant<Constant<Result>, Designator<Result>, FunctionRef<Result>>;
public:
common::CombineVariants<Operations, Others> u;
};
-extern template class Expr<Type<TypeCategory::Logical, 1>>;
-extern template class Expr<Type<TypeCategory::Logical, 2>>;
-extern template class Expr<Type<TypeCategory::Logical, 4>>;
-extern template class Expr<Type<TypeCategory::Logical, 8>>;
+FOR_EACH_LOGICAL_KIND(extern template class Expr)
// A polymorphic expression of known intrinsic type category, but dynamic
// kind, represented as a discriminated union over Expr<Type<CAT, K>>
: result{std::move(r)}, u{std::move(x)} {}
Result result;
- std::variant<Designator<Result>, FunctionReference<Result>> u;
+ std::variant<Designator<Result>, FunctionRef<Result>> u;
};
// A completely generic expression, polymorphic across all of the intrinsic type
Expr<SomeType> v;
};
-extern template class Expr<SomeInteger>;
-extern template class Expr<SomeReal>;
-extern template class Expr<SomeComplex>;
-extern template class Expr<SomeCharacter>;
-extern template class Expr<SomeLogical>;
-extern template class Expr<SomeType>;
-
-extern template struct ExpressionBase<Type<TypeCategory::Integer, 1>>;
-extern template struct ExpressionBase<Type<TypeCategory::Integer, 2>>;
-extern template struct ExpressionBase<Type<TypeCategory::Integer, 4>>;
-extern template struct ExpressionBase<Type<TypeCategory::Integer, 8>>;
-extern template struct ExpressionBase<Type<TypeCategory::Integer, 16>>;
-extern template struct ExpressionBase<Type<TypeCategory::Real, 2>>;
-extern template struct ExpressionBase<Type<TypeCategory::Real, 4>>;
-extern template struct ExpressionBase<Type<TypeCategory::Real, 8>>;
-extern template struct ExpressionBase<Type<TypeCategory::Real, 10>>;
-extern template struct ExpressionBase<Type<TypeCategory::Real, 16>>;
-extern template struct ExpressionBase<Type<TypeCategory::Complex, 2>>;
-extern template struct ExpressionBase<Type<TypeCategory::Complex, 4>>;
-extern template struct ExpressionBase<Type<TypeCategory::Complex, 8>>;
-extern template struct ExpressionBase<Type<TypeCategory::Complex, 10>>;
-extern template struct ExpressionBase<Type<TypeCategory::Complex, 16>>;
-extern template struct ExpressionBase<Type<TypeCategory::Character, 1>>;
-extern template struct ExpressionBase<Type<TypeCategory::Character, 2>>;
-extern template struct ExpressionBase<Type<TypeCategory::Character, 4>>;
-extern template struct ExpressionBase<Type<TypeCategory::Logical, 1>>;
-extern template struct ExpressionBase<Type<TypeCategory::Logical, 2>>;
-extern template struct ExpressionBase<Type<TypeCategory::Logical, 4>>;
-extern template struct ExpressionBase<Type<TypeCategory::Logical, 8>>;
-extern template struct ExpressionBase<SomeInteger>;
-extern template struct ExpressionBase<SomeReal>;
-extern template struct ExpressionBase<SomeComplex>;
-extern template struct ExpressionBase<SomeCharacter>;
-extern template struct ExpressionBase<SomeLogical>;
-extern template struct ExpressionBase<SomeType>;
+FOR_EACH_CATEGORY_TYPE(extern template class Expr)
+FOR_EACH_INTRINSIC_KIND(extern template struct ExpressionBase)
+FOR_EACH_CATEGORY_TYPE(extern template struct ExpressionBase)
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_EXPRESSION_H_
using Scalar = GenericScalar;
};
+// For "[extern] template class", &c. boilerplate
+#define FOR_EACH_INTEGER_KIND(PREFIX) \
+ PREFIX<Type<TypeCategory::Integer, 1>>; \
+ PREFIX<Type<TypeCategory::Integer, 2>>; \
+ PREFIX<Type<TypeCategory::Integer, 4>>; \
+ PREFIX<Type<TypeCategory::Integer, 8>>; \
+ PREFIX<Type<TypeCategory::Integer, 16>>;
+#define FOR_EACH_REAL_KIND(PREFIX) \
+ PREFIX<Type<TypeCategory::Real, 2>>; \
+ PREFIX<Type<TypeCategory::Real, 4>>; \
+ PREFIX<Type<TypeCategory::Real, 8>>; \
+ PREFIX<Type<TypeCategory::Real, 10>>; \
+ PREFIX<Type<TypeCategory::Real, 16>>;
+#define FOR_EACH_COMPLEX_KIND(PREFIX) \
+ PREFIX<Type<TypeCategory::Complex, 2>>; \
+ PREFIX<Type<TypeCategory::Complex, 4>>; \
+ PREFIX<Type<TypeCategory::Complex, 8>>; \
+ PREFIX<Type<TypeCategory::Complex, 10>>; \
+ PREFIX<Type<TypeCategory::Complex, 16>>;
+#define FOR_EACH_CHARACTER_KIND(PREFIX) \
+ PREFIX<Type<TypeCategory::Character, 1>>; \
+ PREFIX<Type<TypeCategory::Character, 2>>; \
+ PREFIX<Type<TypeCategory::Character, 4>>;
+#define FOR_EACH_LOGICAL_KIND(PREFIX) \
+ PREFIX<Type<TypeCategory::Logical, 1>>; \
+ PREFIX<Type<TypeCategory::Logical, 2>>; \
+ PREFIX<Type<TypeCategory::Logical, 4>>; \
+ PREFIX<Type<TypeCategory::Logical, 8>>;
+#define FOR_EACH_INTRINSIC_KIND(PREFIX) \
+ FOR_EACH_INTEGER_KIND(PREFIX) \
+ FOR_EACH_REAL_KIND(PREFIX) \
+ FOR_EACH_COMPLEX_KIND(PREFIX) \
+ FOR_EACH_CHARACTER_KIND(PREFIX) \
+ FOR_EACH_LOGICAL_KIND(PREFIX)
+#define FOR_EACH_SPECIFIC_TYPE(PREFIX) \
+ FOR_EACH_INTRINSIC_KIND(PREFIX) \
+ PREFIX<SomeDerived>;
+#define FOR_EACH_CATEGORY_TYPE(PREFIX) \
+ PREFIX<SomeInteger>; \
+ PREFIX<SomeReal>; \
+ PREFIX<SomeComplex>; \
+ PREFIX<SomeCharacter>; \
+ PREFIX<SomeLogical>; \
+ PREFIX<SomeType>;
+#define FOR_EACH_TYPE_AND_KIND(PREFIX) \
+ FOR_EACH_SPECIFIC_TYPE(PREFIX) \
+ FOR_EACH_CATEGORY_TYPE(PREFIX)
+
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_TYPE_H_
CHECK(!base_.empty());
}
-CoarrayRef &CoarrayRef::setStat(Variable &&v) {
- stat_ = CopyableIndirection<Variable>::Make(std::move(v));
+CoarrayRef &CoarrayRef::set_stat(Variable<DefaultInteger> &&v) {
+ stat_ = CopyableIndirection<Variable<DefaultInteger>>::Make(std::move(v));
return *this;
}
-CoarrayRef &CoarrayRef::setTeam(Variable &&v, bool isTeamNumber) {
- team_ = CopyableIndirection<Variable>::Make(std::move(v));
+CoarrayRef &CoarrayRef::set_team(
+ Variable<DefaultInteger> &&v, bool isTeamNumber) {
+ team_ = CopyableIndirection<Variable<DefaultInteger>>::Make(std::move(v));
teamIsTeamNumber_ = isTeamNumber;
return *this;
}
return Emit(o, u);
}
-template<typename ARG>
-std::ostream &ProcedureRef<ARG>::Dump(std::ostream &o) const {
+std::ostream &UntypedFunctionRef::Dump(std::ostream &o) const {
Emit(o, proc_);
char separator{'('};
- for (const auto &arg : argument_) {
+ for (const auto &arg : arguments_) {
Emit(o << separator, arg);
separator = ',';
}
return o << ')';
}
-std::ostream &Variable::Dump(std::ostream &o) const { return Emit(o, u); }
+std::ostream &SubroutineCall::Dump(std::ostream &o) const {
+ Emit(o, proc_);
+ char separator{'('};
+ for (const auto &arg : arguments_) {
+ Emit(o << separator, arg);
+ separator = ',';
+ }
+ if (separator == '(') {
+ o << '(';
+ }
+ return o << ')';
+}
std::ostream &ActualSubroutineArg::Dump(std::ostream &o) const {
return Emit(o, u);
}},
u);
}
+Expr<SubscriptInteger> UntypedFunctionRef::LEN() const {
+ // TODO: the results of the intrinsic functions REPEAT and TRIM have
+ // unpredictable lengths; maybe the concept of LEN() has to become dynamic
+ return proc_.LEN();
+}
// Rank()
int Component::Rank() const {
CHECK(baseRank == 0 || symbolRank == 0);
return baseRank + symbolRank;
}
-template<typename A> int ProcedureRef<A>::Rank() const {
- if constexpr (std::is_same_v<A, ActualFunctionArg>) { // FunctionRef
- // 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);
- } else {
- return 0;
- }
-}
int Subscript::Rank() const {
return std::visit(common::visitors{[](const IndirectSubscriptIntegerExpr &x) {
int rank{x->Rank()};
for (std::size_t j{0}; j < subscript.size(); ++j) {
rank += subscript[j].Rank();
}
- int baseRank{std::visit(
- common::visitors{[](const Symbol *symbol) { return symbol->Rank(); },
- [](const auto &x) { return x.Rank(); }},
- u)};
- CHECK(rank == 0 || baseRank == 0);
- return baseRank + rank;
+ if (std::holds_alternative<const Symbol *>(u)) {
+ return rank;
+ } else {
+ int baseRank{std::get_if<Component>(&u)->Rank()};
+ CHECK(rank == 0 || baseRank == 0);
+ return baseRank + rank;
+ }
}
int CoarrayRef::Rank() const {
int rank{0};
u_);
}
int ComplexPart::Rank() const { return complex_.Rank(); }
-int Variable::Rank() const {
- return std::visit([](const auto &x) { return x.Rank(); }, u);
+int ProcedureDesignator::Rank() const {
+ return std::visit(
+ common::visitors{[](IntrinsicProcedure) { return 0 /*TODO!!*/; },
+ [](const Symbol *sym) { return sym->Rank(); },
+ [](const Component &c) { return c.symbol().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(); }},
+ return std::visit(common::visitors{[](const ActualFunctionArg &a) {
+ if (a.has_value()) {
+ return (*a)->Rank();
+ } else {
+ return 0;
+ }
+ },
+ [](const Label *) { return 0; }},
u);
}
return nullptr; // substring of character literal
}
}
+const Symbol *ProcedureDesignator::GetSymbol() const {
+ return std::visit(common::visitors{[](const Symbol *sym) { return sym; },
+ [](const Component &c) { return c.GetSymbol(false); },
+ [](const auto &) -> const Symbol * { return nullptr; }},
+ u);
+}
+
+FOR_EACH_CHARACTER_KIND(template class Designator)
+FOR_EACH_SPECIFIC_TYPE(template class FunctionRef)
-template class Designator<Type<TypeCategory::Character, 1>>;
-template class Designator<Type<TypeCategory::Character, 2>>;
-template class Designator<Type<TypeCategory::Character, 4>>;
-template class ProcedureRef<ActualFunctionArg>; // FunctionRef
-template class ProcedureRef<ActualSubroutineArg>;
} // namespace Fortran::evaluate
// Forward declarations
template<typename A> class Expr;
struct DataRef;
-struct Variable;
+template<typename A> struct Variable;
// Subscript and cosubscript expressions are of a kind that matches the
// address size, at least at the top level.
CoarrayRef(std::vector<const Symbol *> &&,
std::vector<Expr<SubscriptInteger>> &&,
std::vector<Expr<SubscriptInteger>> &&); // TODO: stat & team?
- CoarrayRef &setStat(Variable &&);
- CoarrayRef &setTeam(Variable &&, bool isTeamNumber = false);
+ CoarrayRef &set_stat(Variable<DefaultInteger> &&);
+ CoarrayRef &set_team(Variable<DefaultInteger> &&, bool isTeamNumber = false);
int Rank() const;
const Symbol *GetSymbol(bool first) const {
private:
std::vector<const Symbol *> base_;
std::vector<Expr<SubscriptInteger>> subscript_, cosubscript_;
- std::optional<CopyableIndirection<Variable>> stat_, team_;
+ std::optional<CopyableIndirection<Variable<DefaultInteger>>> stat_, team_;
bool teamIsTeamNumber_{false}; // false: TEAM=, true: TEAM_NUMBER=
};
// R901 designator is the most general data reference object, apart from
// calls to pointer-valued functions. Its variant holds everything that
-// a DataRef can, and (when appropriate) a substring or complex part.
+// a DataRef can, and, when appropriate for the result type, a substring
+// reference or complex part (%RE/%IM).
template<typename A> class Designator {
using DataRefs = decltype(DataRef::u);
using MaybeSubstring =
explicit ProcedureDesignator(IntrinsicProcedure p) : u{p} {}
explicit ProcedureDesignator(const Symbol &n) : u{&n} {}
Expr<SubscriptInteger> LEN() const;
+ int Rank() const;
+ const Symbol *GetSymbol() const;
std::ostream &Dump(std::ostream &) const;
std::variant<IntrinsicProcedure, const Symbol *, Component> u;
};
-template<typename ARG> class ProcedureRef {
+using ActualFunctionArg = std::optional<CopyableIndirection<Expr<SomeType>>>;
+
+class UntypedFunctionRef {
public:
- using ArgumentType = CopyableIndirection<ARG>;
- CLASS_BOILERPLATE(ProcedureRef)
- ProcedureRef(ProcedureDesignator &&p, std::vector<ArgumentType> &&a)
- : proc_{std::move(p)}, argument_(std::move(a)) {}
+ using Argument = ActualFunctionArg;
+ using Arguments = std::vector<Argument>;
+ CLASS_BOILERPLATE(UntypedFunctionRef)
+ UntypedFunctionRef(ProcedureDesignator &&p, Arguments &&a, int r)
+ : proc_{std::move(p)}, arguments_(std::move(a)), rank_{r} {}
+ UntypedFunctionRef(ProcedureDesignator &&p, Arguments &&a)
+ : proc_{std::move(p)}, arguments_(std::move(a)) {}
+
const ProcedureDesignator &proc() const { return proc_; }
- const std::vector<ArgumentType> &argument() const { return argument_; }
- int Rank() const;
+ const Arguments &arguments() const { return arguments_; }
+
+ Expr<SubscriptInteger> LEN() const;
+ int Rank() const { return rank_; }
std::ostream &Dump(std::ostream &) const;
-private:
+protected:
ProcedureDesignator proc_;
- std::vector<ArgumentType> argument_;
+ Arguments arguments_;
+ int rank_{proc_.Rank()};
};
-// Subtlety: There is a distinction that must be maintained here between an
-// actual argument expression that *is* a variable and one that is not,
-// e.g. between X and (X).
-using ActualFunctionArg = CopyableIndirection<Expr<SomeType>>;
-using FunctionRef = ProcedureRef<ActualFunctionArg>;
+template<typename A> struct FunctionRef : public UntypedFunctionRef {
+ using Result = A;
+ static_assert(Result::isSpecificType);
+ // Subtlety: There is a distinction that must be maintained here between an
+ // actual argument expression that *is* a variable and one that is not,
+ // e.g. between X and (X). The parser attempts to parse each argument
+ // first as a variable, then as an expression, and the distinction appears
+ // in the parse tree.
+ using Argument = ActualFunctionArg;
+ using Arguments = std::vector<Argument>;
+ CLASS_BOILERPLATE(FunctionRef)
+ explicit FunctionRef(UntypedFunctionRef &&ufr)
+ : UntypedFunctionRef{std::move(ufr)} {}
+ FunctionRef(ProcedureDesignator &&p, Arguments &&a, int r = 0)
+ : UntypedFunctionRef{std::move(p), std::move(a), r} {}
+};
-struct Variable {
+template<typename A> struct Variable {
+ using Result = A;
+ static_assert(Result::isSpecificType);
EVALUATE_UNION_CLASS_BOILERPLATE(Variable)
- int Rank() const;
- std::ostream &Dump(std::ostream &) const;
- std::variant<DataRef, Substring, ComplexPart, FunctionRef> u;
+ int Rank() const {
+ return std::visit([](const auto &x) { return x.Rank(); }, u);
+ }
+ std::ostream &Dump(std::ostream &o) const {
+ std::visit([&](const auto &x) { x.Dump(o); }, u);
+ return o;
+ }
+ std::variant<Designator<Result>, FunctionRef<Result>> u;
};
struct Label { // TODO: this is a placeholder
class ActualSubroutineArg {
public:
EVALUATE_UNION_CLASS_BOILERPLATE(ActualSubroutineArg)
- explicit ActualSubroutineArg(Expr<SomeType> &&x) : u{std::move(x)} {}
+ explicit ActualSubroutineArg(ActualFunctionArg &&x) : u{std::move(x)} {}
explicit ActualSubroutineArg(const Label &l) : u{&l} {}
int Rank() const;
std::ostream &Dump(std::ostream &) const;
public:
- std::variant<CopyableIndirection<Expr<SomeType>>, Variable, const Label *> u;
+ std::variant<ActualFunctionArg, const Label *> u;
};
-using SubroutineRef = ProcedureRef<ActualSubroutineArg>;
+class SubroutineCall {
+public:
+ using Argument = ActualSubroutineArg;
+ using Arguments = std::vector<Argument>;
+ CLASS_BOILERPLATE(SubroutineCall)
+ SubroutineCall(ProcedureDesignator &&p, Arguments &&a)
+ : proc_{std::move(p)}, arguments_(std::move(a)) {}
+ const ProcedureDesignator &proc() const { return proc_; }
+ const Arguments &arguments() const { return arguments_; }
+ int Rank() const { return 0; } // TODO: elemental subroutine representation
+ std::ostream &Dump(std::ostream &) const;
+
+private:
+ ProcedureDesignator proc_;
+ Arguments arguments_;
+};
-extern template class Designator<Type<TypeCategory::Character, 1>>;
-extern template class Designator<Type<TypeCategory::Character, 2>>;
-extern template class Designator<Type<TypeCategory::Character, 4>>;
-extern template class ProcedureRef<ActualFunctionArg>; // FunctionRef
-extern template class ProcedureRef<ActualSubroutineArg>;
+FOR_EACH_CHARACTER_KIND(extern template class Designator)
} // namespace Fortran::evaluate
MaybeExpr TopLevelChecks(DataRef &&);
void CheckUnsubscriptedComponent(const Component &);
+ std::optional<ProcedureDesignator> Procedure(
+ const parser::ProcedureDesignator &);
+
FoldingContext context;
const semantics::IntrinsicTypeDefaultKinds &defaults;
};
return {AsGenericExpr(std::move(value.value))};
}
-template<TypeCategory CATEGORY, typename DATAREF = DataRef>
-MaybeExpr DesignateHelper(int kind, DATAREF &&dataRef) {
- return common::SearchDynamicTypes(
- TypeKindVisitor<CATEGORY, Designator, DATAREF>{kind, std::move(dataRef)});
-}
-
static std::optional<DynamicType> CategorizeSymbolType(const Symbol &symbol) {
if (auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
if (details->type().has_value()) {
return std::nullopt;
}
+// Wraps a object in an explicitly typed representation (e.g., Designator<>
+// or FunctionRef<>) as instantiated on a dynamic type.
+// TODO: move to tools.h?
+template<TypeCategory CATEGORY, template<typename> typename WRAPPER,
+ typename WRAPPED>
+MaybeExpr WrapperHelper(int kind, WRAPPED &&x) {
+ return common::SearchDynamicTypes(
+ TypeKindVisitor<CATEGORY, WRAPPER, WRAPPED>{kind, std::move(x)});
+}
+
+template<template<typename> typename WRAPPER, typename WRAPPED>
+MaybeExpr TypedWrapper(DynamicType &&dyType, WRAPPED &&x) {
+ switch (dyType.category) {
+ case TypeCategory::Integer:
+ return WrapperHelper<TypeCategory::Integer, WRAPPER, WRAPPED>(
+ dyType.kind, std::move(x));
+ case TypeCategory::Real:
+ return WrapperHelper<TypeCategory::Real, WRAPPER, WRAPPED>(
+ dyType.kind, std::move(x));
+ case TypeCategory::Complex:
+ return WrapperHelper<TypeCategory::Complex, WRAPPER, WRAPPED>(
+ dyType.kind, std::move(x));
+ case TypeCategory::Character:
+ return WrapperHelper<TypeCategory::Character, WRAPPER, WRAPPED>(
+ dyType.kind, std::move(x));
+ case TypeCategory::Logical:
+ return WrapperHelper<TypeCategory::Logical, WRAPPER, WRAPPED>(
+ dyType.kind, std::move(x));
+ case TypeCategory::Derived:
+ return AsGenericExpr(
+ Expr<SomeDerived>{*dyType.derived, WRAPPER<SomeDerived>{std::move(x)}});
+ default: CRASH_NO_CASE;
+ }
+}
+
// Wraps a data reference in a typed Designator<>.
static MaybeExpr Designate(DataRef &&dataRef) {
const Symbol &symbol{*dataRef.GetSymbol(false)};
- if (std::optional<DynamicType> dynamicType{CategorizeSymbolType(symbol)}) {
- switch (dynamicType->category) {
- case TypeCategory::Integer:
- return DesignateHelper<TypeCategory::Integer>(
- dynamicType->kind, std::move(dataRef));
- case TypeCategory::Real:
- return DesignateHelper<TypeCategory::Real>(
- dynamicType->kind, std::move(dataRef));
- case TypeCategory::Complex:
- return DesignateHelper<TypeCategory::Complex>(
- dynamicType->kind, std::move(dataRef));
- case TypeCategory::Character:
- return DesignateHelper<TypeCategory::Character>(
- dynamicType->kind, std::move(dataRef));
- case TypeCategory::Logical:
- return DesignateHelper<TypeCategory::Logical>(
- dynamicType->kind, std::move(dataRef));
- case TypeCategory::Derived:
- return AsGenericExpr(Expr<SomeDerived>{
- *dynamicType->derived, Designator<SomeDerived>{std::move(dataRef)}});
- // TODO: graceful errors on CLASS(*) and TYPE(*) misusage
- default: CRASH_NO_CASE;
- }
+ if (std::optional<DynamicType> dyType{CategorizeSymbolType(symbol)}) {
+ return TypedWrapper<Designator, DataRef>(
+ std::move(*dyType), std::move(dataRef));
}
+ // TODO: graceful errors on CLASS(*) and TYPE(*) misusage
return std::nullopt;
}
MaybeExpr ExprAnalyzer::Analyze(const parser::Name &n) {
if (n.symbol == nullptr) {
- context.messages.Say(
- n.source, "TODO INTERNAL: name was not resolved to a symbol"_err_en_US);
+ context.messages.Say(n.source,
+ "TODO INTERNAL: name '%s' was not resolved to a symbol"_err_en_US,
+ n.ToString().data());
} else if (n.symbol->attrs().test(semantics::Attr::PARAMETER)) {
context.messages.Say(
"TODO: PARAMETER references not yet implemented"_err_en_US);
if (std::optional<DynamicType> dynamicType{
CategorizeSymbolType(symbol)}) {
if (dynamicType->category == TypeCategory::Character) {
- return DesignateHelper<TypeCategory::Character, Substring>(
- dynamicType->kind,
+ return WrapperHelper<TypeCategory::Character, Designator,
+ Substring>(dynamicType->kind,
Substring{
std::move(*checked), std::move(first), std::move(last)});
}
return std::nullopt;
}
-MaybeExpr ExprAnalyzer::Analyze(const parser::FunctionReference &) {
+std::optional<ProcedureDesignator> ExprAnalyzer::Procedure(
+ const parser::ProcedureDesignator &pd) {
+ return std::visit(
+ common::visitors{
+ [&](const parser::Name &n) -> std::optional<ProcedureDesignator> {
+ if (n.symbol == nullptr) {
+ context.messages.Say(
+ "TODO INTERNAL no symbol for procedure designator name '%s'"_err_en_US,
+ n.ToString().data());
+ return std::nullopt;
+ }
+ return std::visit(
+ common::visitors{[&](const semantics::ProcEntityDetails &p)
+ -> std::optional<ProcedureDesignator> {
+ // TODO: capture &/or check interface vs.
+ // actual arguments
+ return {ProcedureDesignator{*n.symbol}};
+ },
+ [&](const auto &) -> std::optional<ProcedureDesignator> {
+ context.messages.Say(
+ "TODO: unimplemented/invalid kind of symbol as procedure designator '%s'"_err_en_US,
+ n.ToString().data());
+ return std::nullopt;
+ }},
+ n.symbol->details());
+ },
+ [&](const parser::ProcComponentRef &pcr)
+ -> std::optional<ProcedureDesignator> {
+ if (MaybeExpr component{AnalyzeHelper(*this, pcr.v)}) {
+ // TODO distinguish PCR from TBP
+ // TODO optional PASS argument for TBP
+ context.messages.Say("TODO: proc component ref"_err_en_US);
+ return std::nullopt;
+ } else {
+ return std::nullopt;
+ }
+ },
+ },
+ pd.u);
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::FunctionReference &funcRef) {
// TODO: C1002: Allow a whole assumed-size array to appear if the dummy
// argument would accept it. Handle by special-casing the context
// ActualArg -> Variable -> Designator.
- context.messages.Say("TODO: FunctionReference unimplemented"_err_en_US);
+
+ std::optional<ProcedureDesignator> proc{
+ Procedure(std::get<parser::ProcedureDesignator>(funcRef.v.t))};
+
+ typename UntypedFunctionRef::Arguments arguments;
+ for (const auto &arg :
+ std::get<std::list<parser::ActualArgSpec>>(funcRef.v.t)) {
+ std::optional<parser::CharBlock> keyword;
+ if (const auto &argKW{std::get<std::optional<parser::Keyword>>(arg.t)}) {
+ keyword = argKW->v.source;
+ }
+ // TODO: look up dummy argument info by number/keyword
+ MaybeExpr actualArgExpr;
+ std::visit(
+ common::visitors{[&](const common::Indirection<parser::Variable> &v) {
+ actualArgExpr = AnalyzeHelper(*this, v);
+ },
+ [&](const common::Indirection<parser::Expr> &x) {
+ actualArgExpr = Analyze(*x);
+ },
+ [&](const parser::Name &n) {
+ context.messages.Say("TODO: procedure name actual arg"_err_en_US);
+ },
+ [&](const parser::ProcComponentRef &) {
+ context.messages.Say(
+ "TODO: proc component ref actual arg"_err_en_US);
+ },
+ [&](const parser::AltReturnSpec &) {
+ context.messages.Say(
+ "alternate return specification cannot appear on function reference"_err_en_US);
+ },
+ [&](const parser::ActualArg::PercentRef &) {
+ context.messages.Say("TODO: %REF() argument"_err_en_US);
+ },
+ [&](const parser::ActualArg::PercentVal &) {
+ context.messages.Say("TODO: %VAL() argument"_err_en_US);
+ }},
+ std::get<parser::ActualArg>(arg.t).u);
+ if (actualArgExpr.has_value()) {
+ CopyableIndirection<Expr<SomeType>> indExpr{std::move(*actualArgExpr)};
+ arguments.emplace_back(std::move(indExpr));
+ } else {
+ arguments.emplace_back();
+ }
+ }
+ // TODO: validate arguments against interface
+ // TODO: distinguish applications of elemental functions
+ // TODO: map generic to specific procedure
+
+ if (proc.has_value()) {
+ std::optional<DynamicType> dyType;
+ if (const Symbol * symbol{proc->GetSymbol()}) {
+ dyType = CategorizeSymbolType(*symbol);
+ } else {
+ // TODO: intrinsic function result type - this is a placeholder
+ dyType = DynamicType{TypeCategory::Real, 4};
+ }
+ if (dyType.has_value()) {
+ return TypedWrapper<FunctionRef, UntypedFunctionRef>(std::move(*dyType),
+ UntypedFunctionRef{std::move(*proc), std::move(arguments)});
+ }
+ }
return std::nullopt;
}
expr.typedExpr.reset(
new evaluate::GenericExprWrapper{std::move(*checked)});
} else {
- std::cout << "expression analysis failed for this expression: ";
+ std::cout << "TODO: expression analysis failed for this expression: ";
DumpTree(std::cout, expr);
}
}
projects / platform / upstream / llvm.git / commitdiff