[flang] checkpoint once g++ can build again
authorpeter klausler <pklausler@nvidia.com>
Tue, 28 Aug 2018 22:15:18 +0000 (15:15 -0700)
committerpeter klausler <pklausler@nvidia.com>
Wed, 12 Sep 2018 23:29:03 +0000 (16:29 -0700)
Original-commit: flang-compiler/f18@1c09641a6daf04909561cc8d5ff7b7c223e961c3
Reviewed-on: https://github.com/flang-compiler/f18/pull/183
Tree-same-pre-rewrite: false

13 files changed:
flang/lib/common/idioms.h
flang/lib/common/template.h
flang/lib/evaluate/common.h
flang/lib/evaluate/expression.cc
flang/lib/evaluate/expression.h
flang/lib/evaluate/tools.cc
flang/lib/evaluate/tools.h
flang/lib/evaluate/type.h
flang/lib/evaluate/variable.cc
flang/lib/evaluate/variable.h
flang/lib/parser/parse-tree.h
flang/lib/semantics/expression.cc
flang/test/evaluate/logical.cc

index caebc4e..552ddd6 100644 (file)
@@ -104,7 +104,7 @@ template<typename... LAMBDAS> visitors(LAMBDAS... x)->visitors<LAMBDAS...>;
       return false; \
     } \
   } \
-  template<typename A> constexpr bool T { class_trait_ns_##T::trait_value<A>() }
+  template<typename A> constexpr bool T { class_trait_ns_##T::trait_value<A>() };
 
 // Define enum class NAME with the given enumerators, a static
 // function EnumToString() that maps enumerators to std::string,
index fa2f77a..8a36fe5 100644 (file)
@@ -106,8 +106,8 @@ template<typename... TUPLES>
 using CombineTuples = typename CombineTuplesHelper<TUPLES...>::type;
 
 // CombineVariants takes a list of std::variant<> instantiations and constructs
-// a new instantiation that holds all of their alternatives, which probably
-// should be distinct.
+// a new instantiation that holds all of their alternatives, which must be
+// pairwise distinct.
 template<typename> struct VariantToTupleHelper;
 template<typename... Ts> struct VariantToTupleHelper<std::variant<Ts...>> {
   using type = std::tuple<Ts...>;
@@ -115,8 +115,22 @@ template<typename... Ts> struct VariantToTupleHelper<std::variant<Ts...>> {
 template<typename VARIANT>
 using VariantToTuple = typename VariantToTupleHelper<VARIANT>::type;
 
+template<typename A, typename B, typename... REST> struct AreTypesDistinctHelper {
+  static constexpr bool value() {
+    if constexpr (std::is_same_v<A, B>) {
+      return false;
+    }
+    if constexpr (sizeof...(REST) > 0) {
+      return AreTypesDistinctHelper<A, REST...>::value() && AreTypesDistinctHelper<B, REST...>::value();
+    }
+    return true;
+  }
+};
+template<typename... Ts> constexpr bool AreTypesDistinct{AreTypesDistinctHelper<Ts...>::value()};
+
 template<typename> struct TupleToVariantHelper;
 template<typename... Ts> struct TupleToVariantHelper<std::tuple<Ts...>> {
+  static_assert(AreTypesDistinct<Ts...> || !"TupleToVariant: types are not pairwise distinct");
   using type = std::variant<Ts...>;
 };
 template<typename TUPLE>
@@ -128,6 +142,9 @@ template<typename... VARIANTS> struct CombineVariantsHelper {
 template<typename... VARIANTS>
 using CombineVariants = typename CombineVariantsHelper<VARIANTS...>::type;
 
+template<typename VARIANT>
+using SquashVariantOfVariants = OverMembers<CombineVariants, VARIANT>;
+
 // Given a type function, apply it to each of the types in a tuple or variant,
 // and collect the results in another tuple or variant.
 template<template<typename> class, template<typename...> class, typename...>
index 0fe6ba0..a7afead 100644 (file)
@@ -127,8 +127,8 @@ using HostUnsignedInt =
 template<typename A> using CopyableIndirection = common::Indirection<A, true>;
 
 // Classes that support a Fold(FoldingContext &) member function have the
-// FoldableTrait set.
-CLASS_TRAIT(FoldableTrait);
+// IsFoldableTrait.
+CLASS_TRAIT(IsFoldableTrait)
 struct FoldingContext {
   explicit FoldingContext(parser::ContextualMessages &m,
       Rounding round = defaultRounding, bool flush = false)
index e5c57bc..debbd51 100644 (file)
@@ -32,235 +32,128 @@ namespace Fortran::evaluate {
 
 template<typename D, typename R, typename... O>
 auto Operation<D, R, O...>::Fold(FoldingContext &context)
-    -> std::optional<Scalar<Result>> {
+    -> std::optional<Constant<Result>> {
   auto c0{operand<0>().Fold(context)};
   if constexpr (operands() == 1) {
     if (c0.has_value()) {
-      return derived().FoldScalar(context, *c0);
+      if (auto scalar{derived().FoldScalar(context, c0->value)}) {
+        return {Constant<Result>{std::move(*scalar)}};
+      }
     }
   } else {
     auto c1{operand<1>().Fold(context)};
     if (c0.has_value() && c1.has_value()) {
-      return derived().FoldScalar(context, *c0, *c1);
+      if (auto scalar{derived().FoldScalar(context, c0->value, c1->value)}) {
+        return {Constant<Result>{std::move(*scalar)}};
+      }
     }
   }
   return std::nullopt;
 }
 
-template<int KIND>
-auto Expr<Type<TypeCategory::Integer, KIND>>::Fold(FoldingContext &context)
-    -> std::optional<Scalar<Result>> {
-  if (auto c{ScalarValue()}) {
-    return c;
-  }
-  return std::visit(
-      [&](auto &x) -> std::optional<Scalar<Result>> {
-        using Ty = std::decay_t<decltype(x)>;
-        if constexpr (evaluate::FoldableTrait<Ty>) {
-          if (auto c{x.Fold(context)}) {
-            if constexpr (std::is_same_v<Ty, Parentheses<Result>>) {
-              // Preserve parentheses around constants.
-              u_ = Parentheses<Result>{Expr{*c}};
-            } else {
-              u_ = *c;
-            }
-            return c;
+template<typename RESULT>
+auto ExpressionBase<RESULT>::Fold(FoldingContext &context)
+    -> std::optional<Constant<Result>> {
+  using Const = Constant<Result>;
+  if constexpr (Result::isSpecificType) {
+    // Folding an expression of known type category and kind.
+    return std::visit(
+        [&](auto &x) -> std::optional<Const> {
+          using Thing = std::decay_t<decltype(x)>;
+          if constexpr (IsConstantTrait<Thing>) {
+            return {x};
           }
-        }
-        return std::nullopt;
-      },
-      u_);
-}
-
-template<int KIND>
-auto Expr<Type<TypeCategory::Real, KIND>>::Fold(FoldingContext &context)
-    -> std::optional<Scalar<Result>> {
-  if (auto c{ScalarValue()}) {
-    return c;
-  }
-  return std::visit(
-      [&](auto &x) -> std::optional<Scalar<Result>> {
-        using Ty = std::decay_t<decltype(x)>;
-        if constexpr (evaluate::FoldableTrait<Ty>) {
-          if (auto c{x.Fold(context)}) {
-            if (context.flushDenormalsToZero) {
-              *c = c->FlushDenormalToZero();
+          if constexpr (IsFoldableTrait<Thing>) {
+            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() = truth;
+                return {Const{truth}};
+              }
+              if constexpr (std::is_same_v<Parentheses<Result>, Thing>) {
+                // Preserve parentheses around constants.
+                derived() = Thing{Derived{*c}};
+              } else {
+                derived() = *c;
+              }
+              return {Const{c->value}};
             }
-            if constexpr (std::is_same_v<Ty, Parentheses<Result>>) {
-              // Preserve parentheses around constants.
-              u_ = Parentheses<Result>{Expr{*c}};
-            } else {
-              u_ = *c;
+          }
+          return std::nullopt;
+        },
+        derived().u);
+  } else {
+    // Folding a generic expression into a generic constant.
+    return std::visit(
+        [&](auto &x) -> std::optional<Const> {
+          if constexpr (IsFoldableTrait<std::decay_t<decltype(x)>>) {
+            if (auto c{x.Fold(context)}) {
+              if constexpr (ResultType<decltype(*c)>::isSpecificType) {
+                return {Const{c->value}};
+              } else {
+                // pmk: this is ugly
+                return {Const{common::MoveVariant<GenericScalar>(c->value.u)}};
+              }
             }
-            return c;
           }
-        }
-        return std::nullopt;
-      },
-      u_);
+          return std::nullopt;
+        },
+        derived().u);
+  }
 }
 
-template<int KIND>
-auto Expr<Type<TypeCategory::Complex, KIND>>::Fold(FoldingContext &context)
-    -> std::optional<Scalar<Result>> {
-  if (auto c{ScalarValue()}) {
-    return c;
-  }
+// FoldScalar
+
+template<typename TO, TypeCategory FROMCAT>
+auto Convert<TO, FROMCAT>::FoldScalar(FoldingContext &context,
+    const Scalar<Operand> &x) -> std::optional<Scalar<Result>> {
   return std::visit(
-      [&](auto &x) -> std::optional<Scalar<Result>> {
-        using Ty = std::decay_t<decltype(x)>;
-        if constexpr (evaluate::FoldableTrait<Ty>) {
-          if (auto c{x.Fold(context)}) {
-            if (context.flushDenormalsToZero) {
-              *c = c->FlushDenormalToZero();
+      [&](const auto &c) -> std::optional<Scalar<Result>> {
+        if constexpr (Result::category == TypeCategory::Integer) {
+          if constexpr (Operand::category == TypeCategory::Integer) {
+            auto converted{Scalar<Result>::ConvertSigned(c)};
+            if (converted.overflow) {
+              context.messages.Say(
+                  "INTEGER to INTEGER conversion overflowed"_en_US);
+            } else {
+              return {std::move(converted.value)};
             }
-            if constexpr (std::is_same_v<Ty, Parentheses<Result>>) {
-              // Preserve parentheses around constants.
-              u_ = Parentheses<Result>{Expr{*c}};
+          } else if constexpr (Operand::category == TypeCategory::Real) {
+            auto converted{c.template ToInteger<Scalar<Result>>()};
+            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 {
-              u_ = *c;
+              return {std::move(converted.value)};
             }
-            return c;
           }
-        }
-        return std::nullopt;
-      },
-      u_);
-}
-
-template<int KIND>
-auto Expr<Type<TypeCategory::Character, KIND>>::Fold(FoldingContext &context)
-    -> std::optional<Scalar<Result>> {
-  if (auto c{ScalarValue()}) {
-    return c;
-  }
-  return std::visit(
-      [&](auto &x) -> std::optional<Scalar<Result>> {
-        using Ty = std::decay_t<decltype(x)>;
-        if constexpr (evaluate::FoldableTrait<Ty>) {
-          if (auto c{x.Fold(context)}) {
-            u_ = *c;
-            return c;
+        } else if constexpr (Result::category == TypeCategory::Real) {
+          if constexpr (Operand::category == TypeCategory::Integer) {
+            auto converted{Scalar<Result>::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<Result>::Convert(c)};
+            RealFlagWarnings(
+                context, converted.flags, "REAL to REAL conversion");
+            return {std::move(converted.value)};
           }
         }
         return std::nullopt;
       },
-      u_);
-}
-
-template<int KIND>
-auto Expr<Type<TypeCategory::Logical, KIND>>::Fold(FoldingContext &context)
-    -> std::optional<Scalar<Result>> {
-  if (auto c{ScalarValue()}) {
-    return c;
-  }
-  return std::visit(
-      [&](auto &x) -> std::optional<Scalar<Result>> {
-        using Ty = std::decay_t<decltype(x)>;
-        if constexpr (evaluate::FoldableTrait<Ty>) {
-          if (auto c{x.Fold(context)}) {
-            Scalar<Result> result{c->IsTrue()};
-            u_ = result;
-            return {result};
-          }
-        }
-        return std::nullopt;
-      },
-      u_);
-}
-
-template<TypeCategory CAT>
-auto Expr<SomeKind<CAT>>::Fold(FoldingContext &context)
-    -> std::optional<Scalar<Result>> {
-  return std::visit(
-      [&](auto &x) -> std::optional<Scalar<Result>> {
-        if (auto c{x.Fold(context)}) {
-          return {Scalar<Result>{std::move(*c)}};
-        }
-        return std::nullopt;
-      },
-      u.u);
-}
-
-auto Expr<SomeType>::Fold(FoldingContext &context)
-    -> std::optional<Scalar<Result>> {
-  return std::visit(
-      common::visitors{
-          [](BOZLiteralConstant &) -> std::optional<Scalar<Result>> {
-            return std::nullopt;
-          },
-          [&](auto &x) -> std::optional<Scalar<Result>> {
-            if (auto c{x.Fold(context)}) {
-              return {common::MoveVariant<Scalar<Result>>(std::move(c->u))};
-            }
-            return std::nullopt;
-          }},
-      u);
-}
-
-// FoldScalar
-
-template<typename TO, typename FROM>
-auto Convert<TO, FROM>::FoldScalar(FoldingContext &context,
-    const Scalar<Operand> &c) -> std::optional<Scalar<Result>> {
-  if constexpr (std::is_same_v<Result, Operand>) {
-    return {c};
-  } else if constexpr (std::is_same_v<Result, SomeType>) {
-    using Generic = SomeKind<Operand::category>;
-    if constexpr (std::is_same_v<Operand, Generic>) {
-      return {Scalar<Result>{c}};
-    } else {
-      return {Scalar<Result>{Generic{c}}};
-    }
-  } else if constexpr (std::is_same_v<Operand, SomeType>) {
-    return std::visit(
-        [&](const auto &x) -> std::optional<Scalar<Result>> {
-          using Ty = std::decay_t<decltype(x)>;
-          return Convert<Result, Ty>::FoldScalar(context, x);
-        },
-        c.u.u);
-  } else if constexpr (std::is_same_v<Result, SomeKind<Result::category>>) {
-    if constexpr (Result::category == Operand::category) {
-      return {Scalar<Result>{c}};
-    }
-  } else if constexpr (std::is_same_v<Operand, SomeKind<Operand::category>>) {
-    return std::visit(
-        [&](const auto &x) -> std::optional<Scalar<Result>> {
-          using Ty = TypeOf<std::decay_t<decltype(x)>>;
-          return Convert<Result, Ty>::FoldScalar(context, x);
-        },
-        c.u);
-  } else if constexpr (Result::category == TypeCategory::Integer) {
-    if constexpr (Operand::category == TypeCategory::Integer) {
-      auto converted{Scalar<Result>::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<Scalar<Result>>()};
-      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<Result>::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<Result>::Convert(c)};
-      RealFlagWarnings(context, converted.flags, "REAL to REAL conversion");
-      return {std::move(converted.value)};
-    }
-  }
-  return std::nullopt;
+      x.u);
 }
 
 template<typename A>
@@ -388,9 +281,9 @@ auto Power<A>::FoldScalar(FoldingContext &context, const Scalar<Operand> &x,
   return std::nullopt;
 }
 
-template<typename A, typename B>
-auto RealToIntPower<A, B>::FoldScalar(FoldingContext &context,
-    const Scalar<Operand> &x, const Scalar<ExponentOperand> &y)
+template<typename A>
+auto RealToIntPower<A>::FoldScalar(FoldingContext &context,
+    const Scalar<BaseOperand> &x, const Scalar<ExponentOperand> &y)
     -> std::optional<Scalar<Result>> {
   return std::visit(
       [&](const auto &pow) -> std::optional<Scalar<Result>> {
@@ -517,6 +410,11 @@ template<typename A> std::string Relational<A>::infix() const {
   return "."s + EnumToString(opr) + '.';
 }
 
+std::ostream &Relational<SomeType>::Dump(std::ostream &o) const {
+  std::visit([&](const auto &rel) { rel.Dump(o); }, u);
+  return o;
+}
+
 template<int KIND> const char *LogicalOperation<KIND>::infix() const {
   const char *result{nullptr};
   switch (logicalOperator) {
@@ -528,107 +426,48 @@ template<int KIND> const char *LogicalOperation<KIND>::infix() const {
   return result;
 }
 
-template<typename... A>
-std::ostream &DumpExpr(std::ostream &o, const std::variant<A...> &u) {
-  std::visit(common::visitors{[&](const BOZLiteralConstant &x) {
-                                o << "Z'" << x.Hexadecimal() << "'";
-                              },
-                 [&](const auto &x) { x.Dump(o); }},
-      u);
-  return o;
-}
-
-template<TypeCategory CAT>
-std::ostream &Expr<SomeKind<CAT>>::Dump(std::ostream &o) const {
-  return DumpExpr(o, u.u);
-}
-
-std::ostream &AnyRelational::Dump(std::ostream &o) const {
-  return DumpExpr(o, u);
-}
-
-std::ostream &Expr<SomeType>::Dump(std::ostream &o) const {
-  return DumpExpr(o, u);
-}
-
-template<int KIND>
-std::ostream &Expr<Type<TypeCategory::Integer, KIND>>::Dump(
-    std::ostream &o) const {
-  std::visit(common::visitors{[&](const Scalar<Result> &n) {
-                                o << n.SignedDecimal() << '_' << KIND;
-                              },
-                 [&](const CopyableIndirection<DataRef> &d) { d->Dump(o); },
-                 [&](const CopyableIndirection<FunctionRef> &d) { d->Dump(o); },
-                 [&](const auto &x) { x.Dump(o); }},
-      u_);
-  return o;
-}
-
-template<int KIND>
-std::ostream &Expr<Type<TypeCategory::Real, KIND>>::Dump(
-    std::ostream &o) const {
-  std::visit(common::visitors{[&](const Scalar<Result> &n) {
-                                o << n.DumpHexadecimal();
-                              },
-                 [&](const CopyableIndirection<DataRef> &d) { d->Dump(o); },
-                 [&](const CopyableIndirection<ComplexPart> &d) { d->Dump(o); },
-                 [&](const CopyableIndirection<FunctionRef> &d) { d->Dump(o); },
-                 [&](const auto &x) { x.Dump(o); }},
-      u_);
-  return o;
-}
-
-template<int KIND>
-std::ostream &Expr<Type<TypeCategory::Complex, KIND>>::Dump(
-    std::ostream &o) const {
-  std::visit(common::visitors{[&](const Scalar<Result> &n) {
-                                o << n.DumpHexadecimal();
-                              },
-                 [&](const CopyableIndirection<DataRef> &d) { d->Dump(o); },
-                 [&](const CopyableIndirection<FunctionRef> &d) { d->Dump(o); },
-                 [&](const auto &x) { x.Dump(o); }},
-      u_);
-  return o;
-}
-
-template<int KIND>
-std::ostream &Expr<Type<TypeCategory::Character, KIND>>::Dump(
-    std::ostream &o) const {
-  std::visit(common::visitors{[&](const Scalar<Result> &s) {
-                                o << KIND << '_'
-                                  << parser::QuoteCharacterLiteral(s);
-                              },
-                 //          [&](const Parentheses<Result> &p) { p.Dump(o); },
-                 [&](const Concat<KIND> &c) { c.Dump(o); },
-                 [&](const Extremum<Result> &mm) { mm.Dump(o); },
-                 [&](const auto &ind) { ind->Dump(o); }},
-      u_);
-  return o;
+template<typename T> std::ostream &Constant<T>::Dump(std::ostream &o) const {
+  if constexpr (T::category == TypeCategory::Integer) {
+    return o << value.SignedDecimal() << '_' << Result::kind;
+  } else if constexpr (T::category == TypeCategory::Real ||
+      T::category == TypeCategory::Complex) {
+    return o << value.DumpHexadecimal() << '_' << Result::kind;
+  } else if constexpr (T::category == TypeCategory::Character) {
+    return o << Result::kind << '_' << parser::QuoteCharacterLiteral(value);
+  } else if constexpr (T::category == TypeCategory::Logical) {
+    if (value.IsTrue()) {
+      o << ".TRUE.";
+    } else {
+      o << ".FALSE.";
+    }
+    return o << '_' << Result::kind;
+  } else {
+    return value.u.Dump(o);
+  }
 }
 
-template<int KIND>
-std::ostream &Expr<Type<TypeCategory::Logical, KIND>>::Dump(
-    std::ostream &o) const {
-  std::visit(common::visitors{[&](const Scalar<Result> &tf) {
-                                o << (tf.IsTrue() ? ".TRUE." : ".FALSE.") << '_'
-                                  << KIND;
-                              },
-                 [&](const CopyableIndirection<DataRef> &d) { d->Dump(o); },
-                 [&](const CopyableIndirection<FunctionRef> &d) { d->Dump(o); },
-                 [&](const auto &x) { x.Dump(o); }},
-      u_);
+template<typename RESULT>
+std::ostream &ExpressionBase<RESULT>::Dump(std::ostream &o) const {
+  std::visit(
+      common::visitors{[&](const BOZLiteralConstant &x) {
+                         o << "Z'" << x.Hexadecimal() << "'";
+                       },
+          [&](const DataReference<Result> &dr) { dr.reference->Dump(o); },
+          [&](const FunctionReference<Result> &fr) { fr.reference->Dump(o); },
+          [&](const CopyableIndirection<Substring> &s) { s->Dump(o); },
+          [&](const auto &x) { x.Dump(o); }},
+      derived().u);
   return o;
 }
 
-// LEN()
 template<int KIND>
 Expr<SubscriptInteger> Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
   return std::visit(
-      common::visitors{[](const Scalar<Result> &c) {
+      common::visitors{[](const Constant<Result> &c) {
                          // std::string::size_type isn't convertible to uint64_t
                          // on Darwin
                          return Expr<SubscriptInteger>{
-                             static_cast<std::uint64_t>(c.size())};
+                             static_cast<std::uint64_t>(c.value.size())};
                        },
           [](const Concat<KIND> &c) {
             return c.template operand<0>().LEN() +
@@ -638,64 +477,32 @@ Expr<SubscriptInteger> Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
             return Expr<SubscriptInteger>{Extremum<SubscriptInteger>{
                 c.template operand<0>().LEN(), c.template operand<1>().LEN()}};
           },
-          [](const CopyableIndirection<DataRef> &dr) { return dr->LEN(); },
+          [](const DataReference<Result> &dr) { return dr.reference->LEN(); },
           [](const CopyableIndirection<Substring> &ss) { return ss->LEN(); },
-          [](const CopyableIndirection<FunctionRef> &fr) {
-            return fr->proc().LEN();
-          }},
-      u_);
-}
-
-// ScalarValue
-
-template<TypeCategory CAT>
-auto Expr<SomeKind<CAT>>::ScalarValue() const -> std::optional<Scalar<Result>> {
-  return std::visit(
-      [](const auto &x) -> std::optional<Scalar<Result>> {
-        if (auto c{x.ScalarValue()}) {
-          return {Scalar<Result>{std::move(*c)}};
-        }
-        return std::nullopt;
-      },
-      u.u);
-}
-
-auto Expr<SomeType>::ScalarValue() const -> std::optional<Scalar<Result>> {
-  return std::visit(
-      common::visitors{
-          [](const BOZLiteralConstant &) -> std::optional<Scalar<Result>> {
-            return std::nullopt;
-          },
-          [](const auto &x) -> std::optional<Scalar<Result>> {
-            if (auto c{x.ScalarValue()}) {
-              return {common::MoveVariant<Scalar<Result>>(std::move(c->u))};
-            }
-            return std::nullopt;
+          [](const FunctionReference<Result> &fr) {
+            return fr.reference->proc().LEN();
           }},
       u);
 }
 
-// Rank
-
-template<TypeCategory CAT> int Expr<SomeKind<CAT>>::Rank() const {
-  return std::visit([](const auto &x) { return x.Rank(); }, u.u);
-}
-
-int Expr<SomeType>::Rank() const {
-  // Written thus, instead of common::visitors, to dodge a bug in G++ 7.2.
+template<typename RESULT>
+auto ExpressionBase<RESULT>::ScalarValue() const
+    -> std::optional<Scalar<Result>> {
+  using Const = Scalar<Result>;
   return std::visit(
-      [](const auto &x) {
-        if constexpr (std::is_same_v<std::decay_t<decltype(x)>,
-                          BOZLiteralConstant>) {
-          return 1;
-        } else {
-          return x.Rank();
+      [](const auto &x) -> std::optional<Const> {
+        using Ty = std::decay_t<decltype(x)>;
+        if constexpr (IsConstantTrait<Ty>) {
+          return {Const{x.value}};
         }
+        // TODO: Also succeed for a parenthesized constant
+        return std::nullopt;
       },
-      u);
+      derived().u);
 }
 
-// Template instantiations
+// Template instantiations to resolve the "extern template" declarations
+// in expression.h.
 
 template class Expr<Type<TypeCategory::Integer, 1>>;
 template class Expr<Type<TypeCategory::Integer, 2>>;
@@ -713,6 +520,16 @@ template class Expr<Type<TypeCategory::Complex, 8>>;
 template class Expr<Type<TypeCategory::Complex, 10>>;
 template class Expr<Type<TypeCategory::Complex, 16>>;
 template class Expr<Type<TypeCategory::Character, 1>>;  // TODO others
+template class Expr<Type<TypeCategory::Logical, 1>>;
+template class Expr<Type<TypeCategory::Logical, 2>>;
+template class Expr<Type<TypeCategory::Logical, 4>>;
+template class Expr<Type<TypeCategory::Logical, 8>>;
+template class Expr<SomeInteger>;
+template class Expr<SomeReal>;
+template class Expr<SomeComplex>;
+template class Expr<SomeCharacter>;
+template class Expr<SomeLogical>;
+template class Expr<SomeType>;
 
 template struct Relational<Type<TypeCategory::Integer, 1>>;
 template struct Relational<Type<TypeCategory::Integer, 2>>;
@@ -730,17 +547,33 @@ template struct Relational<Type<TypeCategory::Complex, 8>>;
 template struct Relational<Type<TypeCategory::Complex, 10>>;
 template struct Relational<Type<TypeCategory::Complex, 16>>;
 template struct Relational<Type<TypeCategory::Character, 1>>;  // TODO others
+template struct Relational<SomeType>;
+
+template struct ExpressionBase<Type<TypeCategory::Integer, 1>>;
+template struct ExpressionBase<Type<TypeCategory::Integer, 2>>;
+template struct ExpressionBase<Type<TypeCategory::Integer, 4>>;
+template struct ExpressionBase<Type<TypeCategory::Integer, 8>>;
+template struct ExpressionBase<Type<TypeCategory::Integer, 16>>;
+template struct ExpressionBase<Type<TypeCategory::Real, 2>>;
+template struct ExpressionBase<Type<TypeCategory::Real, 4>>;
+template struct ExpressionBase<Type<TypeCategory::Real, 8>>;
+template struct ExpressionBase<Type<TypeCategory::Real, 10>>;
+template struct ExpressionBase<Type<TypeCategory::Real, 16>>;
+template struct ExpressionBase<Type<TypeCategory::Complex, 2>>;
+template struct ExpressionBase<Type<TypeCategory::Complex, 4>>;
+template struct ExpressionBase<Type<TypeCategory::Complex, 8>>;
+template struct ExpressionBase<Type<TypeCategory::Complex, 10>>;
+template struct ExpressionBase<Type<TypeCategory::Complex, 16>>;
+template struct ExpressionBase<Type<TypeCategory::Character, 1>>;
+template struct ExpressionBase<Type<TypeCategory::Logical, 1>>;
+template struct ExpressionBase<Type<TypeCategory::Logical, 2>>;
+template struct ExpressionBase<Type<TypeCategory::Logical, 4>>;
+template struct ExpressionBase<Type<TypeCategory::Logical, 8>>;
+template struct ExpressionBase<SomeInteger>;
+template struct ExpressionBase<SomeReal>;
+template struct ExpressionBase<SomeComplex>;
+template struct ExpressionBase<SomeCharacter>;
+template struct ExpressionBase<SomeLogical>;
+template struct ExpressionBase<SomeType>;
 
-template class Expr<Type<TypeCategory::Logical, 1>>;
-template class Expr<Type<TypeCategory::Logical, 2>>;
-template class Expr<Type<TypeCategory::Logical, 4>>;
-template class Expr<Type<TypeCategory::Logical, 8>>;
-
-template class Expr<SomeInteger>;
-template class Expr<SomeReal>;
-template class Expr<SomeComplex>;
-template class Expr<SomeCharacter>;
-template class Expr<SomeLogical>;
-
-template class Expr<SomeType>;
 }  // namespace Fortran::evaluate
index 831cc0c..54b77c8 100644 (file)
@@ -18,8 +18,7 @@
 // Represent Fortran expressions in a type-safe manner.
 // Expressions are the sole owners of their constituents; i.e., there is no
 // context-independent hash table or sharing of common subexpressions.
-// Both deep copy and move semantics are supported for expression construction
-// and manipulation in place.
+// Both deep copy and move semantics are supported for expression construction.
 
 #include "common.h"
 #include "type.h"
 #include "../lib/parser/message.h"
 #include <ostream>
 #include <tuple>
+#include <type_traits>
 #include <variant>
 
 namespace Fortran::evaluate {
 
 using common::RelationalOperator;
 
-// Expr<A> represents an expression whose result is the Fortran type A,
-// which can be a specific Type<C,K>, or SomeKind<C> for a type category C, or
-// Expr<SomeType> for a wholly generic expression.  Instances of Expr<>
-// wrap discriminated unions.
+// Expressions are represented by specializations of Expr.
+// Each of these specializations wraps a single data member "u" that
+// is a std::variant<> discriminated union over the representational
+// types of the constants, variables, operations, and other entities that
+// can be valid expressions in that context:
+// - Expr<Type<CATEGORY, KIND>> is an expression whose result is of a
+//   specific intrinsic type category and kind, e.g. Type<TypeCategory::Real, 4>
+// - Expr<SomeKind<CATEGORY>> is a union of Expr<Type<CATEGORY, K>> for each
+//   kind type parameter value K in that intrinsic type category
+// - Expr<SomeType> is a union of Expr<SomeKind<CATEGORY>> over the five
+//   intrinsic type categories of Fortran.
 template<typename A> class Expr;
 
+// 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
+// maps to some instantiation of Type<CATEGORY, KIND>, SomeKind<CATEGORY>,
+// or SomeType.
 template<typename A> using ResultType = typename std::decay_t<A>::Result;
 
-// Abstract Operation<> base class.  The first type parameter is a "CRTP"
+// Wraps a constant value in a class to make its type clear.
+CLASS_TRAIT(IsConstantTrait)
+template<typename T> struct Constant {
+  using Result = T;
+  using Value = Scalar<Result>;  // TODO rank > 0
+  using IsConstantTrait = std::true_type;
+  CLASS_BOILERPLATE(Constant)
+  template<typename A> Constant(const A &x) : value{x} {}
+  template<typename A>
+  Constant(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
+    : value(std::move(x)) {}
+  std::ostream &Dump(std::ostream &) const;
+  Value value;
+};
+
+// Wrappers around data and function references so that their resolved
+// types are clear.
+template<typename T> struct DataReference {
+  using Result = T;
+  CopyableIndirection<DataRef> reference;
+};
+
+template<typename T> struct FunctionReference {
+  using Result = T;
+  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, ...>.
-template<typename DERIVED, typename RESULT, typename... OPERAND>
+template<typename DERIVED, typename RESULT, typename... OPERANDS>
 class Operation {
+  using OperandTypes = std::tuple<OPERANDS...>;
+  static_assert(RESULT::kind > 0 || !"bad result Type");
+
 public:
   using Derived = DERIVED;
   using Result = RESULT;
-  using OperandTypes = std::tuple<OPERAND...>;
-  using OperandTuple = std::tuple<Expr<OPERAND>...>;
+  static constexpr auto operands() { return std::tuple_size_v<OperandTypes>; }
   template<int J> using Operand = std::tuple_element_t<J, OperandTypes>;
-  using FoldableTrait = std::true_type;
+  using IsFoldableTrait = std::true_type;
 
-  static_assert(Result::kind > 0);  // Operations have specific Result types
+  // Unary operations wrap a single Expr with a CopyableIndirection.
+  // Binary operations wrap a tuple of CopyableIndirections to Exprs.
+private:
+  using Container =
+      std::conditional_t<operands() == 1, CopyableIndirection<Expr<Operand<0>>>,
+          std::tuple<CopyableIndirection<Expr<OPERANDS>>...>>;
 
+public:
   CLASS_BOILERPLATE(Operation)
-  Operation(const Expr<OPERAND> &... x) : operand_{OperandTuple{x...}} {}
-  Operation(Expr<OPERAND> &&... x)
-    : operand_{OperandTuple{std::forward<Expr<OPERAND>>(x)...}} {}
-
-  DERIVED &derived() { return *static_cast<DERIVED *>(this); }
-  const DERIVED &derived() const { return *static_cast<const DERIVED *>(this); }
-
-  static constexpr auto operands() { return std::tuple_size_v<OperandTypes>; }
-  template<int J> Expr<Operand<J>> &operand() { return std::get<J>(*operand_); }
+  Operation(const Expr<OPERANDS> &... x) : operand_{x...} {}
+  Operation(Expr<OPERANDS> &&... x)
+    : operand_{std::forward<Expr<OPERANDS>>(x)...} {}
+
+  Derived &derived() { return *static_cast<Derived *>(this); }
+  const Derived &derived() const { return *static_cast<const Derived *>(this); }
+
+  template<int J> Expr<Operand<J>> &operand() {
+    if constexpr (operands() == 1) {
+      static_assert(J == 0);
+      return *operand_;
+    } else {
+      return *std::get<J>(operand_);
+    }
+  }
   template<int J> const Expr<Operand<J>> &operand() const {
-    return std::get<J>(*operand_);
+    if constexpr (operands() == 1) {
+      static_assert(J == 0);
+      return *operand_;
+    } else {
+      return *std::get<J>(operand_);
+    }
   }
 
   std::ostream &Dump(std::ostream &) const;
-  std::optional<Scalar<Result>> Fold(FoldingContext &);  // TODO rank > 0
+  std::optional<Constant<Result>> Fold(FoldingContext &);
 
 protected:
   // Overridable string functions for Dump()
@@ -83,27 +140,27 @@ protected:
   static const char *suffix() { return ")"; }
 
 private:
-  CopyableIndirection<OperandTuple> operand_;
+  Container operand_;
 };
 
 // Unary operations
 
-template<typename TO, typename FROM>
-struct Convert : public Operation<Convert<TO, FROM>, TO, FROM> {
-  using Base = Operation<Convert<TO, FROM>, TO, FROM>;
+template<typename TO, TypeCategory FROMCAT>
+struct Convert : public Operation<Convert<TO, FROMCAT>, TO, SomeKind<FROMCAT>> {
+  using Result = TO;
+  using Operand = SomeKind<FROMCAT>;
+  using Base = Operation<Convert, Result, Operand>;
   using Base::Base;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
   static std::optional<Scalar<Result>> FoldScalar(
       FoldingContext &, const Scalar<Operand> &);
 };
 
 template<typename A>
 struct Parentheses : public Operation<Parentheses<A>, A, A> {
+  using Result = A;
+  using Operand = A;
   using Base = Operation<Parentheses, A, A>;
   using Base::Base;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
   static std::optional<Scalar<Result>> FoldScalar(
       FoldingContext &, const Scalar<Operand> &x) {
     return {x};
@@ -111,10 +168,10 @@ struct Parentheses : public Operation<Parentheses<A>, A, A> {
 };
 
 template<typename A> struct Negate : public Operation<Negate<A>, A, A> {
+  using Result = A;
+  using Operand = A;
   using Base = Operation<Negate, A, A>;
   using Base::Base;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
   static std::optional<Scalar<Result>> FoldScalar(
       FoldingContext &, const Scalar<Operand> &);
   static const char *prefix() { return "(-"; }
@@ -124,10 +181,9 @@ template<int KIND>
 struct ComplexComponent
   : public Operation<ComplexComponent<KIND>, Type<TypeCategory::Real, KIND>,
         Type<TypeCategory::Complex, KIND>> {
-  using Base = Operation<ComplexComponent, Type<TypeCategory::Real, KIND>,
-      Type<TypeCategory::Complex, KIND>>;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
+  using Result = Type<TypeCategory::Real, KIND>;
+  using Operand = Type<TypeCategory::Complex, KIND>;
+  using Base = Operation<ComplexComponent, Result, Operand>;
   CLASS_BOILERPLATE(ComplexComponent)
   ComplexComponent(bool isImaginary, const Expr<Operand> &x)
     : Base{x}, isImaginaryPart{isImaginary} {}
@@ -144,10 +200,9 @@ struct ComplexComponent
 template<int KIND>
 struct Not : public Operation<Not<KIND>, Type<TypeCategory::Logical, KIND>,
                  Type<TypeCategory::Logical, KIND>> {
-  using Base = Operation<Not, Type<TypeCategory::Logical, KIND>,
-      Type<TypeCategory::Logical, KIND>>;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
+  using Result = Type<TypeCategory::Logical, KIND>;
+  using Operand = Result;
+  using Base = Operation<Not, Result, Operand>;
   using Base::Base;
   static std::optional<Scalar<Result>> FoldScalar(
       FoldingContext &, const Scalar<Operand> &);
@@ -157,9 +212,9 @@ struct Not : public Operation<Not<KIND>, Type<TypeCategory::Logical, KIND>,
 // Binary operations
 
 template<typename A> struct Add : public Operation<Add<A>, A, A, A> {
+  using Result = A;
+  using Operand = A;
   using Base = Operation<Add, A, A, A>;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
   using Base::Base;
   static std::optional<Scalar<Result>> FoldScalar(
       FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &);
@@ -167,9 +222,9 @@ template<typename A> struct Add : public Operation<Add<A>, A, A, A> {
 };
 
 template<typename A> struct Subtract : public Operation<Subtract<A>, A, A, A> {
+  using Result = A;
+  using Operand = A;
   using Base = Operation<Subtract, A, A, A>;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
   using Base::Base;
   static std::optional<Scalar<Result>> FoldScalar(
       FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &);
@@ -177,9 +232,9 @@ template<typename A> struct Subtract : public Operation<Subtract<A>, A, A, A> {
 };
 
 template<typename A> struct Multiply : public Operation<Multiply<A>, A, A, A> {
+  using Result = A;
+  using Operand = A;
   using Base = Operation<Multiply, A, A, A>;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
   using Base::Base;
   static std::optional<Scalar<Result>> FoldScalar(
       FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &);
@@ -187,9 +242,9 @@ template<typename A> struct Multiply : public Operation<Multiply<A>, A, A, A> {
 };
 
 template<typename A> struct Divide : public Operation<Divide<A>, A, A, A> {
+  using Result = A;
+  using Operand = A;
   using Base = Operation<Divide, A, A, A>;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
   using Base::Base;
   static std::optional<Scalar<Result>> FoldScalar(
       FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &);
@@ -197,31 +252,31 @@ template<typename A> struct Divide : public Operation<Divide<A>, A, A, A> {
 };
 
 template<typename A> struct Power : public Operation<Power<A>, A, A, A> {
+  using Result = A;
+  using Operand = A;
   using Base = Operation<Power, A, A, A>;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
   using Base::Base;
   static std::optional<Scalar<Result>> FoldScalar(
       FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &);
   static constexpr const char *infix() { return "**"; }
 };
 
-template<typename A, typename B>
-struct RealToIntPower : public Operation<RealToIntPower<A, B>, A, A, B> {
-  using Base = Operation<RealToIntPower, A, A, B>;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
-  using ExponentOperand = typename Base::template Operand<1>;
+template<typename A>
+struct RealToIntPower : public Operation<RealToIntPower<A>, A, A, SomeInteger> {
+  using Base = Operation<RealToIntPower, A, A, SomeInteger>;
+  using Result = A;
+  using BaseOperand = A;
+  using ExponentOperand = SomeInteger;
   using Base::Base;
   static std::optional<Scalar<Result>> FoldScalar(FoldingContext &,
-      const Scalar<Operand> &, const Scalar<ExponentOperand> &);
+      const Scalar<BaseOperand> &, const Scalar<ExponentOperand> &);
   static constexpr const char *infix() { return "**"; }
 };
 
 template<typename A> struct Extremum : public Operation<Extremum<A>, A, A, A> {
+  using Result = A;
+  using Operand = A;
   using Base = Operation<Extremum, A, A, A>;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
   CLASS_BOILERPLATE(Extremum)
   Extremum(const Expr<Operand> &x, const Expr<Operand> &y,
       Ordering ord = Ordering::Greater)
@@ -244,10 +299,9 @@ struct ComplexConstructor
   : public Operation<ComplexConstructor<KIND>,
         Type<TypeCategory::Complex, KIND>, Type<TypeCategory::Real, KIND>,
         Type<TypeCategory::Real, KIND>> {
-  using Base = Operation<ComplexConstructor, Type<TypeCategory::Complex, KIND>,
-      Type<TypeCategory::Real, KIND>, Type<TypeCategory::Real, KIND>>;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
+  using Result = Type<TypeCategory::Complex, KIND>;
+  using Operand = Type<TypeCategory::Real, KIND>;
+  using Base = Operation<ComplexConstructor, Result, Operand, Operand>;
   using Base::Base;
   static std::optional<Scalar<Result>> FoldScalar(
       FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &);
@@ -258,10 +312,9 @@ struct Concat
   : public Operation<Concat<KIND>, Type<TypeCategory::Character, KIND>,
         Type<TypeCategory::Character, KIND>,
         Type<TypeCategory::Character, KIND>> {
-  using Base = Operation<Concat, Type<TypeCategory::Character, KIND>,
-      Type<TypeCategory::Character, KIND>, Type<TypeCategory::Character, KIND>>;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
+  using Result = Type<TypeCategory::Character, KIND>;
+  using Operand = Result;
+  using Base = Operation<Concat, Result, Operand, Operand>;
   using Base::Base;
   static std::optional<Scalar<Result>> FoldScalar(
       FoldingContext &, const Scalar<Operand> &, const Scalar<Operand> &);
@@ -274,10 +327,9 @@ template<int KIND>
 struct LogicalOperation
   : public Operation<LogicalOperation<KIND>, Type<TypeCategory::Logical, KIND>,
         Type<TypeCategory::Logical, KIND>, Type<TypeCategory::Logical, KIND>> {
-  using Base = Operation<LogicalOperation, Type<TypeCategory::Logical, KIND>,
-      Type<TypeCategory::Logical, KIND>, Type<TypeCategory::Logical, KIND>>;
-  using typename Base::Result;
-  using Operand = typename Base::template Operand<0>;
+  using Result = Type<TypeCategory::Logical, KIND>;
+  using Operand = Result;
+  using Base = Operation<LogicalOperation, Result, Operand, Operand>;
   CLASS_BOILERPLATE(LogicalOperation)
   LogicalOperation(
       const Expr<Operand> &x, const Expr<Operand> &y, LogicalOperator opr)
@@ -294,133 +346,119 @@ struct LogicalOperation
 
 // Per-category expressions
 
-template<int KIND> class Expr<Type<TypeCategory::Integer, KIND>> {
+// Common Expr<> behaviors
+template<typename RESULT> struct ExpressionBase {
+  using Result = RESULT;
+  using Derived = Expr<Result>;
+
+  Derived &derived() { return *static_cast<Derived *>(this); }
+  const Derived &derived() const { return *static_cast<const Derived *>(this); }
+
+  int Rank() const { return 0; }  // TODO
+
+  template<typename A> Derived &operator=(const A &x) {
+    Derived &d{derived()};
+    d.u = x;
+    return d;
+  }
+
+  template<typename A>
+  Derived &operator=(std::enable_if_t<!std::is_reference_v<A>, A> &&x) {
+    Derived &d{derived()};
+    d.u = std::move(x);
+    return d;
+  }
+
+  std::ostream &Dump(std::ostream &) const;
+  std::optional<Constant<Result>> Fold(FoldingContext &c);
+  std::optional<Scalar<Result>> ScalarValue() const;
+};
+
+template<int KIND>
+class Expr<Type<TypeCategory::Integer, KIND>>
+  : public ExpressionBase<Type<TypeCategory::Integer, KIND>> {
 public:
   using Result = Type<TypeCategory::Integer, KIND>;
-  using FoldableTrait = std::true_type;
+  using IsFoldableTrait = std::true_type;
   // TODO: R916 type-param-inquiry
 
   CLASS_BOILERPLATE(Expr)
-  Expr(const Scalar<Result> &x) : u_{x} {}
-  Expr(std::int64_t n) : u_{Scalar<Result>{n}} {}
-  Expr(std::uint64_t n) : u_{Scalar<Result>{n}} {}
-  Expr(int n) : u_{Scalar<Result>{n}} {}
-  Expr(const Expr<SomeInteger> &x) : u_{Convert<Result, SomeInteger>{x}} {}
-  Expr(Expr<SomeInteger> &&x)
-    : u_{Convert<Result, SomeInteger>{std::move(x)}} {}
-  template<int K>
-  Expr(const Expr<Type<TypeCategory::Integer, K>> &x)
-    : u_{Convert<Result, SomeInteger>{Expr<SomeInteger>{x}}} {}
-  template<int K>
-  Expr(Expr<Type<TypeCategory::Integer, K>> &&x)
-    : u_{Convert<Result, SomeInteger>{Expr<SomeInteger>{std::move(x)}}} {}
-  Expr(const Expr<SomeReal> &x) : u_{Convert<Result, SomeReal>{x}} {}
-  Expr(Expr<SomeReal> &&x) : u_{Convert<Result, SomeReal>{std::move(x)}} {}
-  template<int K>
-  Expr(const Expr<Type<TypeCategory::Real, K>> &x)
-    : u_{Convert<Result, SomeReal>{Expr<SomeReal>{x}}} {}
-  template<int K>
-  Expr(Expr<Type<TypeCategory::Real, K>> &&x)
-    : u_{Convert<Result, SomeReal>{Expr<SomeReal>{std::move(x)}}} {}
-  template<typename A> Expr(const A &x) : u_{x} {}
+  Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
+  Expr(std::int64_t n) : u{Constant<Result>{n}} {}
+  Expr(std::uint64_t n) : u{Constant<Result>{n}} {}
+  Expr(int n) : u{Constant<Result>{n}} {}
+  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)) {}
-  template<typename A> Expr(CopyableIndirection<A> &&x) : u_{std::move(x)} {}
-
-  std::optional<Scalar<Result>> ScalarValue() const {
-    // TODO: Also succeed when parenthesized constant
-    return common::GetIf<Scalar<Result>>(u_);
-  }
-  std::ostream &Dump(std::ostream &) const;
-  std::optional<Scalar<Result>> Fold(FoldingContext &c);
-  int Rank() const { return 1; }  // TODO
+  Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x) : u(std::move(x)) {}
+  Expr(const DataRef &x) : u{DataReference<Result>{x}} {}
+  Expr(const FunctionRef &x) : u{FunctionReference<Result>{x}} {}
 
 private:
-  std::variant<Scalar<Result>, CopyableIndirection<DataRef>,
-      CopyableIndirection<FunctionRef>, Convert<Result, SomeInteger>,
-      Convert<Result, SomeReal>, Parentheses<Result>, Negate<Result>,
+  using Conversions = std::variant<Convert<Result, TypeCategory::Integer>,
+      Convert<Result, TypeCategory::Real>>;
+  using Operations = std::variant<Parentheses<Result>, Negate<Result>,
       Add<Result>, Subtract<Result>, Multiply<Result>, Divide<Result>,
-      Power<Result>, Extremum<Result>>
-      u_;
+      Power<Result>, Extremum<Result>>;
+  using Others = std::variant<Constant<Result>, DataReference<Result>,
+      FunctionReference<Result>>;
+
+public:
+  common::CombineVariants<Operations, Conversions, Others> u;
 };
 
-template<int KIND> class Expr<Type<TypeCategory::Real, KIND>> {
+template<int KIND>
+class Expr<Type<TypeCategory::Real, KIND>>
+  : public ExpressionBase<Type<TypeCategory::Real, KIND>> {
 public:
   using Result = Type<TypeCategory::Real, KIND>;
-  using FoldableTrait = std::true_type;
-
-  // N.B. Real->Complex and Complex->Real conversions are done with CMPLX
-  // and part access operations (resp.).  Conversions between kinds of
-  // Complex are done via decomposition to Real and reconstruction.
+  using IsFoldableTrait = std::true_type;
 
   CLASS_BOILERPLATE(Expr)
-  Expr(const Scalar<Result> &x) : u_{x} {}
-  Expr(const Expr<SomeInteger> &x) : u_{Convert<Result, SomeInteger>{x}} {}
-  Expr(Expr<SomeInteger> &&x)
-    : u_{Convert<Result, SomeInteger>{std::move(x)}} {}
-  template<int K>
-  Expr(const Expr<Type<TypeCategory::Integer, K>> &x)
-    : u_{Convert<Result, SomeInteger>{Expr<SomeInteger>{x}}} {}
-  template<int K>
-  Expr(Expr<Type<TypeCategory::Integer, K>> &&x)
-    : u_{Convert<Result, SomeInteger>{Expr<SomeInteger>{std::move(x)}}} {}
-  Expr(const Expr<SomeReal> &x) : u_{Convert<Result, SomeReal>{x}} {}
-  Expr(Expr<SomeReal> &&x) : u_{Convert<Result, SomeReal>{std::move(x)}} {}
-  template<int K>
-  Expr(const Expr<Type<TypeCategory::Real, K>> &x)
-    : u_{Convert<Result, SomeReal>{Expr<SomeReal>{x}}} {}
-  template<int K>
-  Expr(Expr<Type<TypeCategory::Real, K>> &&x)
-    : u_{Convert<Result, SomeReal>{Expr<SomeReal>{std::move(x)}}} {}
-  template<typename A> Expr(const A &x) : u_{x} {}
+  Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
+  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)} {}
-  template<typename A> Expr(CopyableIndirection<A> &&x) : u_{std::move(x)} {}
-
-  std::optional<Scalar<Result>> ScalarValue() const {
-    // TODO: parenthesized constants too
-    return common::GetIf<Scalar<Result>>(u_);
-  }
-  std::ostream &Dump(std::ostream &) const;
-  std::optional<Scalar<Result>> Fold(FoldingContext &c);
-  int Rank() const { return 1; }  // TODO
+  Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x) : u{std::move(x)} {}
+  Expr(const DataRef &x) : u{DataReference<Result>{x}} {}
+  Expr(const FunctionRef &x) : u{FunctionReference<Result>{x}} {}
 
 private:
-  std::variant<Scalar<Result>, CopyableIndirection<DataRef>,
-      CopyableIndirection<ComplexPart>, CopyableIndirection<FunctionRef>,
-      Convert<Result, SomeInteger>, Convert<Result, SomeReal>,
-      ComplexComponent<KIND>, Parentheses<Result>, Negate<Result>, Add<Result>,
-      Subtract<Result>, Multiply<Result>, Divide<Result>, Power<Result>,
-      RealToIntPower<Result, SomeInteger>, Extremum<Result>>
-      u_;
+  // N.B. Real->Complex and Complex->Real conversions are done with CMPLX
+  // and part access operations (resp.).  Conversions between kinds of
+  // Complex are done via decomposition to Real and reconstruction.
+  using Conversions = std::variant<Convert<Result, TypeCategory::Integer>,
+      Convert<Result, TypeCategory::Real>>;
+  using Operations = std::variant<ComplexComponent<KIND>, Parentheses<Result>,
+      Negate<Result>, Add<Result>, Subtract<Result>, Multiply<Result>,
+      Divide<Result>, Power<Result>, RealToIntPower<Result>, Extremum<Result>>;
+  using Others = std::variant<Constant<Result>, DataReference<Result>,
+      FunctionReference<Result>>;
+
+public:
+  common::CombineVariants<Operations, Conversions, Others> u;
 };
 
-template<int KIND> class Expr<Type<TypeCategory::Complex, KIND>> {
+template<int KIND>
+class Expr<Type<TypeCategory::Complex, KIND>>
+  : public ExpressionBase<Type<TypeCategory::Complex, KIND>> {
 public:
   using Result = Type<TypeCategory::Complex, KIND>;
-  using FoldableTrait = std::true_type;
+  using IsFoldableTrait = std::true_type;
   CLASS_BOILERPLATE(Expr)
-  Expr(const Scalar<Result> &x) : u_{x} {}
-  template<typename A> Expr(const A &x) : u_{x} {}
+  Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
+  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)} {}
-  template<typename A> Expr(CopyableIndirection<A> &&x) : u_{std::move(x)} {}
-
-  std::optional<Scalar<Result>> ScalarValue() const {
-    // TODO: parenthesized constants too
-    return common::GetIf<Scalar<Result>>(u_);
-  }
-  std::ostream &Dump(std::ostream &) const;
-  std::optional<Scalar<Result>> Fold(FoldingContext &c);
-  int Rank() const { return 1; }  // TODO
+  Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x) : u{std::move(x)} {}
+  Expr(const DataRef &x) : u{DataReference<Result>{x}} {}
+  Expr(const FunctionRef &x) : u{FunctionReference<Result>{x}} {}
 
-private:
-  std::variant<Scalar<Result>, CopyableIndirection<DataRef>,
-      CopyableIndirection<FunctionRef>, Parentheses<Result>, Negate<Result>,
+  using Operations = std::variant<Parentheses<Result>, Negate<Result>,
       Add<Result>, Subtract<Result>, Multiply<Result>, Divide<Result>,
-      Power<Result>, RealToIntPower<Result, SomeInteger>,
-      ComplexConstructor<KIND>>
-      u_;
+      Power<Result>, RealToIntPower<Result>, ComplexConstructor<KIND>>;
+  using Others = std::variant<Constant<Result>, DataReference<Result>,
+      FunctionReference<Result>>;
+
+public:
+  common::CombineVariants<Operations, Others> u;
 };
 
 extern template class Expr<Type<TypeCategory::Integer, 1>>;
@@ -439,42 +477,38 @@ extern template class Expr<Type<TypeCategory::Complex, 8>>;
 extern template class Expr<Type<TypeCategory::Complex, 10>>;
 extern template class Expr<Type<TypeCategory::Complex, 16>>;
 
-template<int KIND> class Expr<Type<TypeCategory::Character, KIND>> {
+template<int KIND>
+class Expr<Type<TypeCategory::Character, KIND>>
+  : public ExpressionBase<Type<TypeCategory::Character, KIND>> {
 public:
   using Result = Type<TypeCategory::Character, KIND>;
-  using FoldableTrait = std::true_type;
+  using IsFoldableTrait = std::true_type;
   CLASS_BOILERPLATE(Expr)
-  Expr(const Scalar<Result> &x) : u_{x} {}
-  Expr(Scalar<Result> &&x) : u_{std::move(x)} {}
-  template<typename A> Expr(const A &x) : u_{x} {}
+  Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
+  Expr(Scalar<Result> &&x) : u{Constant<Result>{std::move(x)}} {}
+  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)} {}
-  template<typename A> Expr(CopyableIndirection<A> &&x) : u_{std::move(x)} {}
+  Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x) : u{std::move(x)} {}
+  Expr(const DataRef &x) : u{DataReference<Result>{x}} {}
+  Expr(const FunctionRef &x) : u{FunctionReference<Result>{x}} {}
+  template<typename A> Expr(CopyableIndirection<A> &&x) : u{std::move(x)} {}
 
-  std::optional<Scalar<Result>> ScalarValue() const {
-    // TODO: parenthesized constants too
-    return common::GetIf<Scalar<Result>>(u_);
-  }
-  std::ostream &Dump(std::ostream &) const;
-  std::optional<Scalar<Result>> Fold(FoldingContext &c);
-  int Rank() const { return 1; }  // TODO
   Expr<SubscriptInteger> LEN() const;
 
-private:
-  std::variant<Scalar<Result>, CopyableIndirection<DataRef>,
-      CopyableIndirection<Substring>, CopyableIndirection<FunctionRef>,
+  std::variant<Constant<Result>, DataReference<Result>,
+      CopyableIndirection<Substring>, FunctionReference<Result>,
       // TODO Parentheses<Result>,
       Concat<KIND>, Extremum<Result>>
-      u_;
+      u;
 };
 
-// The Relation class template is a helper for constructing logical
+// The Relational class template is a helper for constructing logical
 // expressions with polymorphism over the cross product of the possible
 // categories and kinds of comparable operands.
 // Fortran defines a numeric relation with distinct types or kinds as
 // undergoing the same operand conversions that occur with the addition
 // intrinsic operator first.  Character relations must have the same kind.
-// There are no relations between logicals.
+// There are no relations between LOGICAL values.
 
 template<typename A>
 struct Relational : public Operation<Relational<A>, LogicalResult, A, A> {
@@ -495,84 +529,57 @@ struct Relational : public Operation<Relational<A>, LogicalResult, A, A> {
   RelationalOperator opr;
 };
 
-// A generic relation between two operands of the same kind in some intrinsic
-// type category (except LOGICAL).
-struct AnyRelational {
+template<> struct Relational<SomeType> {
   using Result = LogicalResult;
-  template<typename A> AnyRelational(const A &x) : u{x} {}
+  CLASS_BOILERPLATE(Relational)
+  template<typename A> Relational(const A &x) : u(x) {}
   template<typename A>
-  AnyRelational(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
+  Relational(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
     : u{std::move(x)} {}
-  std::optional<Scalar<Result>> Fold(FoldingContext &);
-  std::ostream &Dump(std::ostream &) const;
-
+  std::ostream &Dump(std::ostream &o) const;
   common::MapTemplate<Relational, std::variant, RelationalTypes> u;
 };
 
-template<int KIND> class Expr<Type<TypeCategory::Logical, KIND>> {
+template<int KIND>
+class Expr<Type<TypeCategory::Logical, KIND>>
+  : public ExpressionBase<Type<TypeCategory::Logical, KIND>> {
 public:
   using Result = Type<TypeCategory::Logical, KIND>;
-  using FoldableTrait = std::true_type;
+  using IsFoldableTrait = std::true_type;
   CLASS_BOILERPLATE(Expr)
-  Expr(const Scalar<Result> &x) : u_{x} {}
-  Expr(bool x) : u_{Scalar<Result>{x}} {}
-  template<TypeCategory CAT, int K>
-  Expr(const Relational<Type<CAT, K>> &x) : u_{Relational<SomeKind<CAT>>{x}} {}
-  template<TypeCategory CAT, int K>
-  Expr(Relational<Type<CAT, K>> &&x)
-    : u_{Relational<SomeKind<CAT>>{std::move(x)}} {}
-  template<typename A> Expr(const A &x) : u_(x) {}
+  Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
+  Expr(bool x) : u{Constant<Result>{x}} {}
+  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)} {}
-  template<typename A> Expr(CopyableIndirection<A> &&x) : u_{std::move(x)} {}
-
-  std::optional<Scalar<Result>> ScalarValue() const {
-    // TODO: parenthesized constants too
-    return common::GetIf<Scalar<Result>>(u_);
-  }
-  std::ostream &Dump(std::ostream &) const;
-  std::optional<Scalar<Result>> Fold(FoldingContext &c);
-  int Rank() const { return 1; }  // TODO
+  Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x) : u{std::move(x)} {}
+  Expr(const DataRef &x) : u{DataReference<Result>{x}} {}
+  Expr(const FunctionRef &x) : u{FunctionReference<Result>{x}} {}
 
 private:
-  std::variant<Scalar<Result>, CopyableIndirection<DataRef>,
-      CopyableIndirection<FunctionRef>,
-      // TODO Parentheses<Result>,
-      Not<KIND>, LogicalOperation<KIND>, AnyRelational>
-      u_;
+  using Operations =
+      std::variant<Not<KIND>, LogicalOperation<KIND>, Relational<SomeType>>;
+  using Others = std::variant<Constant<Result>, DataReference<Result>,
+      FunctionReference<Result>>;
+
+public:
+  common::CombineVariants<Operations, Others> u;
 };
 
-// Dynamically polymorphic expressions that can hold any supported kind
-// of a specific intrinsic type category.
-template<TypeCategory CAT> class Expr<SomeKind<CAT>> {
+// A polymorphic expression of known intrinsic type category, but dynamic
+// kind, represented as a discriminated union over Expr<Type<CAT, K>>
+// for each supported kind K in the category.
+template<TypeCategory CAT>
+class Expr<SomeKind<CAT>> : public ExpressionBase<SomeKind<CAT>> {
 public:
   using Result = SomeKind<CAT>;
-  using FoldableTrait = std::true_type;
-  static constexpr TypeCategory category{CAT};
+  using IsFoldableTrait = std::true_type;
   CLASS_BOILERPLATE(Expr)
 
-  template<TypeCategory C, int K> using KindExpr = Expr<Type<C, K>>;
-  using Variant = CategoryUnion<category, KindExpr>;
-  Expr(Variant &&x) : u{std::move(x)} {}
-  template<int KIND> Expr(const KindExpr<category, KIND> &x) : u{x} {}
-  template<int KIND> Expr(KindExpr<category, KIND> &&x) : u{std::move(x)} {}
-  std::optional<Scalar<Result>> ScalarValue() const;
-  std::ostream &Dump(std::ostream &) const;
-  std::optional<Scalar<Result>> Fold(FoldingContext &);
-  int Rank() const;
-
-  template<typename A> static std::optional<Expr> ForceKind(int kind, A &&x) {
-    if (std::optional<Variant> result{
-            Variant::template ForceKind<A>(kind, std::move(x))}) {
-      return {Expr{std::move(*result)}};
-    }
-    return std::nullopt;
-  }
-  template<typename A> static void AtKind(A &x, int kind) {
-    Variant::template AtKind<A>(x, kind);
-  }
+  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)} {}
 
-  Variant u;
+  common::MapTemplate<Expr, std::variant, CategoryTypes<CAT>> u;
 };
 
 // BOZ literal constants need to be wide enough to hold an integer or real
@@ -581,12 +588,12 @@ public:
 // few situations.
 using BOZLiteralConstant = value::Integer<128>;
 
-// A completely generic expression, polymorphic across the intrinsic type
+// A completely generic expression, polymorphic across all of the intrinsic type
 // categories and each of their kinds.
-template<> class Expr<SomeType> {
+template<> class Expr<SomeType> : public ExpressionBase<SomeType> {
 public:
   using Result = SomeType;
-  using FoldableTrait = std::true_type;
+  using IsFoldableTrait = std::true_type;
   CLASS_BOILERPLATE(Expr)
 
   template<typename A> Expr(const A &x) : u{x} {}
@@ -599,17 +606,25 @@ public:
   template<TypeCategory CAT, int KIND>
   Expr(Expr<Type<CAT, KIND>> &&x) : u{Expr<SomeKind<CAT>>{std::move(x)}} {}
 
-  std::optional<Scalar<Result>> ScalarValue() const;
-  std::ostream &Dump(std::ostream &) const;
-  std::optional<Scalar<Result>> Fold(FoldingContext &);
-  int Rank() const;
+  template<TypeCategory CAT, int KIND>
+  Expr &operator=(const Expr<Type<CAT, KIND>> &x) {
+    u = Expr<SomeKind<CAT>>{x};
+    return *this;
+  }
 
-  std::variant<Expr<SomeInteger>, Expr<SomeReal>, Expr<SomeComplex>,
-      Expr<SomeCharacter>, Expr<SomeLogical>, BOZLiteralConstant>
+  template<TypeCategory CAT, int KIND>
+  Expr &operator=(Expr<Type<CAT, KIND>> &&x) {
+    u = Expr<SomeKind<CAT>>{std::move(x)};
+    return *this;
+  }
+
+  using Others = std::variant<BOZLiteralConstant>;
+  common::CombineVariants<Others,
+      common::MapTemplate<Expr, std::variant, SomeCategory>>
       u;
 };
 
-extern template class Expr<Type<TypeCategory::Character, 1>>;  // TODO others
+extern template class Expr<Type<TypeCategory::Character, 1>>;  // TODO more
 extern template struct Relational<Type<TypeCategory::Integer, 1>>;
 extern template struct Relational<Type<TypeCategory::Integer, 2>>;
 extern template struct Relational<Type<TypeCategory::Integer, 4>>;
@@ -627,6 +642,7 @@ extern template struct Relational<Type<TypeCategory::Complex, 10>>;
 extern template struct Relational<Type<TypeCategory::Complex, 16>>;
 extern template struct Relational<Type<TypeCategory::Character, 1>>;  // TODO
                                                                       // more
+extern template struct Relational<SomeType>;
 extern template class Expr<Type<TypeCategory::Logical, 1>>;
 extern template class Expr<Type<TypeCategory::Logical, 2>>;
 extern template class Expr<Type<TypeCategory::Logical, 4>>;
@@ -638,5 +654,32 @@ extern template class Expr<SomeCharacter>;
 extern template class Expr<SomeLogical>;
 extern template class Expr<SomeType>;
 
+extern template struct ExpressionBase<Type<TypeCategory::Integer, 1>>;
+extern template struct ExpressionBase<Type<TypeCategory::Integer, 2>>;
+extern template struct ExpressionBase<Type<TypeCategory::Integer, 4>>;
+extern template struct ExpressionBase<Type<TypeCategory::Integer, 8>>;
+extern template struct ExpressionBase<Type<TypeCategory::Integer, 16>>;
+extern template struct ExpressionBase<Type<TypeCategory::Real, 2>>;
+extern template struct ExpressionBase<Type<TypeCategory::Real, 4>>;
+extern template struct ExpressionBase<Type<TypeCategory::Real, 8>>;
+extern template struct ExpressionBase<Type<TypeCategory::Real, 10>>;
+extern template struct ExpressionBase<Type<TypeCategory::Real, 16>>;
+extern template struct ExpressionBase<Type<TypeCategory::Complex, 2>>;
+extern template struct ExpressionBase<Type<TypeCategory::Complex, 4>>;
+extern template struct ExpressionBase<Type<TypeCategory::Complex, 8>>;
+extern template struct ExpressionBase<Type<TypeCategory::Complex, 10>>;
+extern template struct ExpressionBase<Type<TypeCategory::Complex, 16>>;
+extern template struct ExpressionBase<Type<TypeCategory::Character, 1>>;
+extern template struct ExpressionBase<Type<TypeCategory::Logical, 1>>;
+extern template struct ExpressionBase<Type<TypeCategory::Logical, 2>>;
+extern template struct ExpressionBase<Type<TypeCategory::Logical, 4>>;
+extern template struct ExpressionBase<Type<TypeCategory::Logical, 8>>;
+extern template struct ExpressionBase<SomeInteger>;
+extern template struct ExpressionBase<SomeReal>;
+extern template struct ExpressionBase<SomeComplex>;
+extern template struct ExpressionBase<SomeCharacter>;
+extern template struct ExpressionBase<SomeLogical>;
+extern template struct ExpressionBase<SomeType>;
+
 }  // namespace Fortran::evaluate
 #endif  // FORTRAN_EVALUATE_EXPRESSION_H_
index 4f486de..06355e4 100644 (file)
@@ -26,27 +26,32 @@ ConvertRealOperandsResult ConvertRealOperands(
     parser::ContextualMessages &messages, Expr<SomeType> &&x,
     Expr<SomeType> &&y) {
   return std::visit(
-      common::visitors{[&](Expr<SomeInteger> &&ix, Expr<SomeInteger> &&iy) {
-                         // Can happen in a CMPLX() constructor.  Per F'2018,
-                         // both integer operands are converted to default REAL.
-                         return std::optional{std::make_pair(
-                             Expr<SomeReal>{Expr<DefaultReal>{std::move(ix)}},
-                             Expr<SomeReal>{Expr<DefaultReal>{std::move(iy)}})};
-                       },
-          [&](Expr<SomeInteger> &&ix, Expr<SomeReal> &&ry) {
-            auto rx{ConvertToTypeAndKindOf(ry, std::move(ix))};
+      common::visitors{
+          [&](Expr<SomeInteger> &&ix,
+              Expr<SomeInteger> &&iy) -> ConvertRealOperandsResult {
+            // Can happen in a CMPLX() constructor.  Per F'2018,
+            // both integer operands are converted to default REAL.
+            return std::optional{std::make_pair(
+                ToCategoryExpr(ConvertToType<DefaultReal>(std::move(ix))),
+                ToCategoryExpr(ConvertToType<DefaultReal>(std::move(iy))))};
+          },
+          [&](Expr<SomeInteger> &&ix,
+              Expr<SomeReal> &&ry) -> ConvertRealOperandsResult {
+            auto rx{ConvertTo(ry, std::move(ix))};
             return std::optional{std::make_pair(std::move(rx), std::move(ry))};
           },
-          [&](Expr<SomeReal> &&rx, Expr<SomeInteger> &&iy) {
-            auto ry{ConvertToTypeAndKindOf(rx, std::move(iy))};
+          [&](Expr<SomeReal> &&rx,
+              Expr<SomeInteger> &&iy) -> ConvertRealOperandsResult {
+            auto ry{ConvertTo(rx, std::move(iy))};
             return std::optional{std::make_pair(std::move(rx), std::move(ry))};
           },
-          [&](Expr<SomeReal> &&rx, Expr<SomeReal> &&ry) {
+          [&](Expr<SomeReal> &&rx,
+              Expr<SomeReal> &&ry) -> ConvertRealOperandsResult {
             ConvertToSameKind(rx, ry);
             return std::optional{std::make_pair(std::move(rx), std::move(ry))};
           },
-          [&](const auto &, const auto &)
-              -> std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>> {
+          [&](auto &&, auto &&) -> ConvertRealOperandsResult {
+            // TODO: allow BOZ here?
             messages.Say("operands must be INTEGER or REAL"_err_en_US);
             return std::nullopt;
           }},
@@ -65,15 +70,6 @@ ConvertRealOperandsResult ConvertRealOperands(
       common::MapOptional(f, std::move(x), std::move(y)));
 }
 
-Expr<SomeType> GenericScalarToExpr(const Scalar<SomeType> &x) {
-  return std::visit(
-      [](const auto &c) -> Expr<SomeType> {
-        using Ty = TypeOf<decltype(c)>;
-        return {Expr<SomeKind<Ty::category>>{Expr<Ty>{c}}};
-      },
-      x.u);
-}
-
 template<template<typename> class OPR, TypeCategory CAT>
 std::optional<Expr<SomeType>> PromoteAndCombine(
     Expr<SomeKind<CAT>> &&x, Expr<SomeKind<CAT>> &&y) {
@@ -85,7 +81,7 @@ std::optional<Expr<SomeType>> PromoteAndCombine(
         return {Expr<ToType>{OPR<ToType>{EnsureKind<ToType>(std::move(xk)),
             EnsureKind<ToType>(std::move(yk))}}};
       },
-      std::move(x.u.u), std::move(y.u.u))}};
+      std::move(x.u), std::move(y.u))}};
 }
 
 template<template<typename> class OPR>
@@ -106,10 +102,10 @@ std::optional<Expr<SomeType>> NumericOperation(
                 [&](auto &&rxk) -> Expr<SomeReal> {
                   using kindEx = decltype(rxk);
                   using resultType = ResultType<kindEx>;
-                  return {kindEx{
-                      OPR<resultType>{std::move(rxk), kindEx{std::move(iy)}}}};
+                  return {kindEx{OPR<resultType>{std::move(rxk),
+                      ConvertToType<resultType>(std::move(iy))}}};
                 },
-                std::move(rx.u.u))}};
+                std::move(rx.u))}};
           },
           [](Expr<SomeInteger> &&ix, Expr<SomeReal> &&ry) {
             return std::optional{Expr<SomeType>{std::visit(
@@ -117,9 +113,10 @@ std::optional<Expr<SomeType>> NumericOperation(
                   using kindEx = decltype(ryk);
                   using resultType = ResultType<kindEx>;
                   return {kindEx{
-                      OPR<resultType>{kindEx{std::move(ix)}, std::move(ryk)}}};
+                      OPR<resultType>{ConvertToType<resultType>(std::move(ix)),
+                          std::move(ryk)}}};
                 },
-                std::move(ry.u.u))}};
+                std::move(ry.u))}};
           },
           [](Expr<SomeComplex> &&zx, Expr<SomeComplex> &&zy) {
             return PromoteAndCombine<OPR, TypeCategory::Complex>(
index 1581e63..147e6b3 100644 (file)
@@ -51,7 +51,7 @@ Expr<Type<C, K>> operator/(Expr<Type<C, K>> &&x, Expr<Type<C, K>> &&y) {
 
 template<TypeCategory C> Expr<SomeKind<C>> operator-(Expr<SomeKind<C>> &&x) {
   return std::visit(
-      [](auto &xk) { return Expr<SomeKind<C>>{-std::move(xk)}; }, x.u.u);
+      [](auto &xk) { return Expr<SomeKind<C>>{-std::move(xk)}; }, x.u);
 }
 
 template<TypeCategory C>
@@ -60,7 +60,7 @@ Expr<SomeKind<C>> operator+(Expr<SomeKind<C>> &&x, Expr<SomeKind<C>> &&y) {
       [](auto &xk, auto &yk) {
         return Expr<SomeKind<C>>{std::move(xk) + std::move(yk)};
       },
-      x.u.u, y.u.u);
+      x.u, y.u);
 }
 
 template<TypeCategory C>
@@ -69,7 +69,7 @@ Expr<SomeKind<C>> operator-(Expr<SomeKind<C>> &&x, Expr<SomeKind<C>> &&y) {
       [](auto &xk, auto &yk) {
         return Expr<SomeKind<C>>{std::move(xk) - std::move(yk)};
       },
-      x.u.u, y.u.u);
+      x.u, y.u);
 }
 
 template<TypeCategory C>
@@ -78,7 +78,7 @@ Expr<SomeKind<C>> operator*(Expr<SomeKind<C>> &&x, Expr<SomeKind<C>> &&y) {
       [](auto &xk, auto &yk) {
         return Expr<SomeKind<C>>{std::move(xk) * std::move(yk)};
       },
-      x.u.u, y.u.u);
+      x.u, y.u);
 }
 
 template<TypeCategory C>
@@ -87,24 +87,76 @@ Expr<SomeKind<C>> operator/(Expr<SomeKind<C>> &&x, Expr<SomeKind<C>> &&y) {
       [](auto &xk, auto &yk) {
         return Expr<SomeKind<C>>{std::move(xk) / std::move(yk)};
       },
-      x.u.u, y.u.u);
+      x.u, y.u);
 }
 
-// Convert the second argument expression to an expression of the same type
-// and kind as that of the first.
-template<TypeCategory TC, typename F>
-Expr<SomeKind<TC>> ConvertToTypeAndKindOf(
-    const Expr<SomeKind<TC>> &to, Expr<F> &&from) {
+// Generalizers: these take expressions of more specific types and wrap
+// them in more abstract containers.
+
+template<TypeCategory CAT, int KIND>
+Expr<SomeKind<CAT>> ToCategoryExpr(Expr<Type<CAT, KIND>> &&x) {
+  return {std::move(x)};
+}
+
+template<typename A> Expr<SomeType> ToGenericExpr(A &&x) {
+  return {std::move(x)};
+}
+
+template<TypeCategory CAT, int KIND>
+Expr<SomeType> ToGenericExpr(Expr<Type<CAT, KIND>> &&x) {
+  return {ToCategoryExpr(std::move(x))};
+}
+
+// Creation of conversion expressions can be done to either a known
+// specific intrinsic type with ConvertToType<T>(x) or by converting
+// one arbitrary expression to the type of another with ConvertTo(to, from).
+
+template<typename TO, TypeCategory FC>
+Expr<TO> ConvertToType(Expr<SomeKind<FC>> &&x) {
+  return {Convert<TO, FC>{std::move(x)}};
+}
+
+template<TypeCategory TC, int TK, TypeCategory FC>
+Expr<Type<TC, TK>> ConvertTo(
+    const Expr<Type<TC, TK>> &, Expr<SomeKind<FC>> &&x) {
+  return ConvertToType<Type<TC, TK>>(std::move(x));
+}
+
+template<TypeCategory TC, int TK, TypeCategory FC, int FK>
+Expr<Type<TC, TK>> ConvertTo(
+    const Expr<Type<TC, TK>> &, Expr<Type<FC, FK>> &&x) {
+  return ConvertToType<Type<TC, TK>>(ToCategoryExpr(std::move(x)));
+}
+
+template<TypeCategory TC, TypeCategory FC>
+Expr<SomeKind<TC>> ConvertTo(
+    const Expr<SomeKind<TC>> &to, Expr<SomeKind<FC>> &&from) {
   return std::visit(
-      [&](const auto &tk) -> Expr<SomeKind<TC>> {
-        using SpecificExpr = std::decay_t<decltype(tk)>;
-        return {SpecificExpr{std::move(from)}};
+      [&](const auto &toKindExpr) {
+        using KindExpr = std::decay_t<decltype(toKindExpr)>;
+        return ToCategoryExpr(
+            ConvertToType<ResultType<KindExpr>>(std::move(from)));
       },
-      to.u.u);
+      to.u);
 }
 
-// Given two expressions of the same type category, convert one to the
-// kind of the other in place if it has a smaller kind.
+template<TypeCategory TC, TypeCategory FC, int FK>
+Expr<SomeKind<TC>> ConvertTo(
+    const Expr<SomeKind<TC>> &to, Expr<Type<FC, FK>> &&from) {
+  return ConvertTo(to, ToCategoryExpr(std::move(from)));
+}
+
+template<typename FT>
+Expr<SomeType> ConvertTo(const Expr<SomeType> &to, Expr<FT> &&from) {
+  return std::visit(
+      [&](const auto &toCatExpr) {
+        return ToGenericExpr(ConvertTo(toCatExpr, std::move(from)));
+      },
+      to.u);
+}
+
+// Given references to two expressions of the same type category, convert
+// either to the kind of the other in place if it has a smaller kind.
 template<TypeCategory CAT>
 void ConvertToSameKind(Expr<SomeKind<CAT>> &x, Expr<SomeKind<CAT>> &y) {
   std::visit(
@@ -112,17 +164,18 @@ void ConvertToSameKind(Expr<SomeKind<CAT>> &x, Expr<SomeKind<CAT>> &y) {
         using xt = ResultType<decltype(xk)>;
         using yt = ResultType<decltype(yk)>;
         if constexpr (xt::kind < yt::kind) {
-          x.u = Expr<yt>{xk};
+          x.u = Expr<yt>{Convert<yt, CAT>{x}};
         } else if constexpr (xt::kind > yt::kind) {
-          y.u = Expr<xt>{yk};
+          y.u = Expr<xt>{Convert<xt, CAT>{y}};
         }
       },
-      x.u.u, y.u.u);
+      x.u, y.u);
 }
 
 // Ensure that both operands of an intrinsic REAL operation (or CMPLX()
 // constructor) are INTEGER or REAL, then convert them as necessary to the
 // same kind of REAL.
+// TODO pmk: need a better type that guarantees that both have same kind
 using ConvertRealOperandsResult =
     std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>>;
 ConvertRealOperandsResult ConvertRealOperands(
@@ -131,26 +184,10 @@ ConvertRealOperandsResult ConvertRealOperands(parser::ContextualMessages &,
     std::optional<Expr<SomeType>> &&, std::optional<Expr<SomeType>> &&);
 
 template<typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) {
-  static_assert(std::is_same_v<Scalar<TypeOf<A>>, std::decay_t<A>> ||
-      !"TypeOf<> is broken");
-  return {x};
-}
-
-template<TypeCategory CAT, int KIND>
-Expr<SomeKind<CAT>> ToSomeKindExpr(Expr<Type<CAT, KIND>> &&x) {
-  return {std::move(x)};
-}
-
-Expr<SomeType> GenericScalarToExpr(const Scalar<SomeType> &);
-
-template<TypeCategory CAT, int KIND>
-Expr<SomeType> ToGenericExpr(Expr<Type<CAT, KIND>> &&x) {
-  return Expr<SomeType>{Expr<SomeKind<CAT>>{std::move(x)}};
-}
-
-template<TypeCategory CAT>
-Expr<SomeType> ToGenericExpr(Expr<SomeKind<CAT>> &&x) {
-  return Expr<SomeType>{std::move(x)};
+  using Ty = TypeOf<A>;
+  static_assert(
+      std::is_same_v<Scalar<Ty>, std::decay_t<A>> || !"TypeOf<> is broken");
+  return {Constant<Ty>{x}};
 }
 
 // Convert, if necessary, an expression to a specific kind in the same
@@ -158,8 +195,7 @@ Expr<SomeType> ToGenericExpr(Expr<SomeKind<CAT>> &&x) {
 template<typename TOTYPE>
 Expr<TOTYPE> EnsureKind(Expr<SomeKind<TOTYPE::category>> &&x) {
   using ToType = TOTYPE;
-  using FromGenericType = SomeKind<ToType::category>;
-  if (auto *p{std::get_if<Expr<ToType>>(&x.u.u)}) {
+  if (auto *p{std::get_if<Expr<ToType>>(&x.u)}) {
     return std::move(*p);
   }
   if constexpr (ToType::category == TypeCategory::Complex) {
@@ -169,15 +205,15 @@ Expr<TOTYPE> EnsureKind(Expr<SomeKind<TOTYPE::category>> &&x) {
           using FromPart = typename FromType::Part;
           using FromGeneric = SomeKind<TypeCategory::Real>;
           using ToPart = typename ToType::Part;
-          Convert<ToPart, FromGeneric> re{Expr<FromGeneric>{
+          Convert<ToPart, TypeCategory::Real> re{Expr<FromGeneric>{
               Expr<FromPart>{ComplexComponent<FromType::kind>{false, z}}}};
-          Convert<ToPart, FromGeneric> im{Expr<FromGeneric>{
+          Convert<ToPart, TypeCategory::Real> im{Expr<FromGeneric>{
               Expr<FromPart>{ComplexComponent<FromType::kind>{true, z}}}};
           return {std::move(re), std::move(im)};
         },
-        x.u.u)};
+        x.u)};
   } else {
-    return {Convert<ToType, FromGenericType>{std::move(x)}};
+    return {Convert<ToType, ToType::category>{std::move(x)}};
   }
 }
 
index cb585ba..b1f4fb1 100644 (file)
@@ -26,7 +26,6 @@
 #include "real.h"
 #include "../common/fortran.h"
 #include "../common/idioms.h"
-#include "../common/kind-variant.h"
 #include "../common/template.h"
 #include <cinttypes>
 #include <optional>
@@ -37,14 +36,14 @@ namespace Fortran::evaluate {
 
 using common::TypeCategory;
 
-// Specific intrinsic types
+// Specific intrinsic types are represented by specializations of
+// the class template Type<CATEGORY, KIND>.
+template<TypeCategory CATEGORY, int KIND> struct Type;
 
-template<TypeCategory C, int KIND> struct Type;
-
-template<TypeCategory C, int KIND> struct TypeBase {
-  static constexpr TypeCategory category{C};
+template<TypeCategory CATEGORY, int KIND> struct TypeBase {
+  static constexpr bool isSpecificType{true};
+  static constexpr TypeCategory category{CATEGORY};
   static constexpr int kind{KIND};
-  static constexpr bool hasLen{false};
   static std::string Dump() {
     return EnumToString(category) + '(' + std::to_string(kind) + ')';
   }
@@ -92,14 +91,10 @@ struct Type<TypeCategory::Complex, KIND>
   using Scalar = value::Complex<typename Part::Scalar>;
 };
 
-template<int KIND> struct Type<TypeCategory::Character, KIND> {
-  static constexpr TypeCategory category{TypeCategory::Character};
-  static constexpr int kind{KIND};
-  static constexpr bool hasLen{true};
+template<int KIND>
+struct Type<TypeCategory::Character, KIND>
+  : public TypeBase<TypeCategory::Character, KIND> {
   using Scalar = std::string;
-  static std::string Dump() {
-    return EnumToString(category) + '(' + std::to_string(kind) + ')';
-  }
 };
 
 template<int KIND>
@@ -113,8 +108,8 @@ struct Type<TypeCategory::Logical, KIND>
 template<typename T> using Scalar = typename std::decay_t<T>::Scalar;
 
 // Given a specific type, find the type of the same kind in another category.
-template<TypeCategory C, typename T>
-using SameKind = Type<C, std::decay_t<T>::kind>;
+template<TypeCategory CATEGORY, typename T>
+using SameKind = Type<CATEGORY, std::decay_t<T>::kind>;
 
 // Convenience type aliases:
 // Default REAL just simply has to be IEEE-754 single precision today.
@@ -135,72 +130,12 @@ using DefaultCharacter = Type<TypeCategory::Character, 1>;
 using SubscriptInteger = Type<TypeCategory::Integer, 8>;
 using LogicalResult = Type<TypeCategory::Logical, 1>;
 
-// The CategoryUnion template applies a given template to all of
-// the supported kinds in a given intrinsic type category, and
-// builds a KindVariant<> union over the results.  This allows
-// us to specify the supported kind values in just one place (here)
-// with resorting to macros.
-template<TypeCategory CAT, template<TypeCategory, int> class TYPE>
-struct CategoryUnionTemplate;
-
-template<template<TypeCategory, int> class TYPE>
-struct CategoryUnionTemplate<TypeCategory::Integer, TYPE> {
-  static constexpr auto category{TypeCategory::Integer};
-  template<int K> using PerKind = TYPE<category, K>;
-  using type = common::KindVariant<int, PerKind, 1, 2, 4, 8, 16>;
-};
-
-template<template<TypeCategory, int> class TYPE>
-struct CategoryUnionTemplate<TypeCategory::Real, TYPE> {
-  static constexpr auto category{TypeCategory::Real};
-  template<int K> using PerKind = TYPE<category, K>;
-  using type = common::KindVariant<int, PerKind, 2, 4, 8, 10, 16>;
-};
-
-template<template<TypeCategory, int> class TYPE>
-struct CategoryUnionTemplate<TypeCategory::Complex, TYPE> {
-  static constexpr auto category{TypeCategory::Complex};
-  template<int K> using PerKind = TYPE<category, K>;
-  using type = common::KindVariant<int, PerKind, 2, 4, 8, 10, 16>;
-};
-
-template<template<TypeCategory, int> class TYPE>
-struct CategoryUnionTemplate<TypeCategory::Character, TYPE> {
-  static constexpr auto category{TypeCategory::Character};
-  template<int K> using PerKind = TYPE<category, K>;
-  using type = common::KindVariant<int, PerKind, 1>;  // TODO: add kinds 2 & 4;
-};
-
-template<template<TypeCategory, int> class TYPE>
-struct CategoryUnionTemplate<TypeCategory::Logical, TYPE> {
-  static constexpr auto category{TypeCategory::Logical};
-  template<int K> using PerKind = TYPE<category, K>;
-  using type = common::KindVariant<int, PerKind, 1, 2, 4, 8>;
-};
-
-template<TypeCategory CAT, template<TypeCategory, int> class TYPE>
-using CategoryUnion = typename CategoryUnionTemplate<CAT, TYPE>::type;
-
-// IntrinsicTypeUnion takes a template and instantiates it over
-// all five of the intrinsic type categories, using them as the
-// alternatives in a KindVariant.
-template<template<TypeCategory, int> class A>
-struct IntrinsicTypeUnionTemplate {
-  template<TypeCategory C> using PerCategory = CategoryUnion<C, A>;
-  using type = common::KindVariant<TypeCategory, PerCategory,
-      TypeCategory::Integer, TypeCategory::Real, TypeCategory::Complex,
-      TypeCategory::Character, TypeCategory::Logical>;
-};
-
-template<template<TypeCategory, int> class A>
-using IntrinsicTypeUnion = typename IntrinsicTypeUnionTemplate<A>::type;
-
 // For an intrinsic type category CAT, CategoryTypes<CAT> is an instantiation
-// of std::tuple<Type<CAT, K>> for every supported kind K in that category.
-template<TypeCategory CAT, int... KINDS>
-using CategoryTypesTuple = std::tuple<Type<CAT, KINDS>...>;
+// of std::tuple<Type<CAT, K>> over each supported kind K in that category.
+template<TypeCategory CATEGORY, int... KINDS>
+using CategoryTypesTuple = std::tuple<Type<CATEGORY, KINDS>...>;
 
-template<TypeCategory CAT> struct CategoryTypesHelper;
+template<TypeCategory CATEGORY> struct CategoryTypesHelper;
 template<> struct CategoryTypesHelper<TypeCategory::Integer> {
   using type = CategoryTypesTuple<TypeCategory::Integer, 1, 2, 4, 8, 16>;
 };
@@ -216,8 +151,8 @@ template<> struct CategoryTypesHelper<TypeCategory::Character> {
 template<> struct CategoryTypesHelper<TypeCategory::Logical> {
   using type = CategoryTypesTuple<TypeCategory::Logical, 1, 2, 4, 8>;
 };
-template<TypeCategory CAT>
-using CategoryTypes = typename CategoryTypesHelper<CAT>::type;
+template<TypeCategory CATEGORY>
+using CategoryTypes = typename CategoryTypesHelper<CATEGORY>::type;
 
 using NumericTypes = common::CombineTuples<CategoryTypes<TypeCategory::Integer>,
     CategoryTypes<TypeCategory::Real>, CategoryTypes<TypeCategory::Complex>>;
@@ -238,13 +173,14 @@ template<typename CONST> struct TypeOfHelper {
   };
   static constexpr int index{
       common::SearchMembers<Predicate, AllIntrinsicTypes>};
-  static_assert(index >= 0 || !"No intrinsic type found for constant type");
-  using type = std::tuple_element_t<index, AllIntrinsicTypes>;
+  using type = std::conditional_t<index >= 0,
+      std::tuple_element_t<index, AllIntrinsicTypes>, void>;
 };
 
 template<typename CONST> using TypeOf = typename TypeOfHelper<CONST>::type;
 
-// A variant union that can hold a scalar constant of some type in a set.
+// A variant union that can hold a scalar constant of some type in a set,
+// which is passed in as a tuple of Type<> specializations.
 template<typename TYPES> struct SomeScalar {
   using Types = TYPES;
   CLASS_BOILERPLATE(SomeScalar)
@@ -280,6 +216,19 @@ template<typename TYPES> struct SomeScalar {
         u);
   }
 
+  auto IsTrue() const {
+    return std::visit(
+        [](const auto &x) -> std::optional<bool> {
+          if constexpr (TypeOf<decltype(x)>::category ==
+              TypeCategory::Logical) {
+            return {x.IsTrue()};
+          } else {
+            return std::nullopt;
+          }
+        },
+        u);
+  }
+
   template<typename T> auto GetIf() const {
     return common::GetIf<Scalar<T>>(u);
   }
@@ -287,14 +236,15 @@ template<typename TYPES> struct SomeScalar {
   common::MapTemplate<Scalar, std::variant, Types> u;
 };
 
-template<TypeCategory CAT>
-using SomeKindScalar = SomeScalar<CategoryTypes<CAT>>;
+template<TypeCategory CATEGORY>
+using SomeKindScalar = SomeScalar<CategoryTypes<CATEGORY>>;
 using GenericScalar = SomeScalar<AllIntrinsicTypes>;
 
 // Represents a type of any supported kind within a particular category.
-template<TypeCategory CAT> struct SomeKind {
-  using Scalar = SomeKindScalar<CAT>;
-  static constexpr TypeCategory category{CAT};
+template<TypeCategory CATEGORY> struct SomeKind {
+  static constexpr bool isSpecificType{false};
+  static constexpr TypeCategory category{CATEGORY};
+  using Scalar = SomeKindScalar<category>;
 };
 
 using SomeInteger = SomeKind<TypeCategory::Integer>;
@@ -304,7 +254,10 @@ using SomeCharacter = SomeKind<TypeCategory::Character>;
 using SomeLogical = SomeKind<TypeCategory::Logical>;
 
 // Represents a completely generic intrinsic type.
+using SomeCategory =
+    std::tuple<SomeInteger, SomeReal, SomeComplex, SomeCharacter, SomeLogical>;
 struct SomeType {
+  static constexpr bool isSpecificType{false};
   using Scalar = GenericScalar;
 };
 
index 0dde964..c9547ba 100644 (file)
@@ -127,18 +127,27 @@ Expr<SubscriptInteger> Substring::last() const {
 
 std::optional<std::string> Substring::Fold(FoldingContext &context) {
   std::optional<Scalar<SubscriptInteger>> lbValue, ubValue;
+  // pmk: streamline
   if (first_.has_value()) {
-    lbValue = (*first_)->Fold(context);
+    if (auto c{(*first_)->Fold(context)}) {
+      lbValue = c->value;
+    }
   } else {
-    lbValue = first().Fold(context);
+    if (auto c{first().Fold(context)}) {
+      lbValue = c->value;
+    }
   }
   if (lbValue.has_value()) {
     first_ = IndirectSubscriptIntegerExpr{Expr<SubscriptInteger>{*lbValue}};
   }
   if (last_.has_value()) {
-    ubValue = (*last_)->Fold(context);
+    if (auto c{(*last_)->Fold(context)}) {
+      ubValue = c->value;
+    }
   } else {
-    ubValue = last().Fold(context);
+    if (auto c{last().Fold(context)}) {
+      ubValue = c->value;
+    }
   }
   if (ubValue.has_value()) {
     last_ = IndirectSubscriptIntegerExpr{Expr<SubscriptInteger>{*ubValue}};
index 9ce5bf9..d1a695b 100644 (file)
@@ -171,7 +171,7 @@ private:
 // variants of sections instead.
 class Substring {
 public:
-  using FoldableTrait = std::true_type;
+  using IsFoldableTrait = std::true_type;
   CLASS_BOILERPLATE(Substring)
   Substring(DataRef &&, std::optional<Expr<SubscriptInteger>> &&,
       std::optional<Expr<SubscriptInteger>> &&);
index 2580a5d..5a180b8 100644 (file)
 // although a C++ compiler wouldn't default them anyway due to the presence
 // of explicitly defaulted move constructors and move assignments.
 
-CLASS_TRAIT(EmptyTrait);
-CLASS_TRAIT(WrapperTrait);
-CLASS_TRAIT(UnionTrait);
-CLASS_TRAIT(TupleTrait);
+CLASS_TRAIT(EmptyTrait)
+CLASS_TRAIT(WrapperTrait)
+CLASS_TRAIT(UnionTrait)
+CLASS_TRAIT(TupleTrait)
 
 // Some parse tree nodes have fields in them to cache the results of a
 // successful semantic analysis later.  Their types are forward declared
index ecd26bb..666adfa 100644 (file)
@@ -25,6 +25,7 @@ namespace Fortran::semantics {
 
 using common::TypeCategory;
 using evaluate::Expr;
+using evaluate::SomeKind;
 using evaluate::SomeType;
 using evaluate::Type;
 
@@ -61,7 +62,7 @@ auto AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Scalar<A> &tree)
     -> decltype(AnalyzeHelper(ea, tree.thing)) {
   auto result{AnalyzeHelper(ea, tree.thing)};
   if (result.has_value()) {
-    if (result->Rank() > 1) {
+    if (result->Rank() > 0) {
       ea.context().messages.Say("must be scalar"_err_en_US);
       return std::nullopt;
     }
@@ -91,29 +92,50 @@ std::optional<Expr<evaluate::SomeInteger>> AnalyzeHelper(
     if (auto *intexpr{std::get_if<Expr<evaluate::SomeInteger>>(&result->u)}) {
       return {std::move(*intexpr)};
     }
-    ea.context().messages.Say("expression must be integer"_err_en_US);
+    ea.context().messages.Say("expression must be INTEGER"_err_en_US);
   }
   return std::nullopt;
 }
 
+// pmk: document, maybe put elsewhere
+template<TypeCategory CAT, typename VALUE> struct ConstantHelper {
+  using Types = evaluate::CategoryTypes<CAT>;
+  explicit ConstantHelper(VALUE &&x) : value{std::move(x)} {}
+  template<int J> void SetKindTraverser(int kind) {
+    if constexpr (J < std::tuple_size_v<Types>) {
+      using Ty = std::tuple_element_t<J, Types>;
+      if (kind == Ty::kind) {
+        result = Expr<Ty>{evaluate::Constant<Ty>{std::move(value)}};
+      } else {
+        SetKindTraverser<J+1>(kind);
+      }
+    }
+  }
+  void SetKind(int kind) { SetKindTraverser<0>(kind); }
+  VALUE value;
+  std::optional<Expr<evaluate::SomeKind<CAT>>> result;
+};
+
 static std::optional<Expr<evaluate::SomeCharacter>> AnalyzeLiteral(
     ExpressionAnalyzer &ea, const parser::CharLiteralConstant &x) {
   auto kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
       ExpressionAnalyzer::KindParam{1})};
   auto value{std::get<std::string>(x.t)};
-  using Ex = Expr<evaluate::SomeCharacter>;
-  std::optional<Ex> result{Ex::template ForceKind(kind, std::move(value))};
-  if (!result.has_value()) {
+  ConstantHelper<TypeCategory::Character, std::string> helper{std::move(value)};
+  helper.SetKind(kind);
+  if (!helper.result.has_value()) {
     ea.context().messages.Say("unsupported CHARACTER(KIND=%ju)"_err_en_US,
         static_cast<std::uintmax_t>(kind));
   }
-  return result;
+  return std::move(helper.result);
 }
 
-template<typename A> MaybeExpr PackageGeneric(std::optional<A> &&x) {
-  std::function<Expr<SomeType>(A &&)> f{
-      [](A &&y) { return Expr<SomeType>{std::move(y)}; }};
-  return common::MapOptional(f, std::move(x));
+template<typename A>
+MaybeExpr PackageGeneric(std::optional<A> &&x) {
+  if (x.has_value()) {
+    return {evaluate::ToGenericExpr(std::move(*x))};
+  }
+  return std::nullopt;
 }
 
 template<>
@@ -132,12 +154,12 @@ MaybeExpr AnalyzeHelper(
   std::optional<Expr<evaluate::SubscriptInteger>> lb, ub;
   if (lbTree.has_value()) {
     if (MaybeIntExpr lbExpr{AnalyzeHelper(ea, *lbTree)}) {
-      lb = Expr<evaluate::SubscriptInteger>{std::move(*lbExpr)};
+      lb = evaluate::ConvertToType<evaluate::SubscriptInteger>(std::move(*lbExpr));
     }
   }
   if (ubTree.has_value()) {
     if (MaybeIntExpr ubExpr{AnalyzeHelper(ea, *ubTree)}) {
-      ub = Expr<evaluate::SubscriptInteger>{std::move(*ubExpr)};
+      ub = evaluate::ConvertToType<evaluate::SubscriptInteger>(std::move(*ubExpr));
     }
   }
   if (!lb.has_value() || !ub.has_value()) {
@@ -147,7 +169,7 @@ MaybeExpr AnalyzeHelper(
   evaluate::CopyableIndirection<evaluate::Substring> ind{std::move(substring)};
   Expr<evaluate::DefaultCharacter> chExpr{std::move(ind)};
   chExpr.Fold(ea.context());
-  return {Expr<SomeType>{Expr<evaluate::SomeCharacter>{std::move(chExpr)}}};
+  return {evaluate::ToGenericExpr(chExpr)};
 }
 
 // Common handling of parser::IntLiteralConstant and SignedIntLiteralConstant
@@ -157,13 +179,13 @@ std::optional<Expr<evaluate::SomeInteger>> IntLiteralConstant(
   auto kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
       ea.defaultIntegerKind())};
   auto value{std::get<0>(x.t)};  // std::(u)int64_t
-  using Ex = Expr<evaluate::SomeInteger>;
-  std::optional<Ex> result{Ex::template ForceKind(kind, std::move(value))};
-  if (!result.has_value()) {
+  ConstantHelper<TypeCategory::Integer, decltype(value)> helper{std::move(value)};
+  helper.SetKind(kind);
+  if (!helper.result.has_value()) {
     ea.context().messages.Say("unsupported INTEGER(KIND=%ju)"_err_en_US,
         static_cast<std::uintmax_t>(kind));
   }
-  return result;
+  return std::move(helper.result);
 }
 
 static std::optional<Expr<evaluate::SomeInteger>> AnalyzeLiteral(
@@ -214,16 +236,26 @@ std::optional<Expr<evaluate::SomeReal>> ReadRealLiteral(
   if (context.flushDenormalsToZero) {
     value = value.FlushDenormalToZero();
   }
-  return {evaluate::ToSomeKindExpr(Expr<RealType>{value})};
+  return {evaluate::ToCategoryExpr(Expr<RealType>{evaluate::Constant<RealType>{value}})};
 }
 
 struct RealHelper {
   RealHelper(parser::CharBlock lit, evaluate::FoldingContext &ctx)
     : literal{lit}, context{ctx} {}
-  template<int K> void action() {
-    CHECK(!result.has_value());
-    result = ReadRealLiteral<K>(literal, context);
+
+  using Types = evaluate::CategoryTypes<TypeCategory::Real>;
+  template<int J> void SetKindTraverser(int kind) {
+    if constexpr (J < std::tuple_size_v<Types>) {
+      using Ty = std::tuple_element_t<J, Types>;
+      if (kind == Ty::kind) {
+        result = ReadRealLiteral<Ty::kind>(literal, context);
+      } else {
+        SetKindTraverser<J+1>(kind);
+      }
+    }
   }
+  void SetKind(int kind) { SetKindTraverser<0>(kind); }
+
   parser::CharBlock literal;
   evaluate::FoldingContext &context;
   std::optional<Expr<evaluate::SomeReal>> result;
@@ -252,7 +284,7 @@ static std::optional<Expr<evaluate::SomeReal>> AnalyzeLiteral(
   }
   auto kind{ea.Analyze(x.kind, defaultKind)};
   RealHelper helper{x.real.source, localFoldingContext};
-  Expr<evaluate::SomeReal>::template AtKind(helper, kind);
+  helper.SetKind(kind);
   if (!helper.result.has_value()) {
     ctxMsgs.Say("unsupported REAL(KIND=%ju)"_err_en_US,
         static_cast<std::uintmax_t>(kind));
@@ -325,13 +357,13 @@ static std::optional<Expr<evaluate::SomeLogical>> AnalyzeLiteral(
   auto kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
       ea.defaultLogicalKind())};
   bool value{std::get<bool>(x.t)};
-  using Ex = Expr<evaluate::SomeLogical>;
-  std::optional<Ex> result{Ex::template ForceKind(kind, std::move(value))};
-  if (!result.has_value()) {
+  ConstantHelper<TypeCategory::Logical, bool> helper{std::move(value)};
+  helper.SetKind(kind);
+  if (!helper.result.has_value()) {
     ea.context().messages.Say("unsupported LOGICAL(KIND=%ju)"_err_en_US,
         static_cast<std::uintmax_t>(kind));
   }
-  return result;
+  return std::move(helper.result);
 }
 
 template<>
@@ -431,7 +463,7 @@ MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Divide &x) {
 
 template<>
 MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Add &x) {
-  // TODO pmk WIP
+  // TODO
   return std::nullopt;
 }
 
@@ -565,19 +597,22 @@ ExpressionAnalyzer::KindParam ExpressionAnalyzer::Analyze(
       kindParam->u);
 }
 
+// TODO pmk: need a way to represent a tuple of same-typed expressions, avoid CHECK here
 std::optional<Expr<evaluate::SomeComplex>> ExpressionAnalyzer::ConstructComplex(
     MaybeExpr &&real, MaybeExpr &&imaginary) {
   if (auto converted{evaluate::ConvertRealOperands(
           context_.messages, std::move(real), std::move(imaginary))}) {
     return {std::visit(
-        [](auto &&rx, auto &&ix) -> Expr<evaluate::SomeComplex> {
-          using realType = evaluate::ResultType<decltype(rx)>;
+        [&](auto &&re) -> Expr<evaluate::SomeComplex> {
+          using realType = evaluate::ResultType<decltype(re)>;
+          auto *im{std::get_if<Expr<realType>>(&converted->second.u)};
+          CHECK(im != nullptr);
           constexpr int kind{realType::kind};
           using zType = evaluate::Type<TypeCategory::Complex, kind>;
-          return {Expr<zType>{evaluate::ComplexConstructor<kind>{
-              std::move(rx), std::move(ix)}}};
+          return {Expr<evaluate::SomeComplex>{Expr<zType>{evaluate::ComplexConstructor<kind>{
+              std::move(re), std::move(*im)}}}};
         },
-        std::move(converted->first.u.u), std::move(converted->second.u.u))};
+        std::move(converted->first.u))};
   }
   return std::nullopt;
 }
index 5b92b79..db85079 100644 (file)
@@ -19,9 +19,9 @@
 template<int KIND> void testKind() {
   using Type =
       Fortran::evaluate::Type<Fortran::common::TypeCategory::Logical, KIND>;
+  TEST(Type::isSpecificType);
   TEST(Type::category == Fortran::common::TypeCategory::Logical);
   TEST(Type::kind == KIND);
-  TEST(!Type::hasLen);
   using Value = Fortran::evaluate::Scalar<Type>;
   MATCH(8 * KIND, Value::bits);
   TEST(!Value{}.IsTrue());