[flang][openacc] Lower the bind clause on acc routine

[clementval]

Summary

Lower the bind clause to the corresponding attribute

Depends on D158120

[razvanlupusoru]

LGTM

flang/lib/Lower/OpenACC.cpp

if (funcOp)
                            directiveLocation, accClauseList);
     else if (moduleOp)
       genDeclareInModule(converter, moduleOp, accClauseList);
     return;
   }
   llvm_unreachable("unsupported declarative directive");
 }
 
+template <typename R, typename T>
+std::optional<R>
+GetConstExpr(Fortran::semantics::SemanticsContext &semanticsContext,
+             const T &x) {
+  using DefaultCharConstantType = Fortran::evaluate::Ascii;
+  if (const auto *expr{Fortran::semantics::GetExpr(semanticsContext, x)}) {
+    const auto foldExpr{Fortran::evaluate::Fold(
+        semanticsContext.foldingContext(), Fortran::common::Clone(*expr))};
+    if constexpr (std::is_same_v<R, std::string>) {
+      return Fortran::evaluate::GetScalarConstantValue<DefaultCharConstantType>(
+          foldExpr);
+    }
+  }
+  return std::nullopt;
+}
+
 static void
 genACC(Fortran::lower::AbstractConverter &converter,
+       Fortran::semantics::SemanticsContext &semanticsContext,
        Fortran::lower::pft::Evaluation &eval,
        const Fortran::parser::OpenACCRoutineConstruct &routineConstruct) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   mlir::Location loc = converter.genLocation(routineConstruct.source);
   std::optional<Fortran::parser::Name> name =
       std::get<std::optional<Fortran::parser::Name>>(routineConstruct.t);
   const auto &clauses =
       std::get<Fortran::parser::AccClauseList>(routineConstruct.t);
if (std::get_if<Fortran::parser::AccClause::Seq>(&clause.u)) {
         }
       }
     } else if (std::get_if<Fortran::parser::AccClause::Vector>(&clause.u)) {
       routineOp.setVectorAttr(builder.getUnitAttr());
     } else if (std::get_if<Fortran::parser::AccClause::Worker>(&clause.u)) {
       routineOp.setWorkerAttr(builder.getUnitAttr());
     } else if (std::get_if<Fortran::parser::AccClause::Nohost>(&clause.u)) {
       routineOp.setNohostAttr(builder.getUnitAttr());
+    } else if (const auto *bindClause =
+                   std::get_if<Fortran::parser::AccClause::Bind>(&clause.u)) {
+      if (const auto *name =
+              std::get_if<Fortran::parser::Name>(&bindClause->v.u)) {
+        routineOp.setBindName(
+            builder.getStringAttr(converter.mangleName(*name->symbol)));
+      } else if (const auto charExpr =
+                     std::get_if<Fortran::parser::ScalarDefaultCharExpr>(
+                         &bindClause->v.u)) {
+        const std::optional<std::string> bindName =
+            GetConstExpr<std::string>(semanticsContext, *charExpr);
+        if (!bindName)
+          routineOp.emitError("Could not retrieve the bind name");
+        routineOp.setBindName(builder.getStringAttr(*bindName));
+      }
     }
   }
 
   llvm::SmallVector<mlir::SymbolRefAttr> routines;
   if (func.getOperation()->hasAttr(mlir::acc::getRoutineInfoAttrName())) {
     auto routineInfo =
         func.getOperation()->getAttrOfType<mlir::acc::RoutineInfoAttr>(
             mlir::acc::getRoutineInfoAttrName());
std::visit(
       common::visitors{
           [&](const Fortran::parser::OpenACCStandaloneDeclarativeConstruct
                   &standaloneDeclarativeConstruct) {
             genACC(converter, semanticsContext, fctCtx, eval,
                    standaloneDeclarativeConstruct);
           },
           [&](const Fortran::parser::OpenACCRoutineConstruct
                   &routineConstruct) {
-            genACC(converter, eval, routineConstruct);
+            genACC(converter, semanticsContext, eval, routineConstruct);
           },
       },
       accDeclConstruct.u);
 }
 
 void Fortran::lower::attachDeclarePostAllocAction(
     AbstractConverter &converter, fir::FirOpBuilder &builder,
     const Fortran::semantics::Symbol &sym) {

flang/test/Lower/OpenACC/acc-routine.f90

 ! This test checks lowering of OpenACC routine directive.
 
 ! RUN: bbc -fopenacc -emit-fir %s -o - | FileCheck %s
 
+! CHECK: acc.routine @acc_routine_8 func(@_QPacc_routine9) bind("_QPacc_routine9a")
+! CHECK: acc.routine @acc_routine_7 func(@_QPacc_routine8) bind("routine8_")
 ! CHECK: acc.routine @acc_routine_6 func(@_QPacc_routine7) gang(dim = 1 : i32)
 ! CHECK: acc.routine @acc_routine_5 func(@_QPacc_routine6) nohost
 ! CHECK: acc.routine @acc_routine_4 func(@_QPacc_routine5) worker
 ! CHECK: acc.routine @acc_routine_3 func(@_QPacc_routine4) vector
 ! CHECK: acc.routine @acc_routine_2 func(@_QPacc_routine3) gang
 ! CHECK: acc.routine @acc_routine_1 func(@_QPacc_routine2) seq
 ! CHECK: acc.routine @acc_routine_0 func(@_QPacc_routine1)
 

 
 ! CHECK-LABEL: func.func @_QPacc_routine6() attributes {acc.routine_info = #acc.routine_info<[@acc_routine_5]>}
 
 subroutine acc_routine7()
   !$acc routine gang(dim:1)
 end subroutine
 
 ! CHECK-LABEL: func.func @_QPacc_routine7() attributes {acc.routine_info = #acc.routine_info<[@acc_routine_6]>}
+
+subroutine acc_routine8()
+  !$acc routine bind("routine8_")
+end subroutine
+
+! CHECK-LABEL: func.func @_QPacc_routine8() attributes {acc.routine_info = #acc.routine_info<[@acc_routine_7]>}
+
+subroutine acc_routine9a()
+end subroutine
+
+subroutine acc_routine9()
+  !$acc routine bind(acc_routine9a)
+end subroutine
+
+! CHECK-LABEL: func.func @_QPacc_routine9() attributes {acc.routine_info = #acc.routine_info<[@acc_routine_8]>}