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/Lower/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/Optional.h"
18 #include "llvm/ADT/SmallVector.h"
19 #include "llvm/ADT/StringRef.h"
20 #include "llvm/ADT/Twine.h"
21 
22 // recursively build the vector of module scopes
23 static void moduleNames(const Fortran::semantics::Scope &scope,
24                         llvm::SmallVector<llvm::StringRef> &result) {
25   if (scope.IsTopLevel())
26     return;
27   moduleNames(scope.parent(), result);
28   if (scope.kind() == Fortran::semantics::Scope::Kind::Module)
29     if (const Fortran::semantics::Symbol *symbol = scope.symbol())
30       result.emplace_back(toStringRef(symbol->name()));
31 }
32 
33 static llvm::SmallVector<llvm::StringRef>
34 moduleNames(const Fortran::semantics::Symbol &symbol) {
35   const Fortran::semantics::Scope &scope = symbol.owner();
36   llvm::SmallVector<llvm::StringRef> result;
37   moduleNames(scope, result);
38   return result;
39 }
40 
41 static llvm::Optional<llvm::StringRef>
42 hostName(const Fortran::semantics::Symbol &symbol) {
43   const Fortran::semantics::Scope &scope = symbol.owner();
44   if (scope.kind() == Fortran::semantics::Scope::Kind::Subprogram) {
45     assert(scope.symbol() && "subprogram scope must have a symbol");
46     return toStringRef(scope.symbol()->name());
47   }
48   if (scope.kind() == Fortran::semantics::Scope::Kind::MainProgram)
49     // Do not use the main program name, if any, because it may lead to name
50     // collision with procedures with the same name in other compilation units
51     // (technically illegal, but all compilers are able to compile and link
52     // properly these programs).
53     return llvm::StringRef("");
54   return {};
55 }
56 
57 static const Fortran::semantics::Symbol *
58 findInterfaceIfSeperateMP(const Fortran::semantics::Symbol &symbol) {
59   const auto &scope = symbol.owner();
60   if (symbol.attrs().test(Fortran::semantics::Attr::MODULE) &&
61       scope.IsSubmodule()) {
62     // FIXME symbol from MpSubprogramStmt do not seem to have
63     // Attr::MODULE set.
64     const auto *iface = scope.parent().FindSymbol(symbol.name());
65     assert(iface && "Separate module procedure must be declared");
66     return iface;
67   }
68   return nullptr;
69 }
70 
71 // Mangle the name of `symbol` to make it unique within FIR's symbol table using
72 // the FIR name mangler, `mangler`
73 std::string
74 Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
75                                    bool keepExternalInScope) {
76   // Resolve host and module association before mangling
77   const auto &ultimateSymbol = symbol.GetUltimate();
78   auto symbolName = toStringRef(ultimateSymbol.name());
79 
80   return std::visit(
81       Fortran::common::visitors{
82           [&](const Fortran::semantics::MainProgramDetails &) {
83             return fir::NameUniquer::doProgramEntry().str();
84           },
85           [&](const Fortran::semantics::SubprogramDetails &) {
86             // Mangle external procedure without any scope prefix.
87             if (!keepExternalInScope &&
88                 Fortran::semantics::IsExternal(ultimateSymbol))
89               return fir::NameUniquer::doProcedure(llvm::None, llvm::None,
90                                                    symbolName);
91             // Separate module subprograms must be mangled according to the
92             // scope where they were declared (the symbol we have is the
93             // definition).
94             const auto *interface = &ultimateSymbol;
95             if (const auto *mpIface = findInterfaceIfSeperateMP(ultimateSymbol))
96               interface = mpIface;
97             auto modNames = moduleNames(*interface);
98             return fir::NameUniquer::doProcedure(modNames, hostName(*interface),
99                                                  symbolName);
100           },
101           [&](const Fortran::semantics::ProcEntityDetails &) {
102             // Mangle procedure pointers and dummy procedures as variables
103             if (Fortran::semantics::IsPointer(ultimateSymbol) ||
104                 Fortran::semantics::IsDummy(ultimateSymbol))
105               return fir::NameUniquer::doVariable(moduleNames(ultimateSymbol),
106                                                   hostName(ultimateSymbol),
107                                                   symbolName);
108             // Otherwise, this is an external procedure, even if it does not
109             // have an explicit EXTERNAL attribute. Mangle it without any
110             // prefix.
111             return fir::NameUniquer::doProcedure(llvm::None, llvm::None,
112                                                  symbolName);
113           },
114           [&](const Fortran::semantics::ObjectEntityDetails &) {
115             auto modNames = moduleNames(ultimateSymbol);
116             auto optHost = hostName(ultimateSymbol);
117             if (Fortran::semantics::IsNamedConstant(ultimateSymbol))
118               return fir::NameUniquer::doConstant(modNames, optHost,
119                                                   symbolName);
120             return fir::NameUniquer::doVariable(modNames, optHost, symbolName);
121           },
122           [&](const Fortran::semantics::NamelistDetails &) {
123             auto modNames = moduleNames(ultimateSymbol);
124             auto optHost = hostName(ultimateSymbol);
125             return fir::NameUniquer::doNamelistGroup(modNames, optHost,
126                                                      symbolName);
127           },
128           [&](const Fortran::semantics::CommonBlockDetails &) {
129             return fir::NameUniquer::doCommonBlock(symbolName);
130           },
131           [&](const Fortran::semantics::DerivedTypeDetails &) -> std::string {
132             // Derived type mangling must used mangleName(DerivedTypeSpec&) so
133             // that kind type parameter values can be mangled.
134             llvm::report_fatal_error(
135                 "only derived type instances can be mangled");
136           },
137           [](const auto &) -> std::string { TODO_NOLOC("symbol mangling"); },
138       },
139       ultimateSymbol.details());
140 }
141 
142 std::string Fortran::lower::mangle::mangleName(
143     const Fortran::semantics::DerivedTypeSpec &derivedType) {
144   // Resolve host and module association before mangling
145   const auto &ultimateSymbol = derivedType.typeSymbol().GetUltimate();
146   auto symbolName = toStringRef(ultimateSymbol.name());
147   auto modNames = moduleNames(ultimateSymbol);
148   auto optHost = hostName(ultimateSymbol);
149   llvm::SmallVector<std::int64_t> kinds;
150   for (const auto &param :
151        Fortran::semantics::OrderParameterDeclarations(ultimateSymbol)) {
152     const auto &paramDetails =
153         param->get<Fortran::semantics::TypeParamDetails>();
154     if (paramDetails.attr() == Fortran::common::TypeParamAttr::Kind) {
155       const auto *paramValue = derivedType.FindParameter(param->name());
156       assert(paramValue && "derived type kind parameter value not found");
157       auto paramExpr = paramValue->GetExplicit();
158       assert(paramExpr && "derived type kind param not explicit");
159       auto init = Fortran::evaluate::ToInt64(paramValue->GetExplicit());
160       assert(init && "derived type kind param is not constant");
161       kinds.emplace_back(*init);
162     }
163   }
164   return fir::NameUniquer::doType(modNames, optHost, symbolName, kinds);
165 }
166 
167 std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) {
168   auto result = fir::NameUniquer::deconstruct(name);
169   return result.second.name;
170 }
171 
172 //===----------------------------------------------------------------------===//
173 // Intrinsic Procedure Mangling
174 //===----------------------------------------------------------------------===//
175 
176 /// Helper to encode type into string for intrinsic procedure names.
177 /// Note: mlir has Type::dump(ostream) methods but it may add "!" that is not
178 /// suitable for function names.
179 static std::string typeToString(mlir::Type t) {
180   if (auto refT{t.dyn_cast<fir::ReferenceType>()})
181     return "ref_" + typeToString(refT.getEleTy());
182   if (auto i{t.dyn_cast<mlir::IntegerType>()}) {
183     return "i" + std::to_string(i.getWidth());
184   }
185   if (auto cplx{t.dyn_cast<fir::ComplexType>()}) {
186     return "z" + std::to_string(cplx.getFKind());
187   }
188   if (auto real{t.dyn_cast<fir::RealType>()}) {
189     return "r" + std::to_string(real.getFKind());
190   }
191   if (auto f{t.dyn_cast<mlir::FloatType>()}) {
192     return "f" + std::to_string(f.getWidth());
193   }
194   if (auto logical{t.dyn_cast<fir::LogicalType>()}) {
195     return "l" + std::to_string(logical.getFKind());
196   }
197   if (auto character{t.dyn_cast<fir::CharacterType>()}) {
198     return "c" + std::to_string(character.getFKind());
199   }
200   if (auto boxCharacter{t.dyn_cast<fir::BoxCharType>()}) {
201     return "bc" + std::to_string(boxCharacter.getEleTy().getFKind());
202   }
203   llvm_unreachable("no mangling for type");
204 }
205 
206 std::string fir::mangleIntrinsicProcedure(llvm::StringRef intrinsic,
207                                           mlir::FunctionType funTy) {
208   std::string name = "fir.";
209   name.append(intrinsic.str()).append(".");
210   assert(funTy.getNumResults() == 1 && "only function mangling supported");
211   name.append(typeToString(funTy.getResult(0)));
212   auto e = funTy.getNumInputs();
213   for (decltype(e) i = 0; i < e; ++i)
214     name.append(".").append(typeToString(funTy.getInput(i)));
215   return name;
216 }
217