[flang] Add the Mangler module to flang lowering

[schweitz]

Summary

This module converts symbols from the front-end into unique names used in by the optimizer.

This diff is the latest in a series of diffs to upstream the middle part of flang to llvm-project.

[sameeranjoshi]

Will it make sense to add LIT tests(program-units-fir-mangling.f90 in fir-dev) for InternalNames.h with this patch also if any for Mangler.h?
Looks like it was missed in https://reviews.llvm.org/D78838

[kiranchandramohan]

Agree with @sameeranjoshi. But it would probably require some Bridge code. If @sameeranjoshi can land the unit test patch, maybe we can have some unit tests.

[sameeranjoshi]

>> But it would probably require some Bridge code. If @sameeranjoshi can land the unit test patch, maybe we can have some unit tests.

@isuruf had a comment[1], if he's ok with it I am ready to merge it.
Or the other way round if it's a blocker I can merge the code and later fix @isuruf issue in separate PR.

[1]https://reviews.llvm.org/D80377#2091308

[schweitz]

Right, it will take a functional bridge and test driver to run end-to-end tests. Neither has been upstreamed at this point, so it is a bit premature to start adding end-to-end tests.

Unit tests on internal naming don't have that dependency. But they do have a dependency on the fixes included in this patch.

[sameeranjoshi]

If @sameeranjoshi can land the unit test patch, maybe we can have some unit tests.

It's merged now.

[sameeranjoshi]

In D81764#2093014, @schweitz wrote:

Unit tests on internal naming don't have that dependency. But they do have a dependency on the fixes included in this patch.

I don't think they have dependency, the tests are updated.

IIRC, first the bugs were found using tests and later changes were made to code in fir-dev.
Here's one[1] such I recall

[1]https://github.com/flang-compiler/f18-llvm-project/pull/98/commits/0d0a47020f233f5ea7c10ffb6cd24fb6b9da7b46

[schweitz]

In D81764#2093204, @sameeranjoshi wrote:

In D81764#2093014, @schweitz wrote:

Unit tests on internal naming don't have that dependency. But they do have a dependency on the fixes included in this patch.

I don't think they have dependency, the tests are updated.

IIRC, first the bugs were found using tests and later changes were made to code in fir-dev.
Here's one[1] such I recall

[1]https://github.com/flang-compiler/f18-llvm-project/pull/98/commits/0d0a47020f233f5ea7c10ffb6cd24fb6b9da7b46

If the unit test does NOT depend on the correct behavior of the code it is testing, then the unit test needs more work by definition.

The point of this diff is to upstream code from fir-dev.

[jeanPerier]

LGTM, unit test can always be added later when the framework is ready.

[schweitz]

Rebase and update with the functional unittest.

[sameeranjoshi]

In D81764#2095904, @schweitz wrote:

Rebase and update with the functional unittest.

LGTM.
Thanks for adding test.

flang/lib/Lower/Mangler.cpp

58

nit s/proc/procedure/

[kiranchandramohan]

flang/include/flang/Lower/Mangler.h

2

Nit: generally is like include/flang/Lower/Manger.h

flang/lib/Lower/Mangler.cpp

2

Nit: Usually the path is also there. lib/Lower/Mangler.cpp

67

Is the uniquer modified inside this function?

[schweitz]

flang/lib/Lower/Mangler.cpp

2

Lower uses a lot of the MLIR/LLVM conventions since it is "close to" MLIR.

67

It's passed around a bit like an MLIRContext. The reference just means it can't be a null pointer. Again, lower follows the MLIR conventions, here with respect to const.

https://mlir.llvm.org/docs/Rationale/UsageOfConst/

flang/include/flang/Lower/Mangler.h

+//===-- Lower/Mangler.h -- name mangling ------------------------*- 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_LOWER_MANGLER_H_
+#define FORTRAN_LOWER_MANGLER_H_
+
+#include <string>
+
+namespace fir {
+struct NameUniquer;
+}
+
+namespace llvm {
+class StringRef;
+}
+
+namespace Fortran {
+namespace common {
+template <typename>
+class Reference;
+}
+
+namespace semantics {
+class Symbol;
+}
+
+namespace lower {
+namespace mangle {
+
+/// Convert a front-end Symbol to an internal name
+std::string mangleName(fir::NameUniquer &uniquer, const semantics::Symbol &);
+
+std::string demangleName(llvm::StringRef name);
+
+} // namespace mangle
+} // namespace lower
+} // namespace Fortran
+
+#endif // FORTRAN_LOWER_MANGLER_H_

flang/include/flang/Optimizer/Support/InternalNames.h

struct NameUniquer {
 
   NameUniquer() = default;
 
   /// Unique a common block name
   std::string doCommonBlock(llvm::StringRef name);
 
   /// Unique a (global) constant name
   std::string doConstant(llvm::ArrayRef<llvm::StringRef> modules,
+                         llvm::Optional<llvm::StringRef> host,
                          llvm::StringRef name);
 
   /// Unique a dispatch table name
   std::string doDispatchTable(llvm::ArrayRef<llvm::StringRef> modules,
                               llvm::Optional<llvm::StringRef> host,
                               llvm::StringRef name,
                               llvm::ArrayRef<std::int64_t> kinds);
 

flang/lib/Lower/CMakeLists.txt

 set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-error -Wno-unused-parameter")
 
 add_flang_library(FortranLower
   ComplexExpr.cpp
   ConvertType.cpp
   DoLoopHelper.cpp
+  Mangler.cpp
   OpenMP.cpp
   PFTBuilder.cpp
 
   DEPENDS
   FIROpsIncGen
   MLIROpAsmInterfaceIncGen
   MLIRControlFlowInterfaces
   MLIRLinalgStructuredOpsInterfaceIncGen
 
   LINK_COMPONENTS
   Support
 )

flang/lib/Lower/Mangler.cpp

+//===-- Mangler.cpp -------------------------------------------------------===//
+//
+// 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 "flang/Lower/Mangler.h"
+#include "flang/Common/reference.h"
+#include "flang/Lower/Utils.h"
+#include "flang/Optimizer/Support/InternalNames.h"
+#include "flang/Semantics/tools.h"
+#include "llvm/ADT/ArrayRef.h"
+#include "llvm/ADT/Optional.h"
+#include "llvm/ADT/SmallVector.h"
+#include "llvm/ADT/Twine.h"
+
+// recursively build the vector of module scopes
+static void moduleNames(const Fortran::semantics::Scope &scope,
+                        llvm::SmallVector<llvm::StringRef, 2> &result) {
+  if (scope.kind() == Fortran::semantics::Scope::Kind::Global) {
+    return;
+  }
+  moduleNames(scope.parent(), result);
+  if (scope.kind() == Fortran::semantics::Scope::Kind::Module)
+    if (auto *symbol = scope.symbol())
+      result.emplace_back(toStringRef(symbol->name()));
+}
+
+static llvm::SmallVector<llvm::StringRef, 2>
+moduleNames(const Fortran::semantics::Symbol &symbol) {
+  const auto &scope = symbol.owner();
+  llvm::SmallVector<llvm::StringRef, 2> result;
+  moduleNames(scope, result);
+  return result;
+}
+
+static llvm::Optional<llvm::StringRef>
+hostName(const Fortran::semantics::Symbol &symbol) {
+  const auto &scope = symbol.owner();
+  if (scope.kind() == Fortran::semantics::Scope::Kind::Subprogram) {
+    assert(scope.symbol() && "subprogram scope must have a symbol");
+    return {toStringRef(scope.symbol()->name())};
+  }
+  return {};
+}
+
+static const Fortran::semantics::Symbol *
+findInterfaceIfSeperateMP(const Fortran::semantics::Symbol &symbol) {
+  const auto &scope = symbol.owner();
+  if (symbol.attrs().test(Fortran::semantics::Attr::MODULE) &&
+      scope.IsSubmodule()) {
+    // FIXME symbol from MpSubprogramStmt do not seem to have
+    // Attr::MODULE set.
+    const auto *iface = scope.parent().FindSymbol(symbol.name());
+    assert(iface && "Separate module procedure must be declared");
+    return iface;
+  }
+  return nullptr;
+}
+
+// Mangle the name of `symbol` to make it unique within FIR's symbol table using
+// the FIR name mangler, `mangler`
+std::string
+Fortran::lower::mangle::mangleName(fir::NameUniquer &uniquer,
+                                   const Fortran::semantics::Symbol &symbol) {
+  // Resolve host and module association before mangling
+  const auto &ultimateSymbol = symbol.GetUltimate();
+  auto symbolName = toStringRef(ultimateSymbol.name());
+
+  return std::visit(
+      Fortran::common::visitors{
+          [&](const Fortran::semantics::MainProgramDetails &) {
+            return uniquer.doProgramEntry().str();
+          },
+          [&](const Fortran::semantics::SubprogramDetails &) {
+            // Mangle external procedure without any scope prefix.
+            if (Fortran::semantics::IsExternal(ultimateSymbol))
+              return uniquer.doProcedure(llvm::None, llvm::None, symbolName);
+            // Separate module subprograms must be mangled according to the
+            // scope where they were declared (the symbol we have is the
+            // definition).
+            const auto *interface = &ultimateSymbol;
+            if (const auto *mpIface = findInterfaceIfSeperateMP(ultimateSymbol))
+              interface = mpIface;
+            auto modNames = moduleNames(*interface);
+            return uniquer.doProcedure(modNames, hostName(*interface),
+                                       symbolName);
+          },
+          [&](const Fortran::semantics::ProcEntityDetails &) {
+            // Mangle procedure pointers and dummy procedures as variables
+            if (Fortran::semantics::IsPointer(ultimateSymbol) ||
+                Fortran::semantics::IsDummy(ultimateSymbol))
+              return uniquer.doVariable(moduleNames(ultimateSymbol),
+                                        hostName(ultimateSymbol), symbolName);
+            // Otherwise, this is an external procedure, even if it does not
+            // have an explicit EXTERNAL attribute. Mangle it without any
+            // prefix.
+            return uniquer.doProcedure(llvm::None, llvm::None, symbolName);
+          },
+          [&](const Fortran::semantics::ObjectEntityDetails &) {
+            auto modNames = moduleNames(ultimateSymbol);
+            auto optHost = hostName(ultimateSymbol);
+            if (Fortran::semantics::IsNamedConstant(ultimateSymbol))
+              return uniquer.doConstant(modNames, optHost, symbolName);
+            return uniquer.doVariable(modNames, optHost, symbolName);
+          },
+          [](const auto &) -> std::string {
+            assert(false);
+            return {};
+          },
+      },
+      ultimateSymbol.details());
+}
+
+std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) {
+  auto result = fir::NameUniquer::deconstruct(name);
+  return result.second.name;
+}

flang/lib/Optimizer/Support/InternalNames.cpp

 constexpr std::int64_t BAD_VALUE = -1;
 
 inline std::string prefix() { return "_Q"; }
 
 static std::string doModules(llvm::ArrayRef<llvm::StringRef> mods) {
   std::string result;
   auto *token = "M";
   for (auto mod : mods) {
-    result.append(token).append(mod);
+    result.append(token).append(mod.lower());
     token = "S";
   }
   return result;
 }
 
 static std::string doModulesHost(llvm::ArrayRef<llvm::StringRef> mods,
                                  llvm::Optional<llvm::StringRef> host) {
   std::string result = doModules(mods);
   if (host.hasValue())
-    result.append("F").append(*host);
+    result.append("F").append(host->lower());
   return result;
 }
 
 inline llvm::SmallVector<llvm::StringRef, 2>
 convertToStringRef(llvm::ArrayRef<std::string> from) {
   return {from.begin(), from.end()};
 }
 
 inline llvm::Optional<llvm::StringRef>
 convertToStringRef(const llvm::Optional<std::string> &from) {
   llvm::Optional<llvm::StringRef> to;
   if (from.hasValue())
     to = from.getValue();
   return to;
 }
 
 static std::string readName(llvm::StringRef uniq, std::size_t &i,
                             std::size_t init, std::size_t end) {
-  for (i = init; i < end && uniq[i] >= 'a' && uniq[i] <= 'z'; ++i) {
+  for (i = init; i < end && (uniq[i] < 'A' || uniq[i] > 'Z'); ++i) {
     // do nothing
   }
-  return uniq.substr(init, i).str();
+  return uniq.substr(init, i - init).str();
 }
 
 static std::int64_t readInt(llvm::StringRef uniq, std::size_t &i,
                             std::size_t init, std::size_t end) {
   for (i = init; i < end && uniq[i] >= '0' && uniq[i] <= '9'; ++i) {
     // do nothing
   }
   std::int64_t result = BAD_VALUE;
-  if (uniq.substr(init, i).getAsInteger(10, result))
+  if (uniq.substr(init, i - init).getAsInteger(10, result))
     return BAD_VALUE;
   return result;
 }
 
 std::string fir::NameUniquer::toLower(llvm::StringRef name) {
   return name.lower();
 }
 

 
 std::string fir::NameUniquer::doCommonBlock(llvm::StringRef name) {
   std::string result = prefix();
   return result.append("B").append(toLower(name));
 }
 
 std::string
 fir::NameUniquer::doConstant(llvm::ArrayRef<llvm::StringRef> modules,
+                             llvm::Optional<llvm::StringRef> host,
                              llvm::StringRef name) {
   std::string result = prefix();
-  return result.append(doModules(modules)).append("EC").append(toLower(name));
+  result.append(doModulesHost(modules, host)).append("EC");
+  return result.append(toLower(name));
 }
 
 std::string
 fir::NameUniquer::doDispatchTable(llvm::ArrayRef<llvm::StringRef> modules,
                                   llvm::Optional<llvm::StringRef> host,
                                   llvm::StringRef name,
                                   llvm::ArrayRef<std::int64_t> kinds) {
   std::string result = prefix();

flang/unittests/Optimizer/InternalNamesTest.cpp

-//===- InternalNames.cpp - InternalNames unit tests ---------------===//
+//===- InternalNamesTest.cpp -- InternalNames unit tests ------------------===//
 //
 // 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 "flang/Optimizer/Support/InternalNames.h"
 #include "gtest/gtest.h"
+#include <string>
 
 using namespace fir;
-using namespace llvm;
+using llvm::SmallVector;
+using llvm::StringRef;
 
-TEST(genericName, MyTest) {
+struct DeconstructedName {
+  DeconstructedName(llvm::ArrayRef<std::string> modules,
+      llvm::Optional<std::string> host, llvm::StringRef name,
+      llvm::ArrayRef<std::int64_t> kinds)
+      : modules{modules.begin(), modules.end()}, host{host}, name{name},
+        kinds{kinds.begin(), kinds.end()} {}
+
+  bool isObjEqual(const NameUniquer::DeconstructedName &actualObj) {
+    if ((actualObj.name == name) && (actualObj.modules == modules) &&
+        (actualObj.host == host) && (actualObj.kinds == kinds)) {
+      return true;
+    }
+    return false;
+  }
+
+private:
+  llvm::SmallVector<std::string, 2> modules;
+  llvm::Optional<std::string> host;
+  std::string name;
+  llvm::SmallVector<std::int64_t, 4> kinds;
+};
+
+void validateDeconstructedName(
+    std::pair<NameUniquer::NameKind, NameUniquer::DeconstructedName> &actual,
+    NameUniquer::NameKind &expectedNameKind,
+    struct DeconstructedName &components) {
+  EXPECT_EQ(actual.first, expectedNameKind)
+      << "Possible error: NameKind mismatch";
+  ASSERT_TRUE(components.isObjEqual(actual.second))
+      << "Possible error: DeconstructedName mismatch";
+}
+
+TEST(InternalNamesTest, doCommonBlockTest) {
+  NameUniquer obj;
+  std::string actual = obj.doCommonBlock("hello");
+  std::string actualBlank = obj.doCommonBlock("");
+  std::string expectedMangledName = "_QBhello";
+  std::string expectedMangledNameBlank = "_QB";
+  ASSERT_EQ(actual, expectedMangledName);
+  ASSERT_EQ(actualBlank, expectedMangledNameBlank);
+}
+
+TEST(InternalNamesTest, doGeneratedTest) {
+  NameUniquer obj;
+  std::string actual = obj.doGenerated("@MAIN");
+  std::string expectedMangledName = "_QQ@MAIN";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  std::string actual1 = obj.doGenerated("@_ZNSt8ios_base4InitC1Ev");
+  std::string expectedMangledName1 = "_QQ@_ZNSt8ios_base4InitC1Ev";
+  ASSERT_EQ(actual1, expectedMangledName1);
+
+  std::string actual2 = obj.doGenerated("_QQ@MAIN");
+  std::string expectedMangledName2 = "_QQ_QQ@MAIN";
+  ASSERT_EQ(actual2, expectedMangledName2);
+}
+
+TEST(InternalNamesTest, doConstantTest) {
+  NameUniquer obj;
+  std::string actual = obj.doConstant({"mod1", "mod2"}, {"foo"}, "Hello");
+  std::string expectedMangledName = "_QMmod1Smod2FfooEChello";
+  ASSERT_EQ(actual, expectedMangledName);
+}
+
+TEST(InternalNamesTest, doProcedureTest) {
+  NameUniquer obj;
+  std::string actual = obj.doProcedure({"mod1", "mod2"}, {}, "HeLLo");
+  std::string expectedMangledName = "_QMmod1Smod2Phello";
+  ASSERT_EQ(actual, expectedMangledName);
+}
+
+TEST(InternalNamesTest, doTypeTest) {
   NameUniquer obj;
-  std::string val = obj.doCommonBlock("hello");
-  std::string val2 = "_QBhello";
-  EXPECT_EQ(val, val2);
+  std::string actual = obj.doType({}, {}, "mytype", {4, -1});
+  std::string expectedMangledName = "_QTmytypeK4KN1";
+  ASSERT_EQ(actual, expectedMangledName);
 }
+
+TEST(InternalNamesTest, doIntrinsicTypeDescriptorTest) {
+  using IntrinsicType = fir::NameUniquer::IntrinsicType;
+  NameUniquer obj;
+  std::string actual =
+      obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::REAL, 42);
+  std::string expectedMangledName = "_QCrealK42";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::REAL, {});
+  expectedMangledName = "_QCrealK0";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::INTEGER, 3);
+  expectedMangledName = "_QCintegerK3";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::LOGICAL, 2);
+  expectedMangledName = "_QClogicalK2";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::CHARACTER, 4);
+  expectedMangledName = "_QCcharacterK4";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::COMPLEX, 4);
+  expectedMangledName = "_QCcomplexK4";
+  ASSERT_EQ(actual, expectedMangledName);
+}
+
+TEST(InternalNamesTest, doDispatchTableTest) {
+  NameUniquer obj;
+  std::string actual = obj.doDispatchTable({}, {}, "MyTYPE", {2, 8, 18});
+  std::string expectedMangledName = "_QDTmytypeK2K8K18";
+  ASSERT_EQ(actual, expectedMangledName);
+}
+
+TEST(InternalNamesTest, doTypeDescriptorTest) {
+  NameUniquer obj;
+  std::string actual = obj.doTypeDescriptor(
+      {StringRef("moD1")}, {StringRef("foo")}, "MyTYPE", {2, 8});
+  std::string expectedMangledName = "_QMmod1FfooCTmytypeK2K8";
+  ASSERT_EQ(actual, expectedMangledName);
+}
+
+TEST(InternalNamesTest, doVariableTest) {
+  NameUniquer obj;
+  std::string actual = obj.doVariable(
+      {"mod1", "mod2"}, {""}, "intvar"); // Function is present and is blank.
+  std::string expectedMangledName = "_QMmod1Smod2FEintvar";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  std::string actual2 = obj.doVariable(
+      {"mod1", "mod2"}, {}, "intVariable"); // Function is not present.
+  std::string expectedMangledName2 = "_QMmod1Smod2Eintvariable";
+  ASSERT_EQ(actual2, expectedMangledName2);
+}
+
+TEST(InternalNamesTest, doProgramEntry) {
+  NameUniquer obj;
+  llvm::StringRef actual = obj.doProgramEntry();
+  std::string expectedMangledName = "_QQmain";
+  ASSERT_EQ(actual.str(), expectedMangledName);
+}
+
+TEST(InternalNamesTest, deconstructTest) {
+  NameUniquer obj;
+  std::pair actual = obj.deconstruct("_QBhello");
+  auto expectedNameKind = NameUniquer::NameKind::COMMON;
+  struct DeconstructedName expectedComponents {
+    {}, {}, "hello", {}
+  };
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+}
+
+TEST(InternalNamesTest, complexdeconstructTest) {
+  using NameKind = fir::NameUniquer::NameKind;
+  NameUniquer obj;
+  std::pair actual = obj.deconstruct("_QMmodSs1modSs2modFsubPfun");
+  auto expectedNameKind = NameKind::PROCEDURE;
+  struct DeconstructedName expectedComponents = {
+      {"mod", "s1mod", "s2mod"}, {"sub"}, "fun", {}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+
+  actual = obj.deconstruct("_QPsub");
+  expectedNameKind = NameKind::PROCEDURE;
+  expectedComponents = {{}, {}, "sub", {}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+
+  actual = obj.deconstruct("_QBvariables");
+  expectedNameKind = NameKind::COMMON;
+  expectedComponents = {{}, {}, "variables", {}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+
+  actual = obj.deconstruct("_QMmodEintvar");
+  expectedNameKind = NameKind::VARIABLE;
+  expectedComponents = {{"mod"}, {}, "intvar", {}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+
+  actual = obj.deconstruct("_QMmodECpi");
+  expectedNameKind = NameKind::CONSTANT;
+  expectedComponents = {{"mod"}, {}, "pi", {}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+
+  actual = obj.deconstruct("_QTyourtypeK4KN6");
+  expectedNameKind = NameKind::DERIVED_TYPE;
+  expectedComponents = {{}, {}, "yourtype", {4, -6}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+
+  actual = obj.deconstruct("_QDTt");
+  expectedNameKind = NameKind::DISPATCH_TABLE;
+  expectedComponents = {{}, {}, "t", {}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+}
+
+// main() from gtest_main