[flang] Save analyzed CALL statements in the parse tree

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

flang/lib/evaluate/call.cc

@@ -196,5 +196,8 @@ std::optional<Expr<SubscriptInteger>> ProcedureRef::LEN() const {
   return proc_.LEN();
 }
 
+ProcedureRef::~ProcedureRef() {}
+
 FOR_EACH_SPECIFIC_TYPE(template class FunctionRef, )
 }
+DEFINE_DELETER(Fortran::evaluate::ProcedureRef)

flang/lib/evaluate/call.h

@@ -188,6 +188,7 @@ public:
   CLASS_BOILERPLATE(ProcedureRef)
   ProcedureRef(ProcedureDesignator &&p, ActualArguments &&a)
     : proc_{std::move(p)}, arguments_(std::move(a)) {}
+  ~ProcedureRef();
 
   ProcedureDesignator &proc() { return proc_; }
   const ProcedureDesignator &proc() const { return proc_; }

flang/lib/evaluate/expression.cc

@@ -169,13 +169,13 @@ StructureConstructor &StructureConstructor::Add(
   return *this;
 }
 
-GenericExprWrapper::~GenericExprWrapper() = default;
+GenericExprWrapper::~GenericExprWrapper() {}
 
 bool GenericExprWrapper::operator==(const GenericExprWrapper &that) const {
   return v == that.v;
 }
 
-GenericAssignmentWrapper::~GenericAssignmentWrapper() = default;
+GenericAssignmentWrapper::~GenericAssignmentWrapper() {}
 
 template<TypeCategory CAT> int Expr<SomeKind<CAT>>::GetKind() const {
   return std::visit(

flang/lib/parser/parse-tree.h

@@ -71,6 +71,7 @@ class DerivedTypeSpec;
 namespace Fortran::evaluate {
 struct GenericExprWrapper;  // forward definition, wraps Expr<SomeType>
 struct GenericAssignmentWrapper;  // forward definition, represent assignment
+class ProcedureRef;  // forward definition, represents a CALL statement
 }
 
 // Most non-template classes in this file use these default definitions
@@ -3136,7 +3137,12 @@ struct FunctionReference {
 };
 
 // R1521 call-stmt -> CALL procedure-designator [( [actual-arg-spec-list] )]
-WRAPPER_CLASS(CallStmt, Call);
+struct CallStmt {
+  WRAPPER_CLASS_BOILERPLATE(CallStmt, Call);
+  mutable std::unique_ptr<evaluate::ProcedureRef,
+      common::Deleter<evaluate::ProcedureRef>>
+      typedCall;  // filled by semantics
+};
 
 // R1529 function-subprogram ->
 //         function-stmt [specification-part] [execution-part]

flang/lib/parser/unparse.cc

@@ -33,10 +33,10 @@ class UnparseVisitor {
 public:
   UnparseVisitor(std::ostream &out, int indentationAmount, Encoding encoding,
       bool capitalize, bool backslashEscapes, preStatementType *preStatement,
-      TypedExprAsFortran *expr)
+      AnalyzedObjectsAsFortran *asFortran)
     : out_{out}, indentationAmount_{indentationAmount}, encoding_{encoding},
       capitalizeKeywords_{capitalize}, backslashEscapes_{backslashEscapes},
-      preStatement_{preStatement}, typedExprAsFortran_{expr} {}
+      preStatement_{preStatement}, asFortran_{asFortran} {}
 
   // In nearly all cases, this code avoids defining Boolean-valued Pre()
   // callbacks for the parse tree walking framework in favor of two void
@@ -803,9 +803,9 @@ public:
 
   // R1001 - R1022
   bool Pre(const Expr &x) {
-    if (typedExprAsFortran_ && x.typedExpr.get()) {
+    if (asFortran_ && x.typedExpr.get()) {
       // Format the expression representation from semantics
-      (*typedExprAsFortran_)(out_, *x.typedExpr);
+      asFortran_->expr(out_, *x.typedExpr);
       return false;
     } else {
       return true;
@@ -846,7 +846,11 @@ public:
     Walk(x.v);
   }
   void Unparse(const AssignmentStmt &x) {  // R1032
-    Walk(x.t, " = ");
+    if (asFortran_ && x.typedAssignment.get()) {
+      asFortran_->assignment(out_, *x.typedAssignment);
+    } else {
+      Walk(x.t, " = ");
+    }
   }
   void Unparse(const PointerAssignmentStmt &x) {  // R1033, R1034, R1038
     Walk(std::get<DataRef>(x.t));
@@ -1639,15 +1643,19 @@ public:
     Put('('), Walk(std::get<std::list<ActualArgSpec>>(x.v.t), ", "), Put(')');
   }
   void Unparse(const CallStmt &x) {  // R1521
-    const auto &pd{std::get<ProcedureDesignator>(x.v.t)};
-    const auto &args{std::get<std::list<ActualArgSpec>>(x.v.t)};
-    Word("CALL "), Walk(pd);
-    if (args.empty()) {
-      if (std::holds_alternative<ProcComponentRef>(pd.u)) {
-        Put("()");  // pgf90 crashes on CALL to tbp without parentheses
-      }
+    if (asFortran_ && x.typedCall.get()) {
+      asFortran_->call(out_, *x.typedCall);
     } else {
-      Walk("(", args, ", ", ")");
+      const auto &pd{std::get<ProcedureDesignator>(x.v.t)};
+      const auto &args{std::get<std::list<ActualArgSpec>>(x.v.t)};
+      Word("CALL "), Walk(pd);
+      if (args.empty()) {
+        if (std::holds_alternative<ProcComponentRef>(pd.u)) {
+          Put("()");  // pgf90 crashes on CALL to tbp without parentheses
+        }
+      } else {
+        Walk("(", args, ", ", ")");
+      }
     }
   }
   void Unparse(const ActualArgSpec &x) {  // R1523
@@ -2510,7 +2518,7 @@ private:
   bool openmpDirective_{false};
   bool backslashEscapes_{false};
   preStatementType *preStatement_{nullptr};
-  TypedExprAsFortran *typedExprAsFortran_{nullptr};
+  AnalyzedObjectsAsFortran *asFortran_{nullptr};
 };
 
 void UnparseVisitor::Put(char ch) {
@@ -2583,9 +2591,9 @@ void UnparseVisitor::Word(const std::string &str) { Word(str.c_str()); }
 
 void Unparse(std::ostream &out, const Program &program, Encoding encoding,
     bool capitalizeKeywords, bool backslashEscapes,
-    preStatementType *preStatement, TypedExprAsFortran *expr) {
+    preStatementType *preStatement, AnalyzedObjectsAsFortran *asFortran) {
   UnparseVisitor visitor{out, 1, encoding, capitalizeKeywords, backslashEscapes,
-      preStatement, expr};
+      preStatement, asFortran};
   Walk(program, visitor);
   visitor.Done();
 }

flang/lib/parser/unparse.h

@@ -22,6 +22,8 @@
 
 namespace Fortran::evaluate {
 struct GenericExprWrapper;
+struct GenericAssignmentWrapper;
+class ProcedureRef;
 }
 
 namespace Fortran::parser {
@@ -32,16 +34,22 @@ struct Program;
 using preStatementType =
     std::function<void(const CharBlock &, std::ostream &, int)>;
 
-// A function to handle unparsing of evaluate::GenericExprWrapper
-// rather than original expression parse trees.
-using TypedExprAsFortran =
-    std::function<void(std::ostream &, const evaluate::GenericExprWrapper &)>;
+// Functions to handle unparsing of analyzed expressions and related
+// objects rather than their original parse trees.
+struct AnalyzedObjectsAsFortran {
+  std::function<void(std::ostream &, const evaluate::GenericExprWrapper &)>
+      expr;
+  std::function<void(
+      std::ostream &, const evaluate::GenericAssignmentWrapper &)>
+      assignment;
+  std::function<void(std::ostream &, const evaluate::ProcedureRef &)> call;
+};
 
 // Converts parsed program to out as Fortran.
 void Unparse(std::ostream &out, const Program &program,
     Encoding encoding = Encoding::UTF_8, bool capitalizeKeywords = true,
     bool backslashEscapes = true, preStatementType *preStatement = nullptr,
-    TypedExprAsFortran *expr = nullptr);
+    AnalyzedObjectsAsFortran * = nullptr);
 }
 
 #endif

flang/lib/semantics/expression.cc

@@ -1822,8 +1822,11 @@ MaybeExpr ExpressionAnalyzer::Analyze(
   return AnalyzeCall(funcRef.v, false);
 }
 
-void ExpressionAnalyzer::Analyze(const parser::CallStmt &call) {
-  AnalyzeCall(call.v, true);
+void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
+  auto expr{AnalyzeCall(callStmt.v, true)};
+  if (auto *procRef{UnwrapExpr<ProcedureRef>(expr)}) {
+    callStmt.typedCall.reset(new ProcedureRef{*procRef});
+  }
 }
 
 MaybeExpr ExpressionAnalyzer::AnalyzeCall(

flang/tools/f18/f18.cc

@@ -289,20 +289,40 @@ std::string CompileFortran(std::string path, Fortran::parser::Options options,
     Fortran::parser::DumpTree(std::cout, parseTree);
   }
 
-  Fortran::parser::TypedExprAsFortran unparseExpression{
+  Fortran::parser::AnalyzedObjectsAsFortran asFortran{
       [](std::ostream &o, const Fortran::evaluate::GenericExprWrapper &x) {
         if (x.v) {
           o << *x.v;
         } else {
           o << "(bad expression)";
         }
-      }};
+      },
+      [](std::ostream &o,
+          const Fortran::evaluate::GenericAssignmentWrapper &x) {
+        if (x.v) {
+          std::visit(
+              Fortran::common::visitors{
+                  [&](const Fortran::evaluate::Assignment::IntrinsicAssignment
+                          &y) { y.rhs.AsFortran(y.lhs.AsFortran(o) << '='); },
+                  [&](const Fortran::evaluate::ProcedureRef &y) {
+                    y.AsFortran(o << "CALL ");
+                  },
+              },
+              x.v->u);
+        } else {
+          o << "(bad assignment)";
+        }
+      },
+      [](std::ostream &o, const Fortran::evaluate::ProcedureRef &x) {
+        x.AsFortran(o << "CALL ");
+      },
+  };
 
   if (driver.dumpUnparse) {
     Unparse(std::cout, parseTree, driver.encoding, true /*capitalize*/,
         options.features.IsEnabled(
             Fortran::common::LanguageFeature::BackslashEscapes),
-        nullptr /* action before each statement */, &unparseExpression);
+        nullptr /* action before each statement */, &asFortran);
     return {};
   }
   if (driver.parseOnly) {
@@ -322,7 +342,7 @@ std::string CompileFortran(std::string path, Fortran::parser::Options options,
         options.features.IsEnabled(
             Fortran::common::LanguageFeature::BackslashEscapes),
         nullptr /* action before each statement */,
-        driver.unparseTypedExprsToPGF90 ? &unparseExpression : nullptr);
+        driver.unparseTypedExprsToPGF90 ? &asFortran : nullptr);
     Fortran::evaluate::formatForPGF90 = false;
   }
 

flang/tools/f18/stub-evaluate.cc

@@ -12,10 +12,10 @@
 // See the License for the specific language governing permissions and
 // limitations under the License.
 
-// The parse tree has slots in which pointers to typed expressions may be
-// placed.  When using the parser without the expression library, as here,
-// we need to stub out the dependence on the external destructor, which
-// will never actually be called.
+// The parse tree has slots in which pointers to the results of semantic
+// analysis may be placed.  When using the parser without the semantics
+// libraries, as here, we need to stub out the dependences on the external
+// destructors, which will never actually be called.
 
 #include "../../lib/common/indirection.h"
 
@@ -23,12 +23,17 @@ namespace Fortran::evaluate {
 struct GenericExprWrapper {
   ~GenericExprWrapper();
 };
-GenericExprWrapper::~GenericExprWrapper() = default;
+GenericExprWrapper::~GenericExprWrapper() {}
 struct GenericAssignmentWrapper {
   ~GenericAssignmentWrapper();
 };
-GenericAssignmentWrapper::~GenericAssignmentWrapper() = default;
+GenericAssignmentWrapper::~GenericAssignmentWrapper() {}
+struct ProcedureRef {
+  ~ProcedureRef();
+};
+ProcedureRef::~ProcedureRef() {}
 }
 
 DEFINE_DELETER(Fortran::evaluate::GenericExprWrapper)
 DEFINE_DELETER(Fortran::evaluate::GenericAssignmentWrapper)
+DEFINE_DELETER(Fortran::evaluate::ProcedureRef)