[flang] Implement parse tree rewriting.
authorTim Keith <tkeith@nvidia.com>
Wed, 18 Apr 2018 22:06:35 +0000 (15:06 -0700)
committerTim Keith <tkeith@nvidia.com>
Wed, 18 Apr 2018 22:06:35 +0000 (15:06 -0700)
Add parse-tree-mutator.h like parse-tree-visitor.h except that the Walk
functions take non-const references to parse tree nodes so the Pre and
Post methods of the mutator that are passed around can make changes to
the parse tree.

Change ExecutionPart to be a class that wraps a list so that it can be
identified during parse tree walking.

Add Symbol* field to parser::Name for the result of symbol resolution.
In parse tree dumper, dump symbol when it is there instead of just name.

Add RewriteParseTree to walk the parse tree, fill in resolved symbols in
Name nodes, and make necessary changes to the structure. Currently that
consists of rewriting statement functions as array assignments when
appropriate.

In ResolveNames, call RewriteParseTree if the resolution was successful.
Recognize a statement function that comes after a mis-identified
statement function and report an error. resolve08.f90 tests this case.

Add -fdebug-dump-symbols to dump the scope tree and symbols in each scope.
This is implemented by DumpSymbols in resolve-names.cc. Add an optional
symbol to scopes that correspond to symbols (e.g. subprograms). Remove
debug output from ResolveNamesVisitor as this option can be used instead.

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

14 files changed:
flang/lib/parser/grammar.h
flang/lib/parser/parse-tree-mutator.h [new file with mode: 0644]
flang/lib/parser/parse-tree.h
flang/lib/semantics/CMakeLists.txt
flang/lib/semantics/ParseTreeDump.h
flang/lib/semantics/resolve-names.cc
flang/lib/semantics/resolve-names.h
flang/lib/semantics/rewrite-parse-tree.cc [new file with mode: 0644]
flang/lib/semantics/rewrite-parse-tree.h [new file with mode: 0644]
flang/lib/semantics/scope.cc
flang/lib/semantics/scope.h
flang/lib/semantics/symbol.cc
flang/test/semantics/resolve08.f90 [new file with mode: 0644]
flang/tools/f18/f18.cc

index d742f88..d3dd7a1 100644 (file)
@@ -63,6 +63,7 @@ constexpr Parser<SpecificationPart> specificationPart;  //  R504
 constexpr Parser<ImplicitPart> implicitPart;  //  R505
 constexpr Parser<DeclarationConstruct> declarationConstruct;  //  R507
 constexpr Parser<SpecificationConstruct> specificationConstruct;  //  R508
+constexpr Parser<ExecutionPart> executionPart;  //  R509
 constexpr Parser<ExecutionPartConstruct> executionPartConstruct;  //  R510
 constexpr Parser<InternalSubprogramPart> internalSubprogramPart;  //  R511
 constexpr Parser<ActionStmt> actionStmt;  // R515
@@ -586,8 +587,8 @@ TYPE_CONTEXT_PARSER("execution part construct"_en_US,
         construct<ExecutionPartConstruct>{}(executionPartErrorRecovery)))
 
 // R509 execution-part -> executable-construct [execution-part-construct]...
-constexpr auto executionPart =
-    inContext("execution part"_en_US, many(executionPartConstruct));
+TYPE_CONTEXT_PARSER("execution part"_en_US,
+    construct<ExecutionPart>{}(many(executionPartConstruct)))
 
 // R602 underscore -> _
 constexpr auto underscore = "_"_ch;
diff --git a/flang/lib/parser/parse-tree-mutator.h b/flang/lib/parser/parse-tree-mutator.h
new file mode 100644 (file)
index 0000000..b3aff6d
--- /dev/null
@@ -0,0 +1,358 @@
+#ifndef FORTRAN_PARSER_PARSE_TREE_MUTATOR_H_
+#define FORTRAN_PARSER_PARSE_TREE_MUTATOR_H_
+
+#include "parse-tree.h"
+#include <cstddef>
+#include <optional>
+#include <tuple>
+#include <utility>
+#include <variant>
+
+/// Parse tree mutator
+/// Call Walk(x, mutator) to visit x and, by default, each node under x,
+/// optionally rewriting it in place.
+///
+/// mutator.Pre(x) is called before visiting x and its children are not
+/// visited if it returns false.
+///
+/// mutator.Post(x) is called after visiting x.
+
+namespace Fortran {
+namespace parser {
+
+// Default case for visitation of non-class data members and strings
+template<typename A, typename M>
+typename std::enable_if<!std::is_class_v<A> ||
+    std::is_same_v<std::string, A>>::type
+Walk(A &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    mutator.Post(x);
+  }
+}
+
+template<typename M> void Walk(format::ControlEditDesc &, M &);
+template<typename M> void Walk(format::DerivedTypeDataEditDesc &, M &);
+template<typename M> void Walk(format::FormatItem &, M &);
+template<typename M> void Walk(format::FormatSpecification &, M &);
+template<typename M> void Walk(format::IntrinsicTypeDataEditDesc &, M &);
+
+// Traversal of needed STL template classes (optional, list, tuple, variant)
+template<typename T, typename M>
+void Walk(std::optional<T> &x, M &mutator) {
+  if (x) {
+    Walk(*x, mutator);
+  }
+}
+template<typename T, typename M> void Walk(std::list<T> &x, M &mutator) {
+  for (auto &elem : x) {
+    Walk(elem, mutator);
+  }
+}
+template<std::size_t I = 0, typename Func, typename T>
+void ForEachInTuple(T &tuple, Func func) {
+  if constexpr (I < std::tuple_size_v<T>) {
+    func(std::get<I>(tuple));
+    ForEachInTuple<I + 1>(tuple, func);
+  }
+}
+template<typename M, typename... A>
+void Walk(std::tuple<A...> &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    ForEachInTuple(x, [&](auto &y) { Walk(y, mutator); });
+    mutator.Post(x);
+  }
+}
+template<typename M, typename... A>
+void Walk(std::variant<A...> &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    std::visit([&](auto &y) { Walk(y, mutator); }, x);
+    mutator.Post(x);
+  }
+}
+template<typename A, typename B, typename M>
+void Walk(std::pair<A, B> &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.first, mutator);
+    Walk(x.second, mutator);
+  }
+}
+
+// Trait-determined traversal of empty, tuple, union, and wrapper classes.
+template<typename A, typename M>
+typename std::enable_if<EmptyTrait<A>>::type Walk(A &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    mutator.Post(x);
+  }
+}
+
+template<typename A, typename M>
+typename std::enable_if<TupleTrait<A>>::type Walk(A &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.t, mutator);
+    mutator.Post(x);
+  }
+}
+
+template<typename A, typename M>
+typename std::enable_if<UnionTrait<A>>::type Walk(A &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.u, mutator);
+    mutator.Post(x);
+  }
+}
+
+template<typename A, typename M>
+typename std::enable_if<WrapperTrait<A>>::type Walk(A &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.v, mutator);
+    mutator.Post(x);
+  }
+}
+
+template<typename T, typename M>
+void Walk(Indirection<T> &x, M &mutator) {
+  Walk(*x, mutator);
+}
+
+// Walk a class with a single field 'thing'.
+template<typename T, typename M> void Walk(Scalar<T> &x, M &mutator) {
+  Walk(x.thing, mutator);
+}
+template<typename T, typename M> void Walk(Constant<T> &x, M &mutator) {
+  Walk(x.thing, mutator);
+}
+template<typename T, typename M> void Walk(Integer<T> &x, M &mutator) {
+  Walk(x.thing, mutator);
+}
+template<typename T, typename M> void Walk(Logical<T> &x, M &mutator) {
+  Walk(x.thing, mutator);
+}
+template<typename T, typename M>
+void Walk(DefaultChar<T> &x, M &mutator) {
+  Walk(x.thing, mutator);
+}
+
+template<typename T, typename M> void Walk(Statement<T> &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    // N.B. the label is not traversed
+    Walk(x.statement, mutator);
+    mutator.Post(x);
+  }
+}
+
+template<typename M> void Walk(Name &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    mutator.Post(x);
+  }
+}
+
+template<typename M> void Walk(AcSpec &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.type, mutator);
+    Walk(x.values, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(ArrayElement &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.base, mutator);
+    Walk(x.subscripts, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M>
+void Walk(CharSelector::LengthAndKind &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.length, mutator);
+    Walk(x.kind, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(CaseValueRange::Range &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.lower, mutator);
+    Walk(x.upper, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(CoindexedNamedObject &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.base, mutator);
+    Walk(x.imageSelector, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M>
+void Walk(DeclarationTypeSpec::Class &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.derived, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(DeclarationTypeSpec::Type &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.derived, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(ImportStmt &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.names, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M>
+void Walk(IntrinsicTypeSpec::Character &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.selector, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M>
+void Walk(IntrinsicTypeSpec::Complex &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.kind, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M>
+void Walk(IntrinsicTypeSpec::Logical &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.kind, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(IntrinsicTypeSpec::Real &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.kind, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename T, typename M> void Walk(LoopBounds<T> &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.name, mutator);
+    Walk(x.lower, mutator);
+    Walk(x.upper, mutator);
+    Walk(x.step, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(PartRef &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.name, mutator);
+    Walk(x.subscripts, mutator);
+    Walk(x.imageSelector, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(ReadStmt &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.iounit, mutator);
+    Walk(x.format, mutator);
+    Walk(x.controls, mutator);
+    Walk(x.items, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(RealLiteralConstant &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.real, mutator);
+    Walk(x.kind, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(RealLiteralConstant::Real &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(StructureComponent &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.base, mutator);
+    Walk(x.component, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(Suffix &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.binding, mutator);
+    Walk(x.resultName, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M>
+void Walk(TypeBoundProcedureStmt::WithInterface &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.interfaceName, mutator);
+    Walk(x.attributes, mutator);
+    Walk(x.bindingNames, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M>
+void Walk(TypeBoundProcedureStmt::WithoutInterface &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.attributes, mutator);
+    Walk(x.declarations, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(UseStmt &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.nature, mutator);
+    Walk(x.moduleName, mutator);
+    Walk(x.u, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(WriteStmt &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.iounit, mutator);
+    Walk(x.format, mutator);
+    Walk(x.controls, mutator);
+    Walk(x.items, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(format::ControlEditDesc &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.kind, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M>
+void Walk(format::DerivedTypeDataEditDesc &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.type, mutator);
+    Walk(x.parameters, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M> void Walk(format::FormatItem &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.repeatCount, mutator);
+    Walk(x.u, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M>
+void Walk(format::FormatSpecification &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.items, mutator);
+    Walk(x.unlimitedItems, mutator);
+    mutator.Post(x);
+  }
+}
+template<typename M>
+void Walk(format::IntrinsicTypeDataEditDesc &x, M &mutator) {
+  if (mutator.Pre(x)) {
+    Walk(x.kind, mutator);
+    Walk(x.width, mutator);
+    Walk(x.digits, mutator);
+    Walk(x.exponentWidth, mutator);
+    mutator.Post(x);
+  }
+}
+}  // namespace parser
+}  // namespace Fortran
+#endif  // FORTRAN_PARSER_PARSE_TREE_MUTATOR_H_
index a7b161a..bcf5177 100644 (file)
@@ -55,6 +55,7 @@ CLASS_TRAIT(TupleTrait);
 
 namespace Fortran {
 namespace semantics {
+class Symbol;
 template<typename T> struct Semantic {
   Semantic(T *) {}
 };
@@ -486,7 +487,7 @@ struct ExecutionPartConstruct {
 };
 
 // R509 execution-part -> executable-construct [execution-part-construct]...
-using ExecutionPart = std::list<ExecutionPartConstruct>;
+WRAPPER_CLASS(ExecutionPart, std::list<ExecutionPartConstruct>);
 
 // R502 program-unit ->
 //        main-program | external-subprogram | module | submodule | block-data
@@ -509,7 +510,7 @@ struct Name {
   COPY_AND_ASSIGN_BOILERPLATE(Name);
   std::string ToString() const { return source.ToString(); }
   CharBlock source;
-  // TODO: pointer to symbol table entity
+  semantics::Symbol *symbol{nullptr};
 };
 
 // R516 keyword -> name
index aa87327..a9eca8d 100644 (file)
@@ -3,6 +3,7 @@ add_library(FlangSemantics
   attr.cc
   make-types.cc
   resolve-names.cc
+  rewrite-parse-tree.cc
   scope.cc
   symbol.cc
   type.cc
index a6f4e7d..801c200 100644 (file)
@@ -1,12 +1,12 @@
 #ifndef FLANG_SEMA_PARSE_TREE_DUMP_H
 #define FLANG_SEMA_PARSE_TREE_DUMP_H
 
+#include "symbol.h"
 #include "../parser/format-specification.h"
 #include "../parser/idioms.h"
 #include "../parser/indirection.h"
 #include "../parser/parse-tree-visitor.h"
 #include "../parser/parse-tree.h"
-
 #include <cstring>
 #include <iomanip>
 #include <iostream>
@@ -111,17 +111,32 @@ public:
     }
   }
 
-  bool Pre(const parser::Name &x) { return Pre(x.ToString()); }
+  bool PutName(const std::string &name, const semantics::Symbol *symbol) {
+    if (emptyline) {
+      out_indent();
+      emptyline = false;
+    }
+    if (symbol) {
+      out << "symbol = " << *symbol;
+    } else {
+      out << "Name = '" << name << '\'';
+    }
+    out << '\n';
+    indent++;
+    emptyline = true;
+    return true;
+  }
+
+  bool Pre(const parser::Name &x) {
+    return PutName(x.ToString(), x.symbol);
+  }
+
+  void Post(const parser::Name &) { 
+    indent--;
+  }
 
   bool Pre(const std::string &x) { 
-    if (emptyline ) {
-      out_indent();
-      emptyline = false ;
-    }    
-    out << "Name = '" << x << "'\n";
-    indent++ ;
-    emptyline = true ;    
-    return true ;
+    return PutName(x, nullptr);
   }
   
   void Post(const std::string &x) { 
index c8cf6a1..87428bf 100644 (file)
@@ -1,4 +1,5 @@
 #include "resolve-names.h"
+#include "rewrite-parse-tree.h"
 #include "attr.h"
 #include "scope.h"
 #include "symbol.h"
@@ -6,7 +7,7 @@
 #include "../parser/indirection.h"
 #include "../parser/parse-tree-visitor.h"
 #include "../parser/parse-tree.h"
-#include <iostream>
+#include <ostream>
 #include <list>
 #include <memory>
 #include <stack>
@@ -398,6 +399,8 @@ private:
   const parser::Name *funcResultName_{nullptr};
   // The attribute corresponding to the statement containing an ObjectDecl
   std::optional<Attr> objectDeclAttr_;
+  // Set when we a statement function that is really an array assignment
+  bool badStmtFuncFound_{false};
 
   // Create a subprogram symbol in the current scope and push a new scope.
   Symbol &PushSubprogramScope(const parser::Name &);
@@ -896,6 +899,7 @@ void ResolveNamesVisitor::DeclareEntity(const parser::Name &name, Attrs attrs) {
 }
 
 void ResolveNamesVisitor::Post(const parser::SpecificationPart &s) {
+  badStmtFuncFound_ = false;
   if (isImplicitNoneType()) {
     // Check that every name referenced has an explicit type
     for (const auto &pair : CurrScope()) {
@@ -914,15 +918,11 @@ void ResolveNamesVisitor::Post(const parser::SpecificationPart &s) {
 
 void ResolveNamesVisitor::Post(const parser::EndSubroutineStmt &subp) {
   ApplyImplicitRules();
-  std::cout << "End of subroutine scope\n";
-  std::cout << CurrScope();
   PopScope();
 }
 
 void ResolveNamesVisitor::Post(const parser::EndFunctionStmt &subp) {
   ApplyImplicitRules();
-  std::cout << "End of function scope\n";
-  std::cout << CurrScope();
   PopScope();
 }
 
@@ -965,6 +965,7 @@ bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) {
       if (details->isArray()) {
         // not a stmt-func at all but an array; do nothing
         symbol.add_occurrence(name.source);
+        badStmtFuncFound_ = true;
         return true;
       }
       // TODO: check that attrs are compatible with stmt func
@@ -973,6 +974,10 @@ bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) {
       CurrScope().erase(symbol.name());
     }
   }
+  if (badStmtFuncFound_) {
+    Say(name, "'%s' has not been declared as an array"_err_en_US);
+    return true;
+  }
   BeginAttrs();  // no attrs to collect, but PushSubprogramScope expects this
   auto &symbol = PushSubprogramScope(name);
   CopyImplicitRules();
@@ -1002,9 +1007,10 @@ bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) {
 }
 
 void ResolveNamesVisitor::Post(const parser::StmtFunctionStmt &x) {
+  if (badStmtFuncFound_) {
+    return;  // This wasn't really a stmt function so no scope was created
+  }
   ApplyImplicitRules();
-  std::cout << "End of stmt func scope\n";
-  std::cout << CurrScope();
   PopScope();
 }
 
@@ -1059,7 +1065,7 @@ void ResolveNamesVisitor::Post(const parser::FunctionStmt &stmt) {
 
 Symbol &ResolveNamesVisitor::PushSubprogramScope(const parser::Name &name) {
   auto &symbol = MakeSymbol(name, EndAttrs(), SubprogramDetails());
-  Scope &subpScope = CurrScope().MakeScope(Scope::Kind::Subprogram);
+  Scope &subpScope = CurrScope().MakeScope(Scope::Kind::Subprogram, &symbol);
   PushScope(subpScope);
   auto &details = symbol.details<SubprogramDetails>();
   // can't reuse this name inside subprogram:
@@ -1080,8 +1086,6 @@ bool ResolveNamesVisitor::Pre(const parser::MainProgram &x) {
 
 void ResolveNamesVisitor::Post(const parser::EndProgramStmt &) {
   ApplyImplicitRules();
-  std::cout << "End of program scope\n";
-  std::cout << CurrScope();
   PopScope();
 }
 
@@ -1092,11 +1096,43 @@ void ResolveNamesVisitor::Post(const parser::Program &) {
 }
 
 void ResolveNames(
-    const parser::Program &program, const parser::CookedSource &cookedSource) {
+    parser::Program &program, const parser::CookedSource &cookedSource) {
   parser::Messages messages{cookedSource};
   ResolveNamesVisitor visitor{messages};
   parser::Walk(program, visitor);
-  messages.Emit(std::cerr);
+  if (!messages.empty()) {
+    messages.Emit(std::cerr);
+    return;
+  }
+  RewriteParseTree(program);
+}
+
+static void PutIndent(std::ostream &os, int indent) {
+  for (int i = 0; i < indent; ++i) {
+    os << "  ";
+  }
+}
+
+static void DumpSymbols(std::ostream &os, const Scope &scope, int indent = 0) {
+  PutIndent(os, indent);
+  os << Scope::EnumToString(scope.kind()) << " scope:";
+  if (const auto *symbol = scope.symbol()) {
+    os << ' ' << symbol->name().ToString();
+  }
+  os << '\n';
+  ++indent;
+  for (const auto &symbol : scope) {
+    PutIndent(os, indent);
+    os << symbol.second << "\n";
+  }
+  for (const auto &child : scope.children()) {
+    DumpSymbols(os, child, indent);
+  }
+  --indent;
+}
+
+void DumpSymbols(std::ostream &os) {
+  DumpSymbols(os, Scope::globalScope);
 }
 
 }  // namespace Fortran::semantics
index 6689d1f..ed8e749 100644 (file)
@@ -6,5 +6,8 @@ class CookedSource;
 }  // namespace Fortran::parser
 
 namespace Fortran::semantics {
-void ResolveNames(const parser::Program &, const parser::CookedSource &);
+
+void ResolveNames(parser::Program &, const parser::CookedSource &);
+void DumpSymbols(std::ostream &);
+
 }  // namespace Fortran::semantics
diff --git a/flang/lib/semantics/rewrite-parse-tree.cc b/flang/lib/semantics/rewrite-parse-tree.cc
new file mode 100644 (file)
index 0000000..89a2d29
--- /dev/null
@@ -0,0 +1,109 @@
+#include "rewrite-parse-tree.h"
+#include "scope.h"
+#include "symbol.h"
+#include "../parser/indirection.h"
+#include "../parser/parse-tree-mutator.h"
+#include "../parser/parse-tree.h"
+#include <list>
+
+namespace Fortran::semantics {
+
+// Symbols collected during name resolution that are added to parse tree.
+using symbolMap = std::map<const SourceName, Symbol *>;
+
+/// Walk the parse tree and add symbols from the symbolMap in Name nodes.
+/// Convert mis-identified statement functions to array assignments.
+class RewriteMutator {
+public:
+  RewriteMutator(const symbolMap &symbols) : symbols_{symbols} {}
+
+  // Default action for a parse tree node is to visit children.
+  template<typename T> bool Pre(T &) { return true; }
+  template<typename T> void Post(T &) {}
+
+  // Fill in name.symbol if there is a corresponding symbol
+  void Post(parser::Name &name) {
+    const auto it = symbols_.find(name.source);
+    if (it != symbols_.end()) {
+      name.symbol = it->second;
+    }
+  }
+
+  using stmtFuncType =
+      parser::Statement<parser::Indirection<parser::StmtFunctionStmt>>;
+
+  // Find mis-parsed statement functions and move to stmtFuncsToConvert list.
+  void Post(parser::SpecificationPart &x) {
+    auto &list = std::get<std::list<parser::DeclarationConstruct>>(x.t);
+    for (auto it = list.begin(); it != list.end();) {
+      if (auto stmt = std::get_if<stmtFuncType>(&it->u)) {
+        Symbol *symbol{std::get<parser::Name>(stmt->statement->t).symbol};
+        if (symbol && symbol->has<EntityDetails>()) {
+          // not a stmt func: remove it here and add to ones to convert
+          stmtFuncsToConvert.push_back(std::move(*stmt));
+          it = list.erase(it);
+          continue;
+        }
+      }
+      ++it;
+    }
+  }
+
+  // Insert converted assignments at start of ExecutionPart.
+  bool Pre(parser::ExecutionPart &x) {
+    auto origFirst = x.v.begin();  // insert each elem before origFirst
+    for (stmtFuncType &sf : stmtFuncsToConvert) {
+      x.v.insert(origFirst, std::move(ConvertToAssignment(sf)));
+    }
+    stmtFuncsToConvert.clear();
+    return true;
+  }
+
+private:
+  const symbolMap &symbols_;
+  std::list<stmtFuncType> stmtFuncsToConvert;
+
+  // Convert a statement function statement to an ExecutionPartConstruct
+  // containing an array assignment statement.
+  static parser::ExecutionPartConstruct ConvertToAssignment(stmtFuncType &x) {
+    parser::StmtFunctionStmt &sf{*x.statement};
+    auto &funcName = std::get<parser::Name>(sf.t);
+    auto &funcArgs = std::get<std::list<parser::Name>>(sf.t);
+    auto &funcExpr = std::get<parser::Scalar<parser::Expr>>(sf.t).thing;
+    parser::ArrayElement arrayElement{
+        funcName, std::list<parser::SectionSubscript>{}};
+    for (parser::Name &arg : funcArgs) {
+      arrayElement.subscripts.push_back(parser::SectionSubscript{
+          parser::Scalar{parser::Integer{parser::Indirection{
+              parser::Expr{parser::Indirection{parser::Designator{arg}}}}}}});
+    }
+    auto &&variable = parser::Variable{parser::Indirection{parser::Designator{
+        parser::DataRef{parser::Indirection{std::move(arrayElement)}}}}};
+    auto &&stmt = parser::Statement{std::nullopt,
+        parser::ActionStmt{parser::Indirection{
+            parser::AssignmentStmt{std::move(variable), std::move(funcExpr)}}}};
+    stmt.source = x.source;
+    return parser::ExecutionPartConstruct{parser::ExecutableConstruct{stmt}};
+  }
+};
+
+static void CollectSymbols(Scope &scope, symbolMap &symbols) {
+  for (auto &pair : scope) {
+    Symbol &symbol{pair.second};
+    for (const auto &name : symbol.occurrences()) {
+      symbols.emplace(name, &symbol);
+    }
+  }
+  for (auto &child : scope.children()) {
+    CollectSymbols(child, symbols);
+  }
+}
+
+void RewriteParseTree(parser::Program &program) {
+  symbolMap symbols;
+  CollectSymbols(Scope::globalScope, symbols);
+  RewriteMutator mutator{symbols};
+  parser::Walk(program, mutator);
+}
+
+}  // namespace Fortran::semantics
diff --git a/flang/lib/semantics/rewrite-parse-tree.h b/flang/lib/semantics/rewrite-parse-tree.h
new file mode 100644 (file)
index 0000000..725ddca
--- /dev/null
@@ -0,0 +1,11 @@
+namespace Fortran::parser {
+
+class Program;
+
+}  // namespace Fortran::parser
+
+namespace Fortran::semantics {
+
+void RewriteParseTree(parser::Program &);
+
+}  // namespace Fortran::semantics
index 358d7f3..3c01654 100644 (file)
@@ -4,11 +4,11 @@
 
 namespace Fortran::semantics {
 
-const Scope Scope::systemScope{Scope::systemScope, Scope::Kind::System};
-Scope Scope::globalScope{Scope::systemScope, Scope::Kind::Global};
+const Scope Scope::systemScope{Scope::systemScope, Scope::Kind::System, nullptr};
+Scope Scope::globalScope{Scope::systemScope, Scope::Kind::Global, nullptr};
 
-Scope &Scope::MakeScope(Kind kind) {
-  children_.emplace_back(*this, kind);
+Scope &Scope::MakeScope(Kind kind, const Symbol *symbol) {
+  children_.emplace_back(*this, kind, symbol);
   return children_.back();
 }
 
index fcecc36..d63fd5b 100644 (file)
@@ -21,16 +21,18 @@ public:
 
   ENUM_CLASS(Kind, System, Global, Module, MainProgram, Subprogram)
 
-  Scope(const Scope &parent, Kind kind) : parent_{parent}, kind_{kind} {}
+  Scope(const Scope &parent, Kind kind, const Symbol *symbol)
+    : parent_{parent}, kind_{kind}, symbol_{symbol} {}
 
   const Scope &parent() const {
     CHECK(kind_ != Kind::System);
     return parent_;
   }
   Kind kind() const { return kind_; }
+  const Symbol *symbol() const { return symbol_; }
 
   /// Make a scope nested in this one
-  Scope &MakeScope(Kind kind);
+  Scope &MakeScope(Kind kind, const Symbol *symbol = nullptr);
 
   using size_type = mapType::size_type;
   using iterator = mapType::iterator;
@@ -67,9 +69,13 @@ public:
     return symbols_.try_emplace(name, *this, name, attrs, details);
   }
 
+  std::list<Scope> &children() { return children_; }
+  const std::list<Scope> &children() const { return children_; }
+
 private:
   const Scope &parent_;
   const Kind kind_;
+  const Symbol *const symbol_;
   std::list<Scope> children_;
   mapType symbols_;
 
index 8670b9c..a28cd10 100644 (file)
@@ -32,7 +32,6 @@ const std::string Symbol::GetDetailsName() const {
 }
 
 std::ostream &operator<<(std::ostream &os, const EntityDetails &x) {
-  os << "Entity";
   if (x.type()) {
     os << " type: " << *x.type();
   }
@@ -59,14 +58,14 @@ std::ostream &operator<<(std::ostream &os, const Symbol &sym) {
   if (!sym.attrs().empty()) {
     os << ", " << sym.attrs();
   }
-  os << ": ";
+  os << ": " << sym.GetDetailsName();
   std::visit(
       parser::visitors{
-          [&](const UnknownDetails &x) { os << " Unknown"; },
-          [&](const MainProgramDetails &x) { os << " MainProgram"; },
-          [&](const ModuleDetails &x) { os << " Module"; },
+          [&](const UnknownDetails &x) {},
+          [&](const MainProgramDetails &x) {},
+          [&](const ModuleDetails &x) {},
           [&](const SubprogramDetails &x) {
-            os << " Subprogram (";
+            os << " (";
             int n = 0;
             for (const auto &dummy : x.dummyArgs()) {
               if (n++ > 0) os << ", ";
@@ -80,7 +79,7 @@ std::ostream &operator<<(std::ostream &os, const Symbol &sym) {
               os << x.result().name().ToString() << ')';
             }
           },
-          [&](const EntityDetails &x) { os << ' ' << x; },
+          [&](const EntityDetails &x) { os << x; },
       },
       sym.details_);
   return os;
diff --git a/flang/test/semantics/resolve08.f90 b/flang/test/semantics/resolve08.f90
new file mode 100644 (file)
index 0000000..32274ce
--- /dev/null
@@ -0,0 +1,6 @@
+integer :: g(10)
+f(i) = i + 1  ! statement function
+g(i) = i + 2  ! mis-parsed array assignment
+!ERROR: 'h' has not been declared as an array
+h(i) = i + 3
+end
index d12ec01..f71b0a9 100644 (file)
@@ -71,6 +71,7 @@ struct DriverOptions {
   bool dumpCookedChars{false};
   bool dumpUnparse{false};
   bool dumpParseTree{false};
+  bool dumpSymbols{false};
   bool debugResolveNames{false};
   bool measureTree{false};
   std::vector<std::string> pgf90Args;
@@ -176,9 +177,12 @@ std::string CompileFortran(std::string path, Fortran::parser::Options options,
   if (driver.measureTree) {
     MeasureParseTree(*parsing.parseTree());
   }
-  if (driver.debugResolveNames) {
+  if (driver.debugResolveNames || driver.dumpSymbols) {
     Fortran::semantics::ResolveNames(
         *parsing.parseTree(), parsing.messages().cooked());
+    if (driver.dumpSymbols) {
+      Fortran::semantics::DumpSymbols(std::cout);
+    }
   }
   if (driver.dumpParseTree) {
     Fortran::parser::DumpTree(*parsing.parseTree());
@@ -319,6 +323,8 @@ int main(int argc, char *const argv[]) {
       driver.dumpProvenance = true;
     } else if (arg == "-fdebug-dump-parse-tree") {
       driver.dumpParseTree = true;
+    } else if (arg == "-fdebug-dump-symbols") {
+      driver.dumpSymbols = true;
     } else if (arg == "-fdebug-resolve-names") {
       driver.debugResolveNames = true;
     } else if (arg == "-fdebug-measure-parse-tree") {