[flang] Save AllocateObject and PointerObject analyzed expression

`parser::AllocateObject` and `parser::PointerObject` can be represented
as typed expressions once analyzed. This simplifies the work for parse-tree
consumers that work with typed expressions to deal with allocatable and
pointer objects such as lowering.

This change also makes it easier to add typedExpr in the future by
automatically handling nodes that have this member when possible.

Changes:

- Add a `mutable TypedExpr typedExpr` field to `parser::PointerObject` and `parser::AllocateObject`.
- Add a `parser::HasTypedExpr<T>` helper to better share code relating to typedExpr in the parse tree.
- Add hooks in `semantics::ExprChecker` for AllocateObject and PointerObject nodes, and use
  ExprOrVariable on it to analyze and set the tyedExpr field during
  expression analysis. This required adding overloads for `AssumedTypeDummy`.
- Update check-nullify.cpp and check-deallocate.cpp to not re-analyze the StructureComponent but to
  use the typedExpr field instead.
- Update dump/unparse to use HasTypedExpr and use the typedExpr when there is one.

Differential Revision: https://reviews.llvm.org/D98256

flang/include/flang/Parser/dump-parse-tree.h

@@ -793,7 +793,7 @@ protected:
   template <typename T> std::string AsFortran(const T &x) {
     std::string buf;
     llvm::raw_string_ostream ss{buf};
-    if constexpr (std::is_same_v<T, Expr>) {
+    if constexpr (HasTypedExpr<T>::value) {
       if (asFortran_ && x.typedExpr) {
         asFortran_->expr(ss, *x.typedExpr);
       }

flang/include/flang/Parser/parse-tree.h

@@ -1836,6 +1836,7 @@ struct ArrayElement {
 // R933 allocate-object -> variable-name | structure-component
 struct AllocateObject {
   UNION_CLASS_BOILERPLATE(AllocateObject);
+  mutable TypedExpr typedExpr;
   std::variant<Name, StructureComponent> u;
 };
 
@@ -1907,6 +1908,7 @@ struct AllocateStmt {
 //        variable-name | structure-component | proc-pointer-name
 struct PointerObject {
   UNION_CLASS_BOILERPLATE(PointerObject);
+  mutable TypedExpr typedExpr;
   std::variant<Name, StructureComponent> u;
 };
 

flang/include/flang/Parser/tools.h

@@ -117,5 +117,10 @@ template <typename A>
 struct HasSource<A, decltype(static_cast<void>(A::source), 0)>
     : std::true_type {};
 
+// Detects parse tree nodes with "typedExpr" members.
+template <typename A, typename = int> struct HasTypedExpr : std::false_type {};
+template <typename A>
+struct HasTypedExpr<A, decltype(static_cast<void>(A::typedExpr), 0)>
+    : std::true_type {};
 } // namespace Fortran::parser
 #endif // FORTRAN_PARSER_TOOLS_H_

flang/include/flang/Semantics/expression.h

@@ -74,14 +74,13 @@ struct SetExprHelper {
     x.Reset(new GenericExprWrapper{std::move(expr_)},
         evaluate::GenericExprWrapper::Deleter);
   }
-  void Set(const parser::Expr &x) { Set(x.typedExpr); }
-  void Set(const parser::Variable &x) { Set(x.typedExpr); }
-  void Set(const parser::DataStmtConstant &x) { Set(x.typedExpr); }
   template <typename T> void Set(const common::Indirection<T> &x) {
     Set(x.value());
   }
   template <typename T> void Set(const T &x) {
-    if constexpr (ConstraintTrait<T>) {
+    if constexpr (parser::HasTypedExpr<T>::value) {
+      Set(x.typedExpr);
+    } else if constexpr (ConstraintTrait<T>) {
       Set(x.thing);
     } else if constexpr (WrapperTrait<T>) {
       Set(x.v);
@@ -157,6 +156,8 @@ public:
   MaybeExpr Analyze(const parser::Variable &);
   MaybeExpr Analyze(const parser::Designator &);
   MaybeExpr Analyze(const parser::DataStmtValue &);
+  MaybeExpr Analyze(const parser::AllocateObject &);
+  MaybeExpr Analyze(const parser::PointerObject &);
 
   template <typename A> MaybeExpr Analyze(const common::Indirection<A> &x) {
     return Analyze(x.value());
@@ -451,6 +452,14 @@ public:
     exprAnalyzer_.Analyze(x);
     return false;
   }
+  bool Pre(const parser::AllocateObject &x) {
+    exprAnalyzer_.Analyze(x);
+    return false;
+  }
+  bool Pre(const parser::PointerObject &x) {
+    exprAnalyzer_.Analyze(x);
+    return false;
+  }
   bool Pre(const parser::DataImpliedDo &);
 
   bool Pre(const parser::CallStmt &x) {

flang/include/flang/Semantics/tools.h

@@ -257,9 +257,13 @@ bool ExprTypeKindIsDefault(
     const SomeExpr &expr, const SemanticsContext &context);
 
 struct GetExprHelper {
+  // Specializations for parse tree nodes that have a typedExpr member.
   static const SomeExpr *Get(const parser::Expr &);
   static const SomeExpr *Get(const parser::Variable &);
   static const SomeExpr *Get(const parser::DataStmtConstant &);
+  static const SomeExpr *Get(const parser::AllocateObject &);
+  static const SomeExpr *Get(const parser::PointerObject &);
+
   template <typename T>
   static const SomeExpr *Get(const common::Indirection<T> &x) {
     return Get(x.value());
@@ -268,6 +272,8 @@ struct GetExprHelper {
     return x ? Get(*x) : nullptr;
   }
   template <typename T> static const SomeExpr *Get(const T &x) {
+    static_assert(
+        !parser::HasTypedExpr<T>::value, "explicit Get overload must be added");
     if constexpr (ConstraintTrait<T>) {
       return Get(x.thing);
     } else if constexpr (WrapperTrait<T>) {

flang/lib/Parser/unparse.cpp

@@ -16,6 +16,7 @@
 #include "flang/Parser/characters.h"
 #include "flang/Parser/parse-tree-visitor.h"
 #include "flang/Parser/parse-tree.h"
+#include "flang/Parser/tools.h"
 #include "llvm/Support/raw_ostream.h"
 #include <algorithm>
 #include <cinttypes>
@@ -48,6 +49,14 @@ public:
       Unparse(x);
       Post(x);
       return false; // Walk() does not visit descendents
+    } else if constexpr (HasTypedExpr<T>::value) {
+      // Format the expression representation from semantics
+      if (asFortran_ && x.typedExpr) {
+        asFortran_->expr(out_, *x.typedExpr);
+        return false;
+      } else {
+        return true;
+      }
     } else {
       Before(x);
       return true; // there's no Unparse() defined here, Walk() the descendents
@@ -816,15 +825,6 @@ public:
   }
 
   // R1001 - R1022
-  bool Pre(const Expr &x) {
-    if (asFortran_ && x.typedExpr) {
-      // Format the expression representation from semantics
-      asFortran_->expr(out_, *x.typedExpr);
-      return false;
-    } else {
-      return true;
-    }
-  }
   void Unparse(const Expr::Parentheses &x) { Put('('), Walk(x.v), Put(')'); }
   void Before(const Expr::UnaryPlus &) { Put("+"); }
   void Before(const Expr::Negate &) { Put("-"); }

flang/lib/Semantics/check-deallocate.cpp

@@ -34,8 +34,9 @@ void DeallocateChecker::Leave(const parser::DeallocateStmt &deallocateStmt) {
               }
             },
             [&](const parser::StructureComponent &structureComponent) {
-              evaluate::ExpressionAnalyzer analyzer{context_};
-              if (MaybeExpr checked{analyzer.Analyze(structureComponent)}) {
+              // Only perform structureComponent checks it was successfully
+              // analyzed in expression analysis.
+              if (GetExpr(allocateObject)) {
                 if (!IsAllocatableOrPointer(
                         *structureComponent.component.symbol)) { // C932
                   context_.Say(structureComponent.component.source,

flang/lib/Semantics/check-nullify.cpp

@@ -40,13 +40,12 @@ void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
               }
             },
             [&](const parser::StructureComponent &structureComponent) {
-              evaluate::ExpressionAnalyzer analyzer{context_};
-              if (MaybeExpr checked{analyzer.Analyze(structureComponent)}) {
+              if (const auto *checkedExpr{GetExpr(pointerObject)}) {
                 if (!IsPointer(*structureComponent.component.symbol)) { // C951
                   messages.Say(structureComponent.component.source,
                       "component in NULLIFY statement must have the POINTER attribute"_err_en_US);
                 } else if (pure) {
-                  if (const Symbol * symbol{GetFirstSymbol(checked)}) {
+                  if (const Symbol * symbol{GetFirstSymbol(*checkedExpr)}) {
                     CheckDefinabilityInPureScope(
                         messages, *symbol, scope, *pure);
                   }

flang/lib/Semantics/expression.cpp

@@ -2139,18 +2139,48 @@ template <typename A> static const Symbol *AssumedTypeDummy(const A &x) {
     if (const auto *dataRef{
             std::get_if<parser::DataRef>(&designator->value().u)}) {
       if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
-        if (const Symbol * symbol{name->symbol}) {
-          if (const auto *type{symbol->GetType()}) {
-            if (type->category() == semantics::DeclTypeSpec::TypeStar) {
-              return symbol;
-            }
-          }
-        }
+        return AssumedTypeDummy(*name);
       }
     }
   }
   return nullptr;
 }
+template <>
+const Symbol *AssumedTypeDummy<parser::Name>(const parser::Name &name) {
+  if (const Symbol * symbol{name.symbol}) {
+    if (const auto *type{symbol->GetType()}) {
+      if (type->category() == semantics::DeclTypeSpec::TypeStar) {
+        return symbol;
+      }
+    }
+  }
+  return nullptr;
+}
+template <typename A>
+static const Symbol *AssumedTypePointerOrAllocatableDummy(const A &object) {
+  // It is illegal for allocatable of pointer objects to be TYPE(*), but at that
+  // point it is is not guaranteed that it has been checked the object has
+  // POINTER or ALLOCATABLE attribute, so do not assume nullptr can be directly
+  // returned.
+  return std::visit(
+      common::visitors{
+          [&](const parser::StructureComponent &x) {
+            return AssumedTypeDummy(x.component);
+          },
+          [&](const parser::Name &x) { return AssumedTypeDummy(x); },
+      },
+      object.u);
+}
+template <>
+const Symbol *AssumedTypeDummy<parser::AllocateObject>(
+    const parser::AllocateObject &x) {
+  return AssumedTypePointerOrAllocatableDummy(x);
+}
+template <>
+const Symbol *AssumedTypeDummy<parser::PointerObject>(
+    const parser::PointerObject &x) {
+  return AssumedTypePointerOrAllocatableDummy(x);
+}
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
     std::optional<parser::StructureConstructor> *structureConstructor) {
@@ -2737,6 +2767,18 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::DataStmtConstant &x) {
   return ExprOrVariable(x, x.source);
 }
 
+MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateObject &x) {
+  parser::CharBlock source{parser::FindSourceLocation(x)};
+  auto restorer{GetContextualMessages().SetLocation(source)};
+  return ExprOrVariable(x, source);
+}
+
+MaybeExpr ExpressionAnalyzer::Analyze(const parser::PointerObject &x) {
+  parser::CharBlock source{parser::FindSourceLocation(x)};
+  auto restorer{GetContextualMessages().SetLocation(source)};
+  return ExprOrVariable(x, source);
+}
+
 Expr<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(
     TypeCategory category,
     const std::optional<parser::KindSelector> &selector) {

flang/lib/Semantics/tools.cpp

@@ -374,17 +374,24 @@ static void CheckMissingAnalysis(bool absent, const T &x) {
   }
 }
 
-const SomeExpr *GetExprHelper::Get(const parser::Expr &x) {
+template <typename T> static const SomeExpr *GetTypedExpr(const T &x) {
   CheckMissingAnalysis(!x.typedExpr, x);
   return common::GetPtrFromOptional(x.typedExpr->v);
 }
+const SomeExpr *GetExprHelper::Get(const parser::Expr &x) {
+  return GetTypedExpr(x);
+}
 const SomeExpr *GetExprHelper::Get(const parser::Variable &x) {
-  CheckMissingAnalysis(!x.typedExpr, x);
-  return common::GetPtrFromOptional(x.typedExpr->v);
+  return GetTypedExpr(x);
 }
 const SomeExpr *GetExprHelper::Get(const parser::DataStmtConstant &x) {
-  CheckMissingAnalysis(!x.typedExpr, x);
-  return common::GetPtrFromOptional(x.typedExpr->v);
+  return GetTypedExpr(x);
+}
+const SomeExpr *GetExprHelper::Get(const parser::AllocateObject &x) {
+  return GetTypedExpr(x);
+}
+const SomeExpr *GetExprHelper::Get(const parser::PointerObject &x) {
+  return GetTypedExpr(x);
 }
 
 const evaluate::Assignment *GetAssignment(const parser::AssignmentStmt &x) {