flang/lib/Lower/Mangler.cpp

   1 //===-- Mangler.cpp -------------------------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 #include "flang/Lower/Mangler.h"
  10 #include "flang/Common/reference.h"
  11 #include "flang/Lower/Support/Utils.h"
  12 #include "flang/Optimizer/Builder/Todo.h"
  13 #include "flang/Optimizer/Dialect/FIRType.h"
  14 #include "flang/Optimizer/Support/InternalNames.h"
  15 #include "flang/Semantics/tools.h"
  16 #include "llvm/ADT/ArrayRef.h"
  17 #include "llvm/ADT/SmallVector.h"
  18 #include "llvm/ADT/StringRef.h"
  19 #include "llvm/Support/MD5.h"
  20
  21 /// Return all ancestor module and submodule scope names; all host procedure
  22 /// and statement function scope names; and the innermost blockId containing
  23 /// \p scope, including scope itself.
  24 static std::tuple<llvm::SmallVector<llvm::StringRef>,
  25                   llvm::SmallVector<llvm::StringRef>, std::int64_t>
  26 ancestors(const Fortran::semantics::Scope &scope,
  27           Fortran::lower::mangle::ScopeBlockIdMap &scopeBlockIdMap) {
  28   llvm::SmallVector<const Fortran::semantics::Scope *> scopes;
  29   for (auto *scp = &scope; !scp->IsGlobal(); scp = &scp->parent())
  30     scopes.push_back(scp);
  31   llvm::SmallVector<llvm::StringRef> modules;
  32   llvm::SmallVector<llvm::StringRef> procs;
  33   std::int64_t blockId = 0;
  34   for (auto iter = scopes.rbegin(), rend = scopes.rend(); iter != rend;
  35        ++iter) {
  36     auto *scp = *iter;
  37     switch (scp->kind()) {
  38     case Fortran::semantics::Scope::Kind::Module:
  39       modules.emplace_back(toStringRef(scp->symbol()->name()));
  40       break;
  41     case Fortran::semantics::Scope::Kind::Subprogram:
  42       procs.emplace_back(toStringRef(scp->symbol()->name()));
  43       break;
  44     case Fortran::semantics::Scope::Kind::MainProgram:
  45       // Do not use the main program name, if any, because it may collide
  46       // with a procedure of the same name in another compilation unit.
  47       // This is nonconformant, but universally allowed.
  48       procs.emplace_back(llvm::StringRef(""));
  49       break;
  50     case Fortran::semantics::Scope::Kind::BlockConstruct: {
  51       auto it = scopeBlockIdMap.find(scp);
  52       assert(it != scopeBlockIdMap.end() && it->second &&
  53              "invalid block identifier");
  54       blockId = it->second;
  55     } break;
  56     default:
  57       break;
  58     }
  59   }
  60   return {modules, procs, blockId};
  61 }
  62
  63 /// Return all ancestor module and submodule scope names; all host procedure
  64 /// and statement function scope names; and the innermost blockId containing
  65 /// \p symbol.
  66 static std::tuple<llvm::SmallVector<llvm::StringRef>,
  67                   llvm::SmallVector<llvm::StringRef>, std::int64_t>
  68 ancestors(const Fortran::semantics::Symbol &symbol,
  69           Fortran::lower::mangle::ScopeBlockIdMap &scopeBlockIdMap) {
  70   return ancestors(symbol.owner(), scopeBlockIdMap);
  71 }
  72
  73 /// Return a globally unique string for a compiler generated \p name.
  74 std::string
  75 Fortran::lower::mangle::mangleName(std::string &name,
  76                                    const Fortran::semantics::Scope &scope,
  77                                    ScopeBlockIdMap &scopeBlockIdMap) {
  78   llvm::SmallVector<llvm::StringRef> modules;
  79   llvm::SmallVector<llvm::StringRef> procs;
  80   std::int64_t blockId;
  81   std::tie(modules, procs, blockId) = ancestors(scope, scopeBlockIdMap);
  82   return fir::NameUniquer::doGenerated(modules, procs, blockId, name);
  83 }
  84
  85 // Mangle the name of \p symbol to make it globally unique.
  86 std::string Fortran::lower::mangle::mangleName(
  87     const Fortran::semantics::Symbol &symbol, ScopeBlockIdMap &scopeBlockIdMap,
  88     bool keepExternalInScope, bool underscoring) {
  89   // Resolve module and host associations before mangling.
  90   const auto &ultimateSymbol = symbol.GetUltimate();
  91
  92   // The Fortran and BIND(C) namespaces are counterintuitive. A BIND(C) name is
  93   // substituted early, and has precedence over the Fortran name. This allows
  94   // multiple procedures or objects with identical Fortran names to legally
  95   // coexist. The BIND(C) name is unique.
  96   if (auto *overrideName = ultimateSymbol.GetBindName())
  97     return *overrideName;
  98
  99   llvm::StringRef symbolName = toStringRef(ultimateSymbol.name());
 100   llvm::SmallVector<llvm::StringRef> modules;
 101   llvm::SmallVector<llvm::StringRef> procs;
 102   std::int64_t blockId;
 103
 104   // mangle ObjectEntityDetails or AssocEntityDetails symbols.
 105   auto mangleObject = [&]() -> std::string {
 106     std::tie(modules, procs, blockId) =
 107         ancestors(ultimateSymbol, scopeBlockIdMap);
 108     if (Fortran::semantics::IsNamedConstant(ultimateSymbol))
 109       return fir::NameUniquer::doConstant(modules, procs, blockId, symbolName);
 110     return fir::NameUniquer::doVariable(modules, procs, blockId, symbolName);
 111   };
 112
 113   return Fortran::common::visit(
 114       Fortran::common::visitors{
 115           [&](const Fortran::semantics::MainProgramDetails &) {
 116             return fir::NameUniquer::doProgramEntry().str();
 117           },
 118           [&](const Fortran::semantics::SubprogramDetails &subpDetails) {
 119             // Mangle external procedure without any scope prefix.
 120             if (!keepExternalInScope &&
 121                 Fortran::semantics::IsExternal(ultimateSymbol))
 122               return fir::NameUniquer::doProcedure(std::nullopt, std::nullopt,
 123                                                    symbolName);
 124             // A separate module procedure must be mangled according to its
 125             // declaration scope, not its definition scope.
 126             const Fortran::semantics::Symbol *interface = &ultimateSymbol;
 127             if (interface->attrs().test(Fortran::semantics::Attr::MODULE) &&
 128                 interface->owner().IsSubmodule() && !subpDetails.isInterface())
 129               interface = subpDetails.moduleInterface();
 130             std::tie(modules, procs, blockId) = ancestors(
 131                 interface ? *interface : ultimateSymbol, scopeBlockIdMap);
 132             return fir::NameUniquer::doProcedure(modules, procs, symbolName);
 133           },
 134           [&](const Fortran::semantics::ProcEntityDetails &) {
 135             // Mangle procedure pointers and dummy procedures as variables.
 136             if (Fortran::semantics::IsPointer(ultimateSymbol) ||
 137                 Fortran::semantics::IsDummy(ultimateSymbol)) {
 138               std::tie(modules, procs, blockId) =
 139                   ancestors(ultimateSymbol, scopeBlockIdMap);
 140               return fir::NameUniquer::doVariable(modules, procs, blockId,
 141                                                   symbolName);
 142             }
 143             // Otherwise, this is an external procedure, with or without an
 144             // explicit EXTERNAL attribute. Mangle it without any prefix.
 145             return fir::NameUniquer::doProcedure(std::nullopt, std::nullopt,
 146                                                  symbolName);
 147           },
 148           [&](const Fortran::semantics::ObjectEntityDetails &) {
 149             return mangleObject();
 150           },
 151           [&](const Fortran::semantics::AssocEntityDetails &) {
 152             return mangleObject();
 153           },
 154           [&](const Fortran::semantics::NamelistDetails &) {
 155             std::tie(modules, procs, blockId) =
 156                 ancestors(ultimateSymbol, scopeBlockIdMap);
 157             return fir::NameUniquer::doNamelistGroup(modules, procs,
 158                                                      symbolName);
 159           },
 160           [&](const Fortran::semantics::CommonBlockDetails &) {
 161             return Fortran::semantics::GetCommonBlockObjectName(ultimateSymbol,
 162                                                                 underscoring);
 163           },
 164           [&](const Fortran::semantics::ProcBindingDetails &procBinding) {
 165             return mangleName(procBinding.symbol(), scopeBlockIdMap,
 166                               keepExternalInScope, underscoring);
 167           },
 168           [&](const Fortran::semantics::GenericDetails &generic)
 169               -> std::string {
 170             if (generic.specific())
 171               return mangleName(*generic.specific(), scopeBlockIdMap,
 172                                 keepExternalInScope, underscoring);
 173             else
 174               llvm::report_fatal_error(
 175                   "attempt to mangle a generic name but "
 176                   "it has no specific procedure of the same name");
 177           },
 178           [&](const Fortran::semantics::DerivedTypeDetails &) -> std::string {
 179             // Derived type mangling must use mangleName(DerivedTypeSpec) so
 180             // that kind type parameter values can be mangled.
 181             llvm::report_fatal_error(
 182                 "only derived type instances can be mangled");
 183           },
 184           [](const auto &) -> std::string { TODO_NOLOC("symbol mangling"); },
 185       },
 186       ultimateSymbol.details());
 187 }
 188
 189 std::string
 190 Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
 191                                    bool keepExternalInScope,
 192                                    bool underscoring) {
 193   assert((symbol.owner().kind() !=
 194               Fortran::semantics::Scope::Kind::BlockConstruct ||
 195           symbol.has<Fortran::semantics::SubprogramDetails>() ||
 196           Fortran::semantics::IsBindCProcedure(symbol)) &&
 197          "block object mangling must specify a scopeBlockIdMap");
 198   ScopeBlockIdMap scopeBlockIdMap;
 199   return mangleName(symbol, scopeBlockIdMap, keepExternalInScope, underscoring);
 200 }
 201
 202 std::string Fortran::lower::mangle::mangleName(
 203     const Fortran::semantics::DerivedTypeSpec &derivedType,
 204     ScopeBlockIdMap &scopeBlockIdMap) {
 205   // Resolve module and host associations before mangling.
 206   const Fortran::semantics::Symbol &ultimateSymbol =
 207       derivedType.typeSymbol().GetUltimate();
 208
 209   llvm::StringRef symbolName = toStringRef(ultimateSymbol.name());
 210   llvm::SmallVector<llvm::StringRef> modules;
 211   llvm::SmallVector<llvm::StringRef> procs;
 212   std::int64_t blockId;
 213   std::tie(modules, procs, blockId) =
 214       ancestors(ultimateSymbol, scopeBlockIdMap);
 215   llvm::SmallVector<std::int64_t> kinds;
 216   for (const auto &param :
 217        Fortran::semantics::OrderParameterDeclarations(ultimateSymbol)) {
 218     const auto &paramDetails =
 219         param->get<Fortran::semantics::TypeParamDetails>();
 220     if (paramDetails.attr() == Fortran::common::TypeParamAttr::Kind) {
 221       const Fortran::semantics::ParamValue *paramValue =
 222           derivedType.FindParameter(param->name());
 223       assert(paramValue && "derived type kind parameter value not found");
 224       const Fortran::semantics::MaybeIntExpr paramExpr =
 225           paramValue->GetExplicit();
 226       assert(paramExpr && "derived type kind param not explicit");
 227       std::optional<int64_t> init =
 228           Fortran::evaluate::ToInt64(paramValue->GetExplicit());
 229       assert(init && "derived type kind param is not constant");
 230       kinds.emplace_back(*init);
 231     }
 232   }
 233   return fir::NameUniquer::doType(modules, procs, blockId, symbolName, kinds);
 234 }
 235
 236 std::string Fortran::lower::mangle::getRecordTypeFieldName(
 237     const Fortran::semantics::Symbol &component,
 238     ScopeBlockIdMap &scopeBlockIdMap) {
 239   if (!component.attrs().test(Fortran::semantics::Attr::PRIVATE))
 240     return component.name().ToString();
 241   const Fortran::semantics::DerivedTypeSpec *componentParentType =
 242       component.owner().derivedTypeSpec();
 243   assert(componentParentType &&
 244          "failed to retrieve private component parent type");
 245   // Do not mangle Iso C C_PTR and C_FUNPTR components. This type cannot be
 246   // extended as per Fortran 2018 7.5.7.1, mangling them makes the IR unreadable
 247   // when using ISO C modules, and lowering needs to know the component way
 248   // without access to semantics::Symbol.
 249   if (Fortran::semantics::IsIsoCType(componentParentType))
 250     return component.name().ToString();
 251   return mangleName(*componentParentType, scopeBlockIdMap) + "." +
 252          component.name().ToString();
 253 }
 254
 255 std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) {
 256   auto result = fir::NameUniquer::deconstruct(name);
 257   return result.second.name;
 258 }
 259
 260 //===----------------------------------------------------------------------===//
 261 // Array Literals Mangling
 262 //===----------------------------------------------------------------------===//
 263
 264 static std::string typeToString(Fortran::common::TypeCategory cat, int kind,
 265                                 llvm::StringRef derivedName) {
 266   switch (cat) {
 267   case Fortran::common::TypeCategory::Integer:
 268     return "i" + std::to_string(kind);
 269   case Fortran::common::TypeCategory::Unsigned:
 270     return "u" + std::to_string(kind);
 271   case Fortran::common::TypeCategory::Real:
 272     return "r" + std::to_string(kind);
 273   case Fortran::common::TypeCategory::Complex:
 274     return "z" + std::to_string(kind);
 275   case Fortran::common::TypeCategory::Logical:
 276     return "l" + std::to_string(kind);
 277   case Fortran::common::TypeCategory::Character:
 278     return "c" + std::to_string(kind);
 279   case Fortran::common::TypeCategory::Derived:
 280     return derivedName.str();
 281   }
 282   llvm_unreachable("bad TypeCategory");
 283 }
 284
 285 std::string Fortran::lower::mangle::mangleArrayLiteral(
 286     size_t size, const Fortran::evaluate::ConstantSubscripts &shape,
 287     Fortran::common::TypeCategory cat, int kind,
 288     Fortran::common::ConstantSubscript charLen, llvm::StringRef derivedName) {
 289   std::string typeId;
 290   for (Fortran::evaluate::ConstantSubscript extent : shape)
 291     typeId.append(std::to_string(extent)).append("x");
 292   if (charLen >= 0)
 293     typeId.append(std::to_string(charLen)).append("x");
 294   typeId.append(typeToString(cat, kind, derivedName));
 295   std::string name =
 296       fir::NameUniquer::doGenerated("ro."s.append(typeId).append("."));
 297   if (!size)
 298     name += "null.";
 299   return name;
 300 }
 301
 302 std::string Fortran::lower::mangle::globalNamelistDescriptorName(
 303     const Fortran::semantics::Symbol &sym) {
 304   std::string name = mangleName(sym);
 305   return IsAllocatableOrObjectPointer(&sym) ? name : name + ".desc"s;
 306 }