[flang] Save AllocateObject and PointerObject analyzed expression

[jeanPerier]

Summary

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.

[PeteSteinfeld]

These changes build,install, and look good.

Note that (unrelated to these changes), my latest version of clang-format shows that there's an extra blank line at line 3735 in parse-tree.h.

Also, when I was working on a bug in check-nullify.cpp, I was initially baffled by the fact that the analysis of the PointerObject's wasn't done in expression analysis rather than in semantic checking. Do you know what the trade-offs are for analyzing expressions for ALLOCATE, DEALLOCATE, and NULLIFY expressions in semantic analysis rather than expression analysis?

[tskeith]

flang/lib/Semantics/check-deallocate.cpp

46

This case could be simplified slightly:

MaybeExpr checked{analyzer.Analyze(structureComponent)};
if (checked && ...
}
return checked;

This reduces the indentation and make the explicit return type unnecessary.

[jeanPerier]

In D98256#2614130, @PeteSteinfeld wrote:

Also, when I was working on a bug in check-nullify.cpp, I was initially baffled by the fact that the analysis of the PointerObject's wasn't done in expression analysis rather than in semantic checking. Do you know what the trade-offs are for analyzing expressions for ALLOCATE, DEALLOCATE, and NULLIFY expressions in semantic analysis rather than expression analysis?

You are raising an interesting point, I do not know. It might make sense to move this in semantics::ExprChecker. Let me have a look.

[klausler]

If you grep the sources for "typedExpr" you'll find some other places that should be changed (unparse.cpp, Semantics/tools.cpp, dump-parse-tree.h). And you should think about moving this code into Semantics/expression.cpp to be near the other stuff that analyzes and saves typed expressions.

[jeanPerier]

Move the typedExpr setting in expression analysis. Update dump and unparse to use
the typed expression. Add a HasTypeExpr<T> helper to better share the logic when that
is possible and easy.

Update check-nullify.cpp/check-deallocate.cpp to use the typedExpr instead of
re-analysizing the expression.

[jeanPerier]

flang/lib/Semantics/check-deallocate.cpp

46

This comment is not really applicable anymore after the patch update.

[klausler]

Looks great; thanks!

[sscalpone]

Are these warning problems? Is there a reason these aren’t errors? Or have associated file names and line numbers?

% bbc /proj/ta/tests/nag_f95/chkio.f90
warning: TODO: extended value is missing type parameters
warning: TODO: extended value is missing type parameters
warning: TODO: extended value is missing type parameters
warning: TODO: extended value is missing type parameters

[schweitz]

They are reminders that there are TODOs with PDTs. You can ignore them for the moment.

From: Steve Scalpone <[e-mail]>
Sent: Monday, April 5, 2021 11:32 PM
To: Eric Schweitz <[e-mail]>; Jean Perier <[e-mail]>
Subject: Bbc "warning" without source position

Are these warning problems? Is there a reason these aren’t errors? Or have associated file names and line numbers?

% bbc /proj/ta/tests/nag_f95/chkio.f90
warning: TODO: extended value is missing type parameters
warning: TODO: extended value is missing type parameters
warning: TODO: extended value is missing type parameters
warning: TODO: extended value is missing type parameters

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

#undef NODE_NAME
   template <typename... A> bool Pre(const std::variant<A...> &) { return true; }
   template <typename... A> void Post(const std::variant<A...> &) {}
 
 protected:
   // Return a Fortran representation of this node to include in the dump
   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);
       }
     } else if constexpr (std::is_same_v<T, AssignmentStmt> ||
         std::is_same_v<T, PointerAssignmentStmt>) {
       if (asFortran_ && x.typedAssignment) {
         asFortran_->assignment(ss, *x.typedAssignment);
       }

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

StructureConstructor ConvertToStructureConstructor(
       const semantics::DerivedTypeSpec &);
   DataRef base;
   std::list<SectionSubscript> subscripts;
 };
 
 // R933 allocate-object -> variable-name | structure-component
 struct AllocateObject {
   UNION_CLASS_BOILERPLATE(AllocateObject);
+  mutable TypedExpr typedExpr;
   std::variant<Name, StructureComponent> u;
 };
 
 // R935 lower-bound-expr -> scalar-int-expr
 // R936 upper-bound-expr -> scalar-int-expr
 using BoundExpr = ScalarIntExpr;
 
 // R934 allocate-shape-spec -> [lower-bound-expr :] upper-bound-expr
std::tuple<std::optional<TypeSpec>, std::list<Allocation>,
       std::list<AllocOpt>>
       t;
 };
 
 // R940 pointer-object ->
 //        variable-name | structure-component | proc-pointer-name
 struct PointerObject {
   UNION_CLASS_BOILERPLATE(PointerObject);
+  mutable TypedExpr typedExpr;
   std::variant<Name, StructureComponent> u;
 };
 
 // R939 nullify-stmt -> NULLIFY ( pointer-object-list )
 WRAPPER_CLASS(NullifyStmt, std::list<PointerObject>);
 
 // R941 deallocate-stmt ->
 //        DEALLOCATE ( allocate-object-list [, dealloc-opt-list] )

flang/include/flang/Parser/tools.h

 const CoindexedNamedObject *GetCoindexedNamedObject(const Variable &);
 
 // Detects parse tree nodes with "source" members.
 template <typename A, typename = int> struct HasSource : std::false_type {};
 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

 class IntrinsicProcTable;
 
 struct SetExprHelper {
   explicit SetExprHelper(GenericExprWrapper &&expr) : expr_{std::move(expr)} {}
   void Set(parser::TypedExpr &x) {
     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);
     }
   }
 
   GenericExprWrapper expr_;
 };
public:
 
   Expr<SubscriptInteger> AnalyzeKindSelector(common::TypeCategory category,
       const std::optional<parser::KindSelector> &);
 
   MaybeExpr Analyze(const parser::Expr &);
   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());
   }
   template <typename A> MaybeExpr Analyze(const std::optional<A> &x) {
     if (x) {
       return Analyze(*x);
     } else {
public:
   bool Pre(const parser::Variable &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }
   bool Pre(const parser::DataStmtValue &x) {
     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) {
     AnalyzeCallStmt(context_, x);
     return false;
   }
   bool Pre(const parser::AssignmentStmt &x) {
     AnalyzeAssignmentStmt(context_, x);

flang/include/flang/Semantics/tools.h

 using SomeExpr = evaluate::Expr<evaluate::SomeType>;
 
 bool ExprHasTypeCategory(
     const SomeExpr &expr, const common::TypeCategory &type);
 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());
   }
   template <typename T> static const SomeExpr *Get(const std::optional<T> &x) {
     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>) {
       return Get(x.v);
     } else {
       return nullptr;
     }
   }

flang/lib/Parser/unparse.cpp

 
 #include "flang/Parser/unparse.h"
 #include "flang/Common/Fortran.h"
 #include "flang/Common/idioms.h"
 #include "flang/Common/indirection.h"
 #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>
 #include <cstddef>
 #include <set>
 
 namespace Fortran::parser {
 
public:
   template <typename T> bool Pre(const T &x) {
     if constexpr (std::is_void_v<decltype(Unparse(x))>) {
       // There is a local definition of Unparse() for this type.  It
       // overrides the parse tree walker's default Walk() over the descendents.
       Before(x);
       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
     }
   }
   template <typename T> void Post(const T &) {}
 
   // Emit simple types as-is.
void Before(const StatOrErrmsg &x) { // R942 & R1165
     std::visit(common::visitors{
                    [&](const StatVariable &) { Word("STAT="); },
                    [&](const MsgVariable &) { Word("ERRMSG="); },
                },
         x.u);
   }
 
   // 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("-"); }
   void Before(const Expr::NOT &) { Word(".NOT."); }
   void Unparse(const Expr::PercentLoc &x) {
     Word("%LOC("), Walk(x.v), Put(')');
   }
   void Unparse(const Expr::Power &x) { Walk(x.t, "**"); }

flang/lib/Semantics/check-deallocate.cpp

std::visit(
               } else if (!IsAllocatableOrPointer(*symbol)) { // C932
                 context_.Say(name.source,
                     "name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
               } else {
                 context_.CheckIndexVarRedefine(name);
               }
             },
             [&](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,
                       "component in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute"_err_en_US);
                 }
               }
             },
         },
         allocateObject.u);
   }
   bool gotStat{false}, gotMsg{false};
   for (const parser::StatOrErrmsg &deallocOpt :
       std::get<std::list<parser::StatOrErrmsg>>(deallocateStmt.t)) {
     std::visit(
         common::visitors{

flang/lib/Semantics/check-nullify.cpp

std::visit(
               } else if (!IsPointer(*symbol)) { // C951
                 messages.Say(name.source,
                     "name in NULLIFY statement must have the POINTER attribute"_err_en_US);
               } else if (pure) {
                 CheckDefinabilityInPureScope(messages, *symbol, scope, *pure);
               }
             },
             [&](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);
                   }
                 }
               }
             },
         },
         pointerObject.u);

flang/lib/Semantics/expression.cpp

 }
 
 template <typename A> static const Symbol *AssumedTypeDummy(const A &x) {
   if (const auto *designator{
           std::get_if<common::Indirection<parser::Designator>>(&x.u)}) {
     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 nullptr;
+        return AssumedTypeDummy(*name);
+      }
+    }
+  }
+  return nullptr;
+}
+template <>
+const Symbol *AssumedTypeDummy<parser::Name>(const parser::Name &name) {
+  if (const Symbol * symbol{name.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) {
   const parser::Call &call{funcRef.v};
   auto restorer{GetContextualMessages().SetLocation(call.source)};
   ArgumentAnalyzer analyzer{*this, call.source, true /* isProcedureCall */};
   for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Variable &variable) {
   return ExprOrVariable(variable, variable.GetSource());
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::DataStmtConstant &x) {
   auto restorer{GetContextualMessages().SetLocation(x.source)};
   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) {
   int defaultKind{GetDefaultKind(category)};
   if (!selector) {
     return Expr<SubscriptInteger>{defaultKind};
   }
   return std::visit(

flang/lib/Semantics/tools.cpp

if (absent) {
     std::string buf;
     llvm::raw_string_ostream ss{buf};
     ss << "node has not been analyzed:\n";
     parser::DumpTree(ss, x);
     common::die(ss.str().c_str());
   }
 }
 
-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) {
   CheckMissingAnalysis(!x.typedAssignment, x);
   return common::GetPtrFromOptional(x.typedAssignment->v);
 }
 const evaluate::Assignment *GetAssignment(
     const parser::PointerAssignmentStmt &x) {