Merge branch 'copy-inout-dev' into copy-inout-review

Author: eugeneepshteyn

flang/include/flang/Evaluate/call.h

@@ -248,11 +248,7 @@ class ProcedureRef {
   ProcedureRef(ProcedureDesignator &&p, ActualArguments &&a,
       bool hasAlternateReturns = false)
       : proc_{std::move(p)}, arguments_{std::move(a)},
-        hasAlternateReturns_{hasAlternateReturns} {
-    // Gathers necessary information to determine the need for copy-in and
-    // copy-out
-    DetermineCopyInOut();
-  }
+        hasAlternateReturns_{hasAlternateReturns} {}
   ~ProcedureRef();
   static void Deleter(ProcedureRef *);
 
@@ -289,9 +285,9 @@ class ProcedureRef {
   bool operator==(const ProcedureRef &) const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
 
-protected:
   void DetermineCopyInOut();
 
+protected:
   ProcedureDesignator proc_;
   ActualArguments arguments_;
   Chevrons chevrons_;

flang/include/flang/Evaluate/check-expression.h

@@ -118,6 +118,9 @@ std::optional<bool> IsContiguous(const A &, FoldingContext &,
 extern template std::optional<bool> IsContiguous(const Expr<SomeType> &,
     FoldingContext &, bool namedConstantSectionsAreContiguous,
     bool firstDimensionStride1);
+extern template std::optional<bool> IsContiguous(const ActualArgument &,
+    FoldingContext &, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1);
 extern template std::optional<bool> IsContiguous(const ArrayRef &,
     FoldingContext &, bool namedConstantSectionsAreContiguous,
     bool firstDimensionStride1);

flang/include/flang/Evaluate/tools.h

@@ -1123,6 +1123,7 @@ extern template semantics::UnorderedSymbolSet CollectCudaSymbols(
 
 // Predicate: does a variable contain a vector-valued subscript (not a triplet)?
 bool HasVectorSubscript(const Expr<SomeType> &);
+bool HasVectorSubscript(const ActualArgument &);
 
 // Predicate: does an expression contain constant?
 bool HasConstant(const Expr<SomeType> &);

flang/lib/Evaluate/call.cpp

@@ -248,19 +248,108 @@ ProcedureRef::~ProcedureRef() {}
 
 void ProcedureRef::Deleter(ProcedureRef *p) { delete p; }
 
+// We don't know the dummy argument info (e.g., procedure with implicit
+// interface
+static void DetermineCopyInOutArgument(
+    const characteristics::Procedure &procInfo, ActualArgument &actual,
+    semantics::SemanticsContext &sc) {
+  if (actual.isAlternateReturn()) {
+    return;
+  }
+  if (!evaluate::IsVariable(actual)) {
+    // Actual argument expressions that aren’t variables are copy-in, but
+    // not copy-out.
+    actual.set_mayNeedCopyIn();
+  } else if (!IsSimplyContiguous(actual, sc.foldingContext())) {
+    // Actual arguments that are variables are copy-in when non-contiguous.
+    // They are copy-out when don't have vector subscripts
+    actual.set_mayNeedCopyIn();
+    if (!HasVectorSubscript(actual)) {
+      actual.set_mayNeedCopyOut();
+    }
+  } else if (ExtractCoarrayRef(actual)) {
+    // Coindexed actual args need copy-in and copy-out
+    actual.set_mayNeedCopyIn();
+    actual.set_mayNeedCopyOut();
+  }
+}
+
+static void DetermineCopyInOutArgument(
+    const characteristics::Procedure &procInfo, ActualArgument &actual,
+    characteristics::DummyArgument &dummy, semantics::SemanticsContext &sc) {
+  assert(procInfo.HasExplicitInterface() && "expect explicit interface proc");
+  if (actual.isAlternateReturn()) {
+    return;
+  }
+  // TODO
+}
+
 void ProcedureRef::DetermineCopyInOut() {
-  if (!proc().GetSymbol()) {
+  if (!proc_.GetSymbol()) {
     return;
   }
   // Get folding context of the call site owner
-  FoldingContext &fc{proc_.GetSymbol()->owner().context().foldingContext()};
-  auto procInfo{characteristics::Procedure::Characterize(
-      proc_, fc, /*emitError=*/true)};
+  semantics::SemanticsContext &sc{proc_.GetSymbol()->owner().context()};
+  FoldingContext &fc{sc.foldingContext()};
+  auto procInfo{
+      characteristics::Procedure::Characterize(proc_, fc, /*emitError=*/true)};
   if (!procInfo) {
     return;
   }
-  // TODO: at this point have dummy arguments as procInfo->dummyArguments
-  // and have actual arguments via arguments_
+  if (!procInfo->HasExplicitInterface()) {
+    for (auto &actual : arguments_) {
+      if (!actual) {
+        continue;
+      }
+      DetermineCopyInOutArgument(*procInfo, *actual, sc);
+    }
+    return;
+  }
+  // Don't change anything about actual or dummy arguments, except for
+  // computing copy-in/copy-out information. If detect something wrong with
+  // the arguments, stop processing and let semantic analysis generate the
+  // error messages.
+  size_t index{0};
+  std::set<std::string> processedKeywords;
+  bool seenKeyword{false};
+  for (auto &actual : arguments_) {
+    if (!actual) {
+      continue;
+    }
+    if (index >= procInfo->dummyArguments.size()) {
+      // More actual arguments than dummy arguments. Semantic analysis will
+      // deal with the error.
+      return;
+    }
+    if (actual->keyword()) {
+      seenKeyword = true;
+      auto actualName = actual->keyword()->ToString();
+      if (processedKeywords.find(actualName) != processedKeywords.end()) {
+        // Actual arguments with duplicate keywords. Semantic analysis will
+        // deal with the error.
+        return;
+      } else {
+        processedKeywords.insert(actualName);
+        if (auto it = std::find_if(procInfo->dummyArguments.begin(),
+                procInfo->dummyArguments.end(),
+                [&](const characteristics::DummyArgument &dummy) {
+                  return dummy.name == actualName;
+                });
+            it != procInfo->dummyArguments.end()) {
+          DetermineCopyInOutArgument(*procInfo, *actual, *it, sc);
+        }
+      }
+    } else if (seenKeyword) {
+      // Non-keyword actual argument after have seen at least one keyword
+      // actual argument. Semantic analysis will deal with the error.
+      return;
+    } else {
+      // Positional argument processing
+      DetermineCopyInOutArgument(
+          *procInfo, *actual, procInfo->dummyArguments[index], sc);
+    }
+    ++index;
+  }
 }
 
 } // namespace Fortran::evaluate

flang/lib/Evaluate/check-expression.cpp

@@ -1198,9 +1198,21 @@ std::optional<bool> IsContiguous(const A &x, FoldingContext &context,
   }
 }
 
+std::optional<bool> IsContiguous(const ActualArgument &actual,
+    FoldingContext &fc, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1) {
+  auto *expr{actual.UnwrapExpr()};
+  return expr &&
+      IsContiguous(
+          *expr, fc, namedConstantSectionsAreContiguous, firstDimensionStride1);
+}
+
 template std::optional<bool> IsContiguous(const Expr<SomeType> &,
     FoldingContext &, bool namedConstantSectionsAreContiguous,
     bool firstDimensionStride1);
+template std::optional<bool> IsContiguous(const ActualArgument &,
+    FoldingContext &, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1);
 template std::optional<bool> IsContiguous(const ArrayRef &, FoldingContext &,
     bool namedConstantSectionsAreContiguous, bool firstDimensionStride1);
 template std::optional<bool> IsContiguous(const Substring &, FoldingContext &,

flang/lib/Evaluate/tools.cpp

@@ -1203,6 +1203,11 @@ bool HasVectorSubscript(const Expr<SomeType> &expr) {
   return HasVectorSubscriptHelper{}(expr);
 }
 
+bool HasVectorSubscript(const ActualArgument &actual) {
+  auto expr = actual.UnwrapExpr();
+  return expr && HasVectorSubscript(*expr);
+}
+
 // HasConstant()
 struct HasConstantHelper : public AnyTraverse<HasConstantHelper, bool,
                                /*TraverseAssocEntityDetails=*/false> {

flang/lib/Semantics/expression.cpp

@@ -3455,6 +3455,7 @@ void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
                 HasAlternateReturns(callee->arguments)},
             ProcedureRef::Deleter);
         DEREF(callStmt.typedCall.get()).set_chevrons(std::move(*chevrons));
+        DEREF(callStmt.typedCall.get()).DetermineCopyInOut();
         return;
       }
     }