u_);
}
+template<int KIND>
+std::optional<typename RealExpr<KIND>::Constant>
+RealExpr<KIND>::ConstantValue() const {
+ if (auto c{std::get_if<Constant>(&u_)}) {
+ return {*c};
+ }
+ return {};
+}
+
+template<int KIND> void RealExpr<KIND>::Fold(FoldingContext &context) {
+ // TODO
+}
+
+template<int KIND>
+std::optional<typename ComplexExpr<KIND>::Constant>
+ComplexExpr<KIND>::ConstantValue() const {
+ if (auto c{std::get_if<Constant>(&u_)}) {
+ return {*c};
+ }
+ return {};
+}
+
+template<int KIND> void ComplexExpr<KIND>::Fold(FoldingContext &context) {
+ // TODO
+}
+
+template<int KIND>
+std::optional<typename CharacterExpr<KIND>::Constant>
+CharacterExpr<KIND>::ConstantValue() const {
+ if (auto c{std::get_if<Constant>(&u_)}) {
+ return {*c};
+ }
+ return {};
+}
+
+template<int KIND> void CharacterExpr<KIND>::Fold(FoldingContext &context) {
+ // TODO
+}
+
+std::optional<bool> LogicalExpr::ConstantValue() const {
+ if (auto c{std::get_if<bool>(&u_)}) {
+ return {*c};
+ }
+ return {};
+}
+
+void LogicalExpr::Fold(FoldingContext &context) {
+ // TODO and comparisons too
+}
+
+std::optional<GenericConstant> GenericExpr::ConstantValue() const {
+ return std::visit([](const auto &x) -> std::optional<GenericConstant> {
+ if (auto c{x.ConstantValue()}) {
+ return {GenericConstant{std::move(*c)}};
+ }
+ return {};
+ }, u);
+}
+
+template<Category CAT> std::optional<CategoryConstant<CAT>> CategoryExpr<CAT>::ConstantValue() const {
+ return std::visit([](const auto &x) -> std::optional<CategoryConstant<CAT>> {
+ if (auto c{x.ConstantValue()}) {
+ return {CategoryConstant<CAT>{std::move(*c)}};
+ }
+ return {};
+ }, u);
+}
+
+template<Category CAT> void CategoryExpr<CAT>::Fold(FoldingContext &context) {
+ std::visit([&](auto &x){ x.Fold(context); }, u);
+}
+
+void GenericExpr::Fold(FoldingContext &context) {
+ std::visit([&](auto &x){ x.Fold(context); }, u);
+}
+
+template struct CategoryExpr<Category::Integer>;
+template struct CategoryExpr<Category::Real>;
+template struct CategoryExpr<Category::Complex>;
+template struct CategoryExpr<Category::Character>;
+
template class Expr<Category::Integer, 1>;
template class Expr<Category::Integer, 2>;
template class Expr<Category::Integer, 4>;
Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x) : u_{std::move(x)} {}
template<typename A> Expr(CopyableIndirection<A> &&x) : u_{std::move(x)} {}
+ std::optional<Constant> ConstantValue() const;
+ void Fold(FoldingContext &c);
+
private:
std::variant<Constant, CopyableIndirection<DataRef>,
CopyableIndirection<ComplexPart>, CopyableIndirection<FunctionRef>,
Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x) : u_{std::move(x)} {}
template<typename A> Expr(CopyableIndirection<A> &&x) : u_{std::move(x)} {}
+ std::optional<Constant> ConstantValue() const;
+ void Fold(FoldingContext &c);
+
private:
std::variant<Constant, CopyableIndirection<DataRef>,
CopyableIndirection<FunctionRef>, Parentheses, Negate, Add, Subtract,
Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x) : u_{std::move(x)} {}
template<typename A> Expr(CopyableIndirection<A> &&x) : u_{std::move(x)} {}
+ std::optional<Constant> ConstantValue() const;
+ void Fold(FoldingContext &c);
SubscriptIntegerExpr LEN() const;
private:
: Binary<EXPR, EXPR, bool>{a, b}, opr{r} {}
Comparison(RelationalOperator r, EXPR &&a, EXPR &&b)
: Binary<EXPR, EXPR, bool>{std::move(a), std::move(b)}, opr{r} {}
+ std::optional<bool> Fold(FoldingContext &c);
RelationalOperator opr;
};
// of a specific category.
template<Category CAT> struct CategoryComparison {
CLASS_BOILERPLATE(CategoryComparison)
+ template<int KIND> using KindComparison = Comparison<Expr<CAT, KIND>>;
template<int KIND>
- CategoryComparison(const Comparison<Expr<CAT, KIND>> &x) : u{x} {}
+ CategoryComparison(const KindComparison<KIND> &x) : u{x} {}
template<int KIND>
- CategoryComparison(Comparison<Expr<CAT, KIND>> &&x) : u{std::move(x)} {}
- template<int K> using KindComparison = Comparison<Expr<CAT, K>>;
+ CategoryComparison(KindComparison<KIND> &&x) : u{std::move(x)} {}
+ std::optional<bool> Fold(FoldingContext &c);
typename KindsVariant<CAT, KindComparison>::type u;
};
public:
using Constant = bool;
struct Not : Unary<Expr, bool> {
- using Unary<Expr, Constant>::Unary;
+ using Unary<Expr, bool>::Unary;
};
using Bin = Binary<Expr, Expr, bool>;
struct And : public Bin {
};
CLASS_BOILERPLATE(Expr)
- Expr(Constant x) : u_{x} {}
+ Expr(bool x) : u_{x} {}
template<Category CAT, int KIND>
Expr(const Comparison<Expr<CAT, KIND>> &x) : u_{CategoryComparison<CAT>{x}} {}
template<Category CAT, int KIND>
Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x) : u_{std::move(x)} {}
template<typename A> Expr(CopyableIndirection<A> &&x) : u_{std::move(x)} {}
+ std::optional<bool> ConstantValue() const;
+ void Fold(FoldingContext &c);
+
private:
- std::variant<Constant, CopyableIndirection<DataRef>,
+ std::variant<bool, CopyableIndirection<DataRef>,
CopyableIndirection<FunctionRef>, Not, And, Or, Eqv, Neqv,
CategoryComparison<Category::Integer>, CategoryComparison<Category::Real>,
CategoryComparison<Category::Complex>,
extern template class Expr<Category::Character, 1>;
extern template class Expr<Category::Logical, 1>;
+// Holds a constant of any kind in an intrinsic type category.
+template<Category CAT> struct CategoryConstant {
+ CLASS_BOILERPLATE(CategoryConstant)
+ template<int KIND> using KindConstant = typename Expr<CAT, KIND>::Constant;
+ template<typename A> CategoryConstant(const A &x) : u{x} {}
+ template<typename A> CategoryConstant(std::enable_if_t<!std::is_reference_v<A>, A> &&x) : u{std::move(x)} {}
+ typename KindsVariant<CAT, KindConstant>::type u;
+};
+
+// Holds a constant of any intrinsic category and size.
+struct GenericConstant {
+ CLASS_BOILERPLATE(GenericConstant)
+ template<Category CAT, int KIND>
+ GenericConstant(const typename Expr<CAT, KIND>::Constant &x) : u{CategoryConstant<CAT>{x}} {}
+ template<Category CAT, int KIND>
+ GenericConstant(typename Expr<CAT, KIND>::Constant &&x) : u{CategoryConstant<CAT>{std::move(x)}} {}
+ template<typename A> GenericConstant(const A &x) : u{x} {}
+ template<typename A>
+ GenericConstant(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
+ : u{std::move(x)} {}
+ std::variant<CategoryConstant<Category::Integer>, CategoryConstant<Category::Real>, CategoryConstant<Category::Complex>, CategoryConstant<Category::Character>, bool> u;
+};
+
// Dynamically polymorphic expressions that can hold any supported kind
-// of a specific category.
+// of a specific intrinsic type category.
template<Category CAT> struct CategoryExpr {
CLASS_BOILERPLATE(CategoryExpr)
- template<int KIND> CategoryExpr(const Expr<CAT, KIND> &x) : u{x} {}
- template<int KIND> CategoryExpr(Expr<CAT, KIND> &&x) : u{std::move(x)} {}
- template<int K> using KindExpr = Expr<CAT, K>;
+ template<int KIND> using KindExpr = Expr<CAT, KIND>;
+ template<int KIND> CategoryExpr(const KindExpr<KIND> &x) : u{x} {}
+ template<int KIND> CategoryExpr(KindExpr<KIND> &&x) : u{std::move(x)} {}
+ std::optional<CategoryConstant<CAT>> ConstantValue() const;
+ void Fold(FoldingContext &);
typename KindsVariant<CAT, KindExpr>::type u;
};
-// A completely generic expression, polymorphic across the type categories.
+// A completely generic expression, polymorphic across the intrinsic type
+// categories and each of their kinds.
struct GenericExpr {
CLASS_BOILERPLATE(GenericExpr)
template<Category CAT, int KIND>
template<typename A>
GenericExpr(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
: u{std::move(x)} {}
+ std::optional<GenericConstant> ConstantValue() const;
+ void Fold(FoldingContext &);
+ int Rank() const { return 1; } // TODO
std::variant<GenericIntegerExpr, GenericRealExpr, GenericComplexExpr,
GenericCharacterExpr, LogicalExpr>
u;
using SubscriptInteger = Type<Category::Integer, 8>;
+// These macros invoke other macros on each of the supported kinds of
+// a given category.
+#define COMMA ,
+#define FOR_EACH_INTEGER_KIND(M,SEP) M(1) SEP M(2) SEP M(4) SEP M(8) SEP M(16)
+#define FOR_EACH_REAL_KIND(M,SEP) M(2) SEP M(4) SEP M(8) SEP M(10) SEP M(16)
+#define FOR_EACH_COMPLEX_KIND(M,SEP) FOR_EACH_REAL_KIND(M,SEP)
+#define FOR_EACH_CHARACTER_KIND(M,SEP) M(1)
+#define FOR_EACH_LOGICAL_KIND(M,SEP) M(1) SEP M(2) SEP M(4) SEP M(8)
+
// These templates create instances of std::variant<> that can contain
// applications of some class template to all of the supported kinds of
// a category of intrinsic type.
+#define TKIND(K) T<K>
template<Category CAT, template<int> class T> struct KindsVariant;
template<template<int> class T> struct KindsVariant<Category::Integer, T> {
- using type = std::variant<T<1>, T<2>, T<4>, T<8>, T<16>>;
+ using type = std::variant<FOR_EACH_INTEGER_KIND(TKIND,COMMA)>;
};
+// TODO use FOR_EACH...
template<template<int> class T> struct KindsVariant<Category::Real, T> {
using type = std::variant<T<2>, T<4>, T<8>, T<10>, T<16>>;
};
template<template<int> class T> struct KindsVariant<Category::Logical, T> {
using type = std::variant<T<1>, T<2>, T<4>, T<8>>;
};
+#undef TKIND
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_TYPE_H_
Message(ProvenanceRange pr, const MessageFixedText &t)
: location_{pr}, text_{t} {}
+ Message(ProvenanceRange pr, const MessageFormattedText &s)
+ : location_{pr}, text_{std::move(s)} {}
Message(ProvenanceRange pr, MessageFormattedText &&s)
: location_{pr}, text_{std::move(s)} {}
Message(ProvenanceRange pr, const MessageExpectedText &t)
Message(CharBlock csr, const MessageFixedText &t)
: location_{csr}, text_{t} {}
+ Message(CharBlock csr, const MessageFormattedText &s)
+ : location_{csr}, text_{std::move(s)} {}
Message(CharBlock csr, MessageFormattedText &&s)
: location_{csr}, text_{std::move(s)} {}
Message(CharBlock csr, const MessageExpectedText &t)
} // namespace Fortran::semantics
namespace Fortran::evaluate {
-class GenericExpr;
+struct GenericExpr;
} // namespace Fortran::evaluate
// Most non-template classes in this file use these default definitions
namespace Fortran::semantics {
-std::optional<evaluate::GenericExpr> ExpressionAnalyzer::Analyze(
- const parser::Expr &x) {
- return std::visit(
- common::visitors{
- [&](const parser::LiteralConstant &c) { return Analyze(c); },
- [&](const auto &) { return std::optional<evaluate::GenericExpr>{}; }},
- x.u);
+template<typename A>
+std::optional<evaluate::GenericExpr> AnalyzeHelper(ExpressionAnalyzer &ea, const A &tree) {
+ return ea.Analyze(tree);
}
-std::optional<evaluate::GenericExpr> ExpressionAnalyzer::Analyze(
- const parser::IntLiteralConstant &x) {
- std::uint64_t kind = defaultIntegerKind_;
- const auto &kindParam{std::get<std::optional<parser::KindParam>>(x.t)};
- if (kindParam.has_value()) {
- std::visit(common::visitors{[&](std::uint64_t k) { kind = k; },
- [&](const auto &) {
- messages_.Say(at_, "unimp kind param"_err_en_US);
- }},
- kindParam->u);
+template<typename A>
+std::optional<evaluate::GenericExpr> AnalyzeHelper(ExpressionAnalyzer &ea,
+ const parser::Scalar<A> &tree) {
+ std::optional<evaluate::GenericExpr> result{AnalyzeHelper(ea, tree.thing)};
+ if (result.has_value()) {
+ if (result->Rank() > 1) {
+ ea.Say("must be scalar"_err_en_US);
+ return {};
+ }
+ }
+ return result;
+}
+
+template<typename A>
+std::optional<evaluate::GenericExpr> AnalyzeHelper(ExpressionAnalyzer &ea,
+ const parser::Constant<A> &tree) {
+ std::optional<evaluate::GenericExpr> result{AnalyzeHelper(ea, tree.thing)};
+ if (result.has_value()) {
+ result->Fold(ea.context());
+ if (!result->ConstantValue().has_value()) {
+ ea.Say("must be constant"_err_en_US);
+ return {};
+ }
+ }
+ return result;
+}
+
+template<typename A>
+std::optional<evaluate::GenericExpr> AnalyzeHelper(ExpressionAnalyzer &ea,
+ const parser::Integer<A> &tree) {
+ std::optional<evaluate::GenericExpr> result{AnalyzeHelper(ea, tree.thing)};
+ if (result.has_value() && !std::holds_alternative<evaluate::GenericIntegerExpr>(result->u)) {
+ ea.Say("must be integer"_err_en_US);
+ return {};
+ }
+ return result;
+}
+
+template<> std::optional<evaluate::GenericExpr> AnalyzeHelper(ExpressionAnalyzer &ea,
+ const parser::Name &n) {
+ // TODO
+ return {};
+}
+
+ExpressionAnalyzer::KindParam
+ExpressionAnalyzer::Analyze(const std::optional<parser::KindParam> &kindParam,
+ KindParam defaultKind, KindParam kanjiKind) {
+ if (!kindParam.has_value()) {
+ return defaultKind;
}
+ return std::visit(common::visitors{[](std::uint64_t k) { return static_cast<KindParam>(k); },
+ [&](const parser::Scalar<parser::Integer<parser::Constant<parser::Name>>> &n) {
+ if (std::optional<evaluate::GenericExpr> oge{AnalyzeHelper(*this, n)}) {
+ if (std::optional<evaluate::GenericConstant> ogc{oge->ConstantValue()}) {
+ // TODO pmk more here next
+ }
+ }
+ return defaultKind;
+ },
+ [&](parser::KindParam::Kanji) {
+ if (kanjiKind >= 0) {
+ return kanjiKind;
+ }
+ Say("Kanji not allowed here"_err_en_US);
+ return defaultKind; }}, kindParam->u);
+}
+
+template<> std::optional<evaluate::GenericExpr> AnalyzeHelper(ExpressionAnalyzer &ea,
+ const parser::IntLiteralConstant &x) {
+ auto kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
+ ea.defaultIntegerKind())};
std::uint64_t value{std::get<std::uint64_t>(x.t)};
switch (kind) {
- case 4:
- return {evaluate::GenericExpr{
- evaluate::GenericIntegerExpr{evaluate::IntegerExpr<4>{value}}}};
+#define CASE(k) case k: return {evaluate::GenericExpr{evaluate::GenericIntegerExpr{evaluate::IntegerExpr<k>{value}}}};
+ FOR_EACH_INTEGER_KIND(CASE,)
+#undef CASE
default:
- messages_.Say(at_,
- parser::MessageFormattedText{
+ ea.Say(parser::MessageFormattedText{
"unimplemented INTEGER kind (%ju)"_err_en_US,
static_cast<std::uintmax_t>(kind)});
return {};
}
}
-std::optional<evaluate::GenericExpr> ExpressionAnalyzer::Analyze(
+template<> std::optional<evaluate::GenericExpr> AnalyzeHelper(ExpressionAnalyzer &ea,
const parser::LiteralConstant &x) {
return std::visit(
common::visitors{
- [&](const parser::IntLiteralConstant &c) { return Analyze(c); },
+ [&](const parser::IntLiteralConstant &c) { return AnalyzeHelper(ea, c); },
+ // TODO next [&](const parser::RealLiteralConstant &c) { return AnalyzeHelper(ea, c); },
+ // TODO: remaining cases
+ [&](const auto &) { return std::optional<evaluate::GenericExpr>{}; }},
+ x.u);
+}
+
+std::optional<evaluate::GenericExpr> ExpressionAnalyzer::Analyze(
+ const parser::Expr &x) {
+ return std::visit(
+ common::visitors{
+ [&](const parser::LiteralConstant &c) { return AnalyzeHelper(*this, c); },
+ // TODO: remaining cases
[&](const auto &) { return std::optional<evaluate::GenericExpr>{}; }},
x.u);
}
class ExpressionAnalyzer {
public:
- ExpressionAnalyzer(parser::Messages &m, std::uint64_t dIK)
- : messages_{m}, defaultIntegerKind_{dIK} {}
+ using KindParam = std::int64_t;
+ ExpressionAnalyzer(evaluate::FoldingContext &c, KindParam dIK)
+ : context_{c}, defaultIntegerKind_{dIK} {}
+
+ evaluate::FoldingContext &context() { return context_; }
+ KindParam defaultIntegerKind() const { return defaultIntegerKind_; }
+
+ template<typename M>
+ void Say(const M &msg) {
+ if (context_.messages != nullptr) {
+ context_.messages->Say(context_.at, msg);
+ }
+ }
+
+ // Performs semantic checking on an expression. If successful,
+ // returns its typed expression representation.
std::optional<evaluate::GenericExpr> Analyze(const parser::Expr &);
- std::optional<evaluate::GenericExpr> Analyze(
- const parser::IntLiteralConstant &);
- std::optional<evaluate::GenericExpr> Analyze(const parser::LiteralConstant &);
+ KindParam Analyze(const std::optional<parser::KindParam> &, KindParam defaultKind, KindParam kanjiKind = -1 /* not allowed here */);
private:
- parser::Messages &messages_;
- const parser::CharBlock at_;
- std::uint64_t defaultIntegerKind_{4};
+ evaluate::FoldingContext context_;
+ KindParam defaultIntegerKind_{4};
};
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_EXPRESSION_H_
DerivedTypeSpec
TypeSpec classes are immutable. For intrinsic types (except character) there
-are a limited number of instances -- one for each kind.
+is a limited number of instances -- one for each kind.
A DerivedTypeSpec is based on a DerivedTypeDef (from a derived type statement)
with kind and len parameter values provided.
projects / platform / upstream / llvm.git / commitdiff