[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@b02a41efe12032d67cbc99abe43adfb4abb422bb
Reviewed-on: https://github.com/flang-compiler/f18/pull/422
Tree-same-pre-rewrite: false

diff --git a/flang/lib/parser/parse-tree.h b/flang/lib/parser/parse-tree.h
index 99503a04ea7f3385f6f760024af9deabf9f5c96f..469309134f3ddfb7c86f1a0b552b3276f7916ef1 100644 (file)
--- a/flang/lib/parser/parse-tree.h
+++ b/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;

diff --git a/flang/lib/semantics/check-coarray.cc b/flang/lib/semantics/check-coarray.cc
index a59a57f991fb61a5766dc100fb8816366a2d0419..bb6baac3f4db547202054efe1f6973dcc306233f 100644 (file)
--- a/flang/lib/semantics/check-coarray.cc
+++ b/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) {

diff --git a/flang/lib/semantics/check-coarray.h b/flang/lib/semantics/check-coarray.h
index a402c8952de8b33d6f2ad349c49b8cd4439ab833..4c7b6429fe1295f7db8cd501f36590d1a1ae639d 100644 (file)
--- a/flang/lib/semantics/check-coarray.h
+++ b/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 &&);
 };

diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc
index 485496c1480de0b36ef7fc30a5eef885191ac3d1..480e70a9a0a33f1849f26d77d192d15752af07f3 100644 (file)
--- a/flang/lib/semantics/expression.cc
+++ b/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(

diff --git a/flang/lib/semantics/semantics.h b/flang/lib/semantics/semantics.h
index d99b76e60caf9add959c8e18b9c0a297f8e42df7..6690741a4d03b5d015aaec4c0081e74badf62c42 100644 (file)
--- a/flang/lib/semantics/semantics.h
+++ b/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>

diff --git a/flang/lib/semantics/tools.h b/flang/lib/semantics/tools.h
index ac08d176d668d0eae946ab47307893c058b5dfdd..f25c7cdfd2aaf75ae762877906f78e5f57f586a0 100644 (file)
--- a/flang/lib/semantics/tools.h
+++ b/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_

diff --git a/flang/test/semantics/coarrays01.f90 b/flang/test/semantics/coarrays01.f90
index f90b9f866e008e489b945bba8c47cfef52dd81cf..f2952cdea0ab585ea6275f12205001822818411c 100644 (file)
--- a/flang/test/semantics/coarrays01.f90
+++ b/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