[flang][DRAFT-DEV][DO NOT REVIEW] Copy-in/Copy-out determination

flang/include/flang/Evaluate/call.h

@@ -52,7 +52,7 @@ using SymbolRef = common::Reference<const Symbol>;
 
 class ActualArgument {
 public:
-  ENUM_CLASS(Attr, PassedObject, PercentVal, PercentRef);
+  ENUM_CLASS(Attr, PassedObject, PercentVal, PercentRef, CopyIn, CopyOut);
   using Attrs = common::EnumSet<Attr, Attr_enumSize>;
 
   // Dummy arguments that are TYPE(*) can be forwarded as actual arguments.
@@ -131,7 +131,6 @@ class ActualArgument {
     return *this;
   }
 
-  bool Matches(const characteristics::DummyArgument &) const;
   common::Intent dummyIntent() const { return dummyIntent_; }
   ActualArgument &set_dummyIntent(common::Intent intent) {
     dummyIntent_ = intent;
@@ -161,6 +160,20 @@ class ActualArgument {
     return *this;
   }
 
+  // This actual argument may need copy-in before the procedure call
+  bool GetMayNeedCopyIn() const { return attrs_.test(Attr::CopyIn); };
+  ActualArgument &SetMayNeedCopyIn() {
+    attrs_ = attrs_ + Attr::CopyIn;
+    return *this;
+  }
+
+  // This actual argument may need copy-out after the procedure call
+  bool GetMayNeedCopyOut() const { return attrs_.test(Attr::CopyOut); };
+  ActualArgument &SetMayNeedCopyOut() {
+    attrs_ = attrs_ + Attr::CopyOut;
+    return *this;
+  }
+
 private:
   // Subtlety: There is a distinction that must be maintained here between an
   // actual argument expression that is a variable and one that is not,
@@ -272,6 +285,8 @@ class ProcedureRef {
   bool operator==(const ProcedureRef &) const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
 
+  void DetermineCopyInOut();
+
 protected:
   ProcedureDesignator proc_;
   ActualArguments arguments_;

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/shape.h

@@ -35,6 +35,7 @@ using Shape = std::vector<MaybeExtentExpr>;
 
 bool IsImpliedShape(const Symbol &);
 bool IsExplicitShape(const Symbol &);
+bool IsExplicitShape(const Shape &);
 
 // Conversions between various representations of shapes.
 std::optional<ExtentExpr> AsExtentArrayExpr(const Shape &);

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

@@ -12,6 +12,7 @@
 #include "flang/Evaluate/check-expression.h"
 #include "flang/Evaluate/expression.h"
 #include "flang/Evaluate/tools.h"
+#include "flang/Semantics/semantics.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Support/Fortran.h"
 
@@ -247,4 +248,163 @@ 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.SetMayNeedCopyIn();
+  } 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.SetMayNeedCopyIn();
+    if (!HasVectorSubscript(actual)) {
+      actual.SetMayNeedCopyOut();
+    }
+  } else if (ExtractCoarrayRef(actual)) {
+    // Coindexed actual args need copy-in and copy-out
+    actual.SetMayNeedCopyIn();
+    actual.SetMayNeedCopyOut();
+  }
+}
+
+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;
+  }
+  const auto *dummyObj{std::get_if<characteristics::DummyDataObject>(&dummy.u)};
+  if (!dummyObj) {
+    // Only DummyDataObject has the information we need
+    return;
+  }
+  // Pass by value, always copy-in, never copy-out
+  bool dummyIsValue{
+      dummyObj->attrs.test(characteristics::DummyDataObject::Attr::Value)};
+  if (dummyIsValue) {
+    actual.SetMayNeedCopyIn();
+    return;
+  }
+  bool dummyIntentIn{dummyObj->intent == common::Intent::In};
+  bool dummyIntentOut{dummyObj->intent == common::Intent::Out};
+
+  auto setCopyIn = [&]() {
+    if (!dummyIntentOut) {
+      // INTENT(OUT) never need copy-in
+      actual.SetMayNeedCopyIn();
+    }
+  };
+  auto setCopyOut = [&]() {
+    if (!dummyIntentIn) {
+      // INTENT(IN) never need copy-out
+      actual.SetMayNeedCopyOut();
+    }
+  };
+
+  // Check actual contiguity, unless dummy doesn't care
+  bool actualTreatAsContiguous{
+      dummyObj->ignoreTKR.test(common::IgnoreTKR::Contiguous) ||
+      IsSimplyContiguous(actual, sc.foldingContext())};
+
+  bool actualHasVectorSubscript{HasVectorSubscript(actual)};
+  bool actualIsArray{actual.Rank() > 0};
+
+  bool dummyIsArray{dummyObj->type.Rank() > 0};
+  bool dummyIsExplicitShape{
+      dummyIsArray ? IsExplicitShape(*dummyObj->type.shape()) : false};
+  bool dummyIsAssumedSize{dummyObj->type.attrs().test(
+      characteristics::TypeAndShape::Attr::AssumedSize)};
+  bool dummyNeedsContiguity{dummyIsArray &&
+      (dummyIsExplicitShape || dummyIsAssumedSize ||
+          dummyObj->attrs.test(
+              characteristics::DummyDataObject::Attr::Contiguous))};
+  if (!actualTreatAsContiguous && dummyNeedsContiguity) {
+    setCopyIn();
+    if (!actualHasVectorSubscript) {
+      setCopyOut();
+    }
+    return;
+  }
+
+  // TODO: passing polymorphic to non-polymorphic
+
+  // TODO
+}
+
+void ProcedureRef::DetermineCopyInOut() {
+  if (!proc_.GetSymbol()) {
+    return;
+  }
+  // Get folding context of the call site owner
+  semantics::SemanticsContext &sc{proc_.GetSymbol()->owner().context()};
+  FoldingContext &fc{sc.foldingContext()};
+  auto procInfo{
+      characteristics::Procedure::Characterize(proc_, fc, /*emitError=*/true)};
+  if (!procInfo) {
+    return;
+  }
+  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/shape.cpp

@@ -47,6 +47,17 @@ bool IsExplicitShape(const Symbol &original) {
   }
 }
 
+bool IsExplicitShape(const Shape &shape) {
+  // If extent expression is present for all dimensions, then assume
+  // explicit shape.
+  for (const auto &dim : shape) {
+    if (!dim) {
+      return false;
+    }
+  }
+  return true;
+}
+
 Shape GetShapeHelper::ConstantShape(const Constant<ExtentType> &arrayConstant) {
   CHECK(arrayConstant.Rank() == 1);
   Shape result;

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;
       }
     }