[Flang] Add parsing and attribute registration for SIMPLE procedures

flang/include/flang/Evaluate/call.h

@@ -99,7 +99,7 @@ class ActualArgument {
   }
 
   const Symbol *GetAssumedTypeDummy() const {
-    if (const AssumedType * aType{std::get_if<AssumedType>(&u_)}) {
+    if (const AssumedType *aType{std::get_if<AssumedType>(&u_)}) {
       return &aType->symbol();
     } else {
       return nullptr;
@@ -219,6 +219,7 @@ struct ProcedureDesignator {
   int Rank() const;
   bool IsElemental() const;
   bool IsPure() const;
+  bool IsSimple() const;
   std::optional<Expr<SubscriptInteger>> LEN() const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
 

flang/include/flang/Evaluate/characteristics.h

@@ -363,10 +363,10 @@ struct FunctionResult {
 
 // 15.3.1
 struct Procedure {
-  ENUM_CLASS(Attr, Pure, Elemental, BindC, ImplicitInterface, NullPointer,
-      NullAllocatable, Subroutine)
+  ENUM_CLASS(Attr, Pure, Simple, Elemental, BindC, ImplicitInterface,
+      NullPointer, NullAllocatable, Subroutine)
   using Attrs = common::EnumSet<Attr, Attr_enumSize>;
-  Procedure(){};
+  Procedure() {};
   Procedure(FunctionResult &&, DummyArguments &&, Attrs);
   Procedure(DummyArguments &&, Attrs); // for subroutines and NULL()
   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(Procedure)
@@ -396,6 +396,7 @@ struct Procedure {
   bool IsSubroutine() const { return attrs.test(Attr::Subroutine); }
 
   bool IsPure() const { return attrs.test(Attr::Pure); }
+  bool IsSimple() const { return attrs.test(Attr::Simple); }
   bool IsElemental() const { return attrs.test(Attr::Elemental); }
   bool IsBindC() const { return attrs.test(Attr::BindC); }
   bool HasExplicitInterface() const {

flang/include/flang/Evaluate/tools.h

@@ -380,7 +380,7 @@ const Symbol *IsArrayElement(const Expr<T> &expr, bool intoSubstring = true,
     bool skipComponents = false) {
   if (auto dataRef{ExtractDataRef(expr, intoSubstring)}) {
     for (const DataRef *ref{&*dataRef}; ref;) {
-      if (const Component * component{std::get_if<Component>(&ref->u)}) {
+      if (const Component *component{std::get_if<Component>(&ref->u)}) {
         ref = skipComponents ? &component->base() : nullptr;
       } else if (const auto *coarrayRef{std::get_if<CoarrayRef>(&ref->u)}) {
         ref = &coarrayRef->base();
@@ -436,7 +436,7 @@ struct ExtractCoindexedObjectHelper {
     return common::visit(*this, dataRef.u);
   }
   std::optional<CoarrayRef> operator()(const NamedEntity &named) const {
-    if (const Component * component{named.UnwrapComponent()}) {
+    if (const Component *component{named.UnwrapComponent()}) {
       return (*this)(*component);
     } else {
       return std::nullopt;
@@ -969,7 +969,7 @@ template <typename A> const Symbol *GetLastSymbol(const A &x) {
 // its set of attributes, otherwise the empty set.  Also works on variables that
 // are pointer results of functions.
 template <typename A> semantics::Attrs GetAttrs(const A &x) {
-  if (const Symbol * symbol{GetLastSymbol(x)}) {
+  if (const Symbol *symbol{GetLastSymbol(x)}) {
     return symbol->attrs();
   } else {
     return {};
@@ -980,7 +980,7 @@ template <>
 inline semantics::Attrs GetAttrs<Expr<SomeType>>(const Expr<SomeType> &x) {
   if (IsVariable(x)) {
     if (const auto *procRef{UnwrapProcedureRef(x)}) {
-      if (const Symbol * interface{procRef->proc().GetInterfaceSymbol()}) {
+      if (const Symbol *interface{procRef->proc().GetInterfaceSymbol()}) {
         if (const auto *details{
                 interface->detailsIf<semantics::SubprogramDetails>()}) {
           if (details->isFunction() &&
@@ -992,7 +992,7 @@ inline semantics::Attrs GetAttrs<Expr<SomeType>>(const Expr<SomeType> &x) {
       }
     }
   }
-  if (const Symbol * symbol{GetLastSymbol(x)}) {
+  if (const Symbol *symbol{GetLastSymbol(x)}) {
     return symbol->attrs();
   } else {
     return {};
@@ -1543,6 +1543,8 @@ inline bool IsAlternateEntry(const Symbol *symbol) {
 bool IsVariableName(const Symbol &);
 bool IsPureProcedure(const Symbol &);
 bool IsPureProcedure(const Scope &);
+bool IsSimpleProcedure(const Symbol &);
+bool IsSimpleProcedure(const Scope &);
 bool IsExplicitlyImpureProcedure(const Symbol &);
 bool IsElementalProcedure(const Symbol &);
 bool IsFunction(const Symbol &);

flang/include/flang/Parser/dump-parse-tree.h

@@ -769,6 +769,7 @@ class ParseTreeDumper {
   NODE(PrefixSpec, Non_Recursive)
   NODE(PrefixSpec, Pure)
   NODE(PrefixSpec, Recursive)
+  NODE(PrefixSpec, Simple)
   NODE(PrefixSpec, Attributes)
   NODE(PrefixSpec, Launch_Bounds)
   NODE(PrefixSpec, Cluster_Dims)

flang/include/flang/Parser/parse-tree.h

@@ -3110,7 +3110,7 @@ struct ProcedureDeclarationStmt {
 
 // R1527 prefix-spec ->
 //         declaration-type-spec | ELEMENTAL | IMPURE | MODULE |
-//         NON_RECURSIVE | PURE | RECURSIVE |
+//         NON_RECURSIVE | PURE | SIMPLE | RECURSIVE |
 // (CUDA)  ATTRIBUTES ( (DEVICE | GLOBAL | GRID_GLOBAL | HOST)... )
 //         LAUNCH_BOUNDS(expr-list) | CLUSTER_DIMS(expr-list)
 struct PrefixSpec {
@@ -3121,11 +3121,12 @@ struct PrefixSpec {
   EMPTY_CLASS(Non_Recursive);
   EMPTY_CLASS(Pure);
   EMPTY_CLASS(Recursive);
+  EMPTY_CLASS(Simple);
   WRAPPER_CLASS(Attributes, std::list<common::CUDASubprogramAttrs>);
   WRAPPER_CLASS(Launch_Bounds, std::list<ScalarIntConstantExpr>);
   WRAPPER_CLASS(Cluster_Dims, std::list<ScalarIntConstantExpr>);
   std::variant<DeclarationTypeSpec, Elemental, Impure, Module, Non_Recursive,
-      Pure, Recursive, Attributes, Launch_Bounds, Cluster_Dims>
+      Pure, Recursive, Simple, Attributes, Launch_Bounds, Cluster_Dims>
       u;
 };
 

flang/include/flang/Semantics/attr.h

@@ -25,7 +25,7 @@ ENUM_CLASS(Attr, ABSTRACT, ALLOCATABLE, ASYNCHRONOUS, BIND_C, CONTIGUOUS,
     DEFERRED, ELEMENTAL, EXTENDS, EXTERNAL, IMPURE, INTENT_IN, INTENT_INOUT,
     INTENT_OUT, INTRINSIC, MODULE, NON_OVERRIDABLE, NON_RECURSIVE, NOPASS,
     OPTIONAL, PARAMETER, PASS, POINTER, PRIVATE, PROTECTED, PUBLIC, PURE,
-    RECURSIVE, SAVE, TARGET, VALUE, VOLATILE)
+    RECURSIVE, SAVE, SIMPLE, TARGET, VALUE, VOLATILE)
 
 // Set of attributes
 class Attrs : public common::EnumSet<Attr, Attr_enumSize> {

flang/lib/Evaluate/call.cpp

@@ -66,8 +66,8 @@ void ActualArgument::Parenthesize() {
 
 SpecificIntrinsic::SpecificIntrinsic(
     IntrinsicProcedure n, characteristics::Procedure &&chars)
-    : name{n}, characteristics{
-                   new characteristics::Procedure{std::move(chars)}} {}
+    : name{n},
+      characteristics{new characteristics::Procedure{std::move(chars)}} {}
 
 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(SpecificIntrinsic)
 
@@ -98,7 +98,7 @@ std::optional<DynamicType> ProcedureDesignator::GetType() const {
 }
 
 int ProcedureDesignator::Rank() const {
-  if (const Symbol * symbol{GetSymbol()}) {
+  if (const Symbol *symbol{GetSymbol()}) {
     // Subtle: will be zero for functions returning procedure pointers
     return symbol->Rank();
   }
@@ -116,7 +116,7 @@ int ProcedureDesignator::Rank() const {
 }
 
 const Symbol *ProcedureDesignator::GetInterfaceSymbol() const {
-  if (const Symbol * symbol{GetSymbol()}) {
+  if (const Symbol *symbol{GetSymbol()}) {
     const Symbol &ultimate{symbol->GetUltimate()};
     if (const auto *proc{ultimate.detailsIf<semantics::ProcEntityDetails>()}) {
       return proc->procInterface();
@@ -131,9 +131,9 @@ const Symbol *ProcedureDesignator::GetInterfaceSymbol() const {
 }
 
 bool ProcedureDesignator::IsElemental() const {
-  if (const Symbol * interface{GetInterfaceSymbol()}) {
+  if (const Symbol *interface{GetInterfaceSymbol()}) {
     return IsElementalProcedure(*interface);
-  } else if (const Symbol * symbol{GetSymbol()}) {
+  } else if (const Symbol *symbol{GetSymbol()}) {
     return IsElementalProcedure(*symbol);
   } else if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&u)}) {
     return intrinsic->characteristics.value().attrs.test(
@@ -145,9 +145,9 @@ bool ProcedureDesignator::IsElemental() const {
 }
 
 bool ProcedureDesignator::IsPure() const {
-  if (const Symbol * interface{GetInterfaceSymbol()}) {
+  if (const Symbol *interface{GetInterfaceSymbol()}) {
     return IsPureProcedure(*interface);
-  } else if (const Symbol * symbol{GetSymbol()}) {
+  } 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(
@@ -158,6 +158,20 @@ bool ProcedureDesignator::IsPure() const {
   return false;
 }
 
+bool ProcedureDesignator::IsSimple() const {
+  if (const Symbol *interface{GetInterfaceSymbol()}) {
+    return IsSimpleProcedure(*interface);
+  } else if (const Symbol *symbol{GetSymbol()}) {
+    return IsSimpleProcedure(*symbol);
+  } else if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&u)}) {
+    return intrinsic->characteristics.value().attrs.test(
+        characteristics::Procedure::Attr::Simple);
+  } else {
+    DIE("ProcedureDesignator::IsSimple(): no case");
+  }
+  return false;
+}
+
 const SpecificIntrinsic *ProcedureDesignator::GetSpecificIntrinsic() const {
   return std::get_if<SpecificIntrinsic>(&u);
 }