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

Will hit a TODO in the lowering, which there are tests added
to check for this happening.

Author: Leporacanthicus

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;
+};
+
+struct OpenMPDeclareMapperConstruct {
+  TUPLE_CLASS_BOILERPLATE(OpenMPDeclareMapperConstruct);
+  CharBlock source;
+  std::tuple<Verbatim, OmpDeclareMapperSpecifier,
+      std::list<std::list<OmpMapClause>>>
+      t;
+};
+
 // 2.16 declare-reduction -> DECLARE REDUCTION (reduction-identifier : type-list
 //                                              : combiner) [initializer-clause]
 struct OmpReductionCombiner {
@@ -3924,7 +3937,8 @@ struct OpenMPDeclarativeConstruct {
   CharBlock source;
   std::variant<OpenMPDeclarativeAllocate, OpenMPDeclareReductionConstruct,
       OpenMPDeclareSimdConstruct, OpenMPDeclareTargetConstruct,
-      OpenMPThreadprivate, OpenMPRequiresConstruct>
+      OpenMPThreadprivate, OpenMPRequiresConstruct,
+      OpenMPDeclareMapperConstruct>
       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,16 @@ 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))
+
+// ?.? (not 4.5) Declare Mapper Construct
+TYPE_PARSER(sourced(
+    construct<OpenMPDeclareMapperConstruct>(verbatim("DECLARE MAPPER"_tok),
+        "(" >> Parser<OmpDeclareMapperSpecifier>{} / ")",
+        many("MAP" >> parenthesized(many(Parser<OmpMapClause>{}))))))
+
 TYPE_PARSER(construct<OmpReductionCombiner>(Parser<AssignmentStmt>{}) ||
     construct<OmpReductionCombiner>(
         construct<OmpReductionCombiner::FunctionCombiner>(
@@ -944,6 +954,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,29 @@ 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(")");
+
+              const auto &list{
+                  std::get<std::list<std::list<Fortran::parser::OmpMapClause>>>(
+                      z.t)};
+              for (const auto &m : list) {
+                Put(" MAP(");
+                Walk(m);
+                Put(")");
+              }
+              Put("\n");
+              return false;
+            },
             [&](const OpenMPDeclareReductionConstruct &) {
               Word("DECLARE REDUCTION ");
               return true;

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

@@ -1058,6 +1058,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
   const parser::Name *ResolveDesignator(const parser::Designator &);
   int GetVectorElementKind(
       TypeCategory category, const std::optional<parser::KindSelector> &kind);
+  std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &);
 
 protected:
   bool BeginDecl();
@@ -1205,7 +1206,6 @@ class DeclarationVisitor : public ArraySpecVisitor,
   Symbol &DeclareProcEntity(
       const parser::Name &, Attrs, const Symbol *interface);
   void SetType(const parser::Name &, const DeclTypeSpec &);
-  std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &);
   std::optional<DerivedTypeSpec> ResolveExtendsType(
       const parser::Name &, const parser::Name *);
   Symbol *MakeTypeSymbol(const SourceName &, Details &&);
@@ -1468,6 +1468,10 @@ class OmpVisitor : public virtual DeclarationVisitor {
     AddOmpSourceRange(x.source);
     return true;
   }
+
+  bool Pre(const parser::OpenMPDeclareMapperConstruct &);
+  void Post(const parser::OpenMPDeclareMapperConstruct &) { PopScope(); };
+
   void Post(const parser::OmpBeginLoopDirective &) {
     messageHandler().set_currStmtSource(std::nullopt);
   }
@@ -1605,6 +1609,26 @@ void OmpVisitor::Post(const parser::OpenMPBlockConstruct &x) {
   }
 }
 
+bool OmpVisitor::Pre(const parser::OpenMPDeclareMapperConstruct &x) {
+  AddOmpSourceRange(x.source);
+  BeginDeclTypeSpec();
+  PushScope(Scope::Kind::OtherConstruct, nullptr);
+  const auto &spec{std::get<parser::OmpDeclareMapperSpecifier>(x.t)};
+  if (const auto &mapperName{
+          std::get<std::optional<Fortran::parser::Name>>(spec.t)}) {
+    Symbol *mapperSym{&MakeSymbol(*mapperName, Attrs{})};
+    mapperName->symbol = mapperSym;
+  }
+  Walk(std::get<Fortran::parser::TypeSpec>(spec.t));
+  const auto &varName{std::get<Fortran::parser::ObjectName>(spec.t)};
+  DeclareObjectEntity(varName);
+
+  Walk(std::get<std::list<std::list<Fortran::parser::OmpMapClause>>>(x.t));
+
+  EndDeclTypeSpec();
+  return false;
+}
+
 // Walk the parse tree and resolve names to symbols.
 class ResolveNamesVisitor : public virtual ScopeHandler,
                             public ModuleVisitor,

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 %t/omp-declare-mapper-1.f90 2>&1 | FileCheck %t/omp-declare-mapper-1.f90
+! RUN  not %flang_fc1 -emit-fir -fopenmp %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,28 @@
+! 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'  
+
+end program main
+!CHECK-LABEL: end program main