[flang] Remove ObjectName alternative from Designator

A simple name in a `Designator` is always parsed as a `DataRef`, not
an `ObjectName`. So remove that alternative.

`StmtFunctionStmt::ConvertToAssignment` was creating a `Designator` with
that alternative: change it to do the same thing as the parser.

Add `GetSimpleName` utility functions to check if an `Expr` or `Variable`
represents a simple name. Many of the places that checked for `ObjectName`
in `Designator` are trying to do that.

Clean up includes and forward declarations in `tools.h`.

Original-commit: flang-compiler/f18@97d44de7b146aee601caa0bc529f7af8a6be001e
Reviewed-on: https://github.com/flang-compiler/f18/pull/410

diff --git a/flang/lib/parser/parse-tree.cc b/flang/lib/parser/parse-tree.cc
index 945d74b..3ca56a0 100644 (file)
--- a/flang/lib/parser/parse-tree.cc
+++ b/flang/lib/parser/parse-tree.cc
@@ -45,7 +45,6 @@ CommonStmt::CommonStmt(std::optional<Name> &&name,
 bool Designator::EndsInBareName() const {
   return std::visit(
       common::visitors{
-          [](const ObjectName &) { return true; },
           [](const DataRef &dr) {
             return std::holds_alternative<Name>(dr.u) ||
                 std::holds_alternative<common::Indirection<StructureComponent>>(
@@ -163,7 +162,8 @@ Statement<ActionStmt> StmtFunctionStmt::ConvertToAssignment() {
   auto &funcExpr{std::get<Scalar<Expr>>(t).thing};
   std::list<Expr> subscripts;
   for (Name &arg : funcArgs) {
-    subscripts.push_back(Expr{common::Indirection{Designator{Name{arg}}}});
+    subscripts.push_back(
+        Expr{common::Indirection{Designator{DataRef{Name{arg}}}}});
   }
   auto variable{Variable{common::Indirection{
       MakeArrayElementRef(funcName, std::move(subscripts))}}};

diff --git a/flang/lib/parser/parse-tree.h b/flang/lib/parser/parse-tree.h
index f172437..f9a9185 100644 (file)
--- a/flang/lib/parser/parse-tree.h
+++ b/flang/lib/parser/parse-tree.h
@@ -1757,7 +1757,7 @@ struct CharLiteralConstantSubstring {
 struct Designator {
   UNION_CLASS_BOILERPLATE(Designator);
   bool EndsInBareName() const;
-  std::variant<ObjectName, DataRef, Substring> u;
+  std::variant<DataRef, Substring> u;
 };
 
 // R902 variable -> designator | function-reference

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index 7a68f34..27e7e89 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -22,6 +22,7 @@
 #include "semantics.h"
 #include "symbol.h"
 #include "type.h"
+#include "tools.h"
 #include "../common/Fortran.h"
 #include "../common/default-kinds.h"
 #include "../common/indirection.h"
@@ -4020,16 +4021,10 @@ void ConstructVisitor::Post(const parser::Selector &x) {
       common::visitors{
           [&](const parser::Expr &y) { return EvaluateExpr(y); },
           [&](const parser::Variable &y) {
-            if (const auto *des{
-                    std::get_if<Indirection<parser::Designator>>(&y.u)}) {
-              if (const auto *dr{
-                      std::get_if<parser::DataRef>(&des->value().u)}) {
-                variable = std::get_if<parser::Name>(&dr->u);
-                if (variable && !FindSymbol(*variable)) {
-                  variable = nullptr;
-                  return MaybeExpr{};
-                }
-              }
+            variable = GetSimpleName(y);
+            if (variable && !FindSymbol(*variable)) {
+              variable = nullptr;
+              return MaybeExpr{};
             }
             return EvaluateExpr(y);
           },
@@ -4603,6 +4598,7 @@ void ResolveNamesVisitor::Post(const parser::AllocateObject &x) {
       },
       x.u);
 }
+
 bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
   const auto &dataRef{std::get<parser::DataRef>(x.t)};
   const auto &bounds{std::get<parser::PointerAssignmentStmt::Bounds>(x.t)};
@@ -4610,21 +4606,9 @@ bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
   ResolveDataRef(dataRef);
   Walk(bounds);
   // Resolve unrestricted specific intrinsic procedures as in "p => cos".
-  if (const auto *designator{
-          std::get_if<common::Indirection<parser::Designator>>(&expr.u)}) {
-    if (const parser::Name *
-        name{std::visit(
-            common::visitors{
-                [](const parser::ObjectName &n) { return &n; },
-                [](const parser::DataRef &dataRef) {
-                  return std::get_if<parser::Name>(&dataRef.u);
-                },
-                [](const auto &) -> const parser::Name * { return nullptr; },
-            },
-            designator->value().u)}) {
-      if (NameIsKnownOrIntrinsic(*name)) {
-        return false;
-      }
+  if (const parser::Name *name{GetSimpleName(expr)}) {
+    if (NameIsKnownOrIntrinsic(*name)) {
+      return false;
     }
   }
   Walk(expr);
@@ -4633,7 +4617,6 @@ bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
 void ResolveNamesVisitor::Post(const parser::Designator &x) {
   std::visit(
       common::visitors{
-          [&](const parser::ObjectName &x) { ResolveName(x); },
           [&](const parser::DataRef &x) { ResolveDataRef(x); },
           [&](const parser::Substring &x) {
             ResolveDataRef(std::get<parser::DataRef>(x.t));

diff --git a/flang/lib/semantics/rewrite-parse-tree.cc b/flang/lib/semantics/rewrite-parse-tree.cc
index a2712c7..490705e 100644 (file)
--- a/flang/lib/semantics/rewrite-parse-tree.cc
+++ b/flang/lib/semantics/rewrite-parse-tree.cc
@@ -16,6 +16,7 @@
 #include "scope.h"
 #include "semantics.h"
 #include "symbol.h"
+#include "tools.h"
 #include "../common/indirection.h"
 #include "../parser/parse-tree-visitor.h"
 #include "../parser/parse-tree.h"
@@ -114,18 +115,11 @@ void FixMisparsedUntaggedNamelistName(READ_OR_WRITE &x) {
     if (auto *charExpr{
             std::get_if<parser::DefaultCharExpr>(&x.format.value().u)}) {
       parser::Expr &expr{charExpr->thing.value()};
-      if (auto *designator{
-              std::get_if<common::Indirection<parser::Designator>>(&expr.u)}) {
-        parser::Name *name{
-            std::get_if<parser::ObjectName>(&designator->value().u)};
-        if (auto *dr{std::get_if<parser::DataRef>(&designator->value().u)}) {
-          name = std::get_if<parser::Name>(&dr->u);
-        }
-        if (name != nullptr && name->symbol != nullptr &&
-            name->symbol->has<NamelistDetails>()) {
-          x.controls.emplace_front(parser::IoControlSpec{std::move(*name)});
-          x.format.reset();
-        }
+      parser::Name *name{GetSimpleName(expr)};
+      if (name != nullptr && name->symbol != nullptr &&
+          name->symbol->has<NamelistDetails>()) {
+        x.controls.emplace_front(parser::IoControlSpec{std::move(*name)});
+        x.format.reset();
       }
     }
   }

diff --git a/flang/lib/semantics/tools.cc b/flang/lib/semantics/tools.cc
index 54081b8..d1b76f6 100644 (file)
--- a/flang/lib/semantics/tools.cc
+++ b/flang/lib/semantics/tools.cc
@@ -14,7 +14,11 @@
 
 #include "tools.h"
 #include "scope.h"
-#include "../evaluate/variable.h"
+#include "symbol.h"
+#include "type.h"
+#include "../common/indirection.h"
+#include "../parser/message.h"
+#include "../parser/parse-tree.h"
 #include <algorithm>
 #include <set>
 #include <variant>
@@ -273,4 +277,31 @@ void CheckScalarLogicalExpr(
     messages.Say(expr.source, "Expected a LOGICAL expression"_err_en_US);
   }
 }
+
+static parser::Name *GetSimpleName(
+    common::Indirection<parser::Designator> *designator) {
+  if (designator) {
+    auto *dataRef{std::get_if<parser::DataRef>(&designator->value().u)};
+    return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
+  } else {
+    return nullptr;
+  }
+}
+
+parser::Name *GetSimpleName(parser::Expr &expr) {
+  return GetSimpleName(
+      std::get_if<common::Indirection<parser::Designator>>(&expr.u));
+}
+const parser::Name *GetSimpleName(const parser::Expr &expr) {
+  return GetSimpleName(const_cast<parser::Expr &>(expr));
+}
+
+parser::Name *GetSimpleName(parser::Variable &variable) {
+  return GetSimpleName(
+      std::get_if<common::Indirection<parser::Designator>>(&variable.u));
+}
+const parser::Name *GetSimpleName(const parser::Variable &variable) {
+  return GetSimpleName(const_cast<parser::Variable &>(variable));
+}
+
 }

diff --git a/flang/lib/semantics/tools.h b/flang/lib/semantics/tools.h
index b08b997..0835ba8 100644 (file)
--- a/flang/lib/semantics/tools.h
+++ b/flang/lib/semantics/tools.h
@@ -18,15 +18,27 @@
 // Simple predicates and look-up functions that are best defined
 // canonically for use in semantic checking.
 
-#include "scope.h"
-#include "symbol.h"
-#include "type.h"
+#include "../common/Fortran.h"
 #include "../evaluate/variable.h"
-#include "../parser/message.h"
-#include "../parser/parse-tree.h"
+
+namespace Fortran::parser {
+class Messages;
+struct Expr;
+struct Name;
+struct Variable;
+}
+
+namespace Fortran::evaluate {
+class GenericExprWrapper;
+}
 
 namespace Fortran::semantics {
 
+class DeclTypeSpec;
+class DerivedTypeSpec;
+class Scope;
+class Symbol;
+
 const Symbol *FindCommonBlockContaining(const Symbol &object);
 const Scope *FindProgramUnitContaining(const Scope &);
 const Scope *FindProgramUnitContaining(const Symbol &);
@@ -87,5 +99,12 @@ bool ExprHasTypeCategory(
     const evaluate::GenericExprWrapper &expr, const common::TypeCategory &type);
 void CheckScalarLogicalExpr(
     const parser::Expr &expr, parser::Messages &messages);
+
+// If this Expr or Variable represents a simple Name, return it.
+parser::Name *GetSimpleName(parser::Expr &);
+const parser::Name *GetSimpleName(const parser::Expr &);
+parser::Name *GetSimpleName(parser::Variable &);
+const parser::Name *GetSimpleName(const parser::Variable &);
+
 }
 #endif  // FORTRAN_SEMANTICS_TOOLS_H_