[flang] Save and fetch analyzed Expr in Variable

Add typedExpr data member to Variable like that in Expr.
When expression analysis analyzed a Variable it stores the
resulting evaluate::Expr there.

Add GetExpr overloads in semantics/tools.h for using in statement
semantics. It gets an evaluate::Expr from an Expr, Variable, or
wrapper around one of those. It returns a const pointer so that
clients cannot modify the cached expression (and copies do not
have to be made).

Change CoarrayChecker to make use of GetExpr. It will eventually
replace all references to typedExpr in statement semantics.

Original-commit: flang-compiler/f18@b02a41efe1
Reviewed-on: https://github.com/flang-compiler/f18/pull/422
Tree-same-pre-rewrite: false

flang/lib/parser/parse-tree.h

@@ -1701,9 +1701,9 @@ struct Expr {
   explicit Expr(FunctionReference &&);
 
   // Filled in with expression after successful semantic analysis.
-  mutable std::unique_ptr<evaluate::GenericExprWrapper,
-      common::Deleter<evaluate::GenericExprWrapper>>
-      typedExpr;
+  using TypedExpr = std::unique_ptr<evaluate::GenericExprWrapper,
+      common::Deleter<evaluate::GenericExprWrapper>>;
+  mutable TypedExpr typedExpr;
 
   CharBlock source;
 
@@ -1769,6 +1769,7 @@ struct Designator {
 // R902 variable -> designator | function-reference
 struct Variable {
   UNION_CLASS_BOILERPLATE(Variable);
+  mutable Expr::TypedExpr typedExpr;
   std::variant<common::Indirection<Designator>,
       common::Indirection<FunctionReference>>
       u;

flang/lib/semantics/check-coarray.cc

@@ -34,38 +34,40 @@ static bool IsDerivedTypeFromModule(
         symbol.owner().name() == module;
   }
 }
+
 static bool IsTeamType(const DerivedTypeSpec *derived) {
   return IsDerivedTypeFromModule(derived, "iso_fortran_env", "team_type");
 }
 
+template<typename T>
+static void CheckTeamType(SemanticsContext &context, const T &x) {
+  if (const auto *expr{GetExpr(x)}) {
+    if (auto type{expr->GetType()}) {
+      if (!IsTeamType(type->derived)) {
+        context.Say(parser::FindSourceLocation(x),  // C1114
+            "Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV"_err_en_US);
+      }
+    }
+  }
+}
+
 void CoarrayChecker::Leave(const parser::ChangeTeamStmt &x) {
   CheckNamesAreDistinct(std::get<std::list<parser::CoarrayAssociation>>(x.t));
-  CheckTeamValue(std::get<parser::TeamValue>(x.t));
+  CheckTeamType(context_, std::get<parser::TeamValue>(x.t));
 }
 
 void CoarrayChecker::Leave(const parser::SyncTeamStmt &x) {
-  CheckTeamValue(std::get<parser::TeamValue>(x.t));
+  CheckTeamType(context_, std::get<parser::TeamValue>(x.t));
 }
 
 void CoarrayChecker::Leave(const parser::ImageSelectorSpec &x) {
   if (const auto *team{std::get_if<parser::TeamValue>(&x.u)}) {
-    CheckTeamValue(*team);
+    CheckTeamType(context_, *team);
   }
 }
 
 void CoarrayChecker::Leave(const parser::FormTeamStmt &x) {
-  AnalyzeExpr(context_, std::get<parser::ScalarIntExpr>(x.t));
-  const auto &teamVar{std::get<parser::TeamVariable>(x.t)};
-  AnalyzeExpr(context_, teamVar);
-  const parser::Name *name{parser::Unwrap<parser::Name>(teamVar)};
-  CHECK(name);
-  if (const auto *type{name->symbol->GetType()}) {
-    if (!IsTeamType(type->AsDerived())) {
-      context_.Say(name->source,  // C1179
-          "Team variable '%s' must be of type TEAM_TYPE from module ISO_FORTRAN_ENV"_err_en_US,
-          name->ToString().c_str());
-    }
-  }
+  CheckTeamType(context_, std::get<parser::TeamVariable>(x.t));
 }
 
 // Check that coarray names and selector names are all distinct.
@@ -97,17 +99,6 @@ void CoarrayChecker::CheckNamesAreDistinct(
   }
 }
 
-void CoarrayChecker::CheckTeamValue(const parser::TeamValue &x) {
-  const auto &parsedExpr{x.v.thing.value()};
-  const auto &expr{parsedExpr.typedExpr->v};
-  if (auto type{expr.GetType()}) {
-    if (!IsTeamType(type->derived)) {
-      context_.Say(parsedExpr.source,  // C1114
-          "Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV"_err_en_US);
-    }
-  }
-}
-
 void CoarrayChecker::Say2(const parser::CharBlock &name1,
     parser::MessageFixedText &&msg1, const parser::CharBlock &name2,
     parser::MessageFixedText &&msg2) {

flang/lib/semantics/check-coarray.h

@@ -43,7 +43,6 @@ private:
   SemanticsContext &context_;
 
   void CheckNamesAreDistinct(const std::list<parser::CoarrayAssociation> &);
-  void CheckTeamValue(const parser::TeamValue &);
   void Say2(const parser::CharBlock &, parser::MessageFixedText &&,
       const parser::CharBlock &, parser::MessageFixedText &&);
 };

flang/lib/semantics/expression.cc

@@ -1888,8 +1888,17 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr &expr) {
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Variable &variable) {
-  FixMisparsedFunctionReference(context_, variable.u);
-  return Analyze(variable.u);
+  if (variable.typedExpr) {
+    return std::make_optional<Expr<SomeType>>(variable.typedExpr->v);
+  } else {
+    FixMisparsedFunctionReference(context_, variable.u);
+    if (MaybeExpr result{Analyze(variable.u)}) {
+      variable.typedExpr.reset(new GenericExprWrapper{common::Clone(*result)});
+      return result;
+    } else {
+      return std::nullopt;
+    }
+  }
 }
 
 Expr<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(

flang/lib/semantics/semantics.h

@@ -85,7 +85,7 @@ public:
 
   template<typename... A>
   common::IfNoLvalue<parser::Message &, A...> Say(
-      const parser::CharBlock &at, A &&... args) {
+      parser::CharBlock at, A &&... args) {
     return messages_.Say(at, std::move(args)...);
   }
   template<typename... A>

flang/lib/semantics/tools.h

@@ -20,7 +20,9 @@
 
 #include "semantics.h"
 #include "../common/Fortran.h"
+#include "../evaluate/expression.h"
 #include "../evaluate/variable.h"
+#include "../parser/parse-tree.h"
 
 namespace Fortran::parser {
 class Messages;
@@ -29,10 +31,6 @@ struct Name;
 struct Variable;
 }
 
-namespace Fortran::evaluate {
-struct GenericExprWrapper;
-}
-
 namespace Fortran::semantics {
 
 class DeclTypeSpec;
@@ -101,5 +99,32 @@ bool ExprHasTypeCategory(
     const evaluate::GenericExprWrapper &expr, const common::TypeCategory &type);
 bool ExprTypeKindIsDefault(
     const evaluate::GenericExprWrapper &expr, const SemanticsContext &context);
+
+using SomeExpr = evaluate::Expr<evaluate::SomeType>;
+
+struct GetExprHelper {
+  const SomeExpr *Get(const parser::Expr::TypedExpr &x) {
+    return x ? &x->v : nullptr;
+  }
+  const SomeExpr *Get(const parser::Expr &x) { return Get(x.typedExpr); }
+  const SomeExpr *Get(const parser::Variable &x) { return Get(x.typedExpr); }
+  template<typename T> const SomeExpr *Get(const common::Indirection<T> &x) {
+    return Get(x.value());
+  }
+  template<typename T> const SomeExpr *Get(const T &x) {
+    if constexpr (ConstraintTrait<T>) {
+      return Get(x.thing);
+    } else if constexpr (WrapperTrait<T>) {
+      return Get(x.v);
+    } else {
+      return nullptr;
+    }
+  }
+};
+
+template<typename T> const SomeExpr *GetExpr(const T &x) {
+  return GetExprHelper{}.Get(x);
+}
+
 }
 #endif  // FORTRAN_SEMANTICS_TOOLS_H_

flang/test/semantics/coarrays01.f90

@@ -61,8 +61,8 @@ subroutine s3
   !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
   change team(t2, x[10,*] => y)
   end team
-  !ERROR: Team variable 't1' must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
+  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
   form team(1, t1)
-  !ERROR: Team variable 't2' must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
+  !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
   form team(2, t2)
 end