1 //===-- SymbolMap.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 // Pretty printers for symbol boxes, etc.
10 //
11 //===----------------------------------------------------------------------===//
12
13 #include "flang/Lower/SymbolMap.h"
14 #include "mlir/IR/BuiltinTypes.h"
15 #include "llvm/Support/Debug.h"
16
17 #define DEBUG_TYPE "flang-lower-symbol-map"
18
addSymbol(Fortran::semantics::SymbolRef sym,const fir::ExtendedValue & exv,bool force)19 void Fortran::lower::SymMap::addSymbol(Fortran::semantics::SymbolRef sym,
20 const fir::ExtendedValue &exv,
21 bool force) {
22 exv.match([&](const fir::UnboxedValue &v) { addSymbol(sym, v, force); },
23 [&](const fir::CharBoxValue &v) { makeSym(sym, v, force); },
24 [&](const fir::ArrayBoxValue &v) { makeSym(sym, v, force); },
25 [&](const fir::CharArrayBoxValue &v) { makeSym(sym, v, force); },
26 [&](const fir::BoxValue &v) { makeSym(sym, v, force); },
27 [&](const fir::MutableBoxValue &v) { makeSym(sym, v, force); },
28 [](auto) {
29 llvm::report_fatal_error("value not added to symbol table");
30 });
31 }
32
33 Fortran::lower::SymbolBox
lookupSymbol(Fortran::semantics::SymbolRef symRef)34 Fortran::lower::SymMap::lookupSymbol(Fortran::semantics::SymbolRef symRef) {
35 Fortran::semantics::SymbolRef sym = symRef.get().GetUltimate();
36 for (auto jmap = symbolMapStack.rbegin(), jend = symbolMapStack.rend();
37 jmap != jend; ++jmap) {
38 auto iter = jmap->find(&*sym);
39 if (iter != jmap->end())
40 return iter->second;
41 }
42 return SymbolBox::None{};
43 }
44
shallowLookupSymbol(Fortran::semantics::SymbolRef symRef)45 Fortran::lower::SymbolBox Fortran::lower::SymMap::shallowLookupSymbol(
46 Fortran::semantics::SymbolRef symRef) {
47 auto &map = symbolMapStack.back();
48 auto iter = map.find(&symRef.get().GetUltimate());
49 if (iter != map.end())
50 return iter->second;
51 return SymbolBox::None{};
52 }
53
54 /// Skip one level when looking up the symbol. The use case is such as looking
55 /// up the host variable symbol box by skipping the associated level in
56 /// host-association in OpenMP code.
lookupOneLevelUpSymbol(Fortran::semantics::SymbolRef symRef)57 Fortran::lower::SymbolBox Fortran::lower::SymMap::lookupOneLevelUpSymbol(
58 Fortran::semantics::SymbolRef symRef) {
59 Fortran::semantics::SymbolRef sym = symRef.get().GetUltimate();
60 auto jmap = symbolMapStack.rbegin();
61 auto jend = symbolMapStack.rend();
62 if (jmap == jend)
63 return SymbolBox::None{};
64 // Skip one level in symbol map stack.
65 for (++jmap; jmap != jend; ++jmap) {
66 auto iter = jmap->find(&*sym);
67 if (iter != jmap->end())
68 return iter->second;
69 }
70 return SymbolBox::None{};
71 }
72
73 mlir::Value
lookupImpliedDo(Fortran::lower::SymMap::AcDoVar var)74 Fortran::lower::SymMap::lookupImpliedDo(Fortran::lower::SymMap::AcDoVar var) {
75 for (auto [marker, binding] : llvm::reverse(impliedDoStack))
76 if (var == marker)
77 return binding;
78 return {};
79 }
80
81 llvm::raw_ostream &
operator <<(llvm::raw_ostream & os,const Fortran::lower::SymbolBox & symBox)82 Fortran::lower::operator<<(llvm::raw_ostream &os,
83 const Fortran::lower::SymbolBox &symBox) {
84 symBox.match(
85 [&](const Fortran::lower::SymbolBox::None &box) {
86 os << "** symbol not properly mapped **\n";
87 },
88 [&](const Fortran::lower::SymbolBox::Intrinsic &val) {
89 os << val.getAddr() << '\n';
90 },
91 [&](const auto &box) { os << box << '\n'; });
92 return os;
93 }
94
95 llvm::raw_ostream &
operator <<(llvm::raw_ostream & os,const Fortran::lower::SymMap & symMap)96 Fortran::lower::operator<<(llvm::raw_ostream &os,
97 const Fortran::lower::SymMap &symMap) {
98 os << "Symbol map:\n";
99 for (auto i : llvm::enumerate(symMap.symbolMapStack)) {
100 os << " level " << i.index() << "<{\n";
101 for (auto iter : i.value())
102 os << " symbol @" << static_cast<const void *>(iter.first) << " ["
103 << *iter.first << "] ->\n " << iter.second;
104 os << " }>\n";
105 }
106 return os;
107 }
108