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