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.
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 collide
46 // with a procedure of the same name in another compilation unit.
47 // This is nonconformant, but universally allowed.
48 procs.emplace_back(Args: 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.
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::string
75Fortran::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 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({}, {}, symbolName);
123 // A separate module procedure must be mangled according to its
124 // 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 an
143 // 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 else
172 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) so
178 // 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::string
188Fortran::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 &param :
215 Fortran::semantics::OrderParameterDeclarations(ultimateSymbol)) {
216 const auto &paramDetails =
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 types
228 // are supported:
229 // assert(init && "derived type kind param is not constant");
230 //
231 // The init parameter above will require a FoldingContext for proper
232 // expression evaluation to an integer constant, otherwise the
233 // 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 be
254 // extended as per Fortran 2018 7.5.7.1, mangling them makes the IR unreadable
255 // when using ISO C modules, and lowering needs to know the component way
256 // 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 Mangling
270//===----------------------------------------------------------------------===//
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(val: kind);
277 case Fortran::common::TypeCategory::Unsigned:
278 return "u" + std::to_string(val: kind);
279 case Fortran::common::TypeCategory::Real:
280 return "r" + std::to_string(val: kind);
281 case Fortran::common::TypeCategory::Complex:
282 return "z" + std::to_string(val: kind);
283 case Fortran::common::TypeCategory::Logical:
284 return "l" + std::to_string(val: kind);
285 case Fortran::common::TypeCategory::Character:
286 return "c" + std::to_string(val: 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

source code of flang/lib/Lower/Mangler.cpp