[flang] work on structure components
authorpeter klausler <pklausler@nvidia.com>
Fri, 14 Sep 2018 22:48:40 +0000 (15:48 -0700)
committerpeter klausler <pklausler@nvidia.com>
Tue, 25 Sep 2018 22:23:58 +0000 (15:23 -0700)
Original-commit: flang-compiler/f18@619b6957b47e476fb6fa511efe3ede8a2e9f5a41
Reviewed-on: https://github.com/flang-compiler/f18/pull/195
Tree-same-pre-rewrite: false

15 files changed:
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.cc
flang/lib/evaluate/type.h
flang/lib/evaluate/variable.cc
flang/lib/evaluate/variable.h
flang/lib/parser/grammar.h
flang/lib/parser/message.h
flang/lib/parser/parse-tree.h
flang/lib/semantics/dump-parse-tree.h
flang/lib/semantics/expression.cc
flang/tools/f18/f18.cc

index 89b75ea..62b5ae3 100644 (file)
@@ -116,6 +116,8 @@ using HostUnsignedInt =
 // - There is no default constructor (Class() {}), usually to prevent the
 //   need for std::monostate as a default constituent in a std::variant<>.
 // - There are full copy and move semantics for construction and assignment.
+// - Discriminated unions have a std::variant<> member "u" and support
+//   explicit copy and move constructors.
 #define CLASS_BOILERPLATE(t) \
   t() = delete; \
   t(const t &) = default; \
@@ -123,6 +125,13 @@ using HostUnsignedInt =
   t &operator=(const t &) = default; \
   t &operator=(t &&) = default;
 
+#define EVALUATE_UNION_CLASS_BOILERPLATE(t) \
+  CLASS_BOILERPLATE(t) \
+  template<typename _A> explicit t(const _A &x) : u{x} {} \
+  template<typename _A> \
+  explicit t(std::enable_if_t<!std::is_reference_v<_A>, _A> &&x) \
+    : u(std::move(x)) {}
+
 // Force availability of copy construction and assignment
 template<typename A> using CopyableIndirection = common::Indirection<A, true>;
 
index 1904daf..7085ed2 100644 (file)
@@ -467,10 +467,19 @@ std::ostream &ExpressionBase<RESULT>::Dump(std::ostream &o) const {
       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); }},
+          [&](const auto &x) {
+            if constexpr (Result::isSpecificType) {
+              using Ty = std::decay_t<decltype(x)>;
+              if constexpr (std::is_same_v<Ty, FunctionReference<Result>>) {
+                x.reference->Dump(o);
+              } else {
+                x.Dump(o);
+              }
+            } else {
+              x.Dump(o);
+            }
+          }},
       derived().u);
   return o;
 }
@@ -491,8 +500,7 @@ Expr<SubscriptInteger> Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
             return Expr<SubscriptInteger>{
                 Extremum<SubscriptInteger>{c.left().LEN(), c.right().LEN()}};
           },
-          [](const DataReference<Result> &dr) { return dr.reference->LEN(); },
-          [](const CopyableIndirection<Substring> &ss) { return ss->LEN(); },
+          [](const Designator<Result> &dr) { return dr.LEN(); },
           [](const FunctionReference<Result> &fr) {
             return fr.reference->proc().LEN();
           }},
@@ -519,8 +527,9 @@ auto ExpressionBase<RESULT>::ScalarValue() const
             [](const BOZLiteralConstant &) -> std::optional<Scalar<Result>> {
               return std::nullopt;
             },
-            [](const Expr<Type<TypeCategory::Derived>> &)
-                -> std::optional<Scalar<Result>> { return std::nullopt; },
+            [](const Expr<SomeDerived> &) -> std::optional<Scalar<Result>> {
+              return std::nullopt;
+            },
             [](const auto &catEx) -> std::optional<Scalar<Result>> {
               if (auto cv{catEx.ScalarValue()}) {
                 // *cv is SomeKindScalar<CAT> for some category; rewrap it.
index 339e825..af9bb86 100644 (file)
@@ -26,6 +26,7 @@
 #include "variable.h"
 #include "../lib/common/fortran.h"
 #include "../lib/common/idioms.h"
+#include "../lib/common/template.h"
 #include "../lib/parser/char-block.h"
 #include "../lib/parser/message.h"
 #include <ostream>
@@ -76,15 +77,9 @@ template<typename T> struct Constant {
 // to be used in only a few situations.
 using BOZLiteralConstant = typename LargestReal::Scalar::Word;
 
-// These wrappers around data and function references expose their resolved
-// types.
-template<typename T> struct DataReference {
-  using Result = T;
-  CopyableIndirection<DataRef> reference;
-};
-
 template<typename T> struct FunctionReference {
   using Result = T;
+  static_assert(Result::isSpecificType);
   CopyableIndirection<FunctionRef> reference;
 };
 
@@ -99,7 +94,7 @@ template<typename T> struct FunctionReference {
 // from it via its derived() member function with compile-time type safety.
 template<typename DERIVED, typename RESULT, typename... OPERANDS>
 class Operation {
-  static_assert(RESULT::isSpecificType || !"bad result Type");
+  static_assert(RESULT::isSpecificType);
   // The extra "int" member is a dummy that allows a safe unused reference
   // to element 1 to arise indirectly in the definition of "right()" below
   // when the operation has but a single operand.
@@ -430,15 +425,11 @@ public:
   using IsFoldableTrait = std::true_type;
   // TODO: R916 type-param-inquiry
 
-  CLASS_BOILERPLATE(Expr)
+  EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
   explicit Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
   explicit Expr(std::int64_t n) : u{Constant<Result>{n}} {}
   explicit Expr(std::uint64_t n) : u{Constant<Result>{n}} {}
   explicit Expr(int n) : u{Constant<Result>{n}} {}
-  template<typename A> explicit Expr(const A &x) : u{x} {}
-  template<typename A>
-  explicit Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
-    : u(std::move(x)) {}
 
 private:
   using Conversions = std::variant<Convert<Result, TypeCategory::Integer>,
@@ -446,7 +437,7 @@ private:
   using Operations = std::variant<Parentheses<Result>, Negate<Result>,
       Add<Result>, Subtract<Result>, Multiply<Result>, Divide<Result>,
       Power<Result>, Extremum<Result>>;
-  using Others = std::variant<Constant<Result>, DataReference<Result>,
+  using Others = std::variant<Constant<Result>, Designator<Result>,
       FunctionReference<Result>>;
 
 public:
@@ -460,12 +451,8 @@ public:
   using Result = Type<TypeCategory::Real, KIND>;
   using IsFoldableTrait = std::true_type;
 
-  CLASS_BOILERPLATE(Expr)
+  EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
   explicit Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
-  template<typename A> explicit Expr(const A &x) : u{x} {}
-  template<typename A>
-  explicit Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
-    : u{std::move(x)} {}
 
 private:
   // N.B. Real->Complex and Complex->Real conversions are done with CMPLX
@@ -476,7 +463,7 @@ private:
   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>,
+  using Others = std::variant<Constant<Result>, Designator<Result>,
       FunctionReference<Result>>;
 
 public:
@@ -489,19 +476,15 @@ class Expr<Type<TypeCategory::Complex, KIND>>
 public:
   using Result = Type<TypeCategory::Complex, KIND>;
   using IsFoldableTrait = std::true_type;
-  CLASS_BOILERPLATE(Expr)
+  EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
   explicit Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
-  template<typename A> explicit Expr(const A &x) : u{x} {}
-  template<typename A>
-  explicit Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
-    : u{std::move(x)} {}
 
   // Note that many COMPLEX operations are represented as REAL operations
   // over their components (viz., conversions, negation, add, and subtract).
   using Operations =
       std::variant<Parentheses<Result>, Multiply<Result>, Divide<Result>,
           Power<Result>, RealToIntPower<Result>, ComplexConstructor<KIND>>;
-  using Others = std::variant<Constant<Result>, DataReference<Result>,
+  using Others = std::variant<Constant<Result>, Designator<Result>,
       FunctionReference<Result>>;
 
 public:
@@ -530,20 +513,13 @@ class Expr<Type<TypeCategory::Character, KIND>>
 public:
   using Result = Type<TypeCategory::Character, KIND>;
   using IsFoldableTrait = std::true_type;
-  CLASS_BOILERPLATE(Expr)
+  EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
   explicit Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
   explicit Expr(Scalar<Result> &&x) : u{Constant<Result>{std::move(x)}} {}
-  template<typename A> explicit Expr(const A &x) : u{x} {}
-  template<typename A>
-  explicit Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
-    : u{std::move(x)} {}
-  template<typename A>
-  explicit Expr(CopyableIndirection<A> &&x) : u{std::move(x)} {}
 
   Expr<SubscriptInteger> LEN() const;
 
-  std::variant<Constant<Result>, DataReference<Result>,
-      CopyableIndirection<Substring>, FunctionReference<Result>,
+  std::variant<Constant<Result>, Designator<Result>, FunctionReference<Result>,
       // TODO Parentheses<Result>,
       Concat<KIND>, Extremum<Result>>
       u;
@@ -587,11 +563,7 @@ template<> class Relational<SomeType> {
 
 public:
   using Result = LogicalResult;
-  CLASS_BOILERPLATE(Relational)
-  template<typename A> explicit Relational(const A &x) : u(x) {}
-  template<typename A>
-  explicit Relational(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
-    : u{std::move(x)} {}
+  EVALUATE_UNION_CLASS_BOILERPLATE(Relational)
   std::ostream &Dump(std::ostream &o) const;
   common::MapTemplate<Relational, DirectlyComparableTypes> u;
 };
@@ -617,18 +589,14 @@ class Expr<Type<TypeCategory::Logical, KIND>>
 public:
   using Result = Type<TypeCategory::Logical, KIND>;
   using IsFoldableTrait = std::true_type;
-  CLASS_BOILERPLATE(Expr)
+  EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
   explicit Expr(const Scalar<Result> &x) : u{Constant<Result>{x}} {}
   explicit Expr(bool x) : u{Constant<Result>{x}} {}
-  template<typename A> explicit Expr(const A &x) : u(x) {}
-  template<typename A>
-  explicit Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
-    : u{std::move(x)} {}
 
 private:
   using Operations = std::variant<Convert<Result, TypeCategory::Logical>,
       Not<KIND>, LogicalOperation<KIND>, Relational<SomeType>>;
-  using Others = std::variant<Constant<Result>, DataReference<Result>,
+  using Others = std::variant<Constant<Result>, Designator<Result>,
       FunctionReference<Result>>;
 
 public:
@@ -640,22 +608,6 @@ extern template class Expr<Type<TypeCategory::Logical, 2>>;
 extern template class Expr<Type<TypeCategory::Logical, 4>>;
 extern template class Expr<Type<TypeCategory::Logical, 8>>;
 
-template<>
-class Expr<Type<TypeCategory::Derived>>
-  : public ExpressionBase<Type<TypeCategory::Derived>> {
-public:
-  using Result = Type<TypeCategory::Derived>;
-  using IsFoldableTrait = std::false_type;
-  CLASS_BOILERPLATE(Expr)
-  template<typename A>
-  explicit Expr(const Result &r, const A &x) : result{r}, u{x} {}
-  template<typename A>
-  explicit Expr(Result &&r, std::enable_if_t<!std::is_reference_v<A>, A> &&x)
-    : result{std::move(r)}, u{std::move(x)} {}
-  Result result;
-  std::variant<DataReference<Result>, FunctionReference<Result>> u;
-};
-
 // 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.
@@ -664,14 +616,24 @@ class Expr<SomeKind<CAT>> : public ExpressionBase<SomeKind<CAT>> {
 public:
   using Result = SomeKind<CAT>;
   using IsFoldableTrait = std::true_type;
+  EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
+  common::MapTemplate<Expr, CategoryTypes<CAT>> u;
+};
+
+template<> class Expr<SomeDerived> : public ExpressionBase<SomeDerived> {
+public:
+  using Result = SomeDerived;
+  using IsFoldableTrait = std::false_type;
   CLASS_BOILERPLATE(Expr)
 
-  template<typename A> explicit Expr(const A &x) : u{x} {}
   template<typename A>
-  explicit Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
-    : u{std::move(x)} {}
+  explicit Expr(const Result &r, const A &x) : result{r}, u{x} {}
+  template<typename A>
+  explicit Expr(Result &&r, std::enable_if_t<!std::is_reference_v<A>, A> &&x)
+    : result{std::move(r)}, u{std::move(x)} {}
 
-  common::MapTemplate<Expr, CategoryTypes<CAT>> u;
+  Result result;
+  std::variant<Designator<Result>, FunctionReference<Result>> u;
 };
 
 // A completely generic expression, polymorphic across all of the intrinsic type
@@ -680,18 +642,13 @@ template<> class Expr<SomeType> : public ExpressionBase<SomeType> {
 public:
   using Result = SomeType;
   using IsFoldableTrait = std::true_type;
-  CLASS_BOILERPLATE(Expr)
+  EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
 
   // Owning references to these generic expressions can appear in other
   // compiler data structures (viz., the parse tree and symbol table), so
   // its destructor is externalized to reduce redundant default instances.
   ~Expr();
 
-  template<typename A> explicit Expr(const A &x) : u{x} {}
-  template<typename A>
-  explicit Expr(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
-    : u{std::move(x)} {}
-
   template<TypeCategory CAT, int KIND>
   explicit Expr(const Expr<Type<CAT, KIND>> &x) : u{Expr<SomeKind<CAT>>{x}} {}
 
@@ -711,9 +668,11 @@ public:
     return *this;
   }
 
-  using Others =
-      std::variant<BOZLiteralConstant, Expr<Type<TypeCategory::Derived>>>;
+private:
+  using Others = std::variant<BOZLiteralConstant>;
   using Categories = common::MapTemplate<Expr, SomeCategory>;
+
+public:
   common::CombineVariants<Others, Categories> u;
 };
 
index 45fdb74..414a124 100644 (file)
@@ -342,7 +342,7 @@ std::optional<Expr<SomeType>> Negation(
             messages.Say("LOGICAL cannot be negated"_err_en_US);
             return NoExpr();
           },
-          [&](Expr<Type<TypeCategory::Derived>> &&x) {
+          [&](Expr<SomeDerived> &&x) {
             // TODO: defined operator
             messages.Say("derived type cannot be negated"_err_en_US);
             return NoExpr();
index afab368..ba0453f 100644 (file)
@@ -31,9 +31,14 @@ template<typename A> Expr<ResultType<A>> AsExpr(A &&x) {
   return Expr<ResultType<A>>{std::move(x)};
 }
 
-template<TypeCategory CAT, int KIND>
-Expr<SomeKind<CAT>> AsCategoryExpr(Expr<Type<CAT, KIND>> &&x) {
-  return Expr<SomeKind<CAT>>{std::move(x)};
+template<TypeCategory CAT>
+Expr<SomeKind<CAT>> AsCategoryExpr(Expr<SomeKind<CAT>> &&x) {
+  return std::move(x);
+}
+
+template<typename A>
+Expr<SomeKind<ResultType<A>::category>> AsCategoryExpr(A &&x) {
+  return Expr<SomeKind<ResultType<A>::category>>{AsExpr(std::move(x))};
 }
 
 template<TypeCategory CAT>
@@ -41,26 +46,28 @@ Expr<SomeKind<CAT>> AsCategoryExpr(SomeKindScalar<CAT> &&x) {
   return std::visit(
       [](auto &&scalar) {
         using Ty = TypeOf<std::decay_t<decltype(scalar)>>;
-        return Expr<SomeKind<CAT>>{Expr<Ty>{Constant<Ty>{std::move(scalar)}}};
+        return AsCategoryExpr(Constant<Ty>{std::move(scalar)});
       },
       x.u);
 }
 
 template<typename A> Expr<SomeType> AsGenericExpr(A &&x) {
-  return Expr<SomeType>{std::move(x)};
+  return Expr<SomeType>{AsCategoryExpr(std::move(x))};
 }
 
-template<TypeCategory CAT, int KIND>
-Expr<SomeType> AsGenericExpr(Expr<Type<CAT, KIND>> &&x) {
-  return Expr<SomeType>{AsCategoryExpr(std::move(x))};
+template<> inline Expr<SomeType> AsGenericExpr(Expr<SomeType> &&x) {
+  return std::move(x);
+}
+
+template<> inline Expr<SomeType> AsGenericExpr(BOZLiteralConstant &&x) {
+  return Expr<SomeType>{std::move(x)};
 }
 
 template<> inline Expr<SomeType> AsGenericExpr(Constant<SomeType> &&x) {
   return std::visit(
       [](auto &&scalar) {
         using Ty = TypeOf<std::decay_t<decltype(scalar)>>;
-        return Expr<SomeType>{Expr<SomeKind<Ty::category>>{
-            Expr<Ty>{Constant<Ty>{std::move(scalar)}}}};
+        return AsGenericExpr(Constant<Ty>{std::move(scalar)});
       },
       x.value.u);
 }
@@ -69,8 +76,7 @@ template<> inline Expr<SomeType> AsGenericExpr(GenericScalar &&x) {
   return std::visit(
       [](auto &&scalar) {
         using Ty = TypeOf<std::decay_t<decltype(scalar)>>;
-        return Expr<SomeType>{Expr<SomeKind<Ty::category>>{
-            Expr<Ty>{Constant<Ty>{std::move(scalar)}}}};
+        return AsGenericExpr(Constant<Ty>{std::move(scalar)});
       },
       x.u);
 }
@@ -81,8 +87,7 @@ Expr<SomeReal> GetComplexPart(
 template<int KIND>
 Expr<SomeComplex> MakeComplex(Expr<Type<TypeCategory::Real, KIND>> &&re,
     Expr<Type<TypeCategory::Real, KIND>> &&im) {
-  return AsCategoryExpr(
-      AsExpr(ComplexConstructor<KIND>{std::move(re), std::move(im)}));
+  return AsCategoryExpr(ComplexConstructor<KIND>{std::move(re), std::move(im)});
 }
 
 // Creation of conversion expressions can be done to either a known
@@ -405,8 +410,7 @@ struct TypeKindVisitor {
   template<std::size_t J> Result Test() {
     using Ty = std::tuple_element_t<J, CategoryTypes<CAT>>;
     if (kind == Ty::kind) {
-      return AsGenericExpr(
-          AsCategoryExpr(AsExpr(TEMPLATE<Ty>{std::move(value)})));
+      return AsGenericExpr(TEMPLATE<Ty>{std::move(value)});
     }
     return std::nullopt;
   }
index 2ee4db5..5a05752 100644 (file)
@@ -19,7 +19,7 @@
 using namespace std::literals::string_literals;
 
 namespace Fortran::evaluate {
-std::string Type<TypeCategory::Derived>::Dump() const {
+std::string SomeDerived::Dump() const {
   return "TYPE("s + spec().name().ToString() + ')';
 }
 }  // namespace Fortran::evaluate
index 746c39e..69915b1 100644 (file)
@@ -133,24 +133,6 @@ public:
   using Scalar = value::Logical<8 * KIND>;
 };
 
-template<> class Type<TypeCategory::Derived> {
-public:
-  static constexpr bool isSpecificType{true};
-  static constexpr TypeCategory category{TypeCategory::Derived};
-  using Scalar = void;
-
-  CLASS_BOILERPLATE(Type)
-  explicit Type(const semantics::DerivedTypeSpec &s) : spec_{&s} {}
-
-  const semantics::DerivedTypeSpec &spec() const { return *spec_; }
-  std::string Dump() const;
-
-private:
-  // This member should be a reference, except that copy construction
-  // and assignment would not be possible.
-  const semantics::DerivedTypeSpec *spec_;
-};
-
 // Type functions
 
 template<typename T> using Scalar = typename std::decay_t<T>::Scalar;
@@ -201,6 +183,9 @@ template<> struct CategoryTypesHelper<TypeCategory::Character> {
 template<> struct CategoryTypesHelper<TypeCategory::Logical> {
   using type = CategoryTypesTuple<TypeCategory::Logical, 1, 2, 4, 8>;
 };
+template<> struct CategoryTypesHelper<TypeCategory::Derived> {
+  using type = std::tuple<>;
+};
 template<TypeCategory CATEGORY>
 using CategoryTypes = typename CategoryTypesHelper<CATEGORY>::type;
 
@@ -294,15 +279,32 @@ template<TypeCategory CATEGORY> struct SomeKind {
   using Scalar = SomeKindScalar<category>;
 };
 
+template<> class SomeKind<TypeCategory::Derived> {
+public:
+  static constexpr bool isSpecificType{true};
+  static constexpr TypeCategory category{TypeCategory::Derived};
+  using Scalar = void;
+
+  CLASS_BOILERPLATE(SomeKind)
+  explicit SomeKind(const semantics::DerivedTypeSpec &s) : spec_{&s} {}
+
+  const semantics::DerivedTypeSpec &spec() const { return *spec_; }
+  std::string Dump() const;
+
+private:
+  const semantics::DerivedTypeSpec *spec_;
+};
+
 using SomeInteger = SomeKind<TypeCategory::Integer>;
 using SomeReal = SomeKind<TypeCategory::Real>;
 using SomeComplex = SomeKind<TypeCategory::Complex>;
 using SomeCharacter = SomeKind<TypeCategory::Character>;
 using SomeLogical = SomeKind<TypeCategory::Logical>;
+using SomeDerived = SomeKind<TypeCategory::Derived>;
 
 // Represents a completely generic intrinsic type.
-using SomeCategory =
-    std::tuple<SomeInteger, SomeReal, SomeComplex, SomeCharacter, SomeLogical>;
+using SomeCategory = std::tuple<SomeInteger, SomeReal, SomeComplex,
+    SomeCharacter, SomeLogical, SomeDerived>;
 struct SomeType {
   static constexpr bool isSpecificType{false};
   using Scalar = GenericScalar;
index 81cf416..389fadd 100644 (file)
@@ -244,12 +244,12 @@ std::ostream &Triplet::Dump(std::ostream &o) const {
   return o;
 }
 
-std::ostream &Subscript::Dump(std::ostream &o) const { return Emit(o, u_); }
+std::ostream &Subscript::Dump(std::ostream &o) const { return Emit(o, u); }
 
 std::ostream &ArrayRef::Dump(std::ostream &o) const {
-  Emit(o, u_);
+  Emit(o, u);
   char separator{'('};
-  for (const Subscript &ss : subscript_) {
+  for (const Subscript &ss : subscript) {
     ss.Dump(o << separator);
     separator = ',';
   }
@@ -283,7 +283,7 @@ std::ostream &CoarrayRef::Dump(std::ostream &o) const {
   return o << ']';
 }
 
-std::ostream &DataRef::Dump(std::ostream &o) const { return Emit(o, u_); }
+std::ostream &DataRef::Dump(std::ostream &o) const { return Emit(o, u); }
 
 std::ostream &Substring::Dump(std::ostream &o) const {
   Emit(o, u_) << '(';
@@ -295,10 +295,8 @@ std::ostream &ComplexPart::Dump(std::ostream &o) const {
   return complex_.Dump(o) << '%' << EnumToString(part_);
 }
 
-std::ostream &Designator::Dump(std::ostream &o) const { return Emit(o, u_); }
-
 std::ostream &ProcedureDesignator::Dump(std::ostream &o) const {
-  return Emit(o, u_);
+  return Emit(o, u);
 }
 
 template<typename ARG>
@@ -315,13 +313,13 @@ std::ostream &ProcedureRef<ARG>::Dump(std::ostream &o) const {
   return o << ')';
 }
 
-std::ostream &Variable::Dump(std::ostream &o) const { return Emit(o, u_); }
+std::ostream &Variable::Dump(std::ostream &o) const { return Emit(o, u); }
 
 std::ostream &ActualFunctionArg::Dump(std::ostream &o) const {
-  return Emit(o, u_);
+  return Emit(o, u);
 }
 std::ostream &ActualSubroutineArg::Dump(std::ostream &o) const {
-  return Emit(o, u_);
+  return Emit(o, u);
 }
 
 std::ostream &Label::Dump(std::ostream &o) const {
@@ -337,7 +335,7 @@ Expr<SubscriptInteger> ArrayRef::LEN() const {
   return std::visit(
       common::visitors{[](const Symbol *s) { return SymbolLEN(*s); },
           [](const Component &x) { return x.LEN(); }},
-      u_);
+      u);
 }
 Expr<SubscriptInteger> CoarrayRef::LEN() const {
   return SymbolLEN(*base_.back());
@@ -346,13 +344,20 @@ Expr<SubscriptInteger> DataRef::LEN() const {
   return std::visit(
       common::visitors{[](const Symbol *s) { return SymbolLEN(*s); },
           [](const auto &x) { return x.LEN(); }},
-      u_);
+      u);
 }
 Expr<SubscriptInteger> Substring::LEN() const {
   return AsExpr(
       Extremum<SubscriptInteger>{AsExpr(Constant<SubscriptInteger>{0}),
           last() - first() + AsExpr(Constant<SubscriptInteger>{1})});
 }
+template<typename A> Expr<SubscriptInteger> Designator<A>::LEN() const {
+  return std::visit(
+      common::visitors{[](const Symbol *s) { return SymbolLEN(*s); },
+          [](const Component &c) { return c.LEN(); },
+          [](const auto &x) { return x.LEN(); }},
+      u);
+}
 Expr<SubscriptInteger> ProcedureDesignator::LEN() const {
   return std::visit(
       common::visitors{[](const Symbol *s) { return SymbolLEN(*s); },
@@ -361,7 +366,10 @@ Expr<SubscriptInteger> ProcedureDesignator::LEN() const {
             CRASH_NO_CASE;
             return AsExpr(Constant<SubscriptInteger>{0});
           }},
-      u_);
+      u);
 }
 
+template class Designator<Type<TypeCategory::Character, 1>>;
+template class Designator<Type<TypeCategory::Character, 2>>;
+template class Designator<Type<TypeCategory::Character, 4>>;
 }  // namespace Fortran::evaluate
index b5e6c16..c70b91e 100644 (file)
@@ -25,6 +25,7 @@
 #include "intrinsics.h"
 #include "type.h"
 #include "../common/idioms.h"
+#include "../lib/common/template.h"
 #include "../semantics/symbol.h"
 #include <optional>
 #include <ostream>
@@ -37,9 +38,9 @@ using semantics::Symbol;
 
 // Forward declarations
 template<typename A> class Expr;
-class DataRef;
-class Variable;
-class ActualFunctionArg;
+struct DataRef;
+struct Variable;
+struct ActualFunctionArg;
 
 // Subscript and cosubscript expressions are of a kind that matches the
 // address size, at least at the top level.
@@ -58,6 +59,7 @@ public:
   Component(DataRef &&b, const Symbol &c) : base_{std::move(b)}, symbol_{&c} {}
   Component(CopyableIndirection<DataRef> &&b, const Symbol &c)
     : base_{std::move(b)}, symbol_{&c} {}
+
   const DataRef &base() const { return *base_; }
   DataRef &base() { return *base_; }
   const Symbol &symbol() const { return *symbol_; }
@@ -86,19 +88,12 @@ private:
 };
 
 // R919 subscript when rank 0, R923 vector-subscript when rank 1
-class Subscript {
-public:
-  CLASS_BOILERPLATE(Subscript)
-  explicit Subscript(const Expr<SubscriptInteger> &s)
-    : u_{IndirectSubscriptIntegerExpr::Make(s)} {}
+struct Subscript {
+  EVALUATE_UNION_CLASS_BOILERPLATE(Subscript)
   explicit Subscript(Expr<SubscriptInteger> &&s)
-    : u_{IndirectSubscriptIntegerExpr::Make(std::move(s))} {}
-  explicit Subscript(const Triplet &t) : u_{t} {}
-  explicit Subscript(Triplet &&t) : u_{std::move(t)} {}
+    : u{IndirectSubscriptIntegerExpr::Make(std::move(s))} {}
   std::ostream &Dump(std::ostream &) const;
-
-private:
-  std::variant<IndirectSubscriptIntegerExpr, Triplet> u_;
+  std::variant<IndirectSubscriptIntegerExpr, Triplet> u;
 };
 
 // R917 array-element, R918 array-section; however, the case of an
@@ -106,19 +101,17 @@ private:
 // as a ComplexPart instead.  C919 & C925 require that at most one set of
 // subscripts have rank greater than 0, but that is not explicit in
 // these types.
-class ArrayRef {
-public:
+struct ArrayRef {
   CLASS_BOILERPLATE(ArrayRef)
   ArrayRef(const Symbol &n, std::vector<Subscript> &&ss)
-    : u_{&n}, subscript_(std::move(ss)) {}
+    : u{&n}, subscript(std::move(ss)) {}
   ArrayRef(Component &&c, std::vector<Subscript> &&ss)
-    : u_{std::move(c)}, subscript_(std::move(ss)) {}
+    : u{std::move(c)}, subscript(std::move(ss)) {}
   Expr<SubscriptInteger> LEN() const;
   std::ostream &Dump(std::ostream &) const;
 
-private:
-  std::variant<const Symbol *, Component> u_;
-  std::vector<Subscript> subscript_;
+  std::variant<const Symbol *, Component> u;
+  std::vector<Subscript> subscript;
 };
 
 // R914 coindexed-named-object
@@ -151,18 +144,13 @@ private:
 // possible outcomes are spelled out.  Note that a data-ref cannot include
 // a terminal substring range or complex component designator; use
 // R901 designator for that.
-class DataRef {
-public:
-  CLASS_BOILERPLATE(DataRef)
-  explicit DataRef(const Symbol &n) : u_{&n} {}
-  explicit DataRef(Component &&c) : u_{std::move(c)} {}
-  explicit DataRef(ArrayRef &&a) : u_{std::move(a)} {}
-  explicit DataRef(CoarrayRef &&a) : u_{std::move(a)} {}
+struct DataRef {
+  EVALUATE_UNION_CLASS_BOILERPLATE(DataRef)
+  explicit DataRef(const Symbol &n) : u{&n} {}
   Expr<SubscriptInteger> LEN() const;
   std::ostream &Dump(std::ostream &) const;
 
-private:
-  std::variant<const Symbol *, Component, ArrayRef, CoarrayRef> u_;
+  std::variant<const Symbol *, Component, ArrayRef, CoarrayRef> u;
 };
 
 // R908 substring, R909 parent-string, R910 substring-range.
@@ -208,31 +196,55 @@ private:
 };
 
 // R901 designator is the most general data reference object, apart from
-// calls to pointer-valued functions.
-class Designator {
+// calls to pointer-valued functions.  Its variant holds everything that
+// a DataRef can, and (when appropriate) a substring or complex part.
+template<typename A> class Designator {
+  using DataRefs = decltype(DataRef::u);
+  using MaybeSubstring =
+      std::conditional_t<A::category == TypeCategory::Character,
+          std::variant<Substring>, std::variant<>>;
+  using MaybeComplexPart = std::conditional_t<A::category == TypeCategory::Real,
+      std::variant<ComplexPart>, std::variant<>>;
+  using Variant =
+      common::CombineVariants<DataRefs, MaybeSubstring, MaybeComplexPart>;
+
 public:
-  CLASS_BOILERPLATE(Designator)
-  explicit Designator(DataRef &&d) : u_{std::move(d)} {}
-  explicit Designator(Substring &&s) : u_{std::move(s)} {}
-  explicit Designator(ComplexPart &&c) : u_{std::move(c)} {}
-  std::ostream &Dump(std::ostream &) const;
+  using Result = A;
+  static_assert(Result::isSpecificType);
+  EVALUATE_UNION_CLASS_BOILERPLATE(Designator)
+  explicit Designator(DataRef &&that)
+    : u{common::MoveVariant<Variant>(std::move(that.u))} {}
+  Designator &operator=(DataRef &&that) {
+    *this = Designator{std::move(that)};
+    return *this;
+  }
 
-private:
-  std::variant<DataRef, Substring, ComplexPart> u_;
+  Expr<SubscriptInteger> LEN() const;
+  std::ostream &Dump(std::ostream &o) const {
+    std::visit(common::visitors{[&](const Symbol *sym) {
+                                  o << sym->name().ToString();
+                                },
+                   [&](const auto &x) { x.Dump(o); }},
+        u);
+    return o;
+  }
+
+  Variant u;
 };
 
-class ProcedureDesignator {
-public:
-  CLASS_BOILERPLATE(ProcedureDesignator)
-  explicit ProcedureDesignator(IntrinsicProcedure p) : u_{p} {}
-  explicit ProcedureDesignator(const Symbol &n) : u_{&n} {}
-  explicit ProcedureDesignator(const Component &c) : u_{c} {}
-  explicit ProcedureDesignator(Component &&c) : u_{std::move(c)} {}
+extern template class Designator<Type<TypeCategory::Character, 1>>;
+extern template class Designator<Type<TypeCategory::Character, 2>>;
+extern template class Designator<Type<TypeCategory::Character, 4>>;
+
+struct ProcedureDesignator {
+  EVALUATE_UNION_CLASS_BOILERPLATE(ProcedureDesignator)
+  explicit ProcedureDesignator(IntrinsicProcedure p) : u{p} {}
+  explicit ProcedureDesignator(const Symbol &n) : u{&n} {}
   Expr<SubscriptInteger> LEN() const;
   std::ostream &Dump(std::ostream &) const;
 
 private:
-  std::variant<IntrinsicProcedure, const Symbol *, Component> u_;
+  std::variant<IntrinsicProcedure, const Symbol *, Component> u;
 };
 
 template<typename ARG> class ProcedureRef {
@@ -252,26 +264,18 @@ private:
 
 using FunctionRef = ProcedureRef<ActualFunctionArg>;
 
-class Variable {
-public:
-  CLASS_BOILERPLATE(Variable)
-  explicit Variable(Designator &&d) : u_{std::move(d)} {}
-  explicit Variable(FunctionRef &&p) : u_{std::move(p)} {}
+struct Variable {
+  EVALUATE_UNION_CLASS_BOILERPLATE(Variable)
   std::ostream &Dump(std::ostream &) const;
-
-private:
-  std::variant<Designator, FunctionRef> u_;
+  std::variant<DataRef, Substring, ComplexPart, FunctionRef> u;
 };
 
-class ActualFunctionArg {
-public:
-  CLASS_BOILERPLATE(ActualFunctionArg)
-  explicit ActualFunctionArg(Expr<SomeType> &&x) : u_{std::move(x)} {}
-  explicit ActualFunctionArg(Variable &&x) : u_{std::move(x)} {}
+struct ActualFunctionArg {
+  EVALUATE_UNION_CLASS_BOILERPLATE(ActualFunctionArg)
+  explicit ActualFunctionArg(Expr<SomeType> &&x) : u{std::move(x)} {}
   std::ostream &Dump(std::ostream &) const;
 
-private:
-  std::variant<CopyableIndirection<Expr<SomeType>>, Variable> u_;
+  std::variant<CopyableIndirection<Expr<SomeType>>, Variable> u;
 };
 
 struct Label {  // TODO: this is a placeholder
@@ -283,14 +287,18 @@ struct Label {  // TODO: this is a placeholder
 
 class ActualSubroutineArg {
 public:
-  CLASS_BOILERPLATE(ActualSubroutineArg)
-  explicit ActualSubroutineArg(Expr<SomeType> &&x) : u_{std::move(x)} {}
-  explicit ActualSubroutineArg(Variable &&x) : u_{std::move(x)} {}
-  explicit ActualSubroutineArg(const Label &l) : u_{&l} {}
+  EVALUATE_UNION_CLASS_BOILERPLATE(ActualSubroutineArg)
+  explicit ActualSubroutineArg(Expr<SomeType> &&x) : u{std::move(x)} {}
+  explicit ActualSubroutineArg(const Label &l) : u{&l} {}
   std::ostream &Dump(std::ostream &) const;
 
 private:
-  std::variant<CopyableIndirection<Expr<SomeType>>, Variable, const Label *> u_;
+  using Variables = decltype(Variable::u);
+  using Others =
+      std::variant<CopyableIndirection<Expr<SomeType>>, const Label *>;
+
+public:
+  common::CombineVariants<Variables, Others> u;
 };
 
 using SubroutineRef = ProcedureRef<ActualSubroutineArg>;
index d659624..b3da6bc 100644 (file)
@@ -1488,14 +1488,6 @@ TYPE_PARSER(construct<PartRef>(name,
 TYPE_PARSER(construct<StructureComponent>(
     construct<DataRef>(some(Parser<PartRef>{} / percentOrDot)), name))
 
-// R915 complex-part-designator -> designator % RE | designator % IM
-// %RE and %IM are initially recognized as structure components.
-constexpr auto complexPartDesignator{construct<ComplexPartDesignator>(dataRef)};
-
-// R916 type-param-inquiry -> designator % type-param-name
-// Type parameter inquiries are initially recognized as structure components.
-TYPE_PARSER(construct<TypeParamInquiry>(structureComponent))
-
 // R919 subscript -> scalar-int-expr
 constexpr auto subscript{scalarIntExpr};
 
@@ -1612,6 +1604,7 @@ TYPE_PARSER(construct<StatOrErrmsg>("STAT =" >> statVariable) ||
 //         literal-constant | designator | array-constructor |
 //         structure-constructor | function-reference | type-param-inquiry |
 //         type-param-name | ( expr )
+// N.B. type-param-inquiry is parsed as a structure component
 constexpr auto primary{instrumented("primary"_en_US,
     first(construct<Expr>(indirect(Parser<CharLiteralConstantSubstring>{})),
         construct<Expr>(literalConstant),
@@ -1620,7 +1613,6 @@ constexpr auto primary{instrumented("primary"_en_US,
         construct<Expr>(designator / !"("_tok),
         construct<Expr>(Parser<StructureConstructor>{}),
         construct<Expr>(Parser<ArrayConstructor>{}),
-        construct<Expr>(indirect(Parser<TypeParamInquiry>{})),  // occulted
         // PGI/XLF extension: COMPLEX constructor (x,y)
         extension<LanguageFeature::ComplexConstructor>(
             construct<Expr>(parenthesized(
@@ -3476,6 +3468,10 @@ TYPE_CONTEXT_PARSER("PAUSE statement"_en_US,
 //     is used only via scalar-default-char-variable
 //   R907 int-variable -> variable
 //     is used only via scalar-int-variable
+//   R915 complex-part-designator -> designator % RE | designator % IM
+//     %RE and %IM are initially recognized as structure components
+//   R916 type-param-inquiry -> designator % type-param-name
+//     is occulted by structure component designators
 //   R918 array-section ->
 //        data-ref [( substring-range )] | complex-part-designator
 //     is not used because parsing is not sensitive to rank
index 6368e28..7a3f171 100644 (file)
@@ -253,6 +253,12 @@ public:
     }
   }
 
+  template<typename... A> void Say(const CharBlock &at, A &&... args) {
+    if (messages_ != nullptr) {
+      messages_->Say(at, std::forward<A>(args)...);
+    }
+  }
+
 private:
   CharBlock at_;
   Messages *messages_{nullptr};
index 35b393b..7ca6595 100644 (file)
@@ -184,7 +184,6 @@ struct CharLiteralConstantSubstring;
 struct DataRef;  // R911
 struct StructureComponent;  // R913
 struct CoindexedNamedObject;  // R914
-struct TypeParamInquiry;  // R916
 struct ArrayElement;  // R917
 struct AllocateStmt;  // R927
 struct NullifyStmt;  // R939
@@ -1700,11 +1699,10 @@ struct Expr {
 
   std::variant<common::Indirection<CharLiteralConstantSubstring>,
       LiteralConstant, common::Indirection<Designator>, ArrayConstructor,
-      StructureConstructor, common::Indirection<TypeParamInquiry>,
-      common::Indirection<FunctionReference>, Parentheses, UnaryPlus, Negate,
-      NOT, PercentLoc, DefinedUnary, Power, Multiply, Divide, Add, Subtract,
-      Concat, LT, LE, EQ, NE, GE, GT, AND, OR, EQV, NEQV, XOR, DefinedBinary,
-      ComplexConstructor>
+      StructureConstructor, common::Indirection<FunctionReference>, Parentheses,
+      UnaryPlus, Negate, NOT, PercentLoc, DefinedUnary, Power, Multiply, Divide,
+      Add, Subtract, Concat, LT, LE, EQ, NE, GE, GT, AND, OR, EQV, NEQV, XOR,
+      DefinedBinary, ComplexConstructor>
       u;
 };
 
@@ -1804,16 +1802,6 @@ struct CoindexedNamedObject {
   ImageSelector imageSelector;
 };
 
-// R915 complex-part-designator -> designator % RE | designator % IM
-struct ComplexPartDesignator {
-  WRAPPER_CLASS_BOILERPLATE(ComplexPartDesignator, StructureComponent);
-};
-
-// R916 type-param-inquiry -> designator % type-param-name
-struct TypeParamInquiry {
-  WRAPPER_CLASS_BOILERPLATE(TypeParamInquiry, StructureComponent);
-};
-
 // R917 array-element -> data-ref
 struct ArrayElement {
   BOILERPLATE(ArrayElement);
index bd9261c..9c2e53d 100644 (file)
@@ -687,7 +687,6 @@ public:
   NODE(parser, TypeParamDecl)
   NODE(parser, TypeParamDefStmt)
   NODE(common, TypeParamAttr)
-  NODE(parser, TypeParamInquiry)
   NODE(parser, TypeParamSpec)
   NODE(parser, TypeParamValue)
   NODE(parser::TypeParamValue, Deferred)
index adbb24b..4f24b12 100644 (file)
@@ -37,25 +37,12 @@ using MaybeExpr = std::optional<Expr<SomeType>>;
 
 // A utility subroutine to repackage optional expressions of various levels
 // of type specificity as fully general MaybeExpr values.
-template<typename A> MaybeExpr AsMaybeExpr(std::optional<A> &&x) {
-  if (x.has_value()) {
-    return {AsGenericExpr(AsCategoryExpr(AsExpr(std::move(*x))))};
-  }
-  return std::nullopt;
-}
-
-template<TypeCategory CAT>
-MaybeExpr AsMaybeExpr(std::optional<Expr<SomeKind<CAT>>> &&x) {
-  if (x.has_value()) {
-    return {AsGenericExpr(std::move(*x))};
-  }
-  return std::nullopt;
+template<typename A> MaybeExpr AsMaybeExpr(A &&x) {
+  return std::make_optional(AsGenericExpr(std::move(x)));
 }
-
-template<TypeCategory CAT, int KIND>
-MaybeExpr AsMaybeExpr(std::optional<Expr<Type<CAT, KIND>>> &&x) {
+template<typename A> MaybeExpr AsMaybeExpr(std::optional<A> &&x) {
   if (x.has_value()) {
-    return {AsGenericExpr(AsCategoryExpr(std::move(*x)))};
+    return AsMaybeExpr(std::move(*x));
   }
   return std::nullopt;
 }
@@ -75,6 +62,7 @@ struct ExprAnalyzer {
   MaybeExpr Analyze(const parser::SignedIntLiteralConstant &);
   MaybeExpr Analyze(const parser::RealLiteralConstant &);
   MaybeExpr Analyze(const parser::SignedRealLiteralConstant &);
+  MaybeExpr Analyze(const parser::ComplexPart &);
   MaybeExpr Analyze(const parser::ComplexLiteralConstant &);
   MaybeExpr Analyze(const parser::CharLiteralConstant &);
   MaybeExpr Analyze(const parser::LogicalLiteralConstant &);
@@ -85,9 +73,7 @@ struct ExprAnalyzer {
   MaybeExpr Analyze(const parser::Substring &);
   MaybeExpr Analyze(const parser::ArrayElement &);
   MaybeExpr Analyze(const parser::StructureComponent &);
-  MaybeExpr Analyze(const parser::TypeParamInquiry &);
   MaybeExpr Analyze(const parser::CoindexedNamedObject &);
-  MaybeExpr Analyze(const parser::ComplexPart &);
   MaybeExpr Analyze(const parser::ArrayConstructor &);
   MaybeExpr Analyze(const parser::StructureConstructor &);
   MaybeExpr Analyze(const parser::Expr::Parentheses &);
@@ -396,22 +382,21 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::BOZLiteralConstant &x) {
     context.messages.Say("BOZ literal %s too large"_err_en_US, x.v.data());
     return std::nullopt;
   }
-  return {AsGenericExpr(value.value)};
+  return {AsGenericExpr(std::move(value.value))};
 }
 
 template<TypeCategory CATEGORY>
 MaybeExpr TypedDataRefHelper(int kind, DataRef &&dataRef) {
   return common::SearchDynamicTypes(
-      TypeKindVisitor<CATEGORY, DataReference, DataRef>{
-          kind, std::move(dataRef)});
+      TypeKindVisitor<CATEGORY, Designator, DataRef>{kind, std::move(dataRef)});
 }
 
 static MaybeExpr TypedDataRef(
     const semantics::Symbol &symbol, DataRef &&dataRef) {
   if (auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     if (details->type().has_value()) {
-      if (details->type()->category() ==
-          semantics::DeclTypeSpec::Category::Intrinsic) {
+      switch (details->type()->category()) {
+      case semantics::DeclTypeSpec::Category::Intrinsic: {
         TypeCategory category{details->type()->intrinsicTypeSpec().category()};
         int kind{details->type()->intrinsicTypeSpec().kind()};
         switch (category) {
@@ -432,6 +417,16 @@ static MaybeExpr TypedDataRef(
               kind, std::move(dataRef));
         default: CRASH_NO_CASE;
         }
+      } break;
+      case semantics::DeclTypeSpec::Category::TypeDerived:
+      case semantics::DeclTypeSpec::Category::ClassDerived:
+        return AsGenericExpr(
+            Expr<SomeDerived>{SomeDerived{details->type()->derivedTypeSpec()},
+                Designator<SomeDerived>{std::move(dataRef)}});
+        break;
+      default:
+        // TODO: graceful errors on CLASS(*) and TYPE(*) misusage
+        break;
       }
     }
   }
@@ -442,8 +437,7 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::Name &n) {
   if (n.symbol == nullptr) {
     // TODO: convert this to a CHECK later
     context.messages.Say(
-        "TODO: name '%s' is not resolved to an object"_err_en_US,
-        n.ToString().data());
+        n.source, "name was not resolved to a symbol"_err_en_US);
   } else if (n.symbol->attrs().test(semantics::Attr::PARAMETER)) {
     context.messages.Say(
         "TODO: PARAMETER references not yet implemented"_err_en_US);
@@ -452,8 +446,8 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::Name &n) {
     if (MaybeExpr result{TypedDataRef(*n.symbol, DataRef{*n.symbol})}) {
       return result;
     }
-    context.messages.Say("'%s' is not of a supported type and kind"_err_en_US,
-        n.ToString().data());
+    context.messages.Say(
+        n.source, "not of a supported type and kind"_err_en_US);
   }
   return std::nullopt;
 }
@@ -463,14 +457,13 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::NamedConstant &n) {
     if (std::optional<Constant<SomeType>> folded{value->Fold(context)}) {
       return {AsGenericExpr(std::move(*folded))};
     }
-    context.messages.Say(
-        "'%s' must be a constant"_err_en_US, n.v.ToString().data());
+    context.messages.Say(n.v.source, "must be a constant"_err_en_US);
   }
   return std::nullopt;
 }
 
 MaybeExpr ExprAnalyzer::Analyze(const parser::Substring &ss) {
-  context.messages.Say("TODO: Substring unimplemented\n"_err_en_US);
+  context.messages.Say("TODO: Substring unimplemented"_err_en_US);
   return std::nullopt;
 }
 
@@ -529,62 +522,147 @@ std::vector<Subscript> ExprAnalyzer::Analyze(
   return subscripts;
 }
 
-MaybeExpr ExprAnalyzer::Analyze(const parser::ArrayElement &ae) {
-  std::vector<Subscript> subscripts{Analyze(ae.subscripts)};
-  if (const parser::Name * name{std::get_if<parser::Name>(&ae.base.u)}) {
-    if (name->symbol == nullptr) {
-      // TODO: convert this to a CHECK later
-      context.messages.Say(
-          "TODO: name (%s) is not resolved to an object"_err_en_US,
-          name->ToString().data());
-    } else {
-      ArrayRef arrayRef{*name->symbol, std::move(subscripts)};
-      return TypedDataRef(*name->symbol, DataRef{std::move(arrayRef)});
-    }
-  } else if (const auto *component{
-                 std::get_if<common::Indirection<parser::StructureComponent>>(
-                     &ae.base.u)}) {
-    // pmk continue development here
+// If a generic expression represents a DataRef, convert it to one.
+// TODO: put in tools.h?
+template<typename A> std::optional<DataRef> AsDataRef(A &&) {
+  return std::nullopt;
+}
+
+template<TypeCategory CAT, int KIND>
+std::optional<DataRef> AsDataRef(Expr<Type<CAT, KIND>> &&expr) {
+  using Ty = ResultType<decltype(expr)>;
+  if (auto *designator{std::get_if<Designator<Ty>>(&expr.u)}) {
+    return std::visit(
+        [](auto &&x) -> std::optional<DataRef> {
+          using Ty = std::decay_t<decltype(x)>;
+          if constexpr (common::HasMember<Ty, decltype(DataRef::u)>) {
+            return {DataRef{std::move(x)}};
+          } else {
+            return std::nullopt;
+          }
+        },
+        std::move(designator->u));
   } else {
-    CHECK(!"parser::ArrayRef base DataRef is neither Name nor "
-           "StructureComponent");
+    return std::nullopt;
+  }
+}
+
+template<TypeCategory CAT>
+std::optional<DataRef> AsDataRef(Expr<SomeKind<CAT>> &&expr) {
+  return std::visit(
+      [](auto &&specificExpr) { return AsDataRef(std::move(specificExpr)); },
+      std::move(expr.u));
+}
+
+template<> std::optional<DataRef> AsDataRef(Expr<SomeType> &&expr) {
+  return std::visit(
+      common::visitors{[](BOZLiteralConstant &&) -> std::optional<DataRef> {
+                         return std::nullopt;
+                       },
+          [](auto &&catExpr) { return AsDataRef(std::move(catExpr)); }},
+      std::move(expr.u));
+}
+
+template<typename A> std::optional<DataRef> AsDataRef(std::optional<A> &&x) {
+  if (x.has_value()) {
+    return AsDataRef(std::move(*x));
   }
   return std::nullopt;
 }
 
-MaybeExpr ExprAnalyzer::Analyze(const parser::StructureComponent &sc) {
-  context.messages.Say("TODO: StructureComponent unimplemented\n"_err_en_US);
+MaybeExpr ExprAnalyzer::Analyze(const parser::ArrayElement &ae) {
+  std::vector<Subscript> subscripts{Analyze(ae.subscripts)};
+  if (MaybeExpr baseExpr{AnalyzeHelper(*this, ae.base)}) {
+    // TODO: check rank and subscript count
+    if (std::optional<DataRef> dataRef{AsDataRef(std::move(*baseExpr))}) {
+      if (const Symbol **symbol{std::get_if<const Symbol *>(&dataRef->u)}) {
+        ArrayRef arrayRef{**symbol, std::move(subscripts)};
+        return TypedDataRef(**symbol, DataRef{std::move(arrayRef)});
+      } else if (Component * component{std::get_if<Component>(&dataRef->u)}) {
+        ArrayRef arrayRef{std::move(*component), std::move(subscripts)};
+        return TypedDataRef(component->symbol(), DataRef{std::move(arrayRef)});
+      }
+    }
+  }
+  context.messages.Say(
+      "subscripts must be applied to an object or component"_err_en_US);
   return std::nullopt;
 }
 
-MaybeExpr ExprAnalyzer::Analyze(const parser::TypeParamInquiry &tpi) {
-  context.messages.Say("TODO: TypeParamInquiry unimplemented\n"_err_en_US);
+MaybeExpr ExprAnalyzer::Analyze(const parser::StructureComponent &sc) {
+  if (MaybeExpr base{AnalyzeHelper(*this, sc.base)}) {
+    if (auto *dtExpr{std::get_if<Expr<SomeDerived>>(&base->u)}) {
+      Symbol *sym{sc.component.symbol};
+      if (sym == nullptr) {
+        context.messages.Say(sc.component.source,
+            "component name was not resolved to a symbol"_err_en_US);
+      } else if (const auto *tpDetails{
+                     sym->detailsIf<semantics::TypeParamDetails>()}) {
+        context.messages.Say(sc.component.source,
+            "TODO: type parameter inquiry unimplemented"_err_en_US);
+      } else if (&sym->owner() != dtExpr->result.spec().scope()) {
+        // TODO: extended derived types - insert explicit reference to base?
+        context.messages.Say(sc.component.source,
+            "component is not in scope of derived TYPE(%s)"_err_en_US,
+            dtExpr->result.spec().name().ToString().data());
+      } else if (std::optional<DataRef> dataRef{
+                     AsDataRef(std::move(*dtExpr))}) {
+        Component component{std::move(*dataRef), *sym};
+        return TypedDataRef(*sym, DataRef{std::move(component)});
+      } else {
+        context.messages.Say(sc.component.source,
+            "base of component reference must be a data reference"_err_en_US);
+      }
+    } else if (auto *zExpr{std::get_if<Expr<SomeComplex>>(&base->u)}) {
+      ComplexPart::Part part{ComplexPart::Part::RE};
+      if (sc.component.source == parser::CharBlock{"im", 2}) {
+        part = ComplexPart::Part::IM;
+      } else if (sc.component.source != parser::CharBlock{"re", 2}) {
+        context.messages.Say(sc.component.source,
+            "component of complex value must be %%RE or %%IM"_err_en_US);
+        return std::nullopt;
+      }
+      if (std::optional<DataRef> dataRef{AsDataRef(std::move(*zExpr))}) {
+        Expr<SomeReal> realExpr{std::visit(
+            [&](const auto &z) {
+              using PartType = typename ResultType<decltype(z)>::Part;
+              return AsCategoryExpr(AsExpr(Designator<PartType>{
+                  ComplexPart{std::move(*dataRef), part}}));
+            },
+            zExpr->u)};
+        return {AsGenericExpr(std::move(realExpr))};
+      }
+    } else {
+      context.messages.Say("derived type required before '%%%s'"_err_en_US,
+          sc.component.ToString().data());
+    }
+  }
   return std::nullopt;
 }
 
 MaybeExpr ExprAnalyzer::Analyze(const parser::CoindexedNamedObject &co) {
-  context.messages.Say("TODO: CoindexedNamedObject unimplemented\n"_err_en_US);
+  context.messages.Say("TODO: CoindexedNamedObject unimplemented"_err_en_US);
   return std::nullopt;
 }
 
 MaybeExpr ExprAnalyzer::Analyze(const parser::CharLiteralConstantSubstring &) {
   context.messages.Say(
-      "TODO: CharLiteralConstantSubstring unimplemented\n"_err_en_US);
+      "TODO: CharLiteralConstantSubstring unimplemented"_err_en_US);
   return std::nullopt;
 }
 
 MaybeExpr ExprAnalyzer::Analyze(const parser::ArrayConstructor &) {
-  context.messages.Say("TODO: ArrayConstructor unimplemented\n"_err_en_US);
+  context.messages.Say("TODO: ArrayConstructor unimplemented"_err_en_US);
   return std::nullopt;
 }
 
 MaybeExpr ExprAnalyzer::Analyze(const parser::StructureConstructor &) {
-  context.messages.Say("TODO: StructureConstructor unimplemented\n"_err_en_US);
+  context.messages.Say("TODO: StructureConstructor unimplemented"_err_en_US);
   return std::nullopt;
 }
 
 MaybeExpr ExprAnalyzer::Analyze(const parser::FunctionReference &) {
-  context.messages.Say("TODO: FunctionReference unimplemented\n"_err_en_US);
+  context.messages.Say("TODO: FunctionReference unimplemented"_err_en_US);
   return std::nullopt;
 }
 
@@ -595,7 +673,7 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::Parentheses &x) {
             [&](BOZLiteralConstant &&boz) {
               return operand;  // ignore parentheses around typeless
             },
-            [&](Expr<Type<TypeCategory::Derived>> &&dte) { return operand; },
+            [&](Expr<SomeDerived> &&dte) { return operand; },
             [](auto &&catExpr) {
               return std::visit(
                   [](auto &&expr) -> MaybeExpr {
@@ -659,12 +737,12 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::NOT &x) {
 }
 
 MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::PercentLoc &) {
-  context.messages.Say("TODO: %LOC unimplemented\n"_err_en_US);
+  context.messages.Say("TODO: %LOC unimplemented"_err_en_US);
   return std::nullopt;
 }
 
 MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::DefinedUnary &) {
-  context.messages.Say("TODO: DefinedUnary unimplemented\n"_err_en_US);
+  context.messages.Say("TODO: DefinedUnary unimplemented"_err_en_US);
   return std::nullopt;
 }
 
@@ -818,7 +896,7 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::XOR &x) {
 }
 
 MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::DefinedBinary &) {
-  context.messages.Say("TODO: DefinedBinary unimplemented\n"_err_en_US);
+  context.messages.Say("TODO: DefinedBinary unimplemented"_err_en_US);
   return std::nullopt;
 }
 
index ca92e8e..3b4cfde 100644 (file)
@@ -211,6 +211,22 @@ std::string CompileFortran(std::string path, Fortran::parser::Options options,
     semantics.Perform(parseTree);
     auto &messages{semantics.messages()};
     messages.Emit(std::cerr, parsing.cooked());
+    if (driver.debugExpressions) {
+      // TODO: Move into semantics.Perform()
+      Fortran::parser::CharBlock whole{parsing.cooked().data()};
+      Fortran::parser::Messages messages;
+      Fortran::parser::ContextualMessages contextualMessages{whole, &messages};
+      Fortran::evaluate::FoldingContext context{contextualMessages};
+      Fortran::semantics::IntrinsicTypeDefaultKinds defaults;
+      Fortran::semantics::AnalyzeExpressions(parseTree, context, defaults);
+      messages.Emit(std::cerr, parsing.cooked());
+      if (!messages.empty() &&
+          (driver.warningsAreErrors || messages.AnyFatalError())) {
+        std::cerr << driver.prefix << "semantic errors in " << path << '\n';
+        exitStatus = EXIT_FAILURE;
+        return {};
+      }
+    }
     if (driver.dumpSymbols) {
       semantics.DumpSymbols(std::cout);
     }
@@ -226,21 +242,6 @@ std::string CompileFortran(std::string path, Fortran::parser::Options options,
       return {};
     }
   }
-  if (driver.debugExpressions) {
-    Fortran::parser::CharBlock whole{parsing.cooked().data()};
-    Fortran::parser::Messages messages;
-    Fortran::parser::ContextualMessages contextualMessages{whole, &messages};
-    Fortran::evaluate::FoldingContext context{contextualMessages};
-    Fortran::semantics::IntrinsicTypeDefaultKinds defaults;
-    Fortran::semantics::AnalyzeExpressions(parseTree, context, defaults);
-    messages.Emit(std::cerr, parsing.cooked());
-    if (!messages.empty() &&
-        (driver.warningsAreErrors || messages.AnyFatalError())) {
-      std::cerr << driver.prefix << "semantic errors in " << path << '\n';
-      exitStatus = EXIT_FAILURE;
-      return {};
-    }
-  }
   if (driver.dumpParseTree) {
     Fortran::semantics::DumpTree(std::cout, parseTree);
   }