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/Utils.h"
12 #include "flang/Optimizer/Dialect/FIRType.h"
13 #include "flang/Optimizer/Support/InternalNames.h"
14 #include "flang/Semantics/tools.h"
15 #include "llvm/ADT/ArrayRef.h"
16 #include "llvm/ADT/Optional.h"
17 #include "llvm/ADT/SmallVector.h"
18 #include "llvm/ADT/StringRef.h"
19 #include "llvm/ADT/Twine.h"
20 
21 // recursively build the vector of module scopes
22 static void moduleNames(const Fortran::semantics::Scope &scope,
23                         llvm::SmallVector<llvm::StringRef, 2> &result) {
24   if (scope.kind() == Fortran::semantics::Scope::Kind::Global) {
25     return;
26   }
27   moduleNames(scope.parent(), result);
28   if (scope.kind() == Fortran::semantics::Scope::Kind::Module)
29     if (auto *symbol = scope.symbol())
30       result.emplace_back(toStringRef(symbol->name()));
31 }
32 
33 static llvm::SmallVector<llvm::StringRef, 2>
34 moduleNames(const Fortran::semantics::Symbol &symbol) {
35   const auto &scope = symbol.owner();
36   llvm::SmallVector<llvm::StringRef, 2> 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 auto &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   return {};
49 }
50 
51 static const Fortran::semantics::Symbol *
52 findInterfaceIfSeperateMP(const Fortran::semantics::Symbol &symbol) {
53   const auto &scope = symbol.owner();
54   if (symbol.attrs().test(Fortran::semantics::Attr::MODULE) &&
55       scope.IsSubmodule()) {
56     // FIXME symbol from MpSubprogramStmt do not seem to have
57     // Attr::MODULE set.
58     const auto *iface = scope.parent().FindSymbol(symbol.name());
59     assert(iface && "Separate module procedure must be declared");
60     return iface;
61   }
62   return nullptr;
63 }
64 
65 // Mangle the name of `symbol` to make it unique within FIR's symbol table using
66 // the FIR name mangler, `mangler`
67 std::string
68 Fortran::lower::mangle::mangleName(fir::NameUniquer &uniquer,
69                                    const Fortran::semantics::Symbol &symbol) {
70   // Resolve host and module association before mangling
71   const auto &ultimateSymbol = symbol.GetUltimate();
72   auto symbolName = toStringRef(ultimateSymbol.name());
73 
74   return std::visit(
75       Fortran::common::visitors{
76           [&](const Fortran::semantics::MainProgramDetails &) {
77             return uniquer.doProgramEntry().str();
78           },
79           [&](const Fortran::semantics::SubprogramDetails &) {
80             // Mangle external procedure without any scope prefix.
81             if (Fortran::semantics::IsExternal(ultimateSymbol))
82               return uniquer.doProcedure(llvm::None, llvm::None, symbolName);
83             // Separate module subprograms must be mangled according to the
84             // scope where they were declared (the symbol we have is the
85             // definition).
86             const auto *interface = &ultimateSymbol;
87             if (const auto *mpIface = findInterfaceIfSeperateMP(ultimateSymbol))
88               interface = mpIface;
89             auto modNames = moduleNames(*interface);
90             return uniquer.doProcedure(modNames, hostName(*interface),
91                                        symbolName);
92           },
93           [&](const Fortran::semantics::ProcEntityDetails &) {
94             // Mangle procedure pointers and dummy procedures as variables
95             if (Fortran::semantics::IsPointer(ultimateSymbol) ||
96                 Fortran::semantics::IsDummy(ultimateSymbol))
97               return uniquer.doVariable(moduleNames(ultimateSymbol),
98                                         hostName(ultimateSymbol), symbolName);
99             // Otherwise, this is an external procedure, even if it does not
100             // have an explicit EXTERNAL attribute. Mangle it without any
101             // prefix.
102             return uniquer.doProcedure(llvm::None, llvm::None, symbolName);
103           },
104           [&](const Fortran::semantics::ObjectEntityDetails &) {
105             auto modNames = moduleNames(ultimateSymbol);
106             auto optHost = hostName(ultimateSymbol);
107             if (Fortran::semantics::IsNamedConstant(ultimateSymbol))
108               return uniquer.doConstant(modNames, optHost, symbolName);
109             return uniquer.doVariable(modNames, optHost, symbolName);
110           },
111           [](const auto &) -> std::string {
112             assert(false);
113             return {};
114           },
115       },
116       ultimateSymbol.details());
117 }
118 
119 std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) {
120   auto result = fir::NameUniquer::deconstruct(name);
121   return result.second.name;
122 }
123 
124 //===----------------------------------------------------------------------===//
125 // Intrinsic Procedure Mangling
126 //===----------------------------------------------------------------------===//
127 
128 /// Helper to encode type into string for intrinsic procedure names.
129 /// Note: mlir has Type::dump(ostream) methods but it may add "!" that is not
130 /// suitable for function names.
131 static std::string typeToString(mlir::Type t) {
132   if (auto refT{t.dyn_cast<fir::ReferenceType>()})
133     return "ref_" + typeToString(refT.getEleTy());
134   if (auto i{t.dyn_cast<mlir::IntegerType>()}) {
135     return "i" + std::to_string(i.getWidth());
136   }
137   if (auto cplx{t.dyn_cast<fir::ComplexType>()}) {
138     return "z" + std::to_string(cplx.getFKind());
139   }
140   if (auto real{t.dyn_cast<fir::RealType>()}) {
141     return "r" + std::to_string(real.getFKind());
142   }
143   if (auto f{t.dyn_cast<mlir::FloatType>()}) {
144     return "f" + std::to_string(f.getWidth());
145   }
146   if (auto logical{t.dyn_cast<fir::LogicalType>()}) {
147     return "l" + std::to_string(logical.getFKind());
148   }
149   if (auto character{t.dyn_cast<fir::CharacterType>()}) {
150     return "c" + std::to_string(character.getFKind());
151   }
152   if (auto boxCharacter{t.dyn_cast<fir::BoxCharType>()}) {
153     return "bc" + std::to_string(boxCharacter.getEleTy().getFKind());
154   }
155   llvm_unreachable("no mangling for type");
156 }
157 
158 std::string fir::mangleIntrinsicProcedure(llvm::StringRef intrinsic,
159                                           mlir::FunctionType funTy) {
160   std::string name = "fir.";
161   name.append(intrinsic.str()).append(".");
162   assert(funTy.getNumResults() == 1 && "only function mangling supported");
163   name.append(typeToString(funTy.getResult(0)));
164   auto e = funTy.getNumInputs();
165   for (decltype(e) i = 0; i < e; ++i)
166     name.append(".").append(typeToString(funTy.getInput(i)));
167   return name;
168 }
169