// Intended to be as invisible as a reference, wherever possible.
#include "../common/idioms.h"
+#include <memory>
#include <type_traits>
#include <utility>
A *p_{nullptr};
};
+// A variant of Indirection suitable for use with forward-referenced types.
+// These are nullable pointers, not references. Allocation is not available,
+// and a single externalized destructor must be defined.
+template<typename A> class OwningPointer {
+public:
+ using element_type = A;
+
+ OwningPointer() {}
+ OwningPointer(OwningPointer &&that) : p_{that.release()} {}
+ explicit OwningPointer(std::unique_ptr<A> &&that) : p_{that.release()} {}
+ explicit OwningPointer(A *&&p) : p_{p} { p = nullptr; }
+ ~OwningPointer();
+ OwningPointer &operator=(OwningPointer &&that) {
+ reset(that.release());
+ return *this;
+ }
+
+ A &operator*() { return *p_; }
+ const A &operator*() const { return *p_; }
+ A *operator->() { return p_; }
+ const A *operator->() const { return p_; }
+
+ A *get() const { return p_; }
+
+ A *release() {
+ A *result{p_};
+ p_ = nullptr;
+ return result;
+ }
+
+ void reset(A *p) {
+ this->~OwningPointer();
+ p_ = p;
+ }
+
+private:
+ A *p_{nullptr};
+};
+
} // namespace Fortran::common
#endif // FORTRAN_COMMON_INDIRECTION_H_
template<typename D, typename R, typename... O>
auto Operation<D, R, O...>::Fold(FoldingContext &context)
-> std::optional<Constant<Result>> {
- auto c0{operand<0>().Fold(context)};
- if constexpr (operands() == 1) {
+ auto c0{left().Fold(context)};
+ if constexpr (operands == 1) {
if (c0.has_value()) {
if (auto scalar{derived().FoldScalar(context, c0->value)}) {
return {Constant<Result>{std::move(*scalar)}};
}
}
} else {
- static_assert(operands() == 2); // TODO: generalize to N operands?
- auto c1{operand<1>().Fold(context)};
+ static_assert(operands == 2); // TODO: generalize to N operands?
+ auto c1{right().Fold(context)};
if (c0.has_value() && c1.has_value()) {
if (auto scalar{derived().FoldScalar(context, c0->value, c1->value)}) {
return {Constant<Result>{std::move(*scalar)}};
template<typename D, typename R, typename... O>
std::ostream &Operation<D, R, O...>::Dump(std::ostream &o) const {
- operand<0>().Dump(o << derived().prefix());
- if constexpr (operands() > 1) {
- operand<1>().Dump(o << derived().infix());
+ left().Dump(derived().Prefix(o));
+ if constexpr (operands > 1) {
+ right().Dump(derived().Infix(o));
}
- return o << derived().suffix();
+ return derived().Suffix(o);
}
-template<typename A> std::string Relational<A>::infix() const {
- return "."s + EnumToString(opr) + '.';
+template<typename TO, TypeCategory FROMCAT>
+std::ostream &Convert<TO, FROMCAT>::Dump(std::ostream &o) const {
+ static_assert(TO::category == TypeCategory::Integer ||
+ TO::category == TypeCategory::Real ||
+ TO::category == TypeCategory::Logical || !"Convert<> to bad category!");
+ if constexpr (TO::category == TypeCategory::Integer) {
+ o << "INT";
+ } else if constexpr (TO::category == TypeCategory::Real) {
+ o << "REAL";
+ } else if constexpr (TO::category == TypeCategory::Logical) {
+ o << "LOGICAL";
+ }
+ return this->left().Dump(o << '(') << ",KIND=" << TO::kind << ')';
+}
+
+template<typename A> std::ostream &Relational<A>::Infix(std::ostream &o) const {
+ return o << '.' << EnumToString(opr) << '.';
}
std::ostream &Relational<SomeType>::Dump(std::ostream &o) const {
return o;
}
-template<int KIND> const char *LogicalOperation<KIND>::infix() const {
- const char *result{nullptr};
+template<int KIND>
+std::ostream &LogicalOperation<KIND>::Infix(std::ostream &o) const {
switch (logicalOperator) {
- case LogicalOperator::And: result = ".AND."; break;
- case LogicalOperator::Or: result = ".OR."; break;
- case LogicalOperator::Eqv: result = ".EQV."; break;
- case LogicalOperator::Neqv: result = ".NEQV."; break;
+ case LogicalOperator::And: o << ".AND."; break;
+ case LogicalOperator::Or: o << ".OR."; break;
+ case LogicalOperator::Eqv: o << ".EQV."; break;
+ case LogicalOperator::Neqv: o << ".NEQV."; break;
}
- return result;
+ return o;
}
template<typename T> std::ostream &Constant<T>::Dump(std::ostream &o) const {
static_cast<std::uint64_t>(c.value.size())});
},
[](const Concat<KIND> &c) {
- return c.template operand<0>().LEN() +
- c.template operand<1>().LEN();
+ return c.left().LEN() + c.template right().LEN();
},
[](const Extremum<Result> &c) {
- return Expr<SubscriptInteger>{Extremum<SubscriptInteger>{
- c.template operand<0>().LEN(), c.template operand<1>().LEN()}};
+ return Expr<SubscriptInteger>{
+ Extremum<SubscriptInteger>{c.left().LEN(), c.right().LEN()}};
},
[](const DataReference<Result> &dr) { return dr.reference->LEN(); },
[](const CopyableIndirection<Substring> &ss) { return ss->LEN(); },
if constexpr (common::HasMember<Parentheses<Result>,
decltype(derived().u)>) {
if (auto p{common::GetIf<Parentheses<Result>>(derived().u)}) {
- return p->template operand<0>().ScalarValue();
+ return p->left().ScalarValue();
}
}
} else if constexpr (std::is_same_v<Result, SomeType>) {
return std::nullopt;
}
+Expr<SomeType>::~Expr() {}
+
// Template instantiations to resolve the "extern template" declarations
// in expression.h.
template struct ExpressionBase<SomeType>;
} // namespace Fortran::evaluate
+
+// For reclamation of analyzed expressions to which owning pointers have
+// been embedded in the parse tree. This destructor appears here, where
+// definitions for all the necessary types are available, to obviate a
+// need to include lib/evaluate/*.h headers in the parser proper.
+namespace Fortran::common {
+template<> OwningPointer<evaluate::GenericExprWrapper>::~OwningPointer() {
+ delete p_;
+ p_ = nullptr;
+}
+template class OwningPointer<evaluate::GenericExprWrapper>;
+} // namespace Fortran::common
CopyableIndirection<FunctionRef> reference;
};
-// Abstract Operation<> base class. The first type parameter is a "CRTP"
-// reference to the specific operation class; e.g., Add is defined with
-// struct Add : public Operation<Add, ...>.
+// 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
+// template. Note that Operation has as its first type parameter (DERIVED) a
+// "curiously reoccurring template pattern (CRTP)" reference to the specific
+// operation class being derived from Operation; e.g., Add is defined with
+// struct Add : public Operation<Add, ...>. Uses of instances of Operation<>,
+// including its own member functions, can access each specific class derived
+// from it via its derived() member function with compile-time type safety.
template<typename DERIVED, typename RESULT, typename... OPERANDS>
class Operation {
- using OperandTypes = std::tuple<OPERANDS...>;
- static_assert(RESULT::kind > 0 || !"bad result Type");
+ static_assert(RESULT::isSpecificType || !"bad result Type");
+ // The extra "int" member is a dummy that allows a safe unused reference
+ // to element 1 to arise indirectly in the definition of "right()" below
+ // when the operation has but a single operand.
+ using OperandTypes = std::tuple<OPERANDS..., int>;
public:
using Derived = DERIVED;
using Result = RESULT;
- static constexpr auto operands() { return std::tuple_size_v<OperandTypes>; }
+ static constexpr std::size_t operands{sizeof...(OPERANDS)};
template<int J> using Operand = std::tuple_element_t<J, OperandTypes>;
using IsFoldableTrait = std::true_type;
// Binary operations wrap a tuple of CopyableIndirections to Exprs.
private:
using Container =
- std::conditional_t<operands() == 1, CopyableIndirection<Expr<Operand<0>>>,
+ std::conditional_t<operands == 1, CopyableIndirection<Expr<Operand<0>>>,
std::tuple<CopyableIndirection<Expr<OPERANDS>>...>>;
public:
Derived &derived() { return *static_cast<Derived *>(this); }
const Derived &derived() const { return *static_cast<const Derived *>(this); }
+ // References to operand expressions from member functions of derived
+ // classes for specific operators can be made by index, e.g. operand<0>(),
+ // which must be spelled like "this->template operand<0>()" when
+ // inherited in a derived class template. There are convenience aliases
+ // left() and right() that are not templates.
template<int J> Expr<Operand<J>> &operand() {
- if constexpr (operands() == 1) {
+ if constexpr (operands == 1) {
static_assert(J == 0);
return *operand_;
} else {
}
}
template<int J> const Expr<Operand<J>> &operand() const {
- if constexpr (operands() == 1) {
+ if constexpr (operands == 1) {
static_assert(J == 0);
return *operand_;
} else {
}
}
+ Expr<Operand<0>> &left() { return operand<0>(); }
+ const Expr<Operand<0>> &left() const { return operand<0>(); }
+
+ std::conditional_t<(operands > 1), Expr<Operand<1>> &, void> right() {
+ if constexpr (operands > 1) {
+ return operand<1>();
+ }
+ }
+ std::conditional_t<(operands > 1), const Expr<Operand<1>> &, void>
+ right() const {
+ if constexpr (operands > 1) {
+ return operand<1>();
+ }
+ }
+
std::ostream &Dump(std::ostream &) const;
std::optional<Constant<Result>> Fold(FoldingContext &);
protected:
- // Overridable string functions for Dump()
- static const char *prefix() { return "("; }
- static const char *infix() { return ","; }
- static const char *suffix() { return ")"; }
+ // Overridable functions for Dump()
+ static std::ostream &Prefix(std::ostream &o) { return o << '('; }
+ static std::ostream &Infix(std::ostream &o) { return o << ','; }
+ static std::ostream &Suffix(std::ostream &o) { return o << ')'; }
private:
Container operand_;
// Unary operations
+// Conversions to specific types from expressions of known category and
+// dynamic kind.
template<typename TO, TypeCategory FROMCAT>
struct Convert : public Operation<Convert<TO, FROMCAT>, TO, SomeKind<FROMCAT>> {
+ // Fortran doesn't have conversions between kinds of CHARACTER.
+ // Conversions between kinds of COMPLEX are represented piecewise.
+ static_assert(((TO::category == TypeCategory::Integer ||
+ TO::category == TypeCategory::Real) &&
+ (FROMCAT == TypeCategory::Integer ||
+ FROMCAT == TypeCategory::Real)) ||
+ (TO::category == TypeCategory::Logical &&
+ FROMCAT == TypeCategory::Logical));
using Result = TO;
using Operand = SomeKind<FROMCAT>;
using Base = Operation<Convert, Result, Operand>;
using Base::Base;
static std::optional<Scalar<Result>> FoldScalar(
FoldingContext &, const Scalar<Operand> &);
+ std::ostream &Dump(std::ostream &) const;
};
template<typename A>
using Base::Base;
static std::optional<Scalar<Result>> FoldScalar(
FoldingContext &, const Scalar<Operand> &);
- static const char *prefix() { return "(-"; }
+ static std::ostream &Prefix(std::ostream &o) { return o << "(-"; }
};
template<int KIND>
std::optional<Scalar<Result>> FoldScalar(
FoldingContext &, const Scalar<Operand> &) const;
- const char *suffix() const { return isImaginaryPart ? "%IM)" : "%RE)"; }
+ std::ostream &Suffix(std::ostream &o) const {
+ return o << (isImaginaryPart ? "%IM)" : "%RE)");
+ }
bool isImaginaryPart{true};
};
using Base::Base;
static std::optional<Scalar<Result>> FoldScalar(
FoldingContext &, const Scalar<Operand> &);
- static const char *prefix() { return "(.NOT."; }
+ static std::ostream &Prefix(std::ostream &o) { return o << "(.NOT."; }
};
// Binary operations
using Base::Base;
static std::optional<Scalar<Result>> FoldScalar(
FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &);
- static constexpr const char *infix() { return "+"; }
+ static std::ostream &Infix(std::ostream &o) { return o << '+'; }
};
template<typename A> struct Subtract : public Operation<Subtract<A>, A, A, A> {
using Base::Base;
static std::optional<Scalar<Result>> FoldScalar(
FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &);
- static constexpr const char *infix() { return "-"; }
+ static std::ostream &Infix(std::ostream &o) { return o << '-'; }
};
template<typename A> struct Multiply : public Operation<Multiply<A>, A, A, A> {
using Base::Base;
static std::optional<Scalar<Result>> FoldScalar(
FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &);
- static constexpr const char *infix() { return "*"; }
+ static std::ostream &Infix(std::ostream &o) { return o << '*'; }
};
template<typename A> struct Divide : public Operation<Divide<A>, A, A, A> {
using Base::Base;
static std::optional<Scalar<Result>> FoldScalar(
FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &);
- static constexpr const char *infix() { return "/"; }
+ static std::ostream &Infix(std::ostream &o) { return o << '/'; }
};
template<typename A> struct Power : public Operation<Power<A>, A, A, A> {
using Base::Base;
static std::optional<Scalar<Result>> FoldScalar(
FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &);
- static constexpr const char *infix() { return "**"; }
+ static std::ostream &Infix(std::ostream &o) { return o << "**"; }
};
template<typename A>
using Base::Base;
static std::optional<Scalar<Result>> FoldScalar(FoldingContext &,
const Scalar<BaseOperand> &, const Scalar<ExponentOperand> &);
- static constexpr const char *infix() { return "**"; }
+ static std::ostream &Infix(std::ostream &o) { return o << "**"; }
};
template<typename A> struct Extremum : public Operation<Extremum<A>, A, A, A> {
std::optional<Scalar<Result>> FoldScalar(
FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &) const;
- const char *prefix() const {
- return ordering == Ordering::Less ? "MIN(" : "MAX(";
+ std::ostream &Prefix(std::ostream &o) const {
+ return o << (ordering == Ordering::Less ? "MIN(" : "MAX(");
}
Ordering ordering{Ordering::Greater};
using Base::Base;
static std::optional<Scalar<Result>> FoldScalar(
FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &);
- static constexpr const char *infix() { return "//"; }
+ static std::ostream &Infix(std::ostream &o) { return o << "//"; }
};
ENUM_CLASS(LogicalOperator, And, Or, Eqv, Neqv)
std::optional<Scalar<Result>> FoldScalar(
FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &) const;
- const char *infix() const;
+ std::ostream &Infix(std::ostream &) const;
LogicalOperator logicalOperator;
};
std::optional<Scalar<Result>> FoldScalar(
FoldingContext &c, const Scalar<Operand> &, const Scalar<Operand> &);
- std::string infix() const;
+ std::ostream &Infix(std::ostream &) const;
RelationalOperator opr;
};
using IsFoldableTrait = std::true_type;
CLASS_BOILERPLATE(Expr)
+ // Owning references to these generic expressions can appear in other
+ // compiler data structures (viz., the parse tree and symbol table), so
+ // its destructor is externalized to reduce redundant default instances.
+ ~Expr();
+
template<typename A> Expr(const A &x) : u{x} {}
template<typename A>
Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x) : u{std::move(x)} {}
common::CombineVariants<Others, Categories> u;
};
+// This wrapper class is used, by means of a forward reference with
+// OwningPointer, to implement owning pointers to analyzed expressions
+// from parse tree nodes.
+struct GenericExprWrapper {
+ GenericExprWrapper(Expr<SomeType> &&x) : v{std::move(x)} {}
+ Expr<SomeType> v;
+};
+
extern template class Expr<SomeInteger>;
extern template class Expr<SomeReal>;
extern template class Expr<SomeComplex>;
std::move(x.u), std::move(y.u));
}
-// A helper template for NumericOperation and its subroutines.
+// Helpers for NumericOperation and its subroutines below.
+static std::optional<Expr<SomeType>> NoExpr() { return std::nullopt; }
+
template<TypeCategory CAT>
std::optional<Expr<SomeType>> Package(Expr<SomeKind<CAT>> &&catExpr) {
return {AsGenericExpr(std::move(catExpr))};
if (catExpr.has_value()) {
return {AsGenericExpr(std::move(*catExpr))};
}
- return std::nullopt;
+ return NoExpr();
}
std::optional<Expr<SomeComplex>> ConstructComplex(
Expr<SomeComplex> zy{ConvertTo(zx, std::move(iry))};
return Package(PromoteAndCombine<OPR>(std::move(zx), std::move(zy)));
}
- return std::nullopt;
+ return NoExpr();
}
// Mixed COMPLEX operations with the COMPLEX operand on the right.
Expr<SomeComplex> zx{ConvertTo(zy, std::move(irx))};
return Package(PromoteAndCombine<OPR>(std::move(zx), std::move(zy)));
}
- return std::nullopt;
+ return NoExpr();
}
// N.B. When a "typeless" BOZ literal constant appears as one (not both!) of
},
// Default case
[&](auto &&, auto &&) {
+ // TODO: defined operator
messages.Say("non-numeric operands to numeric operation"_err_en_US);
- return std::optional<Expr<SomeType>>{std::nullopt};
+ return NoExpr();
}},
std::move(x.u), std::move(y.u));
}
template std::optional<Expr<SomeType>> NumericOperation<Divide>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
+std::optional<Expr<SomeType>> Negation(
+ parser::ContextualMessages &messages, Expr<SomeType> &&x) {
+ return std::visit(
+ common::visitors{[&](BOZLiteralConstant &&) {
+ messages.Say(
+ "BOZ literal cannot be negated"_err_en_US);
+ return NoExpr();
+ },
+ [&](Expr<SomeInteger> &&x) { return Package(std::move(x)); },
+ [&](Expr<SomeReal> &&x) { return Package(-std::move(x)); },
+ [&](Expr<SomeComplex> &&x) { return Package(-std::move(x)); },
+ [&](Expr<SomeCharacter> &&x) {
+ // TODO: defined operator
+ messages.Say("CHARACTER cannot be negated"_err_en_US);
+ return NoExpr();
+ },
+ [&](Expr<SomeLogical> &&x) {
+ // TODO: defined operator
+ messages.Say("LOGICAL cannot be negated"_err_en_US);
+ return NoExpr();
+ }},
+ std::move(x.u));
+}
+
} // namespace Fortran::evaluate
extern template std::optional<Expr<SomeType>> NumericOperation<Divide>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
+std::optional<Expr<SomeType>> Negation(
+ parser::ContextualMessages &, Expr<SomeType> &&);
+
// Convenience functions and operator overloadings for expression construction.
// These interfaces are defined only for those situations that cannot possibly
// need to emit any messages. Use the more general NumericOperation<>
return {Negate<Type<C, K>>{std::move(x)}};
}
+template<int K>
+Expr<Type<TypeCategory::Complex, K>> operator-(
+ Expr<Type<TypeCategory::Complex, K>> &&x) {
+ using Part = Type<TypeCategory::Real, K>;
+ return {ComplexConstructor<K>{Negate<Part>{ComplexComponent<K>{false, x}},
+ Negate<Part>{ComplexComponent<K>{true, x}}}};
+}
+
template<TypeCategory C, int K>
Expr<Type<C, K>> operator+(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
return {Add<Type<C, K>>{std::move(x), std::move(y)}};
class Symbol;
} // namespace Fortran::semantics
+// Expressions in the parse tree have owning pointers that can be set to
+// type-checked generic expression representations by semantic analysis.
+// OwningPointer<> is used for leak safety without having to include
+// the bulk of lib/evaluate/*.h headers into the parser proper.
+namespace Fortran::evaluate {
+struct GenericExprWrapper; // forward definition, wraps Expr<SomeType>
+} // namespace Fortran::evaluate
+namespace Fortran::common {
+extern template class OwningPointer<evaluate::GenericExprWrapper>;
+} // namespace Fortran::common
+
// Most non-template classes in this file use these default definitions
// for their move constructor and move assignment operator=, and disable
// their copy constructor and copy assignment operator=.
explicit Expr(Designator &&);
explicit Expr(FunctionReference &&);
+ // Filled in later during semantic analysis of the expression.
+ common::OwningPointer<evaluate::GenericExprWrapper> typedExpr;
+
std::variant<common::Indirection<CharLiteralConstantSubstring>,
LiteralConstant, common::Indirection<Designator>, ArrayConstructor,
StructureConstructor, common::Indirection<TypeParamInquiry>,
// limitations under the License.
#include "expression.h"
+#include "dump-parse-tree.h" // TODO pmk temporary
#include "symbol.h"
#include "../common/idioms.h"
#include "../evaluate/common.h"
#include "../evaluate/tools.h"
+#include "../parser/parse-tree-visitor.h"
+#include "../parser/parse-tree.h"
#include <functional>
#include <optional>
int Analyze(
const std::optional<parser::KindParam> &, int defaultKind, int kanjiKind);
+
MaybeExpr Analyze(const parser::Expr &);
+ MaybeExpr Analyze(const parser::CharLiteralConstantSubstring &);
MaybeExpr Analyze(const parser::LiteralConstant &);
MaybeExpr Analyze(const parser::HollerithLiteralConstant &);
MaybeExpr Analyze(const parser::IntLiteralConstant &);
MaybeExpr Analyze(const parser::Name &);
MaybeExpr Analyze(const parser::NamedConstant &);
MaybeExpr Analyze(const parser::ComplexPart &);
-
+ MaybeExpr Analyze(const parser::Designator &);
+ MaybeExpr Analyze(const parser::ArrayConstructor &);
+ MaybeExpr Analyze(const parser::StructureConstructor &);
+ MaybeExpr Analyze(const parser::TypeParamInquiry &);
+ MaybeExpr Analyze(const parser::FunctionReference &);
MaybeExpr Analyze(const parser::Expr::Parentheses &);
- MaybeExpr Analyze(const parser::Expr::UnaryPlus &); // TODO
- MaybeExpr Analyze(const parser::Expr::Negate &); // TODO
- MaybeExpr Analyze(const parser::Expr::NOT &); // TODO
- MaybeExpr Analyze(const parser::Expr::DefinedUnary &); // TODO
- MaybeExpr Analyze(const parser::Expr::Power &); // TODO
+ MaybeExpr Analyze(const parser::Expr::UnaryPlus &);
+ MaybeExpr Analyze(const parser::Expr::Negate &);
+ MaybeExpr Analyze(const parser::Expr::NOT &);
+ MaybeExpr Analyze(const parser::Expr::PercentLoc &);
+ MaybeExpr Analyze(const parser::Expr::DefinedUnary &);
+ MaybeExpr Analyze(const parser::Expr::Power &);
MaybeExpr Analyze(const parser::Expr::Multiply &);
MaybeExpr Analyze(const parser::Expr::Divide &);
MaybeExpr Analyze(const parser::Expr::Add &);
MaybeExpr Analyze(const parser::Expr::Subtract &);
- MaybeExpr Analyze(const parser::Expr::Concat &); // TODO
- MaybeExpr Analyze(const parser::Expr::LT &); // TODO
- MaybeExpr Analyze(const parser::Expr::LE &); // TODO
- MaybeExpr Analyze(const parser::Expr::EQ &); // TODO
- MaybeExpr Analyze(const parser::Expr::NE &); // TODO
- MaybeExpr Analyze(const parser::Expr::GE &); // TODO
- MaybeExpr Analyze(const parser::Expr::GT &); // TODO
- MaybeExpr Analyze(const parser::Expr::AND &); // TODO
- MaybeExpr Analyze(const parser::Expr::OR &); // TODO
- MaybeExpr Analyze(const parser::Expr::EQV &); // TODO
- MaybeExpr Analyze(const parser::Expr::NEQV &); // TODO
- MaybeExpr Analyze(const parser::Expr::XOR &); // TODO
+ MaybeExpr Analyze(const parser::Expr::Concat &);
+ MaybeExpr Analyze(const parser::Expr::LT &);
+ MaybeExpr Analyze(const parser::Expr::LE &);
+ MaybeExpr Analyze(const parser::Expr::EQ &);
+ MaybeExpr Analyze(const parser::Expr::NE &);
+ MaybeExpr Analyze(const parser::Expr::GE &);
+ MaybeExpr Analyze(const parser::Expr::GT &);
+ MaybeExpr Analyze(const parser::Expr::AND &);
+ MaybeExpr Analyze(const parser::Expr::OR &);
+ MaybeExpr Analyze(const parser::Expr::EQV &);
+ MaybeExpr Analyze(const parser::Expr::NEQV &);
+ MaybeExpr Analyze(const parser::Expr::XOR &);
MaybeExpr Analyze(const parser::Expr::ComplexConstructor &);
- MaybeExpr Analyze(const parser::Expr::DefinedBinary &); // TODO
- // TODO more remain
+ MaybeExpr Analyze(const parser::Expr::DefinedBinary &);
FoldingContext &context;
const semantics::IntrinsicTypeDefaultKinds &defaults;
return std::visit([&](const auto &x) { return AnalyzeHelper(ea, x); }, u);
}
+template<typename A>
+MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const common::Indirection<A> &x) {
+ return AnalyzeHelper(ea, *x);
+}
+
MaybeExpr ExprAnalyzer::Analyze(const parser::Expr &expr) {
- return std::visit(common::visitors{[&](const parser::LiteralConstant &c) {
- return AnalyzeHelper(*this, c);
- },
- // TODO: remaining cases
- [&](const auto &) { return MaybeExpr{}; }},
- expr.u);
+ return std::visit(
+ [&](const auto &x) { return AnalyzeHelper(*this, x); }, expr.u);
}
MaybeExpr ExprAnalyzer::Analyze(const parser::LiteralConstant &x) {
for (const char *p{x.real.source.begin()}; p < end; ++p) {
if (parser::IsLetter(*p)) {
switch (*p) {
- case 'e': letterKind = 4; break;
- case 'd': letterKind = 8; break;
- case 'q': letterKind = 16; break;
+ case 'e': letterKind = defaults.defaultRealKind; break;
+ case 'd': letterKind = defaults.defaultDoublePrecisionKind; break;
+ case 'q': letterKind = defaults.defaultQuadPrecisionKind; break;
default: ctxMsgs.Say("unknown exponent letter '%c'"_err_en_US, *p);
}
break;
return Analyze(n.v);
}
+MaybeExpr ExprAnalyzer::Analyze(const parser::CharLiteralConstantSubstring &) {
+ context.messages.Say(
+ "pmk: CharLiteralConstantSubstring unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Designator &) {
+ context.messages.Say("pmk: Designator unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::ArrayConstructor &) {
+ context.messages.Say("pmk: ArrayConstructor unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::StructureConstructor &) {
+ context.messages.Say("pmk: StructureConstructor unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::TypeParamInquiry &) {
+ context.messages.Say("pmk: TypeParamInquiry unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::FunctionReference &) {
+ context.messages.Say("pmk: FunctionReference unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::Parentheses &x) {
if (MaybeExpr operand{AnalyzeHelper(*this, *x.v)}) {
return std::visit(
return std::nullopt;
}
-// TODO: defined operators for illegal intrinsic operator cases
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::UnaryPlus &x) {
+ return AnalyzeHelper(*this, *x.v);
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::Negate &x) {
+ if (MaybeExpr operand{AnalyzeHelper(*this, *x.v)}) {
+ return Negation(context.messages, std::move(operand->u));
+ }
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::NOT &) {
+ context.messages.Say("pmk: NOT unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::PercentLoc &) {
+ context.messages.Say("pmk: %LOC unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::DefinedUnary &) {
+ context.messages.Say("pmk: DefinedUnary unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+// TODO: check defined operators for illegal intrinsic operator cases
template<template<typename> class OPR, typename PARSED>
MaybeExpr BinaryOperationHelper(ExprAnalyzer &ea, const PARSED &x) {
if (auto both{common::AllPresent(AnalyzeHelper(ea, *std::get<0>(x.t)),
AnalyzeHelper(*this, *std::get<1>(x.t))));
}
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::Power &) {
+ context.messages.Say("pmk: Power unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::Concat &) {
+ context.messages.Say("pmk: Concat unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::LT &) {
+ context.messages.Say("pmk: .LT. unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::LE &) {
+ context.messages.Say("pmk: .LE. unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::EQ &) {
+ context.messages.Say("pmk: .EQ. unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::NE &) {
+ context.messages.Say("pmk: .NE. unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::GT &) {
+ context.messages.Say("pmk: .GT. unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::GE &) {
+ context.messages.Say("pmk: .GE. unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::AND &) {
+ context.messages.Say("pmk: .AND. unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::OR &) {
+ context.messages.Say("pmk: .OR. unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::EQV &) {
+ context.messages.Say("pmk: .EQV. unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::NEQV &) {
+ context.messages.Say("pmk: .NEQV. unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::XOR &) {
+ context.messages.Say("pmk: .XOR. unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
+MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::DefinedBinary &) {
+ context.messages.Say("pmk: DefinedBinary unimplemented\n"_err_en_US);
+ return std::nullopt;
+}
+
} // namespace Fortran::evaluate
namespace Fortran::semantics {
return evaluate::ExprAnalyzer{context, defaults}.Analyze(expr);
}
+class Mutator {
+public:
+ Mutator(evaluate::FoldingContext &context,
+ const IntrinsicTypeDefaultKinds &defaults, std::ostream &o)
+ : context_{context}, defaults_{defaults}, out_{o} {}
+
+ template<typename A> bool Pre(A &) { return true /* visit children */; }
+ template<typename A> void Post(A &) {}
+
+ bool Pre(parser::Expr &expr) {
+ if (expr.typedExpr.get() == nullptr) {
+ if (MaybeExpr checked{AnalyzeExpr(context_, defaults_, expr)}) {
+ checked->Dump(out_ << "pmk checked: ") << '\n';
+ expr.typedExpr.reset(
+ new evaluate::GenericExprWrapper{std::move(*checked)});
+ } else {
+ out_ << "pmk: expression analysis failed for an expression: ";
+ DumpTree(out_, expr);
+ }
+ }
+ return false;
+ }
+
+private:
+ evaluate::FoldingContext &context_;
+ const IntrinsicTypeDefaultKinds &defaults_;
+ std::ostream &out_;
+};
+
+void AnalyzeExpressions(parser::Program &program,
+ evaluate::FoldingContext &context,
+ const IntrinsicTypeDefaultKinds &defaults, std::ostream &o) {
+ Mutator mutator{context, defaults, o};
+ parser::Walk(program, mutator);
+}
+
} // namespace Fortran::semantics
#include "../parser/parse-tree.h"
#include <cinttypes>
#include <optional>
+#include <ostream> // TODO pmk
namespace Fortran::semantics {
struct IntrinsicTypeDefaultKinds {
int defaultIntegerKind{evaluate::DefaultInteger::kind};
int defaultRealKind{evaluate::DefaultReal::kind};
+ int defaultDoublePrecisionKind{evaluate::DefaultDoublePrecision::kind};
+ int defaultQuadPrecisionKind{evaluate::DefaultDoublePrecision::kind};
int defaultCharacterKind{evaluate::DefaultCharacter::kind};
int defaultLogicalKind{evaluate::DefaultLogical::kind};
};
MaybeExpr AnalyzeExpr(evaluate::FoldingContext &,
const IntrinsicTypeDefaultKinds &, const parser::Expr &);
+void AnalyzeExpressions(parser::Program &, evaluate::FoldingContext &,
+ const IntrinsicTypeDefaultKinds &, std::ostream &);
+
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_EXPRESSION_H_
target_link_libraries(f18
FortranParser
FortranSemantics
+ FortranEvaluate
)
#include "../../lib/parser/provenance.h"
#include "../../lib/parser/unparse.h"
#include "../../lib/semantics/dump-parse-tree.h"
+#include "../../lib/semantics/expression.h"
#include "../../lib/semantics/mod-file.h"
#include "../../lib/semantics/resolve-labels.h"
#include "../../lib/semantics/resolve-names.h"
bool dumpUnparseWithSymbols{false};
bool dumpParseTree{false};
bool dumpSymbols{false};
+ bool debugExpressions{false};
bool debugResolveNames{false};
bool measureTree{false};
std::vector<std::string> pgf90Args;
MeasureParseTree(parseTree);
}
if (driver.debugResolveNames || driver.dumpSymbols ||
- driver.dumpUnparseWithSymbols) {
+ driver.dumpUnparseWithSymbols || driver.debugExpressions) {
std::vector<std::string> directories{options.searchDirectories};
directories.insert(directories.begin(), "."s);
if (driver.moduleDirectory != "."s) {
return {};
}
}
+ if (driver.debugExpressions) {
+ Fortran::parser::CharBlock whole{parsing.cooked().data()};
+ Fortran::parser::Messages messages;
+ Fortran::parser::ContextualMessages contextualMessages{whole, &messages};
+ Fortran::evaluate::FoldingContext context{contextualMessages};
+ Fortran::semantics::IntrinsicTypeDefaultKinds defaults;
+ Fortran::semantics::AnalyzeExpressions(
+ parseTree, context, defaults, std::cout);
+ messages.Emit(std::cerr, parsing.cooked());
+ if (!messages.empty() &&
+ (driver.warningsAreErrors || messages.AnyFatalError())) {
+ std::cerr << driver.prefix << "semantic errors in " << path << '\n';
+ exitStatus = EXIT_FAILURE;
+ return {};
+ }
+ }
if (driver.dumpParseTree) {
Fortran::semantics::DumpTree(std::cout, parseTree);
}
driver.dumpParseTree = true;
} else if (arg == "-fdebug-dump-symbols") {
driver.dumpSymbols = true;
+ } else if (arg == "-fdebug-expressions") {
+ driver.debugExpressions = true;
} else if (arg == "-fdebug-resolve-names") {
driver.debugResolveNames = true;
} else if (arg == "-fdebug-measure-parse-tree") {
projects / platform / upstream / llvm.git / commitdiff