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

[Peter Klausler via Phabricator via flang-commits]

This revision was automatically updated to reflect the committed changes.
Closed by commit rG3f10091c04e1: [flang] Allow pure function references in expandable scalar (authored by klausler).

Repository:
  rG LLVM Github Monorepo

CHANGES SINCE LAST ACTION
  https://reviews.llvm.org/D131096/new/

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.450634.patch
Type: text/x-patch
Size: 3501 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20220807/c1ba1fd6/attachment.bin>