[flang-commits] [PATCH] D131096: [flang] Allow pure function references in expandable scalar

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: jeanPerier.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a project: All.
klausler requested review of this revision.

F18 <https://reviews.llvm.org/F18> disallows function references and coarray references from
appearing in scalar expressions that are to be expanded into
arrays to conform with other operands or actual arguments in
an elemental expression.  This is too strong, as pure procedures
can be safely used.


https://reviews.llvm.org/D131096

Files:
  flang/include/flang/Evaluate/call.h
  flang/include/flang/Evaluate/tools.h
  flang/lib/Evaluate/call.cpp
  flang/lib/Semantics/expression.cpp


Index: flang/lib/Semantics/expression.cpp
===================================================================
--- flang/lib/Semantics/expression.cpp
+++ flang/lib/Semantics/expression.cpp
@@ -1833,7 +1833,7 @@
                         "component", "value")};
                 if (checked && *checked && GetRank(*componentShape) > 0 &&
                     GetRank(*valueShape) == 0 &&
-                    !IsExpandableScalar(*converted)) {
+                    !IsExpandableScalar(*converted, true /*admit PURE call*/)) {
                   AttachDeclaration(
                       Say(expr.source,
                           "Scalar value cannot be expanded to shape of array component '%s'"_err_en_US,
Index: flang/lib/Evaluate/call.cpp
===================================================================
--- flang/lib/Evaluate/call.cpp
+++ flang/lib/Evaluate/call.cpp
@@ -145,6 +145,20 @@
   return false;
 }
 
+bool ProcedureDesignator::IsPure() const {
+  if (const Symbol * interface{GetInterfaceSymbol()}) {
+    return IsPureProcedure(*interface);
+  } else if (const Symbol * symbol{GetSymbol()}) {
+    return IsPureProcedure(*symbol);
+  } else if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&u)}) {
+    return intrinsic->characteristics.value().attrs.test(
+        characteristics::Procedure::Attr::Pure);
+  } else {
+    DIE("ProcedureDesignator::IsPure(): no case");
+  }
+  return false;
+}
+
 const SpecificIntrinsic *ProcedureDesignator::GetSpecificIntrinsic() const {
   return std::get_if<SpecificIntrinsic>(&u);
 }
Index: flang/include/flang/Evaluate/tools.h
===================================================================
--- flang/include/flang/Evaluate/tools.h
+++ flang/include/flang/Evaluate/tools.h
@@ -1007,17 +1007,25 @@
 // Predicate: is a scalar expression suitable for naive scalar expansion
 // in the flattening of an array expression?
 // TODO: capture such scalar expansions in temporaries, flatten everything
-struct UnexpandabilityFindingVisitor
+class UnexpandabilityFindingVisitor
     : public AnyTraverse<UnexpandabilityFindingVisitor> {
+public:
   using Base = AnyTraverse<UnexpandabilityFindingVisitor>;
   using Base::operator();
-  UnexpandabilityFindingVisitor() : Base{*this} {}
-  template <typename T> bool operator()(const FunctionRef<T> &) { return true; }
+  explicit UnexpandabilityFindingVisitor(bool admitPureCall)
+      : Base{*this}, admitPureCall_{admitPureCall} {}
+  template <typename T> bool operator()(const FunctionRef<T> &procRef) {
+    return !admitPureCall_ || !procRef.proc().IsPure();
+  }
   bool operator()(const CoarrayRef &) { return true; }
+
+private:
+  bool admitPureCall_{false};
 };
 
-template <typename T> bool IsExpandableScalar(const Expr<T> &expr) {
-  return !UnexpandabilityFindingVisitor{}(expr);
+template <typename T>
+bool IsExpandableScalar(const Expr<T> &expr, bool admitPureCall = false) {
+  return !UnexpandabilityFindingVisitor{admitPureCall}(expr);
 }
 
 // Common handling for procedure pointer compatibility of left- and right-hand
Index: flang/include/flang/Evaluate/call.h
===================================================================
--- flang/include/flang/Evaluate/call.h
+++ flang/include/flang/Evaluate/call.h
@@ -199,6 +199,7 @@
   std::optional<DynamicType> GetType() const;
   int Rank() const;
   bool IsElemental() const;
+  bool IsPure() const;
   std::optional<Expr<SubscriptInteger>> LEN() const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
 


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D131096.449746.patch
Type: text/x-patch
Size: 3501 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20220803/324bae08/attachment.bin>