[Flang] Add parsing and attribute registration for SIMPLE specifier

flang/include/flang/Evaluate/call.h

@@ -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

@@ -357,8 +357,8 @@ 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(FunctionResult &&, DummyArguments &&, Attrs);
@@ -390,6 +390,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

@@ -1547,6 +1547,8 @@ const Symbol *GetMainEntry(const 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

@@ -758,6 +758,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

@@ -3111,7 +3111,7 @@ struct ProcedureDeclarationStmt {
 
 // R1527 prefix-spec ->
 //         declaration-type-spec | ELEMENTAL | IMPURE | MODULE |
-//         NON_RECURSIVE | PURE | RECURSIVE |
+//         NON_RECURSIVE | PURE | RECURSIVE | SIMPLE |
 // (CUDA)  ATTRIBUTES ( (DEVICE | GLOBAL | GRID_GLOBAL | HOST)... )
 //         LAUNCH_BOUNDS(expr-list) | CLUSTER_DIMS(expr-list)
 struct PrefixSpec {
@@ -3122,11 +3122,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

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

flang/lib/Evaluate/tools.cpp

@@ -2067,6 +2067,9 @@ static bool IsPureProcedureImpl(
     }
     return true; // statement function was not found to be impure
   }
+  if (symbol.attrs().test(Attr::SIMPLE)) {
+    return true; // SIMPLE implies PURE (Fortran 2023 §15.8)
+  }
   return symbol.attrs().test(Attr::PURE) ||
       (symbol.attrs().test(Attr::ELEMENTAL) &&
           !symbol.attrs().test(Attr::IMPURE));
@@ -2082,6 +2085,15 @@ bool IsPureProcedure(const Scope &scope) {
   return symbol && IsPureProcedure(*symbol);
 }
 
+bool IsSimpleProcedure(const Symbol &original) {
+  return original.attrs().test(Attr::SIMPLE);
+}
+
+bool IsSimpleProcedure(const Scope &scope) {
+  const Symbol *symbol{scope.GetSymbol()};
+  return symbol && IsSimpleProcedure(*symbol);
+}
+
 bool IsExplicitlyImpureProcedure(const Symbol &original) {
   // An ENTRY is IMPURE if its containing subprogram is so
   return DEREF(GetMainEntry(&original.GetUltimate()))

flang/lib/Parser/program-parsers.cpp

@@ -524,7 +524,7 @@ TYPE_PARSER(construct<AltReturnSpec>(star >> label))
 
 // R1527 prefix-spec ->
 //         declaration-type-spec | ELEMENTAL | IMPURE | MODULE |
-//         NON_RECURSIVE | PURE | RECURSIVE |
+//         NON_RECURSIVE | PURE | RECURSIVE | SIMPLE |
 // (CUDA)  ATTRIBUTES ( (DEVICE | GLOBAL | GRID_GLOBAL | HOST)... ) |
 //         LAUNCH_BOUNDS(expr-list) | CLUSTER_DIMS(expr-list)
 TYPE_PARSER(first("DEVICE" >> pure(common::CUDASubprogramAttrs::Device),
@@ -539,6 +539,7 @@ TYPE_PARSER(first(construct<PrefixSpec>(declarationTypeSpec),
         construct<PrefixSpec::Non_Recursive>("NON_RECURSIVE"_tok)),
     construct<PrefixSpec>(construct<PrefixSpec::Pure>("PURE"_tok)),
     construct<PrefixSpec>(construct<PrefixSpec::Recursive>("RECURSIVE"_tok)),
+    construct<PrefixSpec>(construct<PrefixSpec::Simple>("SIMPLE"_tok)),
     extension<LanguageFeature::CUDA>(
         construct<PrefixSpec>(construct<PrefixSpec::Attributes>("ATTRIBUTES" >>
             parenthesized(

flang/lib/Parser/unparse.cpp

@@ -1761,6 +1761,7 @@ class UnparseVisitor {
   void Post(const PrefixSpec::Non_Recursive) { Word("NON_RECURSIVE"); }
   void Post(const PrefixSpec::Pure) { Word("PURE"); }
   void Post(const PrefixSpec::Recursive) { Word("RECURSIVE"); }
+  void Post(const PrefixSpec::Simple) { Word("SIMPLE"); }
   void Unparse(const PrefixSpec::Attributes &x) {
     Word("ATTRIBUTES("), Walk(x.v), Word(")");
   }

flang/lib/Semantics/resolve-names.cpp

@@ -265,6 +265,7 @@ class AttrsVisitor : public virtual BaseVisitor {
   HANDLE_ATTR_CLASS(PrefixSpec::Non_Recursive, NON_RECURSIVE)
   HANDLE_ATTR_CLASS(PrefixSpec::Pure, PURE)
   HANDLE_ATTR_CLASS(PrefixSpec::Recursive, RECURSIVE)
+  HANDLE_ATTR_CLASS(PrefixSpec::Simple, SIMPLE)
   HANDLE_ATTR_CLASS(TypeAttrSpec::BindC, BIND_C)
   HANDLE_ATTR_CLASS(BindAttr::Deferred, DEFERRED)
   HANDLE_ATTR_CLASS(BindAttr::Non_Overridable, NON_OVERRIDABLE)
@@ -2350,6 +2351,7 @@ bool AttrsVisitor::IsConflictingAttr(Attr attrName) {
       HaveAttrConflict(attrName, Attr::INTENT_INOUT, Attr::INTENT_OUT) ||
       HaveAttrConflict(attrName, Attr::PASS, Attr::NOPASS) || // C781
       HaveAttrConflict(attrName, Attr::PURE, Attr::IMPURE) ||
+      HaveAttrConflict(attrName, Attr::PURE, Attr::SIMPLE) ||
       HaveAttrConflict(attrName, Attr::PUBLIC, Attr::PRIVATE) ||
       HaveAttrConflict(attrName, Attr::RECURSIVE, Attr::NON_RECURSIVE) ||
       HaveAttrConflict(attrName, Attr::INTRINSIC, Attr::EXTERNAL);

flang/test/Parser/simple-unparse.f90

@@ -0,0 +1,14 @@
+! RUN: %flang_fc1 -fdebug-unparse-no-sema %s 2>&1 | FileCheck %s
+
+! Test that SIMPLE function specifier is recognized
+! by the parser and the unparser. This test does not
+! exercise semantic checks.
+
+simple function foo()
+  return
+end function
+
+! CHECK: SIMPLE FUNCTION foo()
+! CHECK-NEXT: RETURN
+! CHECK-NEXT: END FUNCTION
+

flang/test/Parser/simple.f90

@@ -0,0 +1,9 @@
+! RUN: %flang_fc1 -fdebug-dump-parse-tree %s | FileCheck %s
+
+! Check that SIMPLE is recognized in the parse tree
+
+simple function foo()
+  return
+end function
+
+! CHECK: Simple

flang/test/Semantics/simple-conflict.f90

@@ -0,0 +1,12 @@
+! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
+!
+! Verify that PURE and SIMPLE prefix-specs are mutually exclusive
+
+pure simple subroutine ps()
+end
+! CHECK: error: Attributes 'PURE' and 'SIMPLE' conflict
+
+simple pure function sp()
+end
+! CHECK: error: Attributes 'PURE' and 'SIMPLE' conflict
+