315 lines · 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-exception6//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 procedure22/// and statement function scope names; and the innermost blockId containing23/// \p scope, including scope itself.24static std::tuple<llvm::SmallVector<llvm::StringRef>,25 llvm::SmallVector<llvm::StringRef>, std::int64_t>26ancestors(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 collide46 // 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 procedure64/// and statement function scope names; and the innermost blockId containing65/// \p symbol.66static std::tuple<llvm::SmallVector<llvm::StringRef>,67 llvm::SmallVector<llvm::StringRef>, std::int64_t>68ancestors(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.74std::string75Fortran::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.86std::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 is93 // substituted early, and has precedence over the Fortran name. This allows94 // multiple procedures or objects with identical Fortran names to legally95 // 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({}, {}, symbolName);123 // A separate module procedure must be mangled according to its124 // declaration scope, not its definition scope.125 const Fortran::semantics::Symbol *interface = &ultimateSymbol;126 if (interface->attrs().test(Fortran::semantics::Attr::MODULE) &&127 interface->owner().IsSubmodule() && !subpDetails.isInterface())128 interface = subpDetails.moduleInterface();129 std::tie(modules, procs, blockId) = ancestors(130 interface ? *interface : ultimateSymbol, scopeBlockIdMap);131 return fir::NameUniquer::doProcedure(modules, procs, symbolName);132 },133 [&](const Fortran::semantics::ProcEntityDetails &) {134 // Mangle procedure pointers and dummy procedures as variables.135 if (Fortran::semantics::IsPointer(ultimateSymbol) ||136 Fortran::semantics::IsDummy(ultimateSymbol)) {137 std::tie(modules, procs, blockId) =138 ancestors(ultimateSymbol, scopeBlockIdMap);139 return fir::NameUniquer::doVariable(modules, procs, blockId,140 symbolName);141 }142 // Otherwise, this is an external procedure, with or without an143 // explicit EXTERNAL attribute. Mangle it without any prefix.144 return fir::NameUniquer::doProcedure({}, {}, symbolName);145 },146 [&](const Fortran::semantics::ObjectEntityDetails &) {147 return mangleObject();148 },149 [&](const Fortran::semantics::AssocEntityDetails &) {150 return mangleObject();151 },152 [&](const Fortran::semantics::NamelistDetails &) {153 std::tie(modules, procs, blockId) =154 ancestors(ultimateSymbol, scopeBlockIdMap);155 return fir::NameUniquer::doNamelistGroup(modules, procs,156 symbolName);157 },158 [&](const Fortran::semantics::CommonBlockDetails &) {159 return Fortran::semantics::GetCommonBlockObjectName(ultimateSymbol,160 underscoring);161 },162 [&](const Fortran::semantics::ProcBindingDetails &procBinding) {163 return mangleName(procBinding.symbol(), scopeBlockIdMap,164 keepExternalInScope, underscoring);165 },166 [&](const Fortran::semantics::GenericDetails &generic)167 -> std::string {168 if (generic.specific())169 return mangleName(*generic.specific(), scopeBlockIdMap,170 keepExternalInScope, underscoring);171 else172 llvm::report_fatal_error(173 "attempt to mangle a generic name but "174 "it has no specific procedure of the same name");175 },176 [&](const Fortran::semantics::DerivedTypeDetails &) -> std::string {177 // Derived type mangling must use mangleName(DerivedTypeSpec) so178 // that kind type parameter values can be mangled.179 llvm::report_fatal_error(180 "only derived type instances can be mangled");181 },182 [](const auto &) -> std::string { TODO_NOLOC("symbol mangling"); },183 },184 ultimateSymbol.details());185}186 187std::string188Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,189 bool keepExternalInScope,190 bool underscoring) {191 assert((symbol.owner().kind() !=192 Fortran::semantics::Scope::Kind::BlockConstruct ||193 symbol.has<Fortran::semantics::SubprogramDetails>() ||194 Fortran::semantics::IsBindCProcedure(symbol)) &&195 "block object mangling must specify a scopeBlockIdMap");196 ScopeBlockIdMap scopeBlockIdMap;197 return mangleName(symbol, scopeBlockIdMap, keepExternalInScope, underscoring);198}199 200std::string Fortran::lower::mangle::mangleName(201 const Fortran::semantics::DerivedTypeSpec &derivedType,202 ScopeBlockIdMap &scopeBlockIdMap) {203 // Resolve module and host associations before mangling.204 const Fortran::semantics::Symbol &ultimateSymbol =205 derivedType.typeSymbol().GetUltimate();206 207 llvm::StringRef symbolName = toStringRef(ultimateSymbol.name());208 llvm::SmallVector<llvm::StringRef> modules;209 llvm::SmallVector<llvm::StringRef> procs;210 std::int64_t blockId;211 std::tie(modules, procs, blockId) =212 ancestors(ultimateSymbol, scopeBlockIdMap);213 llvm::SmallVector<std::int64_t> kinds;214 for (const auto ¶m :215 Fortran::semantics::OrderParameterDeclarations(ultimateSymbol)) {216 const auto ¶mDetails =217 param->get<Fortran::semantics::TypeParamDetails>();218 if (paramDetails.attr() == Fortran::common::TypeParamAttr::Kind) {219 const Fortran::semantics::ParamValue *paramValue =220 derivedType.FindParameter(param->name());221 assert(paramValue && "derived type kind parameter value not found");222 const Fortran::semantics::MaybeIntExpr paramExpr =223 paramValue->GetExplicit();224 assert(paramExpr && "derived type kind param not explicit");225 std::optional<int64_t> init =226 Fortran::evaluate::ToInt64(paramValue->GetExplicit());227 // TODO: put the assertion check back when parametrized derived types228 // are supported:229 // assert(init && "derived type kind param is not constant");230 //231 // The init parameter above will require a FoldingContext for proper232 // expression evaluation to an integer constant, otherwise the233 // compiler may crash here (see example in issue #127424).234 if (!init) {235 TODO_NOLOC("parameterized derived types");236 } else {237 kinds.emplace_back(*init);238 }239 }240 }241 return fir::NameUniquer::doType(modules, procs, blockId, symbolName, kinds);242}243 244std::string Fortran::lower::mangle::getRecordTypeFieldName(245 const Fortran::semantics::Symbol &component,246 ScopeBlockIdMap &scopeBlockIdMap) {247 if (!component.attrs().test(Fortran::semantics::Attr::PRIVATE))248 return component.name().ToString();249 const Fortran::semantics::DerivedTypeSpec *componentParentType =250 component.owner().derivedTypeSpec();251 assert(componentParentType &&252 "failed to retrieve private component parent type");253 // Do not mangle Iso C C_PTR and C_FUNPTR components. This type cannot be254 // extended as per Fortran 2018 7.5.7.1, mangling them makes the IR unreadable255 // when using ISO C modules, and lowering needs to know the component way256 // without access to semantics::Symbol.257 if (Fortran::semantics::IsIsoCType(componentParentType))258 return component.name().ToString();259 return mangleName(*componentParentType, scopeBlockIdMap) + "." +260 component.name().ToString();261}262 263std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) {264 auto result = fir::NameUniquer::deconstruct(name);265 return result.second.name;266}267 268//===----------------------------------------------------------------------===//269// Array Literals Mangling270//===----------------------------------------------------------------------===//271 272static std::string typeToString(Fortran::common::TypeCategory cat, int kind,273 llvm::StringRef derivedName) {274 switch (cat) {275 case Fortran::common::TypeCategory::Integer:276 return "i" + std::to_string(kind);277 case Fortran::common::TypeCategory::Unsigned:278 return "u" + std::to_string(kind);279 case Fortran::common::TypeCategory::Real:280 return "r" + std::to_string(kind);281 case Fortran::common::TypeCategory::Complex:282 return "z" + std::to_string(kind);283 case Fortran::common::TypeCategory::Logical:284 return "l" + std::to_string(kind);285 case Fortran::common::TypeCategory::Character:286 return "c" + std::to_string(kind);287 case Fortran::common::TypeCategory::Derived:288 return derivedName.str();289 }290 llvm_unreachable("bad TypeCategory");291}292 293std::string Fortran::lower::mangle::mangleArrayLiteral(294 size_t size, const Fortran::evaluate::ConstantSubscripts &shape,295 Fortran::common::TypeCategory cat, int kind,296 Fortran::common::ConstantSubscript charLen, llvm::StringRef derivedName) {297 std::string typeId;298 for (Fortran::evaluate::ConstantSubscript extent : shape)299 typeId.append(std::to_string(extent)).append("x");300 if (charLen >= 0)301 typeId.append(std::to_string(charLen)).append("x");302 typeId.append(typeToString(cat, kind, derivedName));303 std::string name =304 fir::NameUniquer::doGenerated("ro."s.append(typeId).append("."));305 if (!size)306 name += "null.";307 return name;308}309 310std::string Fortran::lower::mangle::globalNamelistDescriptorName(311 const Fortran::semantics::Symbol &sym) {312 std::string name = mangleName(sym);313 return IsAllocatableOrObjectPointer(&sym) ? name : name + ".desc"s;314}315