[Flang][OMP]Add support for DECLARE MAPPER parsing and semantics

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

@@ -504,6 +504,7 @@ class ParseTreeDumper {
   NODE(parser, OmpDeclareTargetSpecifier)
   NODE(parser, OmpDeclareTargetWithClause)
   NODE(parser, OmpDeclareTargetWithList)
+  NODE(parser, OmpDeclareMapperSpecifier)
   NODE(parser, OmpDefaultClause)
   NODE_ENUM(OmpDefaultClause, Type)
   NODE(parser, OmpDefaultmapClause)
@@ -612,6 +613,7 @@ class ParseTreeDumper {
   NODE(parser, OpenMPDeclareReductionConstruct)
   NODE(parser, OpenMPDeclareSimdConstruct)
   NODE(parser, OpenMPDeclareTargetConstruct)
+  NODE(parser, OpenMPDeclareMapperConstruct)
   NODE(parser, OmpMemoryOrderClause)
   NODE(parser, OmpAtomicClause)
   NODE(parser, OmpAtomicClauseList)

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

@@ -3872,6 +3872,19 @@ struct OpenMPDeclareTargetConstruct {
   std::tuple<Verbatim, OmpDeclareTargetSpecifier> t;
 };
 
+struct OmpDeclareMapperSpecifier {
+  TUPLE_CLASS_BOILERPLATE(OmpDeclareMapperSpecifier);
+  std::tuple<std::optional<Name>, TypeSpec, Name> t;
+};
+
+// OMP v5.2: 5.8.8
+//  declare-mapper -> DECLARE MAPPER ([mapper-name :] type :: var) map-clauses
+struct OpenMPDeclareMapperConstruct {
+  TUPLE_CLASS_BOILERPLATE(OpenMPDeclareMapperConstruct);
+  CharBlock source;
+  std::tuple<Verbatim, OmpDeclareMapperSpecifier, OmpClauseList> t;
+};
+
 // 2.16 declare-reduction -> DECLARE REDUCTION (reduction-identifier : type-list
 //                                              : combiner) [initializer-clause]
 struct OmpReductionCombiner {
@@ -3922,9 +3935,10 @@ struct OpenMPDeclarativeAllocate {
 struct OpenMPDeclarativeConstruct {
   UNION_CLASS_BOILERPLATE(OpenMPDeclarativeConstruct);
   CharBlock source;
-  std::variant<OpenMPDeclarativeAllocate, OpenMPDeclareReductionConstruct,
-      OpenMPDeclareSimdConstruct, OpenMPDeclareTargetConstruct,
-      OpenMPThreadprivate, OpenMPRequiresConstruct>
+  std::variant<OpenMPDeclarativeAllocate, OpenMPDeclareMapperConstruct,
+      OpenMPDeclareReductionConstruct, OpenMPDeclareSimdConstruct,
+      OpenMPDeclareTargetConstruct, OpenMPThreadprivate,
+      OpenMPRequiresConstruct>
       u;
 };
 

flang/lib/Lower/OpenMP/OpenMP.cpp

@@ -2597,6 +2597,13 @@ genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
   TODO(converter.getCurrentLocation(), "OpenMPDeclareSimdConstruct");
 }
 
+static void
+genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
+       semantics::SemanticsContext &semaCtx, lower::pft::Evaluation &eval,
+       const parser::OpenMPDeclareMapperConstruct &declareMapperConstruct) {
+  TODO(converter.getCurrentLocation(), "OpenMPDeclareMapperConstruct");
+}
+
 static void
 genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
        semantics::SemanticsContext &semaCtx, lower::pft::Evaluation &eval,

flang/lib/Parser/openmp-parsers.cpp

@@ -836,6 +836,15 @@ TYPE_PARSER(
 TYPE_PARSER(sourced(construct<OpenMPDeclareTargetConstruct>(
     verbatim("DECLARE TARGET"_tok), Parser<OmpDeclareTargetSpecifier>{})))
 
+// declare-mapper-specifier
+TYPE_PARSER(construct<OmpDeclareMapperSpecifier>(
+    maybe(name / ":" / !":"_tok), typeSpec / "::", name))
+
+// OpenMP 5.2: 5.8.8 Declare Mapper Construct
+TYPE_PARSER(sourced(construct<OpenMPDeclareMapperConstruct>(
+    verbatim("DECLARE MAPPER"_tok),
+    "(" >> Parser<OmpDeclareMapperSpecifier>{} / ")", Parser<OmpClauseList>{})))
+
 TYPE_PARSER(construct<OmpReductionCombiner>(Parser<AssignmentStmt>{}) ||
     construct<OmpReductionCombiner>(
         construct<OmpReductionCombiner::FunctionCombiner>(
@@ -944,6 +953,8 @@ TYPE_PARSER(startOmpLine >>
     withMessage("expected OpenMP construct"_err_en_US,
         sourced(construct<OpenMPDeclarativeConstruct>(
                     Parser<OpenMPDeclareReductionConstruct>{}) ||
+            construct<OpenMPDeclarativeConstruct>(
+                Parser<OpenMPDeclareMapperConstruct>{}) ||
             construct<OpenMPDeclarativeConstruct>(
                 Parser<OpenMPDeclareSimdConstruct>{}) ||
             construct<OpenMPDeclarativeConstruct>(

flang/lib/Parser/unparse.cpp

@@ -2665,6 +2665,22 @@ class UnparseVisitor {
               EndOpenMP();
               return false;
             },
+            [&](const OpenMPDeclareMapperConstruct &z) {
+              Word("DECLARE MAPPER (");
+              const auto &spec{std::get<OmpDeclareMapperSpecifier>(z.t)};
+              if (auto mapname{std::get<std::optional<Name>>(spec.t)}) {
+                Walk(mapname);
+                Put(":");
+              }
+              Walk(std::get<TypeSpec>(spec.t));
+              Put("::");
+              Walk(std::get<Name>(spec.t));
+              Put(")");
+
+              Walk(std::get<OmpClauseList>(z.t));
+              Put("\n");
+              return false;
+            },
             [&](const OpenMPDeclareReductionConstruct &) {
               Word("DECLARE REDUCTION ");
               return true;

flang/lib/Semantics/check-omp-structure.cpp

@@ -1434,6 +1434,21 @@ void OmpStructureChecker::Leave(const parser::OmpDeclareTargetWithClause &x) {
   }
 }
 
+void OmpStructureChecker::Enter(const parser::OpenMPDeclareMapperConstruct &x) {
+  const auto &dir{std::get<parser::Verbatim>(x.t)};
+  PushContextAndClauseSets(
+      dir.source, llvm::omp::Directive::OMPD_declare_mapper);
+  const auto &spec{std::get<parser::OmpDeclareMapperSpecifier>(x.t)};
+  const auto &type = std::get<parser::TypeSpec>(spec.t);
+  if (!std::get_if<parser::DerivedTypeSpec>(&type.u)) {
+    context_.Say(dir.source, "Type is not a derived type"_err_en_US);
+  }
+}
+
+void OmpStructureChecker::Leave(const parser::OpenMPDeclareMapperConstruct &) {
+  dirContext_.pop_back();
+}
+
 void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) {
   const auto &dir{std::get<parser::Verbatim>(x.t)};
   PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target);

flang/lib/Semantics/check-omp-structure.h

@@ -90,6 +90,8 @@ class OmpStructureChecker
   void Leave(const parser::OpenMPDeclareSimdConstruct &);
   void Enter(const parser::OpenMPDeclarativeAllocate &);
   void Leave(const parser::OpenMPDeclarativeAllocate &);
+  void Enter(const parser::OpenMPDeclareMapperConstruct &);
+  void Leave(const parser::OpenMPDeclareMapperConstruct &);
   void Enter(const parser::OpenMPDeclareTargetConstruct &);
   void Leave(const parser::OpenMPDeclareTargetConstruct &);
   void Enter(const parser::OpenMPDepobjConstruct &);

flang/lib/Semantics/resolve-directives.cpp

@@ -431,6 +431,9 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
   bool Pre(const parser::OpenMPDeclareTargetConstruct &);
   void Post(const parser::OpenMPDeclareTargetConstruct &) { PopContext(); }
 
+  bool Pre(const parser::OpenMPDeclareMapperConstruct &);
+  void Post(const parser::OpenMPDeclareMapperConstruct &) { PopContext(); }
+
   bool Pre(const parser::OpenMPThreadprivate &);
   void Post(const parser::OpenMPThreadprivate &) { PopContext(); }
 
@@ -1944,6 +1947,11 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclareTargetConstruct &x) {
   return true;
 }
 
+bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclareMapperConstruct &x) {
+  PushContext(x.source, llvm::omp::Directive::OMPD_declare_mapper);
+  return true;
+}
+
 bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
   PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate);
   const auto &list{std::get<parser::OmpObjectList>(x.t)};

flang/lib/Semantics/resolve-names.cpp

@@ -1468,6 +1468,9 @@ class OmpVisitor : public virtual DeclarationVisitor {
     AddOmpSourceRange(x.source);
     return true;
   }
+
+  bool Pre(const parser::OpenMPDeclareMapperConstruct &);
+
   void Post(const parser::OmpBeginLoopDirective &) {
     messageHandler().set_currStmtSource(std::nullopt);
   }
@@ -1605,6 +1608,37 @@ void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) {
   }
 }
 
+// This "manually" walks the tree of the construct, because we need
+// to resolve the type before the map clauses are processed - when
+// just following the natural flow, the map clauses gets processed before
+// the type has been fully processed.
+bool OmpVisitor::Pre(const parser::OpenMPDeclareMapperConstruct &x) {
+  AddOmpSourceRange(x.source);
+  BeginDeclTypeSpec();
+  const auto &spec{std::get<parser::OmpDeclareMapperSpecifier>(x.t)};
+  Symbol *mapperSym{nullptr};
+  if (const auto &mapperName{std::get<std::optional<parser::Name>>(spec.t)}) {
+    mapperSym =
+        &MakeSymbol(*mapperName, MiscDetails{MiscDetails::Kind::ConstructName});
+    mapperName->symbol = mapperSym;
+  } else {
+    const parser::CharBlock defaultName{"default", 7};
+    mapperSym = &MakeSymbol(
+        defaultName, Attrs{}, MiscDetails{MiscDetails::Kind::ConstructName});
+  }
+
+  PushScope(Scope::Kind::OtherConstruct, nullptr);
+  Walk(std::get<parser::TypeSpec>(spec.t));
+  const auto &varName{std::get<parser::ObjectName>(spec.t)};
+  DeclareObjectEntity(varName);
+
+  Walk(std::get<parser::OmpClauseList>(x.t));
+
+  EndDeclTypeSpec();
+  PopScope();
+  return false;
+}
+
 // Walk the parse tree and resolve names to symbols.
 class ResolveNamesVisitor : public virtual ScopeHandler,
                             public ModuleVisitor,

flang/lib/Semantics/unparse-with-symbols.cpp

@@ -53,6 +53,14 @@ class SymbolDumpVisitor {
   void Post(const parser::OpenMPThreadprivate &) { currStmt_ = std::nullopt; }
   void Post(const parser::Name &name);
 
+  bool Pre(const parser::OpenMPDeclareMapperConstruct &x) {
+    currStmt_ = x.source;
+    return true;
+  }
+  void Post(const parser::OpenMPDeclareMapperConstruct &) {
+    currStmt_ = std::nullopt;
+  }
+
 private:
   std::optional<SourceName> currStmt_; // current statement we are processing
   std::multimap<const char *, const Symbol *> symbols_; // location to symbol

flang/test/Lower/OpenMP/Todo/omp-declare-mapper.f90

@@ -0,0 +1,47 @@
+! This test checks lowering of OpenMP declare mapper Directive.
+
+! RUN: split-file %s %t
+! RUN: not %flang_fc1 -emit-fir -fopenmp -fopenmp-version=50 %t/omp-declare-mapper-1.f90 2>&1 | FileCheck %t/omp-declare-mapper-1.f90
+! RUN  not %flang_fc1 -emit-fir -fopenmp -fopenmp-version=50 %t/omp-declare-mapper-2.f90 2>&1 | FileCheck %t/omp-declare-mapper-2.f90
+
+!--- omp-declare-mapper-1.f90
+subroutine declare_mapper_1
+ integer,parameter      :: nvals = 250
+ type my_type
+   integer              :: num_vals
+   integer, allocatable :: values(:)
+ end type 
+
+ type my_type2
+   type (my_type)        :: my_type_var
+   type (my_type)        :: temp
+   real,dimension(nvals) :: unmapped
+   real,dimension(nvals) :: arr
+  end type
+  type (my_type2)        :: t
+  real                   :: x, y(nvals)
+  !$omp declare mapper (my_type :: var) map (var, var%values (1:var%num_vals))
+!CHECK: not yet implemented: OpenMPDeclareMapperConstruct
+end subroutine declare_mapper_1
+
+
+!--- omp-declare-mapper-2.f90
+subroutine declare_mapper_2
+ integer,parameter      :: nvals = 250
+ type my_type
+   integer              :: num_vals
+   integer, allocatable :: values(:)
+ end type 
+
+ type my_type2
+   type (my_type)        :: my_type_var
+   type (my_type)        :: temp
+   real,dimension(nvals) :: unmapped
+   real,dimension(nvals) :: arr
+  end type
+  type (my_type2)        :: t
+  real                   :: x, y(nvals)
+  !$omp declare mapper (my_mapper : my_type2 :: v) map (v%arr, x, y(:)) &
+  !$omp&                map (alloc : v%temp)
+!CHECK: not yet implemented: OpenMPDeclareMapperConstruct
+end subroutine declare_mapper_2

flang/test/Parser/OpenMP/declare-mapper-unparse.f90

@@ -0,0 +1,42 @@
+! RUN: %flang_fc1 -fdebug-unparse-no-sema -fopenmp %s | FileCheck --ignore-case %s
+! RUN: %flang_fc1 -fdebug-dump-parse-tree-no-sema -fopenmp %s | FileCheck --check-prefix="PARSE-TREE" %s
+program main
+!CHECK-LABEL: program main
+  implicit none
+
+  type ty
+     integer :: x
+  end type ty
+
+
+!CHECK: !$OMP DECLARE MAPPER (mymapper:ty::mapped) MAP(mapped,mapped%x)
+  !$omp declare mapper(mymapper : ty :: mapped) map(mapped, mapped%x)
+
+!PARSE-TREE:      OpenMPDeclareMapperConstruct
+!PARSE-TREE:        OmpDeclareMapperSpecifier
+!PARSE-TREE:         Name = 'mymapper'
+!PARSE-TREE:         TypeSpec -> DerivedTypeSpec
+!PARSE-TREE:           Name = 'ty'
+!PARSE-TREE:         Name = 'mapped'    
+!PARSE-TREE:        OmpMapClause
+!PARSE-TREE:          OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'mapped'
+!PARSE-TREE:          OmpObject -> Designator -> DataRef -> StructureComponent
+!PARSE-TREE:           DataRef -> Name = 'mapped'
+!PARSE-TREE:           Name = 'x'  
+
+!CHECK: !$OMP DECLARE MAPPER (ty::mapped) MAP(mapped,mapped%x)
+  !$omp declare mapper(ty :: mapped) map(mapped, mapped%x)
+
+!PARSE-TREE:      OpenMPDeclareMapperConstruct
+!PARSE-TREE:        OmpDeclareMapperSpecifier
+!PARSE-TREE:         TypeSpec -> DerivedTypeSpec
+!PARSE-TREE:           Name = 'ty'
+!PARSE-TREE:         Name = 'mapped'    
+!PARSE-TREE:        OmpMapClause
+!PARSE-TREE:          OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'mapped'
+!PARSE-TREE:          OmpObject -> Designator -> DataRef -> StructureComponent
+!PARSE-TREE:           DataRef -> Name = 'mapped'
+!PARSE-TREE:           Name = 'x'
+
+end program main
+!CHECK-LABEL: end program main

flang/test/Semantics/OpenMP/declare-mapper-symbols.f90

@@ -0,0 +1,24 @@
+! RUN: %flang_fc1 -fdebug-dump-symbols -fopenmp -fopenmp-version=50 %s | FileCheck %s
+
+program main
+!CHECK-LABEL: MainProgram scope: main
+  implicit none
+
+  type ty
+     integer :: x
+  end type ty
+  !$omp declare mapper(mymapper : ty :: mapped) map(mapped, mapped%x)
+  !$omp declare mapper(ty :: maptwo) map(maptwo, maptwo%x)
+
+!! Note, symbols come out in their respective scope, but not in declaration order.
+!CHECK: default: Misc ConstructName
+!CHECK: mymapper: Misc ConstructName
+!CHECK: ty: DerivedType components: x
+!CHECK: DerivedType scope: ty
+!CHECK: OtherConstruct scope:
+!CHECK: mapped (OmpMapToFrom) {{.*}} ObjectEntity type: TYPE(ty)
+!CHECK: OtherConstruct scope:  
+!CHECK: maptwo (OmpMapToFrom) {{.*}} ObjectEntity type: TYPE(ty)
+
+end program main
+

flang/test/Semantics/OpenMP/declare-mapper01.f90

@@ -0,0 +1,8 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=50
+! Test the declare mapper with non-derived type.
+
+integer :: y
+
+!ERROR: Type is not a derived type
+!$omp declare mapper(mm : integer::x) map(x, y)
+end

flang/test/Semantics/OpenMP/declare-mapper02.f90

@@ -0,0 +1,10 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=50
+! Test the declare mapper construct with abstract type.
+
+type, abstract :: t1
+   integer :: y
+end type t1
+
+!ERROR: ABSTRACT derived type may not be used here
+!$omp declare mapper(mm : t1::x) map(x, x%y)
+end

flang/test/Semantics/OpenMP/declare-mapper03.f90

@@ -0,0 +1,16 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=50
+! Test the declare mapper construct with two default mappers.
+
+type :: t1
+   integer :: y
+end type t1
+
+type :: t2
+   real :: y, z
+end type t2
+
+!error: 'default' is already declared in this scoping unit
+
+!$omp declare mapper(t1::x) map(x, x%y)
+!$omp declare mapper(t2::w) map(w, w%y, w%z)
+end

llvm/include/llvm/Frontend/OpenMP/OMP.td

@@ -612,8 +612,8 @@ def OMP_Critical : Directive<"critical"> {
   let category = CA_Executable;
 }
 def OMP_DeclareMapper : Directive<"declare mapper"> {
-  let allowedClauses = [
-    VersionedClause<OMPC_Map>,
+  let requiredClauses = [
+    VersionedClause<OMPC_Map, 45>,
   ];
   let association = AS_None;
   let category = CA_Declarative;