[flang] checkpoint
authorpeter klausler <pklausler@nvidia.com>
Mon, 13 Aug 2018 20:33:31 +0000 (13:33 -0700)
committerpeter klausler <pklausler@nvidia.com>
Wed, 12 Sep 2018 23:28:44 +0000 (16:28 -0700)
Original-commit: flang-compiler/f18@3fae716c44104cd9ec7694ccda93c8881f2e3c7e
Reviewed-on: https://github.com/flang-compiler/f18/pull/183
Tree-same-pre-rewrite: false

flang/lib/common/idioms.h
flang/lib/evaluate/expression-forward.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.cc
flang/lib/evaluate/type.h
flang/lib/semantics/expression.cc
flang/lib/semantics/expression.h

index 675f04c..26044db 100644 (file)
@@ -29,6 +29,7 @@
 #error g++ >= 7.2 is required
 #endif
 
+#include <functional>
 #include <list>
 #include <optional>
 #include <tuple>
@@ -137,5 +138,35 @@ std::optional<A> GetIf(const VARIANT &u) {
   }
   return std::nullopt;
 }
+
+// Collapses a nested std::optional<std::optional<A>>
+template<typename A>
+std::optional<A> JoinOptionals(std::optional<std::optional<A>> &&x) {
+  if (x.has_value()) {
+    return std::move(*x);
+  }
+  return std::nullopt;
+}
+
+// Apply a function to optional argument(s), if are all present.
+// N.B. This function uses a "functor" in the C++ sense -- a type with
+// a member function operator() -- to implement a "functor" in the category
+// theoretical sense.
+template<typename A, typename B>
+std::optional<A> MapOptional(std::function<A(B &&)> &f, std::optional<B> &&x) {
+  if (x.has_value()) {
+    return {f(std::move(*x))};
+  }
+  return std::nullopt;
+}
+
+template<typename A, typename B, typename C>
+std::optional<A> MapOptional(std::function<A(B &&, C &&)> &f,
+    std::optional<B> &&x, std::optional<C> &&y) {
+  if (x.has_value() && y.has_value()) {
+    return {f(std::move(*x), std::move(*y))};
+  }
+  return std::nullopt;
+}
 }  // namespace Fortran::common
 #endif  // FORTRAN_COMMON_IDIOMS_H_
index 98a477b..eb2e34c 100644 (file)
@@ -35,13 +35,13 @@ template<int KIND> using LogicalExpr = Expr<Type<TypeCategory::Logical, KIND>>;
 
 // An expression whose result is within one particular type category and
 // of any supported kind.
-using AnyKindIntegerExpr = Expr<AnyKindType<TypeCategory::Integer>>;
-using AnyKindRealExpr = Expr<AnyKindType<TypeCategory::Real>>;
-using AnyKindComplexExpr = Expr<AnyKindType<TypeCategory::Complex>>;
-using AnyKindCharacterExpr = Expr<AnyKindType<TypeCategory::Character>>;
-using AnyKindLogicalExpr = Expr<AnyKindType<TypeCategory::Logical>>;
+using SomeKindIntegerExpr = Expr<SomeKind<TypeCategory::Integer>>;
+using SomeKindRealExpr = Expr<SomeKind<TypeCategory::Real>>;
+using SomeKindComplexExpr = Expr<SomeKind<TypeCategory::Complex>>;
+using SomeKindCharacterExpr = Expr<SomeKind<TypeCategory::Character>>;
+using SomeKindLogicalExpr = Expr<SomeKind<TypeCategory::Logical>>;
 
-// A completely generic expression.
+// A completely generic expression of any category and kind.
 struct GenericExpr;
 
 }  // namespace Fortran::evaluate
index 4afc6dd..717e401 100644 (file)
@@ -50,7 +50,7 @@ std::ostream &DumpExpr(std::ostream &o, const std::variant<A...> &u) {
 }
 
 template<TypeCategory CAT>
-std::ostream &Expr<AnyKindType<CAT>>::Dump(std::ostream &o) const {
+std::ostream &Expr<SomeKind<CAT>>::Dump(std::ostream &o) const {
   return DumpExpr(o, u);
 }
 
@@ -772,7 +772,7 @@ std::optional<GenericScalar> GenericExpr::ScalarValue() const {
 }
 
 template<TypeCategory CAT>
-auto Expr<AnyKindType<CAT>>::ScalarValue() const -> std::optional<Scalar> {
+auto Expr<SomeKind<CAT>>::ScalarValue() const -> std::optional<Scalar> {
   return std::visit(
       [](const auto &x) -> std::optional<Scalar> {
         if (auto c{x.ScalarValue()}) {
@@ -784,7 +784,7 @@ auto Expr<AnyKindType<CAT>>::ScalarValue() const -> std::optional<Scalar> {
 }
 
 template<TypeCategory CAT>
-auto Expr<AnyKindType<CAT>>::Fold(FoldingContext &context)
+auto Expr<SomeKind<CAT>>::Fold(FoldingContext &context)
     -> std::optional<Scalar> {
   return std::visit(
       [&](auto &x) -> std::optional<Scalar> {
@@ -811,11 +811,11 @@ std::optional<GenericScalar> GenericExpr::Fold(FoldingContext &context) {
       u);
 }
 
-template class Expr<AnyKindType<TypeCategory::Integer>>;
-template class Expr<AnyKindType<TypeCategory::Real>>;
-template class Expr<AnyKindType<TypeCategory::Complex>>;
-template class Expr<AnyKindType<TypeCategory::Character>>;
-template class Expr<AnyKindType<TypeCategory::Logical>>;
+template class Expr<SomeKind<TypeCategory::Integer>>;
+template class Expr<SomeKind<TypeCategory::Real>>;
+template class Expr<SomeKind<TypeCategory::Complex>>;
+template class Expr<SomeKind<TypeCategory::Character>>;
+template class Expr<SomeKind<TypeCategory::Logical>>;
 
 template class Expr<Type<TypeCategory::Integer, 1>>;
 template class Expr<Type<TypeCategory::Integer, 2>>;
index 8324663..0b0f3cc 100644 (file)
@@ -100,16 +100,15 @@ public:
   using FoldableTrait = std::true_type;
 
   struct ConvertInteger
-    : public Unary<ConvertInteger, Result, AnyKindType<TypeCategory::Integer>> {
-    using Unary<ConvertInteger, Result,
-        AnyKindType<TypeCategory::Integer>>::Unary;
+    : public Unary<ConvertInteger, Result, SomeKind<TypeCategory::Integer>> {
+    using Unary<ConvertInteger, Result, SomeKind<TypeCategory::Integer>>::Unary;
     static std::optional<Scalar> FoldScalar(
         FoldingContext &, const ScalarConstant<TypeCategory::Integer> &);
   };
 
   struct ConvertReal
-    : public Unary<ConvertReal, Result, AnyKindType<TypeCategory::Real>> {
-    using Unary<ConvertReal, Result, AnyKindType<TypeCategory::Real>>::Unary;
+    : public Unary<ConvertReal, Result, SomeKind<TypeCategory::Real>> {
+    using Unary<ConvertReal, Result, SomeKind<TypeCategory::Real>>::Unary;
     static std::optional<Scalar> FoldScalar(
         FoldingContext &, const ScalarConstant<TypeCategory::Real> &);
   };
@@ -168,19 +167,19 @@ public:
   Expr(std::int64_t n) : u_{Scalar{n}} {}
   Expr(std::uint64_t n) : u_{Scalar{n}} {}
   Expr(int n) : u_{Scalar{n}} {}
-  Expr(const AnyKindIntegerExpr &x) : u_{ConvertInteger{x}} {}
-  Expr(AnyKindIntegerExpr &&x) : u_{ConvertInteger{std::move(x)}} {}
+  Expr(const SomeKindIntegerExpr &x) : u_{ConvertInteger{x}} {}
+  Expr(SomeKindIntegerExpr &&x) : u_{ConvertInteger{std::move(x)}} {}
   template<int K>
-  Expr(const IntegerExpr<K> &x) : u_{ConvertInteger{AnyKindIntegerExpr{x}}} {}
+  Expr(const IntegerExpr<K> &x) : u_{ConvertInteger{SomeKindIntegerExpr{x}}} {}
   template<int K>
   Expr(IntegerExpr<K> &&x)
-    : u_{ConvertInteger{AnyKindIntegerExpr{std::move(x)}}} {}
-  Expr(const AnyKindRealExpr &x) : u_{ConvertReal{x}} {}
-  Expr(AnyKindRealExpr &&x) : u_{ConvertReal{std::move(x)}} {}
+    : u_{ConvertInteger{SomeKindIntegerExpr{std::move(x)}}} {}
+  Expr(const SomeKindRealExpr &x) : u_{ConvertReal{x}} {}
+  Expr(SomeKindRealExpr &&x) : u_{ConvertReal{std::move(x)}} {}
   template<int K>
-  Expr(const RealExpr<K> &x) : u_{ConvertReal{AnyKindRealExpr{x}}} {}
+  Expr(const RealExpr<K> &x) : u_{ConvertReal{SomeKindRealExpr{x}}} {}
   template<int K>
-  Expr(RealExpr<K> &&x) : u_{ConvertReal{AnyKindRealExpr{std::move(x)}}} {}
+  Expr(RealExpr<K> &&x) : u_{ConvertReal{SomeKindRealExpr{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> &&
@@ -211,15 +210,14 @@ public:
   // and part access operations (resp.).  Conversions between kinds of
   // Complex are done via decomposition to Real and reconstruction.
   struct ConvertInteger
-    : public Unary<ConvertInteger, Result, AnyKindType<TypeCategory::Integer>> {
-    using Unary<ConvertInteger, Result,
-        AnyKindType<TypeCategory::Integer>>::Unary;
+    : public Unary<ConvertInteger, Result, SomeKind<TypeCategory::Integer>> {
+    using Unary<ConvertInteger, Result, SomeKind<TypeCategory::Integer>>::Unary;
     static std::optional<Scalar> FoldScalar(
         FoldingContext &, const ScalarConstant<TypeCategory::Integer> &);
   };
   struct ConvertReal
-    : public Unary<ConvertReal, Result, AnyKindType<TypeCategory::Real>> {
-    using Unary<ConvertReal, Result, AnyKindType<TypeCategory::Real>>::Unary;
+    : public Unary<ConvertReal, Result, SomeKind<TypeCategory::Real>> {
+    using Unary<ConvertReal, Result, SomeKind<TypeCategory::Real>>::Unary;
     static std::optional<Scalar> FoldScalar(
         FoldingContext &, const ScalarConstant<TypeCategory::Real> &);
   };
@@ -260,10 +258,10 @@ public:
     static std::optional<Scalar> FoldScalar(
         FoldingContext &, const Scalar &, const Scalar &);
   };
-  struct IntPower : public Binary<IntPower, Result, Result,
-                        AnyKindType<TypeCategory::Integer>> {
+  struct IntPower
+    : public Binary<IntPower, Result, Result, SomeKind<TypeCategory::Integer>> {
     using Binary<IntPower, Result, Result,
-        AnyKindType<TypeCategory::Integer>>::Binary;
+        SomeKind<TypeCategory::Integer>>::Binary;
     static std::optional<Scalar> FoldScalar(FoldingContext &, const Scalar &,
         const ScalarConstant<TypeCategory::Integer> &);
   };
@@ -294,19 +292,19 @@ public:
 
   CLASS_BOILERPLATE(Expr)
   Expr(const Scalar &x) : u_{x} {}
-  Expr(const AnyKindIntegerExpr &x) : u_{ConvertInteger{x}} {}
-  Expr(AnyKindIntegerExpr &&x) : u_{ConvertInteger{std::move(x)}} {}
+  Expr(const SomeKindIntegerExpr &x) : u_{ConvertInteger{x}} {}
+  Expr(SomeKindIntegerExpr &&x) : u_{ConvertInteger{std::move(x)}} {}
   template<int K>
-  Expr(const IntegerExpr<K> &x) : u_{ConvertInteger{AnyKindIntegerExpr{x}}} {}
+  Expr(const IntegerExpr<K> &x) : u_{ConvertInteger{SomeKindIntegerExpr{x}}} {}
   template<int K>
   Expr(IntegerExpr<K> &&x)
-    : u_{ConvertInteger{AnyKindIntegerExpr{std::move(x)}}} {}
-  Expr(const AnyKindRealExpr &x) : u_{ConvertReal{x}} {}
-  Expr(AnyKindRealExpr &&x) : u_{ConvertReal{std::move(x)}} {}
+    : u_{ConvertInteger{SomeKindIntegerExpr{std::move(x)}}} {}
+  Expr(const SomeKindRealExpr &x) : u_{ConvertReal{x}} {}
+  Expr(SomeKindRealExpr &&x) : u_{ConvertReal{std::move(x)}} {}
   template<int K>
-  Expr(const RealExpr<K> &x) : u_{ConvertReal{AnyKindRealExpr{x}}} {}
+  Expr(const RealExpr<K> &x) : u_{ConvertReal{SomeKindRealExpr{x}}} {}
   template<int K>
-  Expr(RealExpr<K> &&x) : u_{ConvertReal{AnyKindRealExpr{std::move(x)}}} {}
+  Expr(RealExpr<K> &&x) : u_{ConvertReal{SomeKindRealExpr{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)} {}
@@ -367,10 +365,10 @@ public:
     static std::optional<Scalar> FoldScalar(
         FoldingContext &, const Scalar &, const Scalar &);
   };
-  struct IntPower : public Binary<IntPower, Result, Result,
-                        AnyKindType<TypeCategory::Integer>> {
+  struct IntPower
+    : public Binary<IntPower, Result, Result, SomeKind<TypeCategory::Integer>> {
     using Binary<IntPower, Result, Result,
-        AnyKindType<TypeCategory::Integer>>::Binary;
+        SomeKind<TypeCategory::Integer>>::Binary;
     static std::optional<Scalar> FoldScalar(FoldingContext &, const Scalar &,
         const ScalarConstant<TypeCategory::Integer> &);
   };
@@ -577,9 +575,9 @@ extern template class Expr<Type<TypeCategory::Logical, 8>>;
 
 // Dynamically polymorphic expressions that can hold any supported kind
 // of a specific intrinsic type category.
-template<TypeCategory CAT> class Expr<AnyKindType<CAT>> {
+template<TypeCategory CAT> class Expr<SomeKind<CAT>> {
 public:
-  using Result = AnyKindType<CAT>;
+  using Result = SomeKind<CAT>;
   using Scalar = typename Result::Value;
   using FoldableTrait = std::true_type;
   CLASS_BOILERPLATE(Expr)
@@ -591,11 +589,11 @@ public:
   typename KindsVariant<CAT, KindExpr>::type u;
 };
 
-extern template class Expr<AnyKindType<TypeCategory::Integer>>;
-extern template class Expr<AnyKindType<TypeCategory::Real>>;
-extern template class Expr<AnyKindType<TypeCategory::Complex>>;
-extern template class Expr<AnyKindType<TypeCategory::Character>>;
-extern template class Expr<AnyKindType<TypeCategory::Logical>>;
+extern template class Expr<SomeKind<TypeCategory::Integer>>;
+extern template class Expr<SomeKind<TypeCategory::Real>>;
+extern template class Expr<SomeKind<TypeCategory::Complex>>;
+extern template class Expr<SomeKind<TypeCategory::Character>>;
+extern template class Expr<SomeKind<TypeCategory::Logical>>;
 
 // BOZ literal constants need to be wide enough to hold an integer or real
 // value of any supported kind.  They also need to be distinguishable from
@@ -616,17 +614,18 @@ struct GenericExpr {
     : u{std::move(x)} {}
 
   template<TypeCategory CAT, int KIND>
-  GenericExpr(const Expr<Type<CAT, KIND>> &x) : u{Expr<AnyKindType<CAT>>{x}} {}
+  GenericExpr(const Expr<Type<CAT, KIND>> &x) : u{Expr<SomeKind<CAT>>{x}} {}
 
   template<TypeCategory CAT, int KIND>
   GenericExpr(Expr<Type<CAT, KIND>> &&x)
-    : u{Expr<AnyKindType<CAT>>{std::move(x)}} {}
+    : u{Expr<SomeKind<CAT>>{std::move(x)}} {}
 
   std::optional<Scalar> ScalarValue() const;
   std::optional<Scalar> Fold(FoldingContext &);
   int Rank() const { return 1; }  // TODO
-  std::variant<AnyKindIntegerExpr, AnyKindRealExpr, AnyKindComplexExpr,
-      AnyKindCharacterExpr, AnyKindLogicalExpr, BOZLiteralConstant>
+
+  std::variant<SomeKindIntegerExpr, SomeKindRealExpr, SomeKindComplexExpr,
+      SomeKindCharacterExpr, SomeKindLogicalExpr, BOZLiteralConstant>
       u;
 };
 
index 877e955..44a12dd 100644 (file)
@@ -20,19 +20,19 @@ using namespace Fortran::parser::literals;
 
 namespace Fortran::evaluate {
 
-AnyKindRealExpr ConvertToTypeOf(
-    const AnyKindRealExpr &to, const AnyKindIntegerExpr &from) {
+SomeKindRealExpr ConvertToTypeOf(
+    const SomeKindRealExpr &to, const SomeKindIntegerExpr &from) {
   return std::visit(
-      [&](const auto &rk) { return AnyKindRealExpr{decltype(rk){to}}; }, to.u);
+      [&](const auto &rk) { return SomeKindRealExpr{decltype(rk){to}}; }, to.u);
 }
 
-AnyKindRealExpr ConvertToTypeOf(
-    const AnyKindRealExpr &to, const AnyKindRealExpr &from) {
+SomeKindRealExpr ConvertToTypeOf(
+    const SomeKindRealExpr &to, const SomeKindRealExpr &from) {
   return std::visit(
-      [&](const auto &rk) { return AnyKindRealExpr{decltype(rk){to}}; }, to.u);
+      [&](const auto &rk) { return SomeKindRealExpr{decltype(rk){to}}; }, to.u);
 }
 
-static void ConvertToSameRealKind(AnyKindRealExpr &x, AnyKindRealExpr &y) {
+static void ConvertToSameRealKind(SomeKindRealExpr &x, SomeKindRealExpr &y) {
   std::visit(
       [&](auto &xk, auto &yk) {
         using xt = typename std::decay<decltype(xk)>::type;
@@ -47,40 +47,41 @@ static void ConvertToSameRealKind(AnyKindRealExpr &x, AnyKindRealExpr &y) {
       x.u, y.u);
 }
 
-std::optional<std::pair<AnyKindRealExpr, AnyKindRealExpr>> ConvertRealOperands(
+std::optional<std::pair<SomeKindRealExpr, SomeKindRealExpr>>
+ConvertRealOperands(
     parser::ContextualMessages &messages, GenericExpr &&x, GenericExpr &&y) {
   return std::visit(
       common::visitors{
-          [&](AnyKindIntegerExpr &&ix, AnyKindIntegerExpr &&iy) {
+          [&](SomeKindIntegerExpr &&ix, SomeKindIntegerExpr &&iy) {
             // Can happen in a CMPLX() constructor.  Per F'2018, both integer
             // operands are converted to default REAL.
             return std::optional{std::make_pair(
-                AnyKindRealExpr{Expr<DefaultReal>{std::move(ix)}},
-                AnyKindRealExpr{Expr<DefaultReal>{std::move(iy)}})};
+                SomeKindRealExpr{Expr<DefaultReal>{std::move(ix)}},
+                SomeKindRealExpr{Expr<DefaultReal>{std::move(iy)}})};
           },
-          [&](AnyKindIntegerExpr &&ix, AnyKindRealExpr &&ry) {
+          [&](SomeKindIntegerExpr &&ix, SomeKindRealExpr &&ry) {
             auto rx{ConvertToTypeOf(ry, std::move(ix))};
             return std::optional{std::make_pair(std::move(rx), std::move(ry))};
           },
-          [&](AnyKindRealExpr &&rx, AnyKindIntegerExpr &&iy) {
+          [&](SomeKindRealExpr &&rx, SomeKindIntegerExpr &&iy) {
             auto ry{ConvertToTypeOf(rx, std::move(iy))};
             return std::optional{std::make_pair(std::move(rx), std::move(ry))};
           },
-          [&](AnyKindRealExpr &&rx, AnyKindRealExpr &&ry) {
+          [&](SomeKindRealExpr &&rx, SomeKindRealExpr &&ry) {
             ConvertToSameRealKind(rx, ry);
             return std::optional{std::make_pair(std::move(rx), std::move(ry))};
           },
           [&](const auto &, const auto &)
-              -> std::optional<std::pair<AnyKindRealExpr, AnyKindRealExpr>> {
+              -> std::optional<std::pair<SomeKindRealExpr, SomeKindRealExpr>> {
             messages.Say("operands must be INTEGER or REAL"_err_en_US);
             return std::nullopt;
           }},
       std::move(x.u), std::move(y.u));
 }
 
-std::optional<std::pair<AnyKindRealExpr, AnyKindRealExpr>> ConvertRealOperands(
-    parser::ContextualMessages &messages, std::optional<GenericExpr> &&x,
-    std::optional<GenericExpr> &&y) {
+std::optional<std::pair<SomeKindRealExpr, SomeKindRealExpr>>
+ConvertRealOperands(parser::ContextualMessages &messages,
+    std::optional<GenericExpr> &&x, std::optional<GenericExpr> &&y) {
   if (x.has_value() && y.has_value()) {
     return ConvertRealOperands(messages, std::move(*x), std::move(*y));
   }
index 855f3f5..ba7f3a0 100644 (file)
@@ -16,6 +16,7 @@
 #define FORTRAN_EVALUATE_TOOLS_H_
 
 #include "expression.h"
+#include "../common/idioms.h"
 #include "../parser/message.h"
 #include <optional>
 #include <utility>
 namespace Fortran::evaluate {
 
 // Convert the second argument to the same type and kind of the first.
-AnyKindRealExpr ConvertToTypeOf(
-    const AnyKindRealExpr &to, const AnyKindIntegerExpr &from);
-AnyKindRealExpr ConvertToTypeOf(
-    const AnyKindRealExpr &to, const AnyKindRealExpr &from);
+SomeKindRealExpr ConvertToTypeOf(
+    const SomeKindRealExpr &to, const SomeKindIntegerExpr &from);
+SomeKindRealExpr ConvertToTypeOf(
+    const SomeKindRealExpr &to, const SomeKindRealExpr &from);
 
 // Ensure that both operands of an intrinsic REAL operation or CMPLX()
 // are INTEGER or REAL, and convert them as necessary to the same REAL type.
-std::optional<std::pair<AnyKindRealExpr, AnyKindRealExpr>> ConvertRealOperands(
+using ConvertRealOperandsResult =
+    std::optional<std::pair<SomeKindRealExpr, SomeKindRealExpr>>;
+ConvertRealOperandsResult ConvertRealOperands(
     parser::ContextualMessages &, GenericExpr &&, GenericExpr &&);
 
-std::optional<std::pair<AnyKindRealExpr, AnyKindRealExpr>> ConvertRealOperands(
-    parser::ContextualMessages &, std::optional<GenericExpr> &&x,
-    std::optional<GenericExpr> &&y);
-
 }  // namespace Fortran::evaluate
 #endif  // FORTRAN_EVALUATE_TOOLS_H_
index 58f9992..aae0fec 100644 (file)
@@ -13,6 +13,7 @@
 // limitations under the License.
 
 #include "type.h"
+#include "expression.h"
 #include "../common/idioms.h"
 #include <cinttypes>
 #include <optional>
@@ -38,4 +39,25 @@ std::optional<std::string> GenericScalar::ToString() const {
   return std::nullopt;
 }
 
+// There's some opaque type-fu going on below.  Given a GenericScalar, we
+// figure out its intrinsic type category, and then (for each category),
+// we figure out its kind from the type of the constant.  Then, given
+// the category, kind, and constant, we construct a GenericExpr around
+// the constant.
+GenericExpr GenericScalar::ToGenericExpr() const {
+  return std::visit(
+      [](const auto &c) -> GenericExpr {
+        using cType = typename std::decay<decltype(c)>::type;
+        constexpr TypeCategory cat{cType::category};
+        return {std::visit(
+            [&](const auto &value) -> Expr<SomeKind<cat>> {
+              using valueType = typename std::decay<decltype(value)>::type;
+              using Ty = typename TypeOfScalarValue<valueType>::type;
+              return {Expr<Ty>{value}};
+            },
+            c.u)};
+      },
+      u);
+}
+
 }  // namespace Fortran::evaluate
index d3ff848..4220425 100644 (file)
@@ -35,6 +35,8 @@ namespace Fortran::evaluate {
 
 using common::TypeCategory;
 
+struct GenericExpr;
+
 template<TypeCategory C, int KIND> struct TypeBase {
   static constexpr TypeCategory category{C};
   static constexpr int kind{KIND};
@@ -107,12 +109,13 @@ struct Type<TypeCategory::Logical, KIND>
   using Value = value::Logical<8 * KIND>;
 };
 
+// Convenience type aliases:
 // Default REAL just simply has to be IEEE-754 single precision today.
 // It occupies one numeric storage unit by definition.  The default INTEGER
 // and default LOGICAL intrinsic types also have to occupy one numeric
 // storage unit, so their kinds are also forced.  Default COMPLEX occupies
 // two numeric storage units.
-// TODO: Support a compile-time option to default everything to KIND=8
+// TODO: Support compile-time options to default reals, ints, or both to KIND=8
 
 using DefaultReal = Type<TypeCategory::Real, 4>;
 using DefaultDoublePrecision = Type<TypeCategory::Real, 2 * DefaultReal::kind>;
@@ -134,50 +137,76 @@ using SubscriptInteger = Type<TypeCategory::Integer, 8>;
 #define FOR_EACH_CHARACTER_KIND(M, SEP) M(1)
 #define FOR_EACH_LOGICAL_KIND(M, SEP) M(1) SEP M(2) SEP M(4) SEP M(8)
 
-// These templates create instances of std::variant<> that can contain
+#define FOR_EACH_CATEGORY(M) \
+  M(Integer, INTEGER) \
+  M(Real, REAL) M(Complex, COMPLEX) M(Character, CHARACTER) \
+      M(Logical, LOGICAL)
+
+// These macros and template create instances of std::variant<> that can contain
 // applications of some class template to all of the supported kinds of
 // a category of intrinsic type.
-#define TKIND(K) T<K>
 template<TypeCategory CAT, template<int> class T> struct KindsVariant;
-template<template<int> class T> struct KindsVariant<TypeCategory::Integer, T> {
-  using type = std::variant<FOR_EACH_INTEGER_KIND(TKIND, COMMA)>;
-};
-template<template<int> class T> struct KindsVariant<TypeCategory::Real, T> {
-  using type = std::variant<FOR_EACH_REAL_KIND(TKIND, COMMA)>;
-};
-template<template<int> class T> struct KindsVariant<TypeCategory::Complex, T> {
-  using type = std::variant<FOR_EACH_COMPLEX_KIND(TKIND, COMMA)>;
-};
-template<template<int> class T>
-struct KindsVariant<TypeCategory::Character, T> {
-  using type = std::variant<FOR_EACH_CHARACTER_KIND(TKIND, COMMA)>;
-};
-template<template<int> class T> struct KindsVariant<TypeCategory::Logical, T> {
-  using type = std::variant<FOR_EACH_LOGICAL_KIND(TKIND, COMMA)>;
-};
+#define TKIND(K) T<K>
+#define MAKE(Cat, CAT) \
+  template<template<int> class T> struct KindsVariant<TypeCategory::Cat, T> { \
+    using type = std::variant<FOR_EACH_##CAT##_KIND(TKIND, COMMA)>; \
+  };
+FOR_EACH_CATEGORY(MAKE)
+#undef MAKE
 #undef TKIND
 
+// Map scalar constant value types back to their Fortran types.
+// For every type T = Type<CAT, KIND>, TypeOfScalarValue<T::Value>::type == T.
+// E.g., TypeOfScalarValue<Integer<32>> is Type<TypeCategory::Integer, 4>.
+template<typename CONST> struct TypeOfScalarValue;
+#define TOSV(cat, kind) \
+  template<> \
+  struct TypeOfScalarValue<typename Type<TypeCategory::cat, kind>::Value> { \
+    using type = Type<TypeCategory::cat, kind>; \
+  };
+#define M(k) TOSV(Integer, k)
+FOR_EACH_INTEGER_KIND(M, )
+#undef M
+#define M(k) TOSV(Real, k)
+FOR_EACH_REAL_KIND(M, )
+#undef M
+#define M(k) TOSV(Complex, k)
+FOR_EACH_COMPLEX_KIND(M, )
+#undef M
+#define M(k) TOSV(Character, k)
+FOR_EACH_CHARACTER_KIND(M, )
+#undef M
+#define M(k) TOSV(Logical, k)
+FOR_EACH_LOGICAL_KIND(M, )
+#undef M
+#undef TOSV
+
 // Holds a scalar constant of any kind within a particular intrinsic type
 // category.
 template<TypeCategory CAT> struct ScalarConstant {
+  static constexpr TypeCategory category{CAT};
   CLASS_BOILERPLATE(ScalarConstant)
+
   template<int KIND> using KindScalar = typename Type<CAT, KIND>::Value;
   template<typename A> ScalarConstant(const A &x) : u{x} {}
   template<typename A>
   ScalarConstant(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
     : u{std::move(x)} {}
+
   typename KindsVariant<CAT, KindScalar>::type u;
 };
 
 // Holds a scalar constant of any intrinsic category and size.
 struct GenericScalar {
   CLASS_BOILERPLATE(GenericScalar)
+
   template<TypeCategory CAT, int KIND>
   GenericScalar(const typename Type<CAT, KIND>::Value &x)
     : u{ScalarConstant<CAT>{x}} {}
   template<TypeCategory CAT, int KIND>
   GenericScalar(typename Type<CAT, KIND>::Value &&x)
     : u{ScalarConstant<CAT>{std::move(x)}} {}
+
   template<typename A> GenericScalar(const A &x) : u{x} {}
   template<typename A>
   GenericScalar(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
@@ -185,6 +214,7 @@ struct GenericScalar {
 
   std::optional<std::int64_t> ToInt64() const;
   std::optional<std::string> ToString() const;
+  GenericExpr ToGenericExpr() const;
 
   std::variant<ScalarConstant<TypeCategory::Integer>,
       ScalarConstant<TypeCategory::Real>, ScalarConstant<TypeCategory::Complex>,
@@ -194,7 +224,7 @@ struct GenericScalar {
 };
 
 // Represents a type of any supported kind within a particular category.
-template<TypeCategory CAT> struct AnyKindType {
+template<TypeCategory CAT> struct SomeKind {
   static constexpr TypeCategory category{CAT};
   using Value = ScalarConstant<CAT>;
 };
index 04acac5..f3ee629 100644 (file)
 #include "../common/idioms.h"
 #include "../evaluate/common.h"
 #include "../evaluate/tools.h"
+#include <functional>
 
 using namespace Fortran::parser::literals;
 
 namespace Fortran::semantics {
 
-using Result = std::optional<evaluate::GenericExpr>;
-
 // AnalyzeHelper is a local template function that keeps the API
 // member function ExpressionAnalyzer::Analyze from having to be a
 // many-specialized template itself.
-template<typename A> Result AnalyzeHelper(ExpressionAnalyzer &, const A &);
+template<typename A> MaybeExpr AnalyzeHelper(ExpressionAnalyzer &, const A &);
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr &expr) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr &expr) {
   return ea.Analyze(expr);
 }
 
 // Template wrappers are traversed with checking.
 template<typename A>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const std::optional<A> &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const std::optional<A> &x) {
   if (x.has_value()) {
     return AnalyzeHelper(ea, *x);
   } else {
@@ -45,13 +44,14 @@ Result AnalyzeHelper(ExpressionAnalyzer &ea, const std::optional<A> &x) {
 }
 
 template<typename A>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const common::Indirection<A> &p) {
+MaybeExpr AnalyzeHelper(
+    ExpressionAnalyzer &ea, const common::Indirection<A> &p) {
   return AnalyzeHelper(ea, *p);
 }
 
 template<typename A>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Scalar<A> &tree) {
-  Result result{AnalyzeHelper(ea, tree.thing)};
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Scalar<A> &tree) {
+  MaybeExpr result{AnalyzeHelper(ea, tree.thing)};
   if (result.has_value()) {
     if (result->Rank() > 1) {
       ea.context().messages.Say("must be scalar"_err_en_US);
@@ -62,8 +62,9 @@ Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Scalar<A> &tree) {
 }
 
 template<typename A>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Constant<A> &tree) {
-  Result result{AnalyzeHelper(ea, tree.thing)};
+MaybeExpr AnalyzeHelper(
+    ExpressionAnalyzer &ea, const parser::Constant<A> &tree) {
+  MaybeExpr result{AnalyzeHelper(ea, tree.thing)};
   if (result.has_value()) {
     result->Fold(ea.context());
     if (!result->ScalarValue().has_value()) {
@@ -75,24 +76,25 @@ Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Constant<A> &tree) {
 }
 
 template<typename A>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Integer<A> &tree) {
-  Result result{AnalyzeHelper(ea, tree.thing)};
+MaybeExpr AnalyzeHelper(
+    ExpressionAnalyzer &ea, const parser::Integer<A> &tree) {
+  MaybeExpr result{AnalyzeHelper(ea, tree.thing)};
   if (result.has_value() &&
-      !std::holds_alternative<evaluate::AnyKindIntegerExpr>(result->u)) {
+      !std::holds_alternative<evaluate::SomeKindIntegerExpr>(result->u)) {
     ea.context().messages.Say("must be integer"_err_en_US);
     return std::nullopt;
   }
   return result;
 }
 
-static std::optional<evaluate::AnyKindCharacterExpr> AnalyzeLiteral(
+static std::optional<evaluate::SomeKindCharacterExpr> AnalyzeLiteral(
     ExpressionAnalyzer &ea, const parser::CharLiteralConstant &x) {
   auto kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
       ExpressionAnalyzer::KindParam{1})};
   switch (kind) {
 #define CASE(k) \
   case k: \
-    return {evaluate::AnyKindCharacterExpr{ \
+    return {evaluate::SomeKindCharacterExpr{ \
         evaluate::CharacterExpr<k>{std::get<std::string>(x.t)}}};
     FOR_EACH_CHARACTER_KIND(CASE, )
 #undef CASE
@@ -103,32 +105,29 @@ static std::optional<evaluate::AnyKindCharacterExpr> AnalyzeLiteral(
   }
 }
 
-// TODO: move this functor to common?  abstract to more of an fmap?
-template<typename A, typename B>
-std::optional<A> WrapOptional(std::optional<B> &&x) {
-  if (x.has_value()) {
-    return {A{std::move(*x)}};
-  }
-  return std::nullopt;
+template<typename A> MaybeExpr PackageGeneric(std::optional<A> &&x) {
+  std::function<evaluate::GenericExpr(A &&)> f{
+      [](A &&y) -> evaluate::GenericExpr { return {std::move(y)}; }};
+  return common::MapOptional(f, std::move(x));
 }
 
 template<>
-Result AnalyzeHelper(
+MaybeExpr AnalyzeHelper(
     ExpressionAnalyzer &ea, const parser::CharLiteralConstantSubstring &x) {
   const auto &range{std::get<parser::SubstringRange>(x.t)};
   const std::optional<parser::ScalarIntExpr> &lbTree{std::get<0>(range.t)};
   const std::optional<parser::ScalarIntExpr> &ubTree{std::get<1>(range.t)};
   if (!lbTree.has_value() && !ubTree.has_value()) {
     // "..."(:)
-    return WrapOptional<evaluate::GenericExpr>(
+    return PackageGeneric(
         AnalyzeLiteral(ea, std::get<parser::CharLiteralConstant>(x.t)));
   }
   // TODO: ensure that any kind parameter is 1
   std::string str{std::get<parser::CharLiteralConstant>(x.t).GetString()};
   std::optional<evaluate::SubscriptIntegerExpr> lb, ub;
   if (lbTree.has_value()) {
-    if (Result lbExpr{AnalyzeHelper(ea, *lbTree)}) {
-      if (auto *ie{std::get_if<evaluate::AnyKindIntegerExpr>(&lbExpr->u)}) {
+    if (MaybeExpr lbExpr{AnalyzeHelper(ea, *lbTree)}) {
+      if (auto *ie{std::get_if<evaluate::SomeKindIntegerExpr>(&lbExpr->u)}) {
         lb = evaluate::SubscriptIntegerExpr{std::move(*ie)};
       } else {
         ea.context().messages.Say(
@@ -137,8 +136,8 @@ Result AnalyzeHelper(
     }
   }
   if (ubTree.has_value()) {
-    if (Result ubExpr{AnalyzeHelper(ea, *ubTree)}) {
-      if (auto *ie{std::get_if<evaluate::AnyKindIntegerExpr>(&ubExpr->u)}) {
+    if (MaybeExpr ubExpr{AnalyzeHelper(ea, *ubTree)}) {
+      if (auto *ie{std::get_if<evaluate::SomeKindIntegerExpr>(&ubExpr->u)}) {
         ub = evaluate::SubscriptIntegerExpr{std::move(*ie)};
       } else {
         ea.context().messages.Say(
@@ -153,13 +152,13 @@ Result AnalyzeHelper(
   evaluate::CopyableIndirection<evaluate::Substring> ind{std::move(substring)};
   evaluate::CharacterExpr<1> chExpr{std::move(ind)};
   chExpr.Fold(ea.context());
-  return {
-      evaluate::GenericExpr{evaluate::AnyKindCharacterExpr{std::move(chExpr)}}};
+  return {evaluate::GenericExpr{
+      evaluate::SomeKindCharacterExpr{std::move(chExpr)}}};
 }
 
 // Common handling of parser::IntLiteralConstant and SignedIntLiteralConstant
 template<typename PARSED>
-std::optional<evaluate::AnyKindIntegerExpr> IntLiteralConstant(
+std::optional<evaluate::SomeKindIntegerExpr> IntLiteralConstant(
     ExpressionAnalyzer &ea, const PARSED &x) {
   auto kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
       ea.defaultIntegerKind())};
@@ -167,7 +166,7 @@ std::optional<evaluate::AnyKindIntegerExpr> IntLiteralConstant(
   switch (kind) {
 #define CASE(k) \
   case k: \
-    return {evaluate::AnyKindIntegerExpr{evaluate::IntegerExpr<k>{value}}};
+    return {evaluate::SomeKindIntegerExpr{evaluate::IntegerExpr<k>{value}}};
     FOR_EACH_INTEGER_KIND(CASE, )
 #undef CASE
   default:
@@ -177,12 +176,12 @@ std::optional<evaluate::AnyKindIntegerExpr> IntLiteralConstant(
   }
 }
 
-static std::optional<evaluate::AnyKindIntegerExpr> AnalyzeLiteral(
+static std::optional<evaluate::SomeKindIntegerExpr> AnalyzeLiteral(
     ExpressionAnalyzer &ea, const parser::IntLiteralConstant &x) {
   return IntLiteralConstant(ea, x);
 }
 
-static std::optional<evaluate::AnyKindIntegerExpr> AnalyzeLiteral(
+static std::optional<evaluate::SomeKindIntegerExpr> AnalyzeLiteral(
     ExpressionAnalyzer &ea, const parser::SignedIntLiteralConstant &x) {
   return IntLiteralConstant(ea, x);
 }
@@ -213,7 +212,7 @@ static std::optional<evaluate::BOZLiteralConstant> AnalyzeLiteral(
 }
 
 template<int KIND>
-std::optional<evaluate::AnyKindRealExpr> ReadRealLiteral(
+std::optional<evaluate::SomeKindRealExpr> ReadRealLiteral(
     parser::CharBlock source, evaluate::FoldingContext &context) {
   using valueType = typename evaluate::RealExpr<KIND>::Scalar;
   const char *p{source.begin()};
@@ -225,10 +224,10 @@ std::optional<evaluate::AnyKindRealExpr> ReadRealLiteral(
   if (context.flushDenormalsToZero) {
     value = value.FlushDenormalToZero();
   }
-  return {evaluate::AnyKindRealExpr{evaluate::RealExpr<KIND>{value}}};
+  return {evaluate::SomeKindRealExpr{evaluate::RealExpr<KIND>{value}}};
 }
 
-static std::optional<evaluate::AnyKindRealExpr> AnalyzeLiteral(
+static std::optional<evaluate::SomeKindRealExpr> AnalyzeLiteral(
     ExpressionAnalyzer &ea, const parser::RealLiteralConstant &x) {
   // Use a local message context around the real literal.
   parser::ContextualMessages ctxMsgs{x.real.source, ea.context().messages};
@@ -262,7 +261,7 @@ static std::optional<evaluate::AnyKindRealExpr> AnalyzeLiteral(
   }
 }
 
-static std::optional<evaluate::AnyKindRealExpr> AnalyzeLiteral(
+static std::optional<evaluate::SomeKindRealExpr> AnalyzeLiteral(
     ExpressionAnalyzer &ea, const parser::SignedRealLiteralConstant &x) {
   auto result{AnalyzeLiteral(ea, std::get<parser::RealLiteralConstant>(x.t))};
   if (result.has_value()) {
@@ -281,65 +280,52 @@ static std::optional<evaluate::AnyKindRealExpr> AnalyzeLiteral(
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::NamedConstant &n) {
-  CHECK(n.v.symbol != nullptr);
-  auto *details{n.v.symbol->detailsIf<ObjectEntityDetails>()};
-  if (details == nullptr || !n.v.symbol->attrs().test(Attr::PARAMETER)) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Name &n) {
+  CHECK(n.symbol != nullptr);
+  auto *details{n.symbol->detailsIf<ObjectEntityDetails>()};
+  if (details == nullptr || !n.symbol->attrs().test(Attr::PARAMETER)) {
     ea.context().messages.Say(
-        "name (%s) is not a defined constant"_err_en_US, n.v.ToString().data());
+        "name (%s) is not a defined constant"_err_en_US, n.ToString().data());
     return std::nullopt;
   }
+  // TODO: enumerators, do they have the PARAMETER attribute?
   return std::nullopt;  // TODO parameters and enumerators
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::ComplexPart &x) {
+MaybeExpr AnalyzeHelper(
+    ExpressionAnalyzer &ea, const parser::NamedConstant &n) {
+  return AnalyzeHelper(ea, n.v);
+}
+
+template<>
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::ComplexPart &x) {
   return std::visit(common::visitors{[&](const parser::NamedConstant &n) {
                                        return AnalyzeHelper(ea, n);
                                      },
                         [&](const auto &literal) {
-                          return WrapOptional<evaluate::GenericExpr>(
-                              AnalyzeLiteral(ea, literal));
+                          return PackageGeneric(AnalyzeLiteral(ea, literal));
                         }},
       x.u);
 }
 
-static std::optional<evaluate::AnyKindComplexExpr> BuildComplex(
-    ExpressionAnalyzer &ea, Result &&re, Result &&im) {
-  // TODO pmk: what follows should be abstracted, it will appear many more times
-  auto cvtd{evaluate::ConvertRealOperands(
-      ea.context().messages, std::move(re), std::move(im))};
-  if (cvtd.has_value()) {
-    auto cmplx{std::visit(
-        [](auto &&rx, auto &&ix) -> evaluate::AnyKindComplexExpr {
-          using realExpr = typename std::decay<decltype(rx)>::type;
-          using zExpr = evaluate::Expr<typename realExpr::SameKindComplex>;
-          return {zExpr{typename zExpr::CMPLX{std::move(rx), std::move(ix)}}};
-        },
-        std::move(cvtd->first.u), std::move(cvtd->second.u))};
-    return {cmplx};
-  }
-  return std::nullopt;
-}
-
 // Per F'2018 R718, if both components are INTEGER, they are both converted
 // to default REAL and the result is default COMPLEX.  Otherwise, the
 // kind of the result is the kind of largest REAL component, and the other
 // component is converted if necessary its type.
-static std::optional<evaluate::AnyKindComplexExpr> AnalyzeLiteral(
+static std::optional<evaluate::SomeKindComplexExpr> AnalyzeLiteral(
     ExpressionAnalyzer &ea, const parser::ComplexLiteralConstant &z) {
   const parser::ComplexPart &re{std::get<0>(z.t)}, &im{std::get<1>(z.t)};
-  Result reEx{AnalyzeHelper(ea, re)}, imEx{AnalyzeHelper(ea, im)};
-  return BuildComplex(ea, std::move(reEx), std::move(imEx));
+  return ea.ConstructComplex(AnalyzeHelper(ea, re), AnalyzeHelper(ea, im));
 }
 
-static std::optional<evaluate::AnyKindCharacterExpr> AnalyzeLiteral(
+static std::optional<evaluate::SomeKindCharacterExpr> AnalyzeLiteral(
     ExpressionAnalyzer &ea, const parser::HollerithLiteralConstant &x) {
   evaluate::Expr<evaluate::DefaultCharacter> expr{x.v};
-  return {evaluate::AnyKindCharacterExpr{expr}};
+  return {evaluate::SomeKindCharacterExpr{expr}};
 }
 
-static std::optional<evaluate::AnyKindLogicalExpr> AnalyzeLiteral(
+static std::optional<evaluate::SomeKindLogicalExpr> AnalyzeLiteral(
     ExpressionAnalyzer &ea, const parser::LogicalLiteralConstant &x) {
   auto kind{ea.Analyze(std::get<std::optional<parser::KindParam>>(x.t),
       ea.defaultLogicalKind())};
@@ -347,7 +333,7 @@ static std::optional<evaluate::AnyKindLogicalExpr> AnalyzeLiteral(
   switch (kind) {
 #define CASE(k) \
   case k: \
-    return {evaluate::AnyKindLogicalExpr{evaluate::LogicalExpr<k>{value}}};
+    return {evaluate::SomeKindLogicalExpr{evaluate::LogicalExpr<k>{value}}};
     FOR_EACH_LOGICAL_KIND(CASE, )
 #undef CASE
   default:
@@ -358,210 +344,205 @@ static std::optional<evaluate::AnyKindLogicalExpr> AnalyzeLiteral(
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::LiteralConstant &x) {
+MaybeExpr AnalyzeHelper(
+    ExpressionAnalyzer &ea, const parser::LiteralConstant &x) {
   return std::visit(
-      [&](const auto &c) {
-        return WrapOptional<evaluate::GenericExpr>(AnalyzeLiteral(ea, c));
-      },
+      [&](const auto &c) { return PackageGeneric(AnalyzeLiteral(ea, c)); },
       x.u);
 }
 
-template<> Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Name &n) {
-  // TODO
-  return std::nullopt;
-}
-
 template<>
-Result AnalyzeHelper(
+MaybeExpr AnalyzeHelper(
     ExpressionAnalyzer &ea, const parser::ArrayConstructor &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(
+MaybeExpr AnalyzeHelper(
     ExpressionAnalyzer &ea, const parser::StructureConstructor &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(
+MaybeExpr AnalyzeHelper(
     ExpressionAnalyzer &ea, const parser::TypeParamInquiry &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(
+MaybeExpr AnalyzeHelper(
     ExpressionAnalyzer &ea, const parser::FunctionReference &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(
+MaybeExpr AnalyzeHelper(
     ExpressionAnalyzer &ea, const parser::Expr::Parentheses &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::UnaryPlus &x) {
+MaybeExpr AnalyzeHelper(
+    ExpressionAnalyzer &ea, const parser::Expr::UnaryPlus &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Negate &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Negate &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::NOT &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::NOT &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(
+MaybeExpr AnalyzeHelper(
     ExpressionAnalyzer &ea, const parser::Expr::PercentLoc &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(
+MaybeExpr AnalyzeHelper(
     ExpressionAnalyzer &ea, const parser::Expr::DefinedUnary &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Power &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Power &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Multiply &x) {
+MaybeExpr AnalyzeHelper(
+    ExpressionAnalyzer &ea, const parser::Expr::Multiply &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Divide &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Divide &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Add &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Add &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Subtract &x) {
+MaybeExpr AnalyzeHelper(
+    ExpressionAnalyzer &ea, const parser::Expr::Subtract &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Concat &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::Concat &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::LT &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::LT &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::LE &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::LE &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::EQ &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::EQ &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::NE &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::NE &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::GE &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::GE &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::GT &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::GT &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::AND &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::AND &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::OR &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::OR &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::EQV &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::EQV &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::NEQV &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::NEQV &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::XOR &x) {
+MaybeExpr AnalyzeHelper(ExpressionAnalyzer &ea, const parser::Expr::XOR &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(
+MaybeExpr AnalyzeHelper(
     ExpressionAnalyzer &ea, const parser::Expr::DefinedBinary &x) {
   // TODO
   return std::nullopt;
 }
 
 template<>
-Result AnalyzeHelper(
+MaybeExpr AnalyzeHelper(
     ExpressionAnalyzer &ea, const parser::Expr::ComplexConstructor &x) {
-  Result reEx{ea.Analyze(*std::get<0>(x.t))};
-  Result imEx{ea.Analyze(*std::get<1>(x.t))};
-  return WrapOptional<evaluate::GenericExpr>(
-      BuildComplex(ea, std::move(reEx), std::move(imEx)));
+  return PackageGeneric(ea.ConstructComplex(
+      ea.Analyze(*std::get<0>(x.t)), ea.Analyze(*std::get<1>(x.t))));
 }
 
-Result ExpressionAnalyzer::Analyze(const parser::Expr &x) {
+MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr &x) {
   return std::visit(common::visitors{[&](const parser::LiteralConstant &c) {
                                        return AnalyzeHelper(*this, c);
                                      },
                         // TODO: remaining cases
-                        [&](const auto &) { return Result{}; }},
+                        [&](const auto &) { return MaybeExpr{}; }},
       x.u);
 }
 
@@ -576,11 +557,22 @@ ExpressionAnalyzer::KindParam ExpressionAnalyzer::Analyze(
           [](std::uint64_t k) { return static_cast<KindParam>(k); },
           [&](const parser::Scalar<
               parser::Integer<parser::Constant<parser::Name>>> &n) {
-            if (Result oge{AnalyzeHelper(*this, n)}) {
+            if (MaybeExpr oge{AnalyzeHelper(*this, n)}) {
               if (std::optional<evaluate::GenericScalar> ogs{
                       oge->ScalarValue()}) {
-                // TODO pmk more here next
+                if (std::optional<std::int64_t> v{ogs->ToInt64()}) {
+                  return *v;
+                } else {
+                  context_.messages.Say(
+                      "KIND type parameter must be INTEGER"_err_en_US);
+                }
+              } else {
+                context_.messages.Say(
+                    "KIND type parameter must be constant"_err_en_US);
               }
+            } else {
+              context_.messages.Say(
+                  "KIND type parameter must be constant"_err_en_US);
             }
             return defaultKind;
           },
@@ -588,10 +580,33 @@ ExpressionAnalyzer::KindParam ExpressionAnalyzer::Analyze(
             if (kanjiKind >= 0) {
               return kanjiKind;
             }
-            context().messages.Say("Kanji not allowed here"_err_en_US);
+            context_.messages.Say("Kanji not allowed here"_err_en_US);
             return defaultKind;
           }},
       kindParam->u);
 }
 
+std::optional<evaluate::SomeKindComplexExpr>
+ExpressionAnalyzer::ConstructComplex(MaybeExpr &&real, MaybeExpr &&imaginary) {
+  // TODO: pmk abstract further, this will be a common pattern
+  auto partial{[&](evaluate::GenericExpr &&x, evaluate::GenericExpr &&y) {
+    return evaluate::ConvertRealOperands(
+        context_.messages, std::move(x), std::move(y));
+  }};
+  using fType = evaluate::ConvertRealOperandsResult(
+      evaluate::GenericExpr &&, evaluate::GenericExpr &&);
+  std::function<fType> f{partial};
+  auto converted{common::MapOptional(f, std::move(real), std::move(imaginary))};
+  if (auto joined{common::JoinOptionals(std::move(converted))}) {
+    return {std::visit(
+        [](auto &&rx, auto &&ix) -> evaluate::SomeKindComplexExpr {
+          using realExpr = typename std::decay<decltype(rx)>::type;
+          using zExpr = evaluate::Expr<typename realExpr::SameKindComplex>;
+          return {zExpr{typename zExpr::CMPLX{std::move(rx), std::move(ix)}}};
+        },
+        std::move(joined->first.u), std::move(joined->second.u))};
+  }
+  return std::nullopt;
+}
+
 }  // namespace Fortran::semantics
index 1ee08bb..98743dc 100644 (file)
@@ -23,6 +23,8 @@
 
 namespace Fortran::semantics {
 
+using MaybeExpr = std::optional<evaluate::GenericExpr>;
+
 class ExpressionAnalyzer {
 public:
   using KindParam = std::int64_t;
@@ -37,10 +39,13 @@ public:
 
   // Performs semantic checking on an expression.  If successful,
   // returns its typed expression representation.
-  std::optional<evaluate::GenericExpr> Analyze(const parser::Expr &);
+  MaybeExpr Analyze(const parser::Expr &);
   KindParam Analyze(const std::optional<parser::KindParam> &,
       KindParam defaultKind, KindParam kanjiKind = -1 /* not allowed here */);
 
+  std::optional<evaluate::SomeKindComplexExpr> ConstructComplex(
+      MaybeExpr &&real, MaybeExpr &&imaginary);
+
 private:
   evaluate::FoldingContext context_;
   KindParam defaultIntegerKind_{4};