[fir] Add external name interop pass

Add the external name conversion pass needed for compiler
interoperability. This pass convert the Flang internal symbol name to
the common gfortran convention.

Clean up old passes without implementation in the Passes.ts file so
the project and fir-opt can build correctly.

This patch is part of the upstreaming effort from fir-dev branch.

Reviewed By: schweitz

Differential Revision: https://reviews.llvm.org/D111057

GitOrigin-RevId: fc66dbba1fe0a3120abd98134a1a8aebfede8553
diff --git a/include/flang/Optimizer/Support/InternalNames.h b/include/flang/Optimizer/Support/InternalNames.h
index b6e1e37..401cc2f 100644
--- a/include/flang/Optimizer/Support/InternalNames.h
+++ b/include/flang/Optimizer/Support/InternalNames.h
@@ -126,6 +126,13 @@
   static std::pair<NameKind, DeconstructedName>
   deconstruct(llvm::StringRef uniquedName);
 
+  /// Check if the name is an external facing name.
+  static bool isExternalFacingUniquedName(
+      const std::pair<NameKind, DeconstructedName> &deconstructResult);
+
+  /// Check whether the name should be re-mangle with external ABI convention.
+  static bool needExternalNameMangling(llvm::StringRef uniquedName);
+
 private:
   static std::string intAsString(std::int64_t i);
   static std::string doKind(std::int64_t kind);
diff --git a/include/flang/Optimizer/Transforms/Passes.h b/include/flang/Optimizer/Transforms/Passes.h
index 5e71995..881cef2 100644
--- a/include/flang/Optimizer/Transforms/Passes.h
+++ b/include/flang/Optimizer/Transforms/Passes.h
@@ -22,25 +22,7 @@
 
 namespace fir {
 
-/// Convert fir.select_type to the standard dialect
-std::unique_ptr<mlir::Pass> createControlFlowLoweringPass();
-
-/// Effects aware CSE pass
-std::unique_ptr<mlir::Pass> createCSEPass();
-
-/// Convert FIR loop constructs to the Affine dialect
-std::unique_ptr<mlir::Pass> createPromoteToAffinePass();
-
-/// Convert `fir.do_loop` and `fir.if` to a CFG.  This
-/// conversion enables the `createLowerToCFGPass` to transform these to CFG
-/// form.
-std::unique_ptr<mlir::Pass> createFirToCfgPass();
-
-/// A pass to convert the FIR dialect from "Mem-SSA" form to "Reg-SSA"
-/// form. This pass is a port of LLVM's mem2reg pass, but modified for the FIR
-/// dialect as well as the restructuring of MLIR's representation to present PHI
-/// nodes as block arguments.
-std::unique_ptr<mlir::Pass> createMemToRegPass();
+std::unique_ptr<mlir::Pass> createExternalNameConversionPass();
 
 /// Support for inlining on FIR.
 bool canLegallyInline(mlir::Operation *op, mlir::Region *reg,
diff --git a/include/flang/Optimizer/Transforms/Passes.td b/include/flang/Optimizer/Transforms/Passes.td
index cfa7e34..680f80e 100644
--- a/include/flang/Optimizer/Transforms/Passes.td
+++ b/include/flang/Optimizer/Transforms/Passes.td
@@ -16,36 +16,12 @@
 
 include "mlir/Pass/PassBase.td"
 
-def AffineDialectPromotion : FunctionPass<"promote-to-affine"> {
-  let summary = "Promotes fir.do_loop and fir.where to affine.for and affine.if where possible";
+def ExternalNameConversion : Pass<"external-name-interop", "mlir::ModuleOp"> {
+  let summary = "Convert name for external interoperability";
   let description = [{
-    TODO
+    Demangle FIR internal name and mangle them for external interoperability.
   }];
-  let constructor = "fir::createPromoteToAffinePass()";
-}
-
-def BasicCSE : FunctionPass<"basic-cse"> {
-  let summary = "Basic common sub-expression elimination";
-  let description = [{
-      TODO
-  }];
-  let constructor = "fir::createCSEPass()";
-}
-
-def ControlFlowLowering : FunctionPass<"lower-control-flow"> {
-  let summary = "Convert affine dialect, fir.select_type to standard dialect";
-  let description = [{
-      TODO
-  }];
-  let constructor = "fir::createControlFlowLoweringPass()";
-}
-
-def CFGConversion : FunctionPass<"cfg-conversion"> {
-  let summary = "Convert FIR structured control flow ops to CFG ops.";
-  let description = [{
-      TODO
-  }];
-  let constructor = "fir::createFirToCfgPass()";
+  let constructor = "::fir::createExternalNameConversionPass()";
 }
 
 #endif // FLANG_OPTIMIZER_TRANSFORMS_PASSES
diff --git a/lib/Optimizer/Support/InternalNames.cpp b/lib/Optimizer/Support/InternalNames.cpp
index 08dd927..7aec778 100644
--- a/lib/Optimizer/Support/InternalNames.cpp
+++ b/lib/Optimizer/Support/InternalNames.cpp
@@ -302,3 +302,18 @@
   }
   return {NameKind::NOT_UNIQUED, DeconstructedName(uniq)};
 }
+
+bool fir::NameUniquer::isExternalFacingUniquedName(
+    const std::pair<fir::NameUniquer::NameKind,
+                    fir::NameUniquer::DeconstructedName> &deconstructResult) {
+  return (deconstructResult.first == NameKind::PROCEDURE ||
+          deconstructResult.first == NameKind::COMMON) &&
+         deconstructResult.second.modules.empty() &&
+         !deconstructResult.second.host;
+}
+
+bool fir::NameUniquer::needExternalNameMangling(llvm::StringRef uniquedName) {
+  auto result = fir::NameUniquer::deconstruct(uniquedName);
+  return result.first != fir::NameUniquer::NameKind::NOT_UNIQUED &&
+         fir::NameUniquer::isExternalFacingUniquedName(result);
+}
diff --git a/lib/Optimizer/Transforms/CMakeLists.txt b/lib/Optimizer/Transforms/CMakeLists.txt
index 462ae40..59a1a63 100644
--- a/lib/Optimizer/Transforms/CMakeLists.txt
+++ b/lib/Optimizer/Transforms/CMakeLists.txt
@@ -1,5 +1,6 @@
 add_flang_library(FIRTransforms
   Inliner.cpp
+  ExternalNameConversion.cpp
 
   DEPENDS
   FIRDialect
diff --git a/lib/Optimizer/Transforms/ExternalNameConversion.cpp b/lib/Optimizer/Transforms/ExternalNameConversion.cpp
new file mode 100644
index 0000000..0376ca8
--- /dev/null
+++ b/lib/Optimizer/Transforms/ExternalNameConversion.cpp
@@ -0,0 +1,192 @@
+//===- ExternalNameConversion.cpp -- convert name with external convention ===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "PassDetail.h"
+#include "flang/Optimizer/Dialect/FIROps.h"
+#include "flang/Optimizer/Support/InternalNames.h"
+#include "flang/Optimizer/Transforms/Passes.h"
+#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
+#include "mlir/Dialect/OpenACC/OpenACC.h"
+#include "mlir/Dialect/OpenMP/OpenMPDialect.h"
+#include "mlir/IR/SymbolTable.h"
+#include "mlir/Pass/Pass.h"
+#include "mlir/Transforms/DialectConversion.h"
+
+//===----------------------------------------------------------------------===//
+// Helper functions
+//===----------------------------------------------------------------------===//
+
+/// Mangle the name with gfortran convention.
+std::string
+mangleExternalName(const std::pair<fir::NameUniquer::NameKind,
+                                   fir::NameUniquer::DeconstructedName>
+                       result) {
+  if (result.first == fir::NameUniquer::NameKind::COMMON &&
+      result.second.name.empty())
+    return "__BLNK__";
+  return result.second.name + "_";
+}
+
+//===----------------------------------------------------------------------===//
+// Rewrite patterns
+//===----------------------------------------------------------------------===//
+
+namespace {
+
+class MangleNameOnCallOp : public mlir::OpRewritePattern<fir::CallOp> {
+public:
+  using OpRewritePattern::OpRewritePattern;
+
+  mlir::LogicalResult
+  matchAndRewrite(fir::CallOp op,
+                  mlir::PatternRewriter &rewriter) const override {
+    rewriter.startRootUpdate(op);
+    auto callee = op.callee();
+    if (callee.hasValue()) {
+      auto result = fir::NameUniquer::deconstruct(
+          callee.getValue().getRootReference().getValue());
+      if (fir::NameUniquer::isExternalFacingUniquedName(result))
+        op.calleeAttr(
+            SymbolRefAttr::get(op.getContext(), mangleExternalName(result)));
+    }
+    rewriter.finalizeRootUpdate(op);
+    return success();
+  }
+};
+
+struct MangleNameOnFuncOp : public mlir::OpRewritePattern<mlir::FuncOp> {
+public:
+  using OpRewritePattern::OpRewritePattern;
+
+  mlir::LogicalResult
+  matchAndRewrite(mlir::FuncOp op,
+                  mlir::PatternRewriter &rewriter) const override {
+    rewriter.startRootUpdate(op);
+    auto result = fir::NameUniquer::deconstruct(op.sym_name());
+    if (fir::NameUniquer::isExternalFacingUniquedName(result)) {
+      auto newName = mangleExternalName(result);
+      op.sym_nameAttr(rewriter.getStringAttr(newName));
+      SymbolTable::setSymbolName(op, newName);
+    }
+    rewriter.finalizeRootUpdate(op);
+    return success();
+  }
+};
+
+struct MangleNameForCommonBlock : public mlir::OpRewritePattern<fir::GlobalOp> {
+public:
+  using OpRewritePattern::OpRewritePattern;
+
+  mlir::LogicalResult
+  matchAndRewrite(fir::GlobalOp op,
+                  mlir::PatternRewriter &rewriter) const override {
+    rewriter.startRootUpdate(op);
+    auto result = fir::NameUniquer::deconstruct(
+        op.symref().getRootReference().getValue());
+    if (fir::NameUniquer::isExternalFacingUniquedName(result)) {
+      auto newName = mangleExternalName(result);
+      op.symrefAttr(mlir::SymbolRefAttr::get(op.getContext(), newName));
+      SymbolTable::setSymbolName(op, newName);
+    }
+    rewriter.finalizeRootUpdate(op);
+    return success();
+  }
+};
+
+struct MangleNameOnAddrOfOp : public mlir::OpRewritePattern<fir::AddrOfOp> {
+public:
+  using OpRewritePattern::OpRewritePattern;
+
+  mlir::LogicalResult
+  matchAndRewrite(fir::AddrOfOp op,
+                  mlir::PatternRewriter &rewriter) const override {
+    auto result = fir::NameUniquer::deconstruct(
+        op.symbol().getRootReference().getValue());
+    if (fir::NameUniquer::isExternalFacingUniquedName(result)) {
+      auto newName =
+          SymbolRefAttr::get(op.getContext(), mangleExternalName(result));
+      rewriter.replaceOpWithNewOp<fir::AddrOfOp>(op, op.resTy().getType(),
+                                                 newName);
+    }
+    return success();
+  }
+};
+
+struct MangleNameOnEmboxProcOp
+    : public mlir::OpRewritePattern<fir::EmboxProcOp> {
+public:
+  using OpRewritePattern::OpRewritePattern;
+
+  mlir::LogicalResult
+  matchAndRewrite(fir::EmboxProcOp op,
+                  mlir::PatternRewriter &rewriter) const override {
+    rewriter.startRootUpdate(op);
+    auto result = fir::NameUniquer::deconstruct(
+        op.funcname().getRootReference().getValue());
+    if (fir::NameUniquer::isExternalFacingUniquedName(result))
+      op.funcnameAttr(
+          SymbolRefAttr::get(op.getContext(), mangleExternalName(result)));
+    rewriter.finalizeRootUpdate(op);
+    return success();
+  }
+};
+
+class ExternalNameConversionPass
+    : public fir::ExternalNameConversionBase<ExternalNameConversionPass> {
+public:
+  mlir::ModuleOp getModule() { return getOperation(); }
+  void runOnOperation() override;
+};
+} // namespace
+
+void ExternalNameConversionPass::runOnOperation() {
+  auto op = getOperation();
+  auto *context = &getContext();
+
+  mlir::OwningRewritePatternList patterns(context);
+  patterns.insert<MangleNameOnCallOp, MangleNameOnCallOp, MangleNameOnFuncOp,
+                  MangleNameForCommonBlock, MangleNameOnAddrOfOp,
+                  MangleNameOnEmboxProcOp>(context);
+
+  ConversionTarget target(*context);
+  target.addLegalDialect<fir::FIROpsDialect, LLVM::LLVMDialect,
+                         acc::OpenACCDialect, omp::OpenMPDialect>();
+
+  target.addDynamicallyLegalOp<fir::CallOp>([](fir::CallOp op) {
+    if (op.callee().hasValue())
+      return !fir::NameUniquer::needExternalNameMangling(
+          op.callee().getValue().getRootReference().getValue());
+    return true;
+  });
+
+  target.addDynamicallyLegalOp<mlir::FuncOp>([](mlir::FuncOp op) {
+    return !fir::NameUniquer::needExternalNameMangling(op.sym_name());
+  });
+
+  target.addDynamicallyLegalOp<fir::GlobalOp>([](fir::GlobalOp op) {
+    return !fir::NameUniquer::needExternalNameMangling(
+        op.symref().getRootReference().getValue());
+  });
+
+  target.addDynamicallyLegalOp<fir::AddrOfOp>([](fir::AddrOfOp op) {
+    return !fir::NameUniquer::needExternalNameMangling(
+        op.symbol().getRootReference().getValue());
+  });
+
+  target.addDynamicallyLegalOp<fir::EmboxProcOp>([](fir::EmboxProcOp op) {
+    return !fir::NameUniquer::needExternalNameMangling(
+        op.funcname().getRootReference().getValue());
+  });
+
+  if (failed(applyPartialConversion(op, target, std::move(patterns))))
+    signalPassFailure();
+}
+
+std::unique_ptr<mlir::Pass> fir::createExternalNameConversionPass() {
+  return std::make_unique<ExternalNameConversionPass>();
+}
diff --git a/lib/Optimizer/Transforms/PassDetail.h b/lib/Optimizer/Transforms/PassDetail.h
new file mode 100644
index 0000000..3155c08
--- /dev/null
+++ b/lib/Optimizer/Transforms/PassDetail.h
@@ -0,0 +1,26 @@
+//===- PassDetail.h - Optimizer Transforms Pass class details ---*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+#ifndef FORTRAN_OPTMIZER_TRANSFORMS_PASSDETAIL_H
+#define FORTRAN_OPTMIZER_TRANSFORMS_PASSDETAIL_H
+
+#include "flang/Optimizer/Dialect/FIRDialect.h"
+#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
+#include "mlir/Dialect/OpenACC/OpenACC.h"
+#include "mlir/Dialect/OpenMP/OpenMPDialect.h"
+#include "mlir/Dialect/StandardOps/IR/Ops.h"
+#include "mlir/Pass/Pass.h"
+#include "mlir/Pass/PassRegistry.h"
+
+namespace fir {
+
+#define GEN_PASS_CLASSES
+#include "flang/Optimizer/Transforms/Passes.h.inc"
+
+} // namespace fir
+
+#endif // FORTRAN_OPTMIZER_TRANSFORMS_PASSDETAIL_H
diff --git a/test/Fir/external-mangling-emboxproc.fir b/test/Fir/external-mangling-emboxproc.fir
new file mode 100644
index 0000000..d344f51
--- /dev/null
+++ b/test/Fir/external-mangling-emboxproc.fir
@@ -0,0 +1,10 @@
+// RUN: fir-opt --external-name-interop %s | FileCheck %s
+
+func @_QPfoo() {  
+  %e6 = fir.alloca tuple<i32,f64>
+  %0 = fir.emboxproc @_QPfoo_impl, %e6 : ((!fir.box<!fir.type<derived3{f:f32}>>) -> (), !fir.ref<tuple<i32,f64>>) -> !fir.boxproc<(!fir.box<!fir.type<derived3{f:f32}>>) -> ()>  
+  return
+}
+func private @_QPfoo_impl(!fir.ref<i32>)
+
+// CHECK: %{{.*}}= fir.emboxproc @foo_impl_
diff --git a/test/Fir/external-mangling.fir b/test/Fir/external-mangling.fir
new file mode 100644
index 0000000..886a23d
--- /dev/null
+++ b/test/Fir/external-mangling.fir
@@ -0,0 +1,29 @@
+// RUN: fir-opt --external-name-interop %s | FileCheck %s
+
+func @_QPfoo() {  
+  %c0 = constant 0 : index
+  %0 = fir.address_of(@_QBa) : !fir.ref<!fir.array<4xi8>>
+  %1 = fir.convert %0 : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
+  %2 = fir.coordinate_of %1, %c0 : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+  %3 = fir.convert %2 : (!fir.ref<i8>) -> !fir.ref<i32>
+  %4 = fir.address_of(@_QB) : !fir.ref<!fir.array<4xi8>>
+  %5 = fir.convert %4 : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
+  %6 = fir.coordinate_of %5, %c0 : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+  %7 = fir.convert %6 : (!fir.ref<i8>) -> !fir.ref<f32>
+  fir.call @_QPbar(%3) : (!fir.ref<i32>) -> ()
+  fir.call @_QPbar2(%7) : (!fir.ref<f32>) -> ()
+  return
+}
+fir.global common @_QBa(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+fir.global common @_QB(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+func private @_QPbar(!fir.ref<i32>)
+func private @_QPbar2(!fir.ref<f32>)
+
+// CHECK: func @foo_
+// CHECK: %{{.*}} = fir.address_of(@a_) : !fir.ref<!fir.array<4xi8>>
+// CHECK: %{{.*}} = fir.address_of(@__BLNK__) : !fir.ref<!fir.array<4xi8>>
+// CHECK: fir.call @bar_
+// CHECK: fir.call @bar2_
+// CHECK: fir.global common @a_(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+// CHECK: fir.global common @__BLNK__(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+// CHECK: func private @bar_(!fir.ref<i32>)
diff --git a/tools/fir-opt/CMakeLists.txt b/tools/fir-opt/CMakeLists.txt
index 566aa78..d6bddd0 100644
--- a/tools/fir-opt/CMakeLists.txt
+++ b/tools/fir-opt/CMakeLists.txt
@@ -11,6 +11,18 @@
 
   # TODO: these should be transitive dependencies from a target providing
   # "registerFIRPasses()"
+  MLIRIR
+  MLIRLLVMIR
+  MLIRPass
+  MLIRStandardToLLVM
+  MLIRTransforms
   MLIRAffineToStandard
+  MLIRAnalysis
+  MLIRSCFToStandard
+  MLIRParser
+  MLIRStandardToLLVM
+  MLIRSupport
+  MLIRVectorToLLVM
   MLIROptLib
+
 )
diff --git a/tools/fir-opt/fir-opt.cpp b/tools/fir-opt/fir-opt.cpp
index b662943..246d584 100644
--- a/tools/fir-opt/fir-opt.cpp
+++ b/tools/fir-opt/fir-opt.cpp
@@ -13,11 +13,13 @@
 
 #include "mlir/Support/MlirOptMain.h"
 #include "flang/Optimizer/Support/InitFIR.h"
+#include "flang/Optimizer/Transforms/Passes.h"
 
 using namespace mlir;
 
 int main(int argc, char **argv) {
   fir::support::registerMLIRPassesForFortranTools();
+  fir::registerOptTransformPasses();
   DialectRegistry registry;
   fir::support::registerDialects(registry);
   return failed(MlirOptMain(argc, argv, "FIR modular optimizer driver\n",
diff --git a/unittests/Optimizer/InternalNamesTest.cpp b/unittests/Optimizer/InternalNamesTest.cpp
index ca26cf9..c434874 100644
--- a/unittests/Optimizer/InternalNamesTest.cpp
+++ b/unittests/Optimizer/InternalNamesTest.cpp
@@ -221,4 +221,36 @@
   validateDeconstructedName(actual, expectedNameKind, expectedComponents);
 }
 
+TEST(InternalNamesTest, needExternalNameMangling) {
+  ASSERT_FALSE(
+      NameUniquer::needExternalNameMangling("_QMmodSs1modSs2modFsubPfun"));
+  ASSERT_FALSE(NameUniquer::needExternalNameMangling("omp_num_thread"));
+  ASSERT_FALSE(NameUniquer::needExternalNameMangling(""));
+  ASSERT_FALSE(NameUniquer::needExternalNameMangling("_QDTmytypeK2K8K18"));
+  ASSERT_FALSE(NameUniquer::needExternalNameMangling("exit_"));
+  ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QPfoo"));
+  ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QPbar"));
+  ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QBa"));
+}
+
+TEST(InternalNamesTest, isExternalFacingUniquedName) {
+  std::pair result = NameUniquer::deconstruct("_QMmodSs1modSs2modFsubPfun");
+
+  ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("omp_num_thread");
+  ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("");
+  ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("_QDTmytypeK2K8K18");
+  ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("exit_");
+  ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("_QPfoo");
+  ASSERT_TRUE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("_QPbar");
+  ASSERT_TRUE(NameUniquer::isExternalFacingUniquedName(result));
+  result = NameUniquer::deconstruct("_QBa");
+  ASSERT_TRUE(NameUniquer::isExternalFacingUniquedName(result));
+}
+
 // main() from gtest_main