From abac228b8276b462d97c04d99ed5bc381b1c1322 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Fri, 26 Oct 2018 15:10:24 -0700 Subject: [PATCH] [flang] Complete refactor of Fold() - checkpoint Original-commit: flang-compiler/f18@5061171268ef6a4552aa365642d3f5ad120f871f Reviewed-on: https://github.com/flang-compiler/f18/pull/219 Tree-same-pre-rewrite: false --- flang/lib/evaluate/CMakeLists.txt | 1 + flang/lib/evaluate/call.cc | 2 +- flang/lib/evaluate/call.h | 1 + flang/lib/evaluate/common.h | 6 +- flang/lib/evaluate/expression.cc | 417 +--------------------------------- flang/lib/evaluate/expression.h | 70 +----- flang/lib/evaluate/fold.cc | 463 ++++++++++++++++++++++++++++++++++++++ flang/lib/evaluate/fold.h | 395 +++----------------------------- flang/lib/evaluate/intrinsics.cc | 16 +- flang/lib/evaluate/tools.h | 87 ++++--- flang/lib/evaluate/type.h | 155 ++++--------- flang/lib/evaluate/variable.cc | 126 ++++++----- flang/lib/evaluate/variable.h | 26 ++- flang/lib/semantics/expression.cc | 29 +-- flang/test/evaluate/expression.cc | 3 +- 15 files changed, 725 insertions(+), 1072 deletions(-) create mode 100644 flang/lib/evaluate/fold.cc diff --git a/flang/lib/evaluate/CMakeLists.txt b/flang/lib/evaluate/CMakeLists.txt index a98c921..8fed50a 100644 --- a/flang/lib/evaluate/CMakeLists.txt +++ b/flang/lib/evaluate/CMakeLists.txt @@ -17,6 +17,7 @@ add_library(FortranEvaluate common.cc complex.cc expression.cc + fold.cc integer.cc intrinsics.cc logical.cc diff --git a/flang/lib/evaluate/call.cc b/flang/lib/evaluate/call.cc index b9a9098..f8d82f3 100644 --- a/flang/lib/evaluate/call.cc +++ b/flang/lib/evaluate/call.cc @@ -60,5 +60,5 @@ Expr ProcedureRef::LEN() const { return proc_.LEN(); } -FOR_EACH_SPECIFIC_TYPE(template struct FunctionRef) +FOR_EACH_SPECIFIC_TYPE(template struct FunctionRef, ;) } diff --git a/flang/lib/evaluate/call.h b/flang/lib/evaluate/call.h index 2ac4cd7..d7737b0 100644 --- a/flang/lib/evaluate/call.h +++ b/flang/lib/evaluate/call.h @@ -45,6 +45,7 @@ struct ActualArgument { bool isAlternateReturn{false}; // when true, "value" is a label number // TODO: Mark legacy %VAL and %REF arguments + // TODO: pmk: Mark arguments that were originally parenthesized // Subtlety: There is a distinction that must be maintained here between an // actual argument expression that is a variable and one that is not, diff --git a/flang/lib/evaluate/common.h b/flang/lib/evaluate/common.h index 701c58b..11fb3d3 100644 --- a/flang/lib/evaluate/common.h +++ b/flang/lib/evaluate/common.h @@ -82,6 +82,7 @@ static constexpr bool Satisfies(RelationalOperator op, Ordering order) { return op == RelationalOperator::NE || op == RelationalOperator::GE || op == RelationalOperator::GT; } + return false; // silence g++ warning } static constexpr bool Satisfies(RelationalOperator op, Relation relation) { @@ -97,6 +98,7 @@ static constexpr bool Satisfies(RelationalOperator op, Relation relation) { op == RelationalOperator::GT; case Relation::Unordered: return false; } + return false; // silence g++ warning } ENUM_CLASS( @@ -174,10 +176,6 @@ template using CopyableIndirection = common::Indirection; // definition template class Expr; -// Classes that support a Fold(FoldingContext &) member function have the -// IsFoldableTrait. -CLASS_TRAIT(IsFoldableTrait) // TODO pmk rm - struct FoldingContext { explicit FoldingContext(const parser::ContextualMessages &m, Rounding round = defaultRounding, bool flush = false) diff --git a/flang/lib/evaluate/expression.cc b/flang/lib/evaluate/expression.cc index d2bb60d..e71d425 100644 --- a/flang/lib/evaluate/expression.cc +++ b/flang/lib/evaluate/expression.cc @@ -14,7 +14,6 @@ #include "expression.h" #include "common.h" -#include "fold.h" #include "int-power.h" #include "tools.h" #include "variable.h" @@ -29,368 +28,6 @@ using namespace Fortran::parser::literals; namespace Fortran::evaluate { -// Fold - -template -auto Operation::Fold(FoldingContext &context) - -> std::optional> { - auto c0{left().Fold(context)}; - if constexpr (operands == 1) { - if (c0.has_value()) { - if (auto scalar{derived().FoldScalar(context, c0->value)}) { - return {Constant{std::move(*scalar)}}; - } - } - } else { - 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{std::move(*scalar)}}; - } - } - } - return std::nullopt; -} - -template -auto ExpressionBase::Fold(FoldingContext &context) - -> std::optional> { - using Const = Constant; - if constexpr (Result::isSpecificIntrinsicType) { - // Folding an expression of known type category and kind. - return std::visit( - [&](auto &x) -> std::optional { - using Thing = std::decay_t; - if constexpr (std::is_same_v) { - return {x}; - } - if constexpr (IsFoldableTrait) { - if (auto c{x.Fold(context)}) { - static constexpr TypeCategory category{Result::category}; - if constexpr (category == TypeCategory::Real || - category == TypeCategory::Complex) { - if (context.flushDenormalsToZero) { - c->value = c->value.FlushDenormalToZero(); - } - } else if constexpr (category == TypeCategory::Logical) { - // Folding may have produced a constant of some - // dissimilar LOGICAL kind. - bool truth{c->value.IsTrue()}; - derived() = Derived{truth}; - return {Const{truth}}; - } - if constexpr (std::is_same_v, Thing>) { - // Preserve parentheses around constants. - derived() = Derived{Thing{Derived{*c}}}; - } else { - derived() = Derived{*c}; - } - return {Const{c->value}}; - } - } - return std::nullopt; - }, - derived().u); - } else { - // Folding a generic expression into a generic constant. - return std::visit( - [&](auto &x) -> std::optional { - if constexpr (IsFoldableTrait>) { - if (auto c{x.Fold(context)}) { - if constexpr (ResultType::isSpecificIntrinsicType) { - return {Const{c->value}}; - } else { - return {Const{common::MoveVariant(c->value.u)}}; - } - } - } - return std::nullopt; - }, - derived().u); - } -} - -// FoldScalar - -template -auto Convert::FoldScalar(FoldingContext &context, - const Scalar &x) -> std::optional> { - return std::visit( - [&](const auto &c) -> std::optional> { - if constexpr (Result::category == TypeCategory::Integer) { - if constexpr (Operand::category == TypeCategory::Integer) { - auto converted{Scalar::ConvertSigned(c)}; - if (converted.overflow) { - context.messages.Say( - "INTEGER to INTEGER conversion overflowed"_en_US); - } else { - return {std::move(converted.value)}; - } - } else if constexpr (Operand::category == TypeCategory::Real) { - auto converted{c.template ToInteger>()}; - if (converted.flags.test(RealFlag::InvalidArgument)) { - context.messages.Say( - "REAL to INTEGER conversion: invalid argument"_en_US); - } else if (converted.flags.test(RealFlag::Overflow)) { - context.messages.Say( - "REAL to INTEGER conversion overflowed"_en_US); - } else { - return {std::move(converted.value)}; - } - } - } else if constexpr (Result::category == TypeCategory::Real) { - if constexpr (Operand::category == TypeCategory::Integer) { - auto converted{Scalar::FromInteger(c)}; - RealFlagWarnings( - context, converted.flags, "INTEGER to REAL conversion"); - return {std::move(converted.value)}; - } else if constexpr (Operand::category == TypeCategory::Real) { - auto converted{Scalar::Convert(c)}; - RealFlagWarnings( - context, converted.flags, "REAL to REAL conversion"); - return {std::move(converted.value)}; - } - } - return std::nullopt; - }, - x.u); -} - -template -auto Negate::FoldScalar(FoldingContext &context, const Scalar &c) - -> std::optional> { - if constexpr (Result::category == TypeCategory::Integer) { - auto negated{c.Negate()}; - if (negated.overflow) { - context.messages.Say("INTEGER negation overflowed"_en_US); - } else { - return {std::move(negated.value)}; - } - } else { - return {c.Negate()}; // REAL & COMPLEX: no exceptions possible - } - return std::nullopt; -} - -template -auto ComplexComponent::FoldScalar(FoldingContext &context, - const Scalar &z) const -> std::optional> { - return {isImaginaryPart ? z.AIMAG() : z.REAL()}; -} - -template -auto Not::FoldScalar(FoldingContext &context, const Scalar &x) - -> std::optional> { - return {Scalar{!x.IsTrue()}}; -} - -template -auto Add::FoldScalar(FoldingContext &context, const Scalar &x, - const Scalar &y) -> std::optional> { - if constexpr (Result::category == TypeCategory::Integer) { - auto sum{x.AddSigned(y)}; - if (sum.overflow) { - context.messages.Say( - "INTEGER(KIND=%d) addition overflowed"_en_US, Result::kind); - return std::nullopt; - } - return {std::move(sum.value)}; - } else { - auto sum{x.Add(y, context.rounding)}; - RealFlagWarnings(context, sum.flags, "addition"); - return {std::move(sum.value)}; - } -} - -template -auto Subtract::FoldScalar(FoldingContext &context, const Scalar &x, - const Scalar &y) -> std::optional> { - if constexpr (Result::category == TypeCategory::Integer) { - auto diff{x.SubtractSigned(y)}; - if (diff.overflow) { - context.messages.Say( - "INTEGER(KIND=%d) subtraction overflowed"_en_US, Result::kind); - return std::nullopt; - } - return {std::move(diff.value)}; - } else { - auto difference{x.Subtract(y, context.rounding)}; - RealFlagWarnings(context, difference.flags, "subtraction"); - return {std::move(difference.value)}; - } -} - -template -auto Multiply::FoldScalar(FoldingContext &context, const Scalar &x, - const Scalar &y) -> std::optional> { - if constexpr (Result::category == TypeCategory::Integer) { - auto product{x.MultiplySigned(y)}; - if (product.SignedMultiplicationOverflowed()) { - context.messages.Say( - "INTEGER(KIND=%d) multiplication overflowed"_en_US, Result::kind); - return std::nullopt; - } - return {std::move(product.lower)}; - } else { - auto product{x.Multiply(y, context.rounding)}; - RealFlagWarnings(context, product.flags, "multiplication"); - return {std::move(product.value)}; - } -} - -template -auto Divide::FoldScalar(FoldingContext &context, const Scalar &x, - const Scalar &y) -> std::optional> { - if constexpr (Result::category == TypeCategory::Integer) { - auto qr{x.DivideSigned(y)}; - if (qr.divisionByZero) { - context.messages.Say("INTEGER division by zero"_en_US); - return std::nullopt; - } - if (qr.overflow) { - context.messages.Say( - "INTEGER(KIND=%d) division overflowed"_en_US, Result::kind); - return std::nullopt; - } - return {std::move(qr.quotient)}; - } else { - auto quotient{x.Divide(y, context.rounding)}; - RealFlagWarnings(context, quotient.flags, "division"); - return {std::move(quotient.value)}; - } -} - -template -auto Power::FoldScalar(FoldingContext &context, const Scalar &x, - const Scalar &y) -> std::optional> { - if constexpr (Result::category == TypeCategory::Integer) { - typename Scalar::PowerWithErrors power{x.Power(y)}; - if (power.divisionByZero) { - context.messages.Say("zero to negative power"_en_US); - } else if (power.overflow) { - context.messages.Say( - "INTEGER(KIND=%d) power overflowed"_en_US, Result::kind); - } else if (power.zeroToZero) { - context.messages.Say("INTEGER 0**0 is not defined"_en_US); - } else { - return {std::move(power.power)}; - } - } else { - // TODO: real and complex exponentiation to non-integer powers - } - return std::nullopt; -} - -template -auto RealToIntPower::FoldScalar(FoldingContext &context, - const Scalar &x, const Scalar &y) - -> std::optional> { - return std::visit( - [&](const auto &pow) -> std::optional> { - auto power{evaluate::IntPower(x, pow)}; - RealFlagWarnings(context, power.flags, "raising to INTEGER power"); - return {std::move(power.value)}; - }, - y.u); -} - -template -auto Extremum::FoldScalar(FoldingContext &context, const Scalar &x, - const Scalar &y) const -> std::optional> { - if constexpr (Operand::category == TypeCategory::Integer) { - if (ordering == x.CompareSigned(y)) { - return {x}; - } - } else if constexpr (Operand::category == TypeCategory::Real) { - if (x.IsNotANumber() || - (x.Compare(y) == Relation::Less) == (ordering == Ordering::Less)) { - return {x}; - } - } else { - if (ordering == Compare(x, y)) { - return {x}; - } - } - return {y}; -} - -template -auto ComplexConstructor::FoldScalar( - FoldingContext &context, const Scalar &x, const Scalar &y) - -> std::optional> { - return {Scalar{x, y}}; -} - -template -auto Concat::FoldScalar(FoldingContext &context, const Scalar &x, - const Scalar &y) -> std::optional> { - if constexpr (KIND == 1) { - return {x + y}; - } - return std::nullopt; -} - -template -auto Relational::FoldScalar(FoldingContext &c, const Scalar &a, - const Scalar &b) -> std::optional> { - if constexpr (A::category == TypeCategory::Integer) { - switch (a.CompareSigned(b)) { - case Ordering::Less: - return {opr == RelationalOperator::LE || opr == RelationalOperator::LE || - opr == RelationalOperator::NE}; - case Ordering::Equal: - return {opr == RelationalOperator::LE || opr == RelationalOperator::EQ || - opr == RelationalOperator::GE}; - case Ordering::Greater: - return {opr == RelationalOperator::NE || opr == RelationalOperator::GE || - opr == RelationalOperator::GT}; - } - } - if constexpr (A::category == TypeCategory::Real) { - switch (a.Compare(b)) { - case Relation::Less: - return {opr == RelationalOperator::LE || opr == RelationalOperator::LE || - opr == RelationalOperator::NE}; - case Relation::Equal: - return {opr == RelationalOperator::LE || opr == RelationalOperator::EQ || - opr == RelationalOperator::GE}; - case Relation::Greater: - return {opr == RelationalOperator::NE || opr == RelationalOperator::GE || - opr == RelationalOperator::GT}; - case Relation::Unordered: return std::nullopt; - } - } - if constexpr (A::category == TypeCategory::Character) { - switch (Compare(a, b)) { - case Ordering::Less: - return {opr == RelationalOperator::LE || opr == RelationalOperator::LE || - opr == RelationalOperator::NE}; - case Ordering::Equal: - return {opr == RelationalOperator::LE || opr == RelationalOperator::EQ || - opr == RelationalOperator::GE}; - case Ordering::Greater: - return {opr == RelationalOperator::NE || opr == RelationalOperator::GE || - opr == RelationalOperator::GT}; - } - } - return std::nullopt; -} - -template -auto LogicalOperation::FoldScalar(FoldingContext &context, - const Scalar &x, const Scalar &y) const - -> std::optional> { - bool xt{x.IsTrue()}, yt{y.IsTrue()}; - switch (logicalOperator) { - case LogicalOperator::And: return {Scalar{xt && yt}}; - case LogicalOperator::Or: return {Scalar{xt || yt}}; - case LogicalOperator::Eqv: return {Scalar{xt == yt}}; - case LogicalOperator::Neqv: return {Scalar{xt != yt}}; - } - return std::nullopt; -} - // Dump template @@ -498,46 +135,6 @@ Expr Expr>::LEN() const { u); } -template -auto ExpressionBase::ScalarValue() const - -> std::optional> { - if constexpr (Result::isSpecificIntrinsicType) { - if (auto *c{std::get_if>(&derived().u)}) { - return {c->value}; - } - if (auto *p{std::get_if>(&derived().u)}) { - return p->left().ScalarValue(); - } - } else if constexpr (std::is_same_v) { - return std::visit( - common::visitors{ - [](const BOZLiteralConstant &) -> std::optional> { - return std::nullopt; - }, - [](const Expr &) -> std::optional> { - return std::nullopt; - }, - [](const auto &catEx) -> std::optional> { - if (auto cv{catEx.ScalarValue()}) { - // *cv is SomeKindScalar for some category; rewrap it. - return {common::MoveVariant(std::move(cv->u))}; - } - return std::nullopt; - }}, - derived().u); - } else { - return std::visit( - [](const auto &kindEx) -> std::optional> { - if (auto sv{kindEx.ScalarValue()}) { - return {SomeKindScalar{*sv}}; - } - return std::nullopt; - }, - derived().u); - } - return std::nullopt; -} - Expr::~Expr() {} template @@ -581,14 +178,14 @@ int Expr::Rank() const { // Template instantiations to resolve the "extern template" declarations // that appear in expression.h. -FOR_EACH_INTRINSIC_KIND(template class Expr) -FOR_EACH_CATEGORY_TYPE(template class Expr) -FOR_EACH_INTEGER_KIND(template struct Relational) -FOR_EACH_REAL_KIND(template struct Relational) -FOR_EACH_CHARACTER_KIND(template struct Relational) +FOR_EACH_INTRINSIC_KIND(template class Expr, ;) +FOR_EACH_CATEGORY_TYPE(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; -FOR_EACH_INTRINSIC_KIND(template struct ExpressionBase) -FOR_EACH_CATEGORY_TYPE(template struct ExpressionBase) +FOR_EACH_INTRINSIC_KIND(template struct ExpressionBase, ;) +FOR_EACH_CATEGORY_TYPE(template struct ExpressionBase, ;) } // For reclamation of analyzed expressions to which owning pointers have diff --git a/flang/lib/evaluate/expression.h b/flang/lib/evaluate/expression.h index 1030dfc..610a5a0 100644 --- a/flang/lib/evaluate/expression.h +++ b/flang/lib/evaluate/expression.h @@ -56,13 +56,9 @@ using common::RelationalOperator; // // Every Expr specialization supports at least these interfaces: // using Result = ...; // type of a result of this expression -// using IsFoldableTrait = ...; // DynamicType GetType() const; // int Rank() const; // std::ostream &Dump(std::ostream &) const; -// // If IsFoldableTrait::value is true, then these exist: -// std::optional> Fold(FoldingContext &c); -// std::optional> ScalarValue() const; // Everything that can appear in, or as, a valid Fortran expression must be // represented with an instance of some class containing a Result typedef that @@ -98,7 +94,6 @@ public: static_assert(Result::isSpecificIntrinsicType); static constexpr std::size_t operands{sizeof...(OPERANDS)}; template using Operand = std::tuple_element_t; - using IsFoldableTrait = std::true_type; // Unary operations wrap a single Expr with a CopyableIndirection. // Binary operations wrap a tuple of CopyableIndirections to Exprs. @@ -166,7 +161,6 @@ public: } std::ostream &Dump(std::ostream &) const; - std::optional> Fold(FoldingContext &); protected: // Overridable functions for Dump() @@ -196,8 +190,6 @@ struct Convert : public Operation, TO, SomeKind> { using Operand = SomeKind; using Base = Operation; using Base::Base; - static std::optional> FoldScalar( - FoldingContext &, const Scalar &); std::ostream &Dump(std::ostream &) const; }; @@ -207,10 +199,6 @@ struct Parentheses : public Operation, A, A> { using Operand = A; using Base = Operation; using Base::Base; - static std::optional> FoldScalar( - FoldingContext &, const Scalar &x) { - return {x}; - } }; template struct Negate : public Operation, A, A> { @@ -218,8 +206,6 @@ template struct Negate : public Operation, A, A> { using Operand = A; using Base = Operation; using Base::Base; - static std::optional> FoldScalar( - FoldingContext &, const Scalar &); static std::ostream &Prefix(std::ostream &o) { return o << "(-"; } }; @@ -236,8 +222,6 @@ struct ComplexComponent ComplexComponent(bool isImaginary, Expr &&x) : Base{std::move(x)}, isImaginaryPart{isImaginary} {} - std::optional> FoldScalar( - FoldingContext &, const Scalar &) const; std::ostream &Suffix(std::ostream &o) const { return o << (isImaginaryPart ? "%IM)" : "%RE)"); } @@ -252,8 +236,6 @@ struct Not : public Operation, Type, using Operand = Result; using Base = Operation; using Base::Base; - static std::optional> FoldScalar( - FoldingContext &, const Scalar &); static std::ostream &Prefix(std::ostream &o) { return o << "(.NOT."; } }; @@ -264,8 +246,6 @@ template struct Add : public Operation, A, A, A> { using Operand = A; using Base = Operation; using Base::Base; - static std::optional> FoldScalar( - FoldingContext &, const Scalar &, const Scalar &); static std::ostream &Infix(std::ostream &o) { return o << '+'; } }; @@ -274,8 +254,6 @@ template struct Subtract : public Operation, A, A, A> { using Operand = A; using Base = Operation; using Base::Base; - static std::optional> FoldScalar( - FoldingContext &, const Scalar &, const Scalar &); static std::ostream &Infix(std::ostream &o) { return o << '-'; } }; @@ -284,8 +262,6 @@ template struct Multiply : public Operation, A, A, A> { using Operand = A; using Base = Operation; using Base::Base; - static std::optional> FoldScalar( - FoldingContext &, const Scalar &, const Scalar &); static std::ostream &Infix(std::ostream &o) { return o << '*'; } }; @@ -294,8 +270,6 @@ template struct Divide : public Operation, A, A, A> { using Operand = A; using Base = Operation; using Base::Base; - static std::optional> FoldScalar( - FoldingContext &, const Scalar &, const Scalar &); static std::ostream &Infix(std::ostream &o) { return o << '/'; } }; @@ -304,8 +278,6 @@ template struct Power : public Operation, A, A, A> { using Operand = A; using Base = Operation; using Base::Base; - static std::optional> FoldScalar( - FoldingContext &, const Scalar &, const Scalar &); static std::ostream &Infix(std::ostream &o) { return o << "**"; } }; @@ -316,8 +288,6 @@ struct RealToIntPower : public Operation, A, A, SomeInteger> { using BaseOperand = A; using ExponentOperand = SomeInteger; using Base::Base; - static std::optional> FoldScalar(FoldingContext &, - const Scalar &, const Scalar &); static std::ostream &Infix(std::ostream &o) { return o << "**"; } }; @@ -333,8 +303,6 @@ template struct Extremum : public Operation, A, A, A> { Expr &&x, Expr &&y, Ordering ord = Ordering::Greater) : Base{std::move(x), std::move(y)}, ordering{ord} {} - std::optional> FoldScalar( - FoldingContext &, const Scalar &, const Scalar &) const; std::ostream &Prefix(std::ostream &o) const { return o << (ordering == Ordering::Less ? "MIN(" : "MAX("); } @@ -351,8 +319,6 @@ struct ComplexConstructor using Operand = Type; using Base = Operation; using Base::Base; - static std::optional> FoldScalar( - FoldingContext &, const Scalar &, const Scalar &); }; template @@ -364,8 +330,6 @@ struct Concat using Operand = Result; using Base = Operation; using Base::Base; - static std::optional> FoldScalar( - FoldingContext &, const Scalar &, const Scalar &); static std::ostream &Infix(std::ostream &o) { return o << "//"; } }; @@ -385,8 +349,6 @@ struct LogicalOperation LogicalOperation(LogicalOperator opr, Expr &&x, Expr &&y) : Base{std::move(x), std::move(y)}, logicalOperator{opr} {} - std::optional> FoldScalar( - FoldingContext &, const Scalar &, const Scalar &) const; std::ostream &Infix(std::ostream &) const; LogicalOperator logicalOperator; @@ -418,8 +380,6 @@ template struct ExpressionBase { std::optional GetType() const; int Rank() const; std::ostream &Dump(std::ostream &) const; - std::optional> Fold(FoldingContext &c); - std::optional> ScalarValue() const; }; template @@ -427,7 +387,6 @@ class Expr> : public ExpressionBase> { public: using Result = Type; - using IsFoldableTrait = std::true_type; // TODO: R916 type-param-inquiry EVALUATE_UNION_CLASS_BOILERPLATE(Expr) @@ -454,7 +413,6 @@ class Expr> : public ExpressionBase> { public: using Result = Type; - using IsFoldableTrait = std::true_type; EVALUATE_UNION_CLASS_BOILERPLATE(Expr) explicit Expr(const Scalar &x) : u{Constant{x}} {} @@ -480,7 +438,6 @@ class Expr> : public ExpressionBase> { public: using Result = Type; - using IsFoldableTrait = std::true_type; EVALUATE_UNION_CLASS_BOILERPLATE(Expr) explicit Expr(const Scalar &x) : u{Constant{x}} {} @@ -496,16 +453,15 @@ public: common::CombineVariants u; }; -FOR_EACH_INTEGER_KIND(extern template class Expr) -FOR_EACH_REAL_KIND(extern template class Expr) -FOR_EACH_COMPLEX_KIND(extern template class Expr) +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 class Expr> : public ExpressionBase> { public: using Result = Type; - using IsFoldableTrait = std::true_type; EVALUATE_UNION_CLASS_BOILERPLATE(Expr) explicit Expr(const Scalar &x) : u{Constant{x}} {} explicit Expr(Scalar &&x) : u{Constant{std::move(x)}} {} @@ -517,7 +473,7 @@ public: u; }; -FOR_EACH_CHARACTER_KIND(extern template class Expr) +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 @@ -542,8 +498,6 @@ struct Relational : public Operation, LogicalResult, A, A> { Relational(RelationalOperator r, Expr &&a, Expr &&b) : Base{std::move(a), std::move(b)}, opr{r} {} - std::optional> FoldScalar( - FoldingContext &c, const Scalar &, const Scalar &); std::ostream &Infix(std::ostream &) const; RelationalOperator opr; @@ -567,9 +521,9 @@ public: common::MapTemplate u; }; -FOR_EACH_INTEGER_KIND(extern template struct Relational) -FOR_EACH_REAL_KIND(extern template struct Relational) -FOR_EACH_CHARACTER_KIND(extern template struct Relational) +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; // Logical expressions of a kind bigger than LogicalResult @@ -581,7 +535,6 @@ class Expr> : public ExpressionBase> { public: using Result = Type; - using IsFoldableTrait = std::true_type; EVALUATE_UNION_CLASS_BOILERPLATE(Expr) explicit Expr(const Scalar &x) : u{Constant{x}} {} explicit Expr(bool x) : u{Constant{x}} {} @@ -598,7 +551,7 @@ public: common::CombineVariants u; }; -FOR_EACH_LOGICAL_KIND(extern template class Expr) +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> @@ -607,7 +560,6 @@ template class Expr> : public ExpressionBase> { public: using Result = SomeKind; - using IsFoldableTrait = std::true_type; EVALUATE_UNION_CLASS_BOILERPLATE(Expr) common::MapTemplate> u; }; @@ -618,7 +570,6 @@ public: template<> class Expr { public: using Result = SomeDerived; - using IsFoldableTrait = std::false_type; EVALUATE_UNION_CLASS_BOILERPLATE(Expr) std::optional GetType() const; @@ -633,7 +584,6 @@ public: template<> class Expr : public ExpressionBase { public: using Result = SomeType; - using IsFoldableTrait = std::true_type; EVALUATE_UNION_CLASS_BOILERPLATE(Expr) // Owning references to these generic expressions can appear in other @@ -676,7 +626,7 @@ struct GenericExprWrapper { Expr v; }; -FOR_EACH_CATEGORY_TYPE(extern template class Expr) -FOR_EACH_TYPE_AND_KIND(extern template struct ExpressionBase) +FOR_EACH_CATEGORY_TYPE(extern template class Expr, ;) +FOR_EACH_TYPE_AND_KIND(extern template struct ExpressionBase, ;) } #endif // FORTRAN_EVALUATE_EXPRESSION_H_ diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc new file mode 100644 index 0000000..a22ddee --- /dev/null +++ b/flang/lib/evaluate/fold.cc @@ -0,0 +1,463 @@ +// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#include "fold.h" +#include "common.h" +#include "expression.h" +#include "int-power.h" +#include "tools.h" +#include "type.h" +#include "../common/indirection.h" +#include "../parser/message.h" +#include +#include // TODO pmk rm +#include +#include +#include + +namespace Fortran::evaluate { + +// no-op base case +template +Expr> FoldOperation(FoldingContext &, A &&x) { + return Expr>{std::move(x)}; +} + +// Designators +// At the moment, only substrings fold. +// TODO: Parameters, KIND type parameters +template +Expr> FoldOperation(FoldingContext &context, + Designator> &&designator) { + using CHAR = Type; + if (auto *substring{std::get_if(&designator.u)}) { + if (auto folded{substring->Fold(context)}) { + if (auto *string{std::get_if>(&*folded)}) { + return Expr{Constant{std::move(*string)}}; + } + // A zero-length substring of an arbitrary data reference can + // be folded, but the C++ string type of the empty value will be + // std::string and that may not be right for multi-byte CHARACTER + // kinds. + if (auto length{ToInt64(Fold(context, substring->LEN()))}) { + if (*length == 0) { + return Expr{Constant{Scalar{}}}; + } + } + } + } + return Expr{std::move(designator)}; +} + +// TODO: Fold/rewrite intrinsic function references + +// Unary operations + +template +Expr FoldOperation( + FoldingContext &context, Convert &&convert) { + return std::visit( + [&](auto &kindExpr) -> Expr { + kindExpr = Fold(context, std::move(kindExpr)); + using Operand = ResultType; + char buffer[64]; + if (auto c{GetScalarConstantValue(kindExpr)}) { + if constexpr (TO::category == TypeCategory::Integer) { + if constexpr (Operand::category == TypeCategory::Integer) { + auto converted{Scalar::ConvertSigned(c->value)}; + if (converted.overflow) { + context.messages.Say( + "INTEGER(%d) to INTEGER(%d) conversion overflowed"_en_US, + Operand::kind, TO::kind); + } + return Expr{Constant{std::move(converted.value)}}; + } else if constexpr (Operand::category == TypeCategory::Real) { + auto converted{c->value.template ToInteger>()}; + if (converted.flags.test(RealFlag::InvalidArgument)) { + context.messages.Say( + "REAL(%d) to INTEGER(%d) conversion: invalid argument"_en_US, + Operand::kind, TO::kind); + } else if (converted.flags.test(RealFlag::Overflow)) { + context.messages.Say( + "REAL(%d) to INTEGER(%d) conversion overflowed"_en_US, + Operand::kind, TO::kind); + } + return Expr{Constant{std::move(converted.value)}}; + } + } else if constexpr (TO::category == TypeCategory::Real) { + if constexpr (Operand::category == TypeCategory::Integer) { + auto converted{Scalar::FromInteger(c->value)}; + if (!converted.flags.empty()) { + std::snprintf(buffer, sizeof buffer, + "INTEGER(%d) to REAL(%d) conversion", Operand::kind, + TO::kind); + RealFlagWarnings(context, converted.flags, buffer); + } + return Expr{Constant{std::move(converted.value)}}; + } else if constexpr (Operand::category == TypeCategory::Real) { + auto converted{Scalar::Convert(c->value)}; + if (!converted.flags.empty()) { + std::snprintf(buffer, sizeof buffer, + "REAL(%d) to REAL(%d) conversion", Operand::kind, TO::kind); + RealFlagWarnings(context, converted.flags, buffer); + } + if (context.flushDenormalsToZero) { + converted.value = converted.value.FlushDenormalToZero(); + } + return Expr{Constant{std::move(converted.value)}}; + } + } else if constexpr (TO::category == TypeCategory::Logical && + Operand::category == TypeCategory::Logical) { + return Expr{Constant{c->value.IsTrue()}}; + } + } + return Expr{std::move(convert)}; + }, + convert.left().u); +} + +template +Expr FoldOperation(FoldingContext &context, Parentheses &&x) { + auto &operand{x.left()}; + operand.Dump(std::cout << "pmk: Parentheses Fold operand: ") << '\n'; + operand = Fold(context, std::move(operand)); + if (auto c{GetScalarConstantValue(operand)}) { + // Preserve parentheses, even around constants. + // TODO pmk: Once parentheses around arguments are recorded, don't do this + return Expr{Parentheses{Expr{Constant{std::move(c->value)}}}}; + } + return Expr{std::move(x)}; +} + +template +Expr FoldOperation(FoldingContext &context, Negate &&x) { + auto &operand{x.left()}; + operand = Fold(context, std::move(operand)); + if (auto c{GetScalarConstantValue(operand)}) { + if constexpr (T::category == TypeCategory::Integer) { + auto negated{c->value.Negate()}; + if (negated.overflow) { + context.messages.Say("INTEGER(%d) negation overflowed"_en_US, T::kind); + } + return Expr{Constant{std::move(negated.value)}}; + } else { + // REAL & COMPLEX negation: no exceptions possible + return Expr{Constant{c->value.Negate()}}; + } + } + return Expr{std::move(x)}; +} + +template +Expr> FoldOperation( + FoldingContext &context, ComplexComponent &&x) { + using Part = Type; + auto &operand{x.left()}; + operand = Fold(context, std::move(operand)); + if (auto z{GetScalarConstantValue(operand)}) { + if (x.isImaginaryPart) { + return Expr{Constant{z->value.AIMAG()}}; + } else { + return Expr{Constant{z->value.REAL()}}; + } + } + return Expr{std::move(x)}; +} + +template +Expr> FoldOperation( + FoldingContext &context, Not &&x) { + using Ty = Type; + auto &operand{x.left()}; + operand = Fold(context, std::move(operand)); + if (auto c{GetScalarConstantValue(operand)}) { + return Expr{Constant{c->value.IsTrue()}}; + } + return Expr{x}; +} + +// Binary (dyadic) operations + +template +std::optional, Scalar>> FoldOperands( + FoldingContext &context, Expr &x, Expr &y) { + std::cout << "pmk: FoldOperands begin\n"; + x = Fold(context, std::move(x)); + y = Fold(context, std::move(y)); + if (auto xc{GetScalarConstantValue(x)}) { + if (auto yc{GetScalarConstantValue(y)}) { + std::cout << "pmk: FoldOperands success\n"; + return {std::make_pair(xc->value, yc->value)}; + } + } + std::cout << "pmk: FoldOperands failure\n"; + return std::nullopt; +} + +template +Expr FoldOperation(FoldingContext &context, Add &&x) { + if (auto folded{FoldOperands(context, x.left(), x.right())}) { + if constexpr (T::category == TypeCategory::Integer) { + auto sum{folded->first.AddSigned(folded->second)}; + if (sum.overflow) { + context.messages.Say("INTEGER(%d) addition overflowed"_en_US, T::kind); + } + return Expr{Constant{sum.value}}; + } else { + auto sum{folded->first.Add(folded->second, context.rounding)}; + RealFlagWarnings(context, sum.flags, "addition"); + if (context.flushDenormalsToZero) { + sum.value = sum.value.FlushDenormalToZero(); + } + return Expr{Constant{sum.value}}; + } + } + return Expr{std::move(x)}; +} + +template +Expr FoldOperation(FoldingContext &context, Subtract &&x) { + if (auto folded{FoldOperands(context, x.left(), x.right())}) { + if constexpr (T::category == TypeCategory::Integer) { + auto difference{folded->first.SubtractSigned(folded->second)}; + if (difference.overflow) { + context.messages.Say( + "INTEGER(%d) subtraction overflowed"_en_US, T::kind); + } + return Expr{Constant{difference.value}}; + } else { + auto difference{folded->first.Subtract(folded->second, context.rounding)}; + RealFlagWarnings(context, difference.flags, "subtraction"); + if (context.flushDenormalsToZero) { + difference.value = difference.value.FlushDenormalToZero(); + } + return Expr{Constant{difference.value}}; + } + } + return Expr{std::move(x)}; +} + +template +Expr FoldOperation(FoldingContext &context, Multiply &&x) { + if (auto folded{FoldOperands(context, x.left(), x.right())}) { + if constexpr (T::category == TypeCategory::Integer) { + auto product{folded->first.MultiplySigned(folded->second)}; + if (product.SignedMultiplicationOverflowed()) { + context.messages.Say( + "INTEGER(%d) multiplication overflowed"_en_US, T::kind); + } + return Expr{Constant{product.lower}}; + } else { + auto product{folded->first.Multiply(folded->second, context.rounding)}; + RealFlagWarnings(context, product.flags, "multiplication"); + if (context.flushDenormalsToZero) { + product.value = product.value.FlushDenormalToZero(); + } + return Expr{Constant{product.value}}; + } + } + return Expr{std::move(x)}; +} + +template +Expr FoldOperation(FoldingContext &context, Divide &&x) { + if (auto folded{FoldOperands(context, x.left(), x.right())}) { + if constexpr (T::category == TypeCategory::Integer) { + auto quotAndRem{folded->first.DivideSigned(folded->second)}; + if (quotAndRem.divisionByZero) { + context.messages.Say("INTEGER(%d) division by zero"_en_US, T::kind); + } + if (quotAndRem.overflow) { + context.messages.Say("INTEGER(%d) division overflowed"_en_US, T::kind); + } + return Expr{Constant{quotAndRem.quotient}}; + } else { + auto quotient{folded->first.Divide(folded->second, context.rounding)}; + RealFlagWarnings(context, quotient.flags, "division"); + if (context.flushDenormalsToZero) { + quotient.value = quotient.value.FlushDenormalToZero(); + } + return Expr{Constant{quotient.value}}; + } + } + return Expr{std::move(x)}; +} + +template +Expr FoldOperation(FoldingContext &context, Power &&x) { + if (auto folded{FoldOperands(context, x.left(), x.right())}) { + if constexpr (T::category == TypeCategory::Integer) { + auto power{folded->first.Power(folded->second)}; + if (power.divisionByZero) { + context.messages.Say( + "INTEGER(%d) zero to negative power"_en_US, T::kind); + } else if (power.overflow) { + context.messages.Say("INTEGER(%d) power overflowed"_en_US, T::kind); + } else if (power.zeroToZero) { + context.messages.Say("INTEGER(%d) 0**0 is not defined"_en_US, T::kind); + } + return Expr{Constant{power.power}}; + } else { + // TODO: real & complex power with non-integral exponent + } + } + return Expr{std::move(x)}; +} + +template +Expr FoldOperation(FoldingContext &context, RealToIntPower &&x) { + return std::visit( + [&](auto &y) -> Expr { + if (auto folded{FoldOperands(context, x.left(), y)}) { + auto power{evaluate::IntPower(folded->first, folded->second)}; + RealFlagWarnings(context, power.flags, "power with INTEGER exponent"); + if (context.flushDenormalsToZero) { + power.value = power.value.FlushDenormalToZero(); + } + return Expr{Constant{power.value}}; + } else { + return Expr{std::move(x)}; + } + }, + x.right().u); +} + +template +Expr FoldOperation(FoldingContext &context, Extremum &&x) { + if (auto folded{FoldOperands(context, x.left(), x.right())}) { + if constexpr (T::category == TypeCategory::Integer) { + if (folded->first.CompareSigned(folded->second) == x.ordering) { + return Expr{Constant{folded->first}}; + } + } else if constexpr (T::category == TypeCategory::Real) { + if (folded->first.IsNotANumber() || + (folded->first.Compare(folded->second) == Relation::Less) == + (x.ordering == Ordering::Less)) { + return Expr{Constant{folded->first}}; + } + } else { + if (x.ordering == Compare(folded->first, folded->second)) { + return Expr{Constant{folded->first}}; + } + } + return Expr{Constant{folded->second}}; + } + return Expr{std::move(x)}; +} + +template +Expr> FoldOperation( + FoldingContext &context, ComplexConstructor &&x) { + using COMPLEX = Type; + if (auto folded{FoldOperands(context, x.left(), x.right())}) { + return Expr{ + Constant{Scalar{folded->first, folded->second}}}; + } + return Expr{std::move(x)}; +} + +template +Expr> FoldOperation( + FoldingContext &context, Concat &&x) { + using CHAR = Type; + if (auto folded{FoldOperands(context, x.left(), x.right())}) { + return Expr{Constant{folded->first + folded->second}}; + } + return Expr{std::move(x)}; +} + +template +Expr FoldOperation( + FoldingContext &context, Relational &&relation) { + if (auto folded{FoldOperands(context, relation.left(), relation.right())}) { + bool result{}; + if constexpr (T::category == TypeCategory::Integer) { + result = + Satisfies(relation.opr, folded->first.CompareSigned(folded->second)); + } else if constexpr (T::category == TypeCategory::Real) { + result = Satisfies(relation.opr, folded->first.Compare(folded->second)); + } else if constexpr (T::category == TypeCategory::Character) { + result = Satisfies(relation.opr, Compare(folded->first, folded->second)); + } else { + static_assert(T::category != TypeCategory::Complex && + T::category != TypeCategory::Logical); + } + return Expr{Constant{result}}; + } + return Expr{Relational{std::move(relation)}}; +} + +template<> +inline Expr FoldOperation( + FoldingContext &context, Relational &&relation) { + return std::visit( + [&](auto &&x) { + return Expr{FoldOperation(context, std::move(x))}; + }, + std::move(relation.u)); +} + +template +Expr> FoldOperation( + FoldingContext &context, LogicalOperation &&x) { + using LOGICAL = Type; + if (auto folded{FoldOperands(context, x.left(), x.right())}) { + bool xt{folded->first.IsTrue()}, yt{folded->second.IsTrue()}, result{}; + switch (x.logicalOperator) { + case LogicalOperator::And: result = xt && yt; break; + case LogicalOperator::Or: result = xt || yt; break; + case LogicalOperator::Eqv: result = xt == yt; break; + case LogicalOperator::Neqv: result = xt != yt; break; + } + return Expr{Constant{result}}; + } + return Expr{std::move(x)}; +} + +// end per-operation folding functions + +template +Expr FoldHelper::FoldExpr(FoldingContext &context, Expr &&expr) { + return std::visit( + [&](auto &&x) -> Expr { + if constexpr (T::isSpecificIntrinsicType) { + return FoldOperation(context, std::move(x)); + } else if constexpr (std::is_same_v) { + return FoldOperation(context, std::move(x)); + } else if constexpr (std::is_same_v>) { + return std::move(expr); + } else { + return Expr{Fold(context, std::move(x))}; + } + }, + std::move(expr.u)); +} + +FOR_EACH_TYPE_AND_KIND(template struct FoldHelper, ;) + +template +std::optional> +GetScalarConstantValueHelper::GetScalarConstantValue(const Expr &expr) { + if (const auto *c{std::get_if>(&expr.u)}) { + return {*c}; + } else if (const auto *p{std::get_if>(&expr.u)}) { + return GetScalarConstantValue(p->left()); + } else { + return std::nullopt; + } +} + +FOR_EACH_INTRINSIC_KIND(template struct GetScalarConstantValueHelper, ;) +} // namespace Fortran::evaluate diff --git a/flang/lib/evaluate/fold.h b/flang/lib/evaluate/fold.h index d148dcc..f0a36fb 100644 --- a/flang/lib/evaluate/fold.h +++ b/flang/lib/evaluate/fold.h @@ -15,388 +15,63 @@ #ifndef FORTRAN_EVALUATE_FOLD_H_ #define FORTRAN_EVALUATE_FOLD_H_ +// Implements expression tree rewriting, particularly constant expression +// evaluation. + #include "common.h" #include "expression.h" -#include "int-power.h" -#include "tools.h" #include "type.h" -#include "../common/indirection.h" -#include "../parser/message.h" -#include -#include -#include -#include namespace Fortran::evaluate { using namespace Fortran::parser::literals; -// The result of Fold() is always packaged as an Expr<>. -// This allows Fold() to replace an operation with a constant or -// a canonicalized expression. -// When the operand is an Expr, the result has the same type. - -// Base no-op case -template Expr> Fold(FoldingContext &, A &&x) { - return Expr>{std::move(x)}; -} - -// Unary operations - -template -Expr Fold(FoldingContext &context, Convert &&convert) { - return std::visit( - [&](auto &kindExpr) -> Expr { - kindExpr = Fold(context, std::move(kindExpr)); - using Operand = ResultType; - char buffer[64]; - if (const auto *c{std::get_if>(&kindExpr.u)}) { - if constexpr (TO::category == TypeCategory::Integer) { - if constexpr (Operand::category == TypeCategory::Integer) { - auto converted{Scalar::ConvertSigned(c->value)}; - if (converted.overflow) { - context.messages.Say( - "INTEGER(%d) to INTEGER(%d) conversion overflowed"_en_US, - Operand::kind, TO::kind); - } - return Expr{Constant{std::move(converted.value)}}; - } else if constexpr (Operand::category == TypeCategory::Real) { - auto converted{c->value.template ToInteger>()}; - if (converted.flags.test(RealFlag::InvalidArgument)) { - context.messages.Say( - "REAL(%d) to INTEGER(%d) conversion: invalid argument"_en_US, - Operand::kind, TO::kind); - } else if (converted.flags.test(RealFlag::Overflow)) { - context.messages.Say( - "REAL(%d) to INTEGER(%d) conversion overflowed"_en_US, - Operand::kind, TO::kind); - } - return Expr{Constant{std::move(converted.value)}}; - } - } else if constexpr (TO::category == TypeCategory::Real) { - if constexpr (Operand::category == TypeCategory::Integer) { - auto converted{Scalar::FromInteger(c->value)}; - if (!converted.flags.empty()) { - std::snprintf(buffer, sizeof buffer, - "INTEGER(%d) to REAL(%d) conversion", Operand::kind, - TO::kind); - RealFlagWarnings(context, converted.flags, buffer); - } - return Expr{Constant{std::move(converted.value)}}; - } else if constexpr (Operand::category == TypeCategory::Real) { - auto converted{Scalar::Convert(c->value)}; - if (!converted.flags.empty()) { - std::snprintf(buffer, sizeof buffer, - "REAL(%d) to REAL(%d) conversion", Operand::kind, TO::kind); - RealFlagWarnings(context, converted.flags, buffer); - } - return Expr{Constant{std::move(converted.value)}}; - } - } else if constexpr (TO::category == TypeCategory::Logical && - Operand::category == TypeCategory::Logical) { - return Expr{Constant{c->value.IsTrue()}}; - } - } - return Expr{std::move(convert)}; - }, - convert.left().u); -} - -template Expr Fold(FoldingContext &context, Negate &&x) { - auto &operand{x.left()}; - operand = Fold(context, std::move(operand)); - if (const auto *c{std::get_if>(&operand.u)}) { - if constexpr (T::category == TypeCategory::Integer) { - auto negated{c->value.Negate()}; - if (negated.overflow) { - context.messages.Say("INTEGER(%d) negation overflowed"_en_US, T::kind); - } - return Expr{Constant{std::move(negated.value)}}; - } else { - return Expr{Constant{ - c->value - .Negate()}}; // REAL & COMPLEX negation: no exceptions possible - } - } - return Expr{std::move(x)}; -} - -template -Expr> Fold( - FoldingContext &context, ComplexComponent &&x) { - using Operand = Type; - using Part = Type; - auto &operand{x.left()}; - operand = Fold(context, std::move(operand)); - if (const auto *z{std::get_if>(&operand.u)}) { - if (x.isImaginaryPart) { - return Expr{Constant{z->value.AIMAG()}}; - } else { - return Expr{Constant{z->value.REAL()}}; - } - } - return Expr{std::move(x)}; -} - -template -Expr> Fold( - FoldingContext &context, Not &&x) { - using Ty = Type; - auto &operand{x.left()}; - operand = Fold(context, std::move(operand)); - if (const auto *c{std::get_if>(&operand.u)}) { - return Expr{Constant{c->value.IsTrue()}}; - } - return Expr{x}; -} - -// Binary (dyadic) operations - -template -std::optional, Scalar>> FoldOperands( - FoldingContext &context, Expr &x, Expr &y) { - x = Fold(context, std::move(x)); - y = Fold(context, std::move(y)); - if (const auto *xc{std::get_if>(&x.u)}) { - if (const auto *yc{std::get_if>(&y.u)}) { - return {std::make_pair(xc->value, yc->value)}; - } - } - return std::nullopt; -} - -template Expr Fold(FoldingContext &context, Add &&x) { - if (auto folded{FoldOperands(context, x.left(), x.right())}) { - if constexpr (T::category == TypeCategory::Integer) { - auto sum{folded->first.AddSigned(folded->second)}; - if (sum.overflow) { - context.messages.Say("INTEGER(%d) addition overflowed"_en_US, T::kind); - } - return Expr{Constant{sum.value}}; - } else { - auto sum{folded->first.Add(folded->second, context.rounding)}; - RealFlagWarnings(context, sum.flags, "addition"); - return Expr{Constant{sum.value}}; - } - } - return Expr{std::move(x)}; -} - -template Expr Fold(FoldingContext &context, Subtract &&x) { - if (auto folded{FoldOperands(context, x.left(), x.right())}) { - if constexpr (T::category == TypeCategory::Integer) { - auto difference{folded->first.SubtractSigned(folded->second)}; - if (difference.overflow) { - context.messages.Say( - "INTEGER(%d) subtraction overflowed"_en_US, T::kind); - } - return Expr{Constant{difference.value}}; - } else { - auto difference{folded->first.Subtract(folded->second, context.rounding)}; - RealFlagWarnings(context, difference.flags, "subtraction"); - return Expr{Constant{difference.value}}; - } - } - return Expr{std::move(x)}; -} - -template Expr Fold(FoldingContext &context, Multiply &&x) { - if (auto folded{FoldOperands(context, x.left(), x.right())}) { - if constexpr (T::category == TypeCategory::Integer) { - auto product{folded->first.MultiplySigned(folded->second)}; - if (product.SignedMultiplicationOverflowed()) { - context.messages.Say( - "INTEGER(%d) multiplication overflowed"_en_US, T::kind); - } - return Expr{Constant{product.lower}}; - } else { - auto product{folded->first.Multiply(folded->second, context.rounding)}; - RealFlagWarnings(context, product.flags, "multiplication"); - return Expr{Constant{product.value}}; - } - } - return Expr{std::move(x)}; -} - -template Expr Fold(FoldingContext &context, Divide &&x) { - if (auto folded{FoldOperands(context, x.left(), x.right())}) { - if constexpr (T::category == TypeCategory::Integer) { - auto quotAndRem{folded->first.DivideSigned(folded->second)}; - if (quotAndRem.divisionByZero) { - context.messages.Say("INTEGER(%d) division by zero"_en_US, T::kind); - } - if (quotAndRem.overflow) { - context.messages.Say("INTEGER(%d) division overflowed"_en_US, T::kind); - } - return Expr{Constant{quotAndRem.quotient}}; - } else { - auto quotient{folded->first.Divide(folded->second, context.rounding)}; - RealFlagWarnings(context, quotient.flags, "division"); - return Expr{Constant{quotient.value}}; - } - } - return Expr{std::move(x)}; -} +// Fold() rewrites an expression and returns it. When the rewritten expression +// is a constant, GetScalarConstantValue() below will be able to extract it. +// Note the rvalue reference argument: the rewrites are performed in place +// for efficiency. The implementation is wrapped in a helper template class so +// that all the per-type template instantiations can be made once in fold.cc. +template struct FoldHelper { + static Expr FoldExpr(FoldingContext &, Expr &&); +}; -template Expr Fold(FoldingContext &context, Power &&x) { - if (auto folded{FoldOperands(context, x.left(), x.right())}) { - if constexpr (T::category == TypeCategory::Integer) { - auto power{folded->first.Power(folded->second)}; - if (power.divisionByZero) { - context.messages.Say( - "INTEGER(%d) zero to negative power"_en_US, T::kind); - } else if (power.overflow) { - context.messages.Say("INTEGER(%d) power overflowed"_en_US, T::kind); - } else if (power.zeroToZero) { - context.messages.Say("INTEGER(%d) 0**0 is not defined"_en_US, T::kind); - } - return Expr{Constant{power.power}}; - } else { - // TODO: real & complex power with non-integral exponent - } - } - return Expr{std::move(x)}; +template Expr Fold(FoldingContext &context, Expr &&expr) { + return FoldHelper::FoldExpr(context, std::move(expr)); } template -Expr Fold(FoldingContext &context, RealToIntPower &&x) { - return std::visit( - [&](auto &y) -> Expr { - if (auto folded{FoldOperands(context, x.left(), y)}) { - auto power{evaluate::IntPower(folded->first, folded->second)}; - RealFlagWarnings(context, power.flags, "power with INTEGER exponent"); - return Expr{Constant{power.value}}; - } else { - return Expr{std::move(x)}; - } - }, - x.right().u); -} - -template Expr Fold(FoldingContext &context, Extremum &&x) { - if (auto folded{FoldOperands(context, x.left(), x.right())}) { - if constexpr (T::category == TypeCategory::Integer) { - if (folded->first.CompareSigned(folded->second) == x.ordering) { - return Expr{Constant{folded->first}}; - } - } else if constexpr (T::category == TypeCategory::Real) { - if (folded->first.IsNotANumber() || - (folded->first.Compare(folded->second) == Relation::Less) == - (x.ordering == Ordering::Less)) { - return Expr{Constant{folded->first}}; - } - } else { - if (x.ordering == Compare(folded->first, folded->second)) { - return Expr{Constant{folded->first}}; - } - } - return Expr{Constant{folded->second}}; +std::optional> Fold( + FoldingContext &context, std::optional> &&expr) { + if (expr.has_value()) { + return {Fold(context, std::move(*expr))}; + } else { + return std::nullopt; } - return Expr{std::move(x)}; } -template -Expr> Fold( - FoldingContext &context, ComplexConstructor &&x) { - using COMPLEX = Type; - if (auto folded{FoldOperands(context, x.left(), x.right())}) { - return Expr{ - Constant{Scalar{folded->first, folded->second}}}; - } - return Expr{std::move(x)}; -} +FOR_EACH_TYPE_AND_KIND(extern template struct FoldHelper, ;) -template -Expr> Fold( - FoldingContext &context, Concat &&x) { - using CHAR = Type; - if (auto folded{FoldOperands(context, x.left(), x.right())}) { - return Expr{Constant{folded->first + folded->second}}; - } - return Expr{std::move(x)}; -} +// GetScalarConstantValue() extracts the constant value of an expression, +// when it has one, even if it is parenthesized or optional. +template struct GetScalarConstantValueHelper { + static std::optional> GetScalarConstantValue(const Expr &); +}; template -Expr FoldRelational( - FoldingContext &context, Relational &&relation) { - if (auto folded{FoldOperands(context, relation.left(), relation.right())}) { - bool result{}; - if constexpr (T::category == TypeCategory::Integer) { - result = - Satisfies(relation.opr, folded->first.CompareSigned(folded->second)); - } else if constexpr (T::category == TypeCategory::Real) { - result = Satisfies(relation.opr, folded->first.Compare(folded->second)); - } else if constexpr (T::category == TypeCategory::Character) { - result = Satisfies(relation.opr, Compare(folded->first, folded->second)); - } else { - static_assert(T::category != TypeCategory::Complex && - T::category != TypeCategory::Logical); - } - return Expr{Constant{result}}; - } - return Expr{Relational{std::move(relation)}}; +std::optional> GetScalarConstantValue(const Expr &expr) { + return GetScalarConstantValueHelper::GetScalarConstantValue(expr); } - -template<> -inline Expr Fold( - FoldingContext &context, Relational &&relation) { - return std::visit( - [&](auto &&x) { - return Expr{FoldRelational(context, std::move(x))}; - }, - std::move(relation.u)); -} - -template -Expr> Fold( - FoldingContext &context, LogicalOperation &&x) { - using LOGICAL = Type; - if (auto folded{FoldOperands(context, x.left(), x.right())}) { - bool xt{folded->first.IsTrue()}, yt{folded->second.IsTrue()}, result{}; - switch (x.logicalOperator) { - case LogicalOperator::And: result = xt && yt; break; - case LogicalOperator::Or: result = xt || yt; break; - case LogicalOperator::Eqv: result = xt == yt; break; - case LogicalOperator::Neqv: result = xt != yt; break; - } - return Expr{Constant{result}}; +template +std::optional> GetScalarConstantValue( + const std::optional> &expr) { + if (expr.has_value()) { + return GetScalarConstantValueHelper::GetScalarConstantValue(*expr); + } else { + return std::nullopt; } - return Expr{std::move(x)}; -} - -template Expr Fold(FoldingContext &context, Expr &&expr) { - static_assert(A::isSpecificIntrinsicType); - return std::visit( - [&](auto &&x) -> Expr { return Fold(context, std::move(x)); }, - std::move(expr.u)); } -template -Expr> Fold(FoldingContext &context, Expr> &&expr) { - return std::visit( - [&](auto &&x) -> Expr> { - if constexpr (CAT == TypeCategory::Derived) { - return Fold(context, std::move(x)); - } else { - return Expr>{Fold(context, std::move(x))}; - } - }, - std::move(expr.u)); -} - -template<> -inline Expr Fold(FoldingContext &context, Expr &&expr) { - return std::visit( - [&](auto &&x) -> Expr { - if constexpr (std::is_same_v, - BOZLiteralConstant>) { - return std::move(expr); - } else { - return Expr{Fold(context, std::move(x))}; - } - }, - std::move(expr.u)); -} +FOR_EACH_INTRINSIC_KIND(extern template struct GetScalarConstantValueHelper, ;) } // namespace Fortran::evaluate #endif // FORTRAN_EVALUATE_FOLD_H_ diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc index 486ea4b..872b46f 100644 --- a/flang/lib/evaluate/intrinsics.cc +++ b/flang/lib/evaluate/intrinsics.cc @@ -14,6 +14,7 @@ #include "intrinsics.h" #include "expression.h" +#include "tools.h" #include "type.h" #include "../common/enum-set.h" #include "../common/fortran.h" @@ -1057,15 +1058,12 @@ std::optional IntrinsicInterface::Match( CHECK(kindDummyArg != nullptr); CHECK(result.categorySet == CategorySet{resultType->category}); if (kindArg != nullptr) { - if (auto *jExpr{std::get_if>(&kindArg->value->u)}) { - CHECK(jExpr->Rank() == 0); - if (auto value{jExpr->ScalarValue()}) { - if (auto code{value->ToInt64()}) { - if (IsValidKindOfIntrinsicType(resultType->category, *code)) { - resultType->kind = *code; - break; - } - } + auto &expr{*kindArg->value}; + CHECK(expr.Rank() == 0); + if (auto code{ToInt64(expr)}) { + if (IsValidKindOfIntrinsicType(resultType->category, *code)) { + resultType->kind = *code; + break; } } messages.Say("'kind=' argument must be a constant scalar integer " diff --git a/flang/lib/evaluate/tools.h b/flang/lib/evaluate/tools.h index 4e1898f..1cf7e9e 100644 --- a/flang/lib/evaluate/tools.h +++ b/flang/lib/evaluate/tools.h @@ -17,7 +17,9 @@ #include "expression.h" #include "../common/idioms.h" +#include "../common/template.h" #include "../parser/message.h" +#include "../semantics/symbol.h" #include #include #include @@ -42,10 +44,32 @@ std::optional> AsVariable(const Expr &expr) { expr.u); } +template +std::optional> AsVariable(const std::optional> &expr) { + if (expr.has_value()) { + return AsVariable(*expr); + } else { + return std::nullopt; + } +} + // Predicate: true when an expression is a variable reference template bool IsVariable(const A &) { return false; } -template bool IsVariable(const Designator &) { return true; } -template bool IsVariable(const FunctionRef &) { return true; } +template bool IsVariable(const Designator &designator) { + if constexpr (common::HasMember::u)>) { + if (const auto *substring{std::get_if(&designator.u)}) { + return substring->GetSymbol(false) != nullptr; + } + } + return true; +} +template bool IsVariable(const FunctionRef &funcRef) { + if (const semantics::Symbol * symbol{funcRef.proc().GetSymbol()}) { + return symbol->attrs().test(semantics::Attr::POINTER); + } else { + return false; + } +} template bool IsVariable(const Expr &expr) { return std::visit([](const auto &x) { return IsVariable(x); }, expr.u); } @@ -53,10 +77,41 @@ template bool IsVariable(const Expr &expr) { // Predicate: true when an expression is a constant value template bool IsConstant(const A &) { return false; } template bool IsConstant(const Constant &) { return true; } +template bool IsConstant(const Parentheses &p) { + return IsConstant(p.left()); +} template bool IsConstant(const Expr &expr) { return std::visit([](const auto &x) { return IsConstant(x); }, expr.u); } +// When an expression is a constant integer, extract its value. +template std::optional ToInt64(const A &) { + return std::nullopt; +} +template +std::optional ToInt64( + const Constant> &c) { + return {c.value.ToInt64()}; +} +template +std::optional ToInt64( + const Parentheses> &p) { + return ToInt64(p.left()); +} +template std::optional ToInt64(const Expr &expr) { + return std::visit([](const auto &x) { return ToInt64(x); }, expr.u); +} +template +std::optional ToInt64(const std::optional &x) { + if (x.has_value()) { + return ToInt64(*x); + } else { + return std::nullopt; + } +} + +// TODO pmk: GetSymbol and Rank and GetType here, too + // Generalizing packagers: these take operations and expressions of more // specific types and wrap them in Expr<> containers of more abstract types. @@ -74,16 +129,6 @@ Expr::category>> AsCategoryExpr(A &&x) { return Expr::category>>{AsExpr(std::move(x))}; } -template -Expr> AsCategoryExpr(SomeKindScalar &&x) { - return std::visit( - [](auto &&scalar) { - using Ty = TypeOf>; - return AsCategoryExpr(Constant{std::move(scalar)}); - }, - x.u); -} - template Expr AsGenericExpr(A &&x) { return Expr{AsCategoryExpr(std::move(x))}; } @@ -96,24 +141,6 @@ template<> inline Expr AsGenericExpr(BOZLiteralConstant &&x) { return Expr{std::move(x)}; } -template<> inline Expr AsGenericExpr(Constant &&x) { - return std::visit( - [](auto &&scalar) { - using Ty = TypeOf>; - return AsGenericExpr(Constant{std::move(scalar)}); - }, - x.value.u); -} - -template<> inline Expr AsGenericExpr(GenericScalar &&x) { - return std::visit( - [](auto &&scalar) { - using Ty = TypeOf>; - return AsGenericExpr(Constant{std::move(scalar)}); - }, - x.u); -} - Expr GetComplexPart( const Expr &, bool isImaginary = false); diff --git a/flang/lib/evaluate/type.h b/flang/lib/evaluate/type.h index 229e640..cc8c452 100644 --- a/flang/lib/evaluate/type.h +++ b/flang/lib/evaluate/type.h @@ -231,81 +231,16 @@ template struct TypeOfHelper { template using TypeOf = typename TypeOfHelper::type; -// A variant union that can hold a scalar constant of any type chosen from -// a set of types, which is passed in as a tuple of Type<> specializations. -template struct SomeScalar { - using Types = TYPES; - CLASS_BOILERPLATE(SomeScalar) - - template SomeScalar(const A &x) : u{x} {} - template - SomeScalar(std::enable_if_t, A> &&x) - : u{std::move(x)} {} - - std::optional ToInt64() const { - return std::visit( - [](const auto &x) -> std::optional { - if constexpr (TypeOf::category == - TypeCategory::Integer) { - return {x.ToInt64()}; - } - return std::nullopt; - }, - u); - } - - std::optional ToString() const { - return std::visit( - [](const auto &x) -> std::optional { - if constexpr (std::is_same_v>) { - return {x}; - } - return std::nullopt; - }, - u); - } - - std::optional IsTrue() const { - return std::visit( - [](const auto &x) -> std::optional { - if constexpr (TypeOf::category == - TypeCategory::Logical) { - return {x.IsTrue()}; - } - return std::nullopt; - }, - u); - } - - std::optional GetType() const { - return std::visit( - [](const auto &x) { - using Ty = std::decay_t; - return TypeOf::GetType(); - }, - u); - } - - common::MapTemplate u; -}; - -template -using SomeKindScalar = SomeScalar>; -using GenericScalar = SomeScalar; - // Represents a type of any supported kind within a particular category. template struct SomeKind { static constexpr bool isSpecificIntrinsicType{false}; static constexpr TypeCategory category{CATEGORY}; - using Scalar = SomeKindScalar; }; template<> class SomeKind { public: static constexpr bool isSpecificIntrinsicType{true}; static constexpr TypeCategory category{TypeCategory::Derived}; - using Scalar = void; CLASS_BOILERPLATE(SomeKind) explicit SomeKind(const semantics::DerivedTypeSpec &s) : spec_{&s} {} @@ -332,56 +267,52 @@ using SomeCategory = std::tuple; struct SomeType { static constexpr bool isSpecificIntrinsicType{false}; - using Scalar = GenericScalar; }; // For "[extern] template class", &c. boilerplate -#define FOR_EACH_INTEGER_KIND(PREFIX) \ - PREFIX>; \ - PREFIX>; \ - PREFIX>; \ - PREFIX>; \ - PREFIX>; -#define FOR_EACH_REAL_KIND(PREFIX) \ - PREFIX>; \ - PREFIX>; \ - PREFIX>; \ - PREFIX>; \ - PREFIX>; -#define FOR_EACH_COMPLEX_KIND(PREFIX) \ - PREFIX>; \ - PREFIX>; \ - PREFIX>; \ - PREFIX>; \ - PREFIX>; -#define FOR_EACH_CHARACTER_KIND(PREFIX) \ - PREFIX>; \ - PREFIX>; \ - PREFIX>; -#define FOR_EACH_LOGICAL_KIND(PREFIX) \ - PREFIX>; \ - PREFIX>; \ - PREFIX>; \ - PREFIX>; -#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; -#define FOR_EACH_CATEGORY_TYPE(PREFIX) \ - PREFIX; \ - PREFIX; \ - PREFIX; \ - PREFIX; \ - PREFIX; \ - PREFIX; -#define FOR_EACH_TYPE_AND_KIND(PREFIX) \ - FOR_EACH_SPECIFIC_TYPE(PREFIX) \ - FOR_EACH_CATEGORY_TYPE(PREFIX) +#define FOR_EACH_INTEGER_KIND(PREFIX, SUFFIX) \ + PREFIX> SUFFIX \ + PREFIX> \ + SUFFIX PREFIX> SUFFIX \ + PREFIX> \ + SUFFIX PREFIX> SUFFIX +#define FOR_EACH_REAL_KIND(PREFIX, SUFFIX) \ + PREFIX> SUFFIX \ + PREFIX> \ + SUFFIX PREFIX> SUFFIX \ + PREFIX> \ + SUFFIX PREFIX> SUFFIX +#define FOR_EACH_COMPLEX_KIND(PREFIX, SUFFIX) \ + PREFIX> SUFFIX \ + PREFIX> \ + SUFFIX PREFIX> SUFFIX \ + PREFIX> \ + SUFFIX PREFIX> SUFFIX +#define FOR_EACH_CHARACTER_KIND(PREFIX, SUFFIX) \ + PREFIX> SUFFIX \ + PREFIX> \ + SUFFIX PREFIX> SUFFIX +#define FOR_EACH_LOGICAL_KIND(PREFIX, SUFFIX) \ + PREFIX> \ + SUFFIX PREFIX> SUFFIX \ + PREFIX> \ + SUFFIX PREFIX> SUFFIX +#define FOR_EACH_INTRINSIC_KIND(PREFIX, SUFFIX) \ + FOR_EACH_INTEGER_KIND(PREFIX, SUFFIX) \ + FOR_EACH_REAL_KIND(PREFIX, SUFFIX) \ + FOR_EACH_COMPLEX_KIND(PREFIX, SUFFIX) \ + FOR_EACH_CHARACTER_KIND(PREFIX, SUFFIX) \ + FOR_EACH_LOGICAL_KIND(PREFIX, SUFFIX) +#define FOR_EACH_SPECIFIC_TYPE(PREFIX, SUFFIX) \ + FOR_EACH_INTRINSIC_KIND(PREFIX, SUFFIX) \ + PREFIX SUFFIX +#define FOR_EACH_CATEGORY_TYPE(PREFIX, SUFFIX) \ + PREFIX SUFFIX PREFIX SUFFIX PREFIX \ + SUFFIX PREFIX SUFFIX PREFIX \ + SUFFIX PREFIX SUFFIX +#define FOR_EACH_TYPE_AND_KIND(PREFIX, SUFFIX) \ + FOR_EACH_SPECIFIC_TYPE(PREFIX, SUFFIX) \ + FOR_EACH_CATEGORY_TYPE(PREFIX, SUFFIX) // Wraps a constant scalar value of a specific intrinsic type // in a class with its resolved type. diff --git a/flang/lib/evaluate/variable.cc b/flang/lib/evaluate/variable.cc index 50aaa5c..7665933 100644 --- a/flang/lib/evaluate/variable.cc +++ b/flang/lib/evaluate/variable.cc @@ -13,6 +13,7 @@ // limitations under the License. #include "variable.h" +#include "fold.h" #include "tools.h" #include "../common/idioms.h" #include "../parser/char-block.h" @@ -20,6 +21,7 @@ #include "../parser/message.h" #include "../semantics/symbol.h" #include +#include using namespace Fortran::parser::literals; @@ -83,91 +85,87 @@ CoarrayRef &CoarrayRef::set_team(Expr &&v, bool isTeamNumber) { return *this; } -Substring::Substring(DataRef &&d, std::optional> &&f, - std::optional> &&l) - : u_{std::move(d)} { - if (f.has_value()) { - first_ = IndirectSubscriptIntegerExpr::Make(std::move(*f)); +void Substring::SetBounds(std::optional> &first, + std::optional> &last) { + if (first.has_value()) { + first_ = IndirectSubscriptIntegerExpr::Make(std::move(*first)); } - if (l.has_value()) { - last_ = IndirectSubscriptIntegerExpr::Make(std::move(*l)); - } -} - -Substring::Substring(std::string &&s, std::optional> &&f, - std::optional> &&l) - : u_{std::move(s)} { - if (f.has_value()) { - first_ = IndirectSubscriptIntegerExpr::Make(std::move(*f)); - } - if (l.has_value()) { - last_ = IndirectSubscriptIntegerExpr::Make(std::move(*l)); + if (last.has_value()) { + last_ = IndirectSubscriptIntegerExpr::Make(std::move(*last)); } } Expr Substring::first() const { if (first_.has_value()) { return **first_; + } else { + return AsExpr(Constant{1}); } - return AsExpr(Constant{1}); } Expr Substring::last() const { if (last_.has_value()) { return **last_; + } else { + return std::visit([](const auto &x) { + if constexpr (std::is_same_v>) { + return x.LEN(); + } else { + return AsExpr(Constant{x.size()}); + }}, u_); } - return std::visit( - common::visitors{[](const std::string &s) { - return AsExpr(Constant{s.size()}); - }, - [](const DataRef &x) { return x.LEN(); }}, - u_); } -std::optional Substring::Fold(FoldingContext &context) { - std::optional> lbConst{first().Fold(context)}; - if (lbConst.has_value()) { - first_ = AsExpr(*lbConst); +auto Substring::Fold(FoldingContext &context) -> std::optional { + std::optional lbi, ubi; + if (first_.has_value()) { + *first_ = evaluate::Fold(context, std::move(**first_)); + lbi = ToInt64(**first_); } - std::optional> ubConst{last().Fold(context)}; - if (ubConst.has_value()) { - last_ = AsExpr(*ubConst); + if (last_.has_value()) { + *last_ = evaluate::Fold(context, std::move(**last_)); + ubi = ToInt64(**last_); } - if (auto both{common::AllPresent(std::move(lbConst), std::move(ubConst))}) { - std::int64_t lbi{std::get<0>(*both).value.ToInt64()}; - std::int64_t ubi{std::get<1>(*both).value.ToInt64()}; - if (ubi < lbi) { + if (lbi.has_value() && ubi.has_value()) { + if (*ubi < *lbi) { // These cases are well defined, and they produce zero-length results. u_ = ""s; first_ = AsExpr(Constant{1}); last_ = AsExpr(Constant{0}); - return {""s}; + return {Strings{""s}}; } - if (lbi <= 0) { + if (*lbi <= 0) { context.messages.Say( "lower bound on substring (%jd) is less than one"_en_US, - static_cast(lbi)); - lbi = 1; - first_ = AsExpr(Constant{lbi}); + static_cast(*lbi)); + *lbi = 1; + first_ = AsExpr(Constant{1}); } - if (ubi <= 0) { + if (*ubi <= 0) { u_ = ""s; last_ = AsExpr(Constant{0}); - return {""s}; - } - if (std::string * str{std::get_if(&u_)}) { - std::int64_t len = str->size(); - if (ubi > len) { - context.messages.Say( - "upper bound on substring (%jd) is greater than character length (%jd)"_en_US, - static_cast(ubi), static_cast(len)); - ubi = len; - last_ = AsExpr(Constant{ubi}); - } - std::string result{str->substr(lbi - 1, ubi - lbi + 1)}; - u_ = result; - return {result}; + return {Strings{""s}}; } + return std::visit( + [&](const auto &x) -> std::optional { + if constexpr (std::is_same_v>) { + return std::nullopt; + } else { + std::int64_t len = x.size(); + if (*ubi > len) { + context.messages.Say( + "upper bound on substring (%jd) is greater than character length (%jd)"_en_US, + static_cast(*ubi), + static_cast(len)); + *ubi = len; + last_ = AsExpr(Constant{len}); + } + auto substring{x.substr(*lbi - 1, *ubi - *lbi + 1)}; + u_ = substring; + return std::make_optional(Strings{substring}); + } + }, + u_); } return std::nullopt; } @@ -182,6 +180,14 @@ template<> std::ostream &Emit(std::ostream &o, const std::string &lit) { return o << parser::QuoteCharacterLiteral(lit); } +template<> std::ostream &Emit(std::ostream &o, const std::u16string &lit) { + return o << "TODO: dumping CHARACTER*2"; +} + +template<> std::ostream &Emit(std::ostream &o, const std::u32string &lit) { + return o << "TODO: dumping CHARACTER*4"; +} + template std::ostream &Emit(std::ostream &o, const A *p, const char *kw = nullptr) { if (p != nullptr) { @@ -395,10 +401,10 @@ int DataRef::Rank() const { int Substring::Rank() const { return std::visit( [](const auto &x) { - if constexpr (std::is_same_v, std::string>) { - return 0; - } else { + if constexpr (std::is_same_v, DataRef>) { return x.Rank(); + } else { + return 0; // parent string is a literal scalar } }, u_); @@ -466,5 +472,5 @@ std::optional ProcedureDesignator::GetType() const { return std::nullopt; } -FOR_EACH_CHARACTER_KIND(template class Designator) +FOR_EACH_CHARACTER_KIND(template class Designator, ;) } diff --git a/flang/lib/evaluate/variable.h b/flang/lib/evaluate/variable.h index 6b9edb6..bf4960f 100644 --- a/flang/lib/evaluate/variable.h +++ b/flang/lib/evaluate/variable.h @@ -25,7 +25,7 @@ #include "common.h" #include "type.h" #include "../common/idioms.h" -#include "../lib/common/template.h" +#include "../common/template.h" #include "../semantics/symbol.h" #include #include @@ -178,24 +178,28 @@ struct DataRef { // variants of sections instead. class Substring { public: - using IsFoldableTrait = std::true_type; + using Strings = std::variant; CLASS_BOILERPLATE(Substring) - Substring(DataRef &&, std::optional> &&, - std::optional> &&); - Substring(std::string &&, std::optional> &&, - std::optional> &&); + template + Substring(A &&parent, std::optional> &&first, + std::optional> &&last) + : u_{std::move(parent)} { + SetBounds(first, last); + } Expr first() const; Expr last() const; int Rank() const; const Symbol *GetSymbol(bool first) const; Expr LEN() const; - std::optional Fold(FoldingContext &); + std::optional Fold(FoldingContext &); std::ostream &Dump(std::ostream &) const; private: - // TODO: character kinds > 1 - std::variant u_; + using Variant = common::CombineVariants, Strings>; + void SetBounds(std::optional> &, + std::optional> &); + Variant u_; std::optional first_, last_; }; @@ -282,7 +286,7 @@ public: Variant u; }; -FOR_EACH_CHARACTER_KIND(extern template class Designator) +FOR_EACH_CHARACTER_KIND(extern template class Designator, ;) class ProcedureRef { public: @@ -325,7 +329,7 @@ template struct FunctionRef : public ProcedureRef { std::optional> Fold(FoldingContext &); // for intrinsics }; -FOR_EACH_SPECIFIC_TYPE(extern template struct FunctionRef) +FOR_EACH_SPECIFIC_TYPE(extern template struct FunctionRef, ;) template struct Variable { using Result = A; diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 16fb59e..8fe1207 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -18,6 +18,7 @@ #include "symbol.h" #include "../common/idioms.h" #include "../evaluate/common.h" +#include "../evaluate/fold.h" #include "../evaluate/tools.h" #include "../parser/parse-tree-visitor.h" #include "../parser/parse-tree.h" @@ -230,9 +231,10 @@ MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const parser::Integer &x) { template MaybeExpr AnalyzeHelper(ExprAnalyzer &ea, const parser::Constant &x) { if (MaybeExpr result{AnalyzeHelper(ea, x.thing)}) { - if (std::optional> folded{ - result->Fold(ea.context.foldingContext())}) { - return {AsGenericExpr(std::move(*folded))}; + Expr folded{ + Fold(ea.context.foldingContext(), std::move(*result))}; + if (IsConstant(folded)) { + return {folded}; } ea.Say("expression must be constant"_err_en_US); } @@ -289,13 +291,10 @@ int ExprAnalyzer::Analyze(const std::optional &kindParam, [&](const parser::Scalar< parser::Integer>> &n) { if (MaybeExpr ie{AnalyzeHelper(*this, n)}) { - if (std::optional sv{ie->ScalarValue()}) { - if (std::optional i64{sv->ToInt64()}) { - std::int64_t i64v{*i64}; - int iv = i64v; - if (iv == i64v) { - return iv; - } + if (std::optional i64{ToInt64(*ie)}) { + int iv = *i64; + if (iv == *i64) { + return iv; } } } @@ -549,9 +548,9 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::Name &n) { MaybeExpr ExprAnalyzer::Analyze(const parser::NamedConstant &n) { if (MaybeExpr value{Analyze(n.v)}) { - if (std::optional> folded{ - value->Fold(context.foldingContext())}) { - return {AsGenericExpr(std::move(*folded))}; + Expr folded{Fold(context.foldingContext(), std::move(*value))}; + if (IsConstant(folded)) { + return {folded}; } Say(n.v.source, "must be a constant"_err_en_US); } @@ -900,7 +899,9 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::FunctionReference &funcRef) { }}, std::get(arg.t).u); if (actualArgExpr.has_value()) { - arguments.emplace_back(std::move(actualArgExpr)); + // TODO pmk: strip and record outermost parentheses here + arguments.emplace_back(std::make_optional( + Fold(context.foldingContext(), std::move(*actualArgExpr)))); if (const auto &argKW{std::get>(arg.t)}) { arguments.back()->keyword = argKW->v.source; } diff --git a/flang/test/evaluate/expression.cc b/flang/test/evaluate/expression.cc index 57d4de4..4a6f2ba 100644 --- a/flang/test/evaluate/expression.cc +++ b/flang/test/evaluate/expression.cc @@ -14,6 +14,7 @@ #include "../../lib/evaluate/expression.h" #include "testing.h" +#include "../../lib/evaluate/fold.h" #include "../../lib/evaluate/tools.h" #include "../../lib/parser/message.h" #include @@ -40,7 +41,7 @@ int main() { Fortran::parser::CharBlock src; Fortran::parser::ContextualMessages messages{src, nullptr}; FoldingContext context{messages}; - ex1.Fold(context); + ex1 = Fold(context, std::move(ex1)); MATCH("-10_4", Dump(ex1)); MATCH("(1_4/2_4)", Dump(DefaultIntegerExpr{1} / DefaultIntegerExpr{2})); DefaultIntegerExpr a{1}; -- 2.7.4