1 //===-- lib/Semantics/scope.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/Semantics/scope.h"
10 #include "flang/Parser/characters.h"
11 #include "flang/Semantics/symbol.h"
12 #include "flang/Semantics/type.h"
13 #include "llvm/Support/raw_ostream.h"
14 #include <algorithm>
15 #include <memory>
16 
17 namespace Fortran::semantics {
18 
19 Symbols<1024> Scope::allSymbols;
20 
21 bool EquivalenceObject::operator==(const EquivalenceObject &that) const {
22   return symbol == that.symbol && subscripts == that.subscripts &&
23       substringStart == that.substringStart;
24 }
25 
26 bool EquivalenceObject::operator<(const EquivalenceObject &that) const {
27   return &symbol < &that.symbol ||
28       (&symbol == &that.symbol &&
29           (subscripts < that.subscripts ||
30               (subscripts == that.subscripts &&
31                   substringStart < that.substringStart)));
32 }
33 
34 std::string EquivalenceObject::AsFortran() const {
35   std::string buf;
36   llvm::raw_string_ostream ss{buf};
37   ss << symbol.name().ToString();
38   if (!subscripts.empty()) {
39     char sep{'('};
40     for (auto subscript : subscripts) {
41       ss << sep << subscript;
42       sep = ',';
43     }
44     ss << ')';
45   }
46   if (substringStart) {
47     ss << '(' << *substringStart << ":)";
48   }
49   return ss.str();
50 }
51 
52 Scope &Scope::MakeScope(Kind kind, Symbol *symbol) {
53   return children_.emplace_back(*this, kind, symbol);
54 }
55 
56 template <typename T>
57 static std::vector<common::Reference<T>> GetSortedSymbols(
58     std::map<SourceName, MutableSymbolRef> symbols) {
59   std::vector<common::Reference<T>> result;
60   result.reserve(symbols.size());
61   for (auto &pair : symbols) {
62     result.push_back(*pair.second);
63   }
64   std::sort(result.begin(), result.end());
65   return result;
66 }
67 
68 MutableSymbolVector Scope::GetSymbols() {
69   return GetSortedSymbols<Symbol>(symbols_);
70 }
71 SymbolVector Scope::GetSymbols() const {
72   return GetSortedSymbols<const Symbol>(symbols_);
73 }
74 
75 Scope::iterator Scope::find(const SourceName &name) {
76   return symbols_.find(name);
77 }
78 Scope::size_type Scope::erase(const SourceName &name) {
79   auto it{symbols_.find(name)};
80   if (it != end()) {
81     symbols_.erase(it);
82     return 1;
83   } else {
84     return 0;
85   }
86 }
87 Symbol *Scope::FindSymbol(const SourceName &name) const {
88   auto it{find(name)};
89   if (it != end()) {
90     return &*it->second;
91   } else if (CanImport(name)) {
92     return parent_.FindSymbol(name);
93   } else {
94     return nullptr;
95   }
96 }
97 
98 Symbol *Scope::FindComponent(SourceName name) const {
99   CHECK(IsDerivedType());
100   auto found{find(name)};
101   if (found != end()) {
102     return &*found->second;
103   } else if (const Scope * parent{GetDerivedTypeParent()}) {
104     return parent->FindComponent(name);
105   } else {
106     return nullptr;
107   }
108 }
109 
110 bool Scope::Contains(const Scope &that) const {
111   for (const Scope *scope{&that};; scope = &scope->parent()) {
112     if (*scope == *this) {
113       return true;
114     }
115     if (scope->IsGlobal()) {
116       return false;
117     }
118   }
119 }
120 
121 Symbol *Scope::CopySymbol(const Symbol &symbol) {
122   auto pair{try_emplace(symbol.name(), symbol.attrs())};
123   if (!pair.second) {
124     return nullptr; // already exists
125   } else {
126     Symbol &result{*pair.first->second};
127     result.flags() = symbol.flags();
128     result.set_details(common::Clone(symbol.details()));
129     return &result;
130   }
131 }
132 
133 void Scope::add_equivalenceSet(EquivalenceSet &&set) {
134   equivalenceSets_.emplace_back(std::move(set));
135 }
136 
137 void Scope::add_crayPointer(const SourceName &name, Symbol &pointer) {
138   CHECK(pointer.test(Symbol::Flag::CrayPointer));
139   crayPointers_.emplace(name, pointer);
140 }
141 
142 Symbol &Scope::MakeCommonBlock(const SourceName &name) {
143   const auto it{commonBlocks_.find(name)};
144   if (it != commonBlocks_.end()) {
145     return *it->second;
146   } else {
147     Symbol &symbol{MakeSymbol(name, Attrs{}, CommonBlockDetails{})};
148     commonBlocks_.emplace(name, symbol);
149     return symbol;
150   }
151 }
152 Symbol *Scope::FindCommonBlock(const SourceName &name) {
153   const auto it{commonBlocks_.find(name)};
154   return it != commonBlocks_.end() ? &*it->second : nullptr;
155 }
156 
157 Scope *Scope::FindSubmodule(const SourceName &name) const {
158   auto it{submodules_.find(name)};
159   if (it == submodules_.end()) {
160     return nullptr;
161   } else {
162     return &*it->second;
163   }
164 }
165 bool Scope::AddSubmodule(const SourceName &name, Scope &submodule) {
166   return submodules_.emplace(name, submodule).second;
167 }
168 
169 const DeclTypeSpec *Scope::FindType(const DeclTypeSpec &type) const {
170   auto it{std::find(declTypeSpecs_.begin(), declTypeSpecs_.end(), type)};
171   return it != declTypeSpecs_.end() ? &*it : nullptr;
172 }
173 
174 const DeclTypeSpec &Scope::MakeNumericType(
175     TypeCategory category, KindExpr &&kind) {
176   return MakeLengthlessType(NumericTypeSpec{category, std::move(kind)});
177 }
178 const DeclTypeSpec &Scope::MakeLogicalType(KindExpr &&kind) {
179   return MakeLengthlessType(LogicalTypeSpec{std::move(kind)});
180 }
181 const DeclTypeSpec &Scope::MakeTypeStarType() {
182   return MakeLengthlessType(DeclTypeSpec{DeclTypeSpec::TypeStar});
183 }
184 const DeclTypeSpec &Scope::MakeClassStarType() {
185   return MakeLengthlessType(DeclTypeSpec{DeclTypeSpec::ClassStar});
186 }
187 // Types that can't have length parameters can be reused without having to
188 // compare length expressions. They are stored in the global scope.
189 const DeclTypeSpec &Scope::MakeLengthlessType(DeclTypeSpec &&type) {
190   const auto *found{FindType(type)};
191   return found ? *found : declTypeSpecs_.emplace_back(std::move(type));
192 }
193 
194 const DeclTypeSpec &Scope::MakeCharacterType(
195     ParamValue &&length, KindExpr &&kind) {
196   return declTypeSpecs_.emplace_back(
197       CharacterTypeSpec{std::move(length), std::move(kind)});
198 }
199 
200 DeclTypeSpec &Scope::MakeDerivedType(
201     DeclTypeSpec::Category category, DerivedTypeSpec &&spec) {
202   return declTypeSpecs_.emplace_back(category, std::move(spec));
203 }
204 
205 Scope::ImportKind Scope::GetImportKind() const {
206   if (importKind_) {
207     return *importKind_;
208   }
209   if (symbol_ && !symbol_->attrs().test(Attr::MODULE)) {
210     if (auto *details{symbol_->detailsIf<SubprogramDetails>()}) {
211       if (details->isInterface()) {
212         return ImportKind::None; // default for non-mod-proc interface body
213       }
214     }
215   }
216   return ImportKind::Default;
217 }
218 
219 std::optional<parser::MessageFixedText> Scope::SetImportKind(ImportKind kind) {
220   if (!importKind_) {
221     importKind_ = kind;
222     return std::nullopt;
223   }
224   bool hasNone{kind == ImportKind::None || *importKind_ == ImportKind::None};
225   bool hasAll{kind == ImportKind::All || *importKind_ == ImportKind::All};
226   // Check C8100 and C898: constraints on multiple IMPORT statements
227   if (hasNone || hasAll) {
228     return hasNone
229         ? "IMPORT,NONE must be the only IMPORT statement in a scope"_err_en_US
230         : "IMPORT,ALL must be the only IMPORT statement in a scope"_err_en_US;
231   } else if (kind != *importKind_ &&
232       (kind != ImportKind::Only || kind != ImportKind::Only)) {
233     return "Every IMPORT must have ONLY specifier if one of them does"_err_en_US;
234   } else {
235     return std::nullopt;
236   }
237 }
238 
239 void Scope::add_importName(const SourceName &name) {
240   importNames_.insert(name);
241 }
242 
243 // true if name can be imported or host-associated from parent scope.
244 bool Scope::CanImport(const SourceName &name) const {
245   if (IsGlobal() || parent_.IsGlobal()) {
246     return false;
247   }
248   switch (GetImportKind()) {
249     SWITCH_COVERS_ALL_CASES
250   case ImportKind::None:
251     return false;
252   case ImportKind::All:
253   case ImportKind::Default:
254     return true;
255   case ImportKind::Only:
256     return importNames_.count(name) > 0;
257   }
258 }
259 
260 const Scope *Scope::FindScope(parser::CharBlock source) const {
261   return const_cast<Scope *>(this)->FindScope(source);
262 }
263 
264 Scope *Scope::FindScope(parser::CharBlock source) {
265   bool isContained{sourceRange_.Contains(source)};
266   if (!isContained && !IsGlobal() && !IsModuleFile()) {
267     return nullptr;
268   }
269   for (auto &child : children_) {
270     if (auto *scope{child.FindScope(source)}) {
271       return scope;
272     }
273   }
274   return isContained ? this : nullptr;
275 }
276 
277 void Scope::AddSourceRange(const parser::CharBlock &source) {
278   for (auto *scope = this; !scope->IsGlobal(); scope = &scope->parent()) {
279     scope->sourceRange_.ExtendToCover(source);
280   }
281 }
282 
283 llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Scope &scope) {
284   os << Scope::EnumToString(scope.kind()) << " scope: ";
285   if (auto *symbol{scope.symbol()}) {
286     os << *symbol << ' ';
287   }
288   if (scope.derivedTypeSpec_) {
289     os << "instantiation of " << *scope.derivedTypeSpec_ << ' ';
290   }
291   os << scope.children_.size() << " children\n";
292   for (const auto &pair : scope.symbols_) {
293     const Symbol &symbol{*pair.second};
294     os << "  " << symbol << '\n';
295   }
296   if (!scope.equivalenceSets_.empty()) {
297     os << "  Equivalence Sets:\n";
298     for (const auto &set : scope.equivalenceSets_) {
299       os << "   ";
300       for (const auto &object : set) {
301         os << ' ' << object.AsFortran();
302       }
303       os << '\n';
304     }
305   }
306   for (const auto &pair : scope.commonBlocks_) {
307     const Symbol &symbol{*pair.second};
308     os << "  " << symbol << '\n';
309   }
310   return os;
311 }
312 
313 bool Scope::IsStmtFunction() const {
314   return symbol_ && symbol_->test(Symbol::Flag::StmtFunction);
315 }
316 
317 bool Scope::IsParameterizedDerivedType() const {
318   if (!IsDerivedType()) {
319     return false;
320   }
321   if (const Scope * parent{GetDerivedTypeParent()}) {
322     if (parent->IsParameterizedDerivedType()) {
323       return true;
324     }
325   }
326   for (const auto &pair : symbols_) {
327     if (pair.second->has<TypeParamDetails>()) {
328       return true;
329     }
330   }
331   return false;
332 }
333 
334 const DeclTypeSpec *Scope::FindInstantiatedDerivedType(
335     const DerivedTypeSpec &spec, DeclTypeSpec::Category category) const {
336   DeclTypeSpec type{category, spec};
337   if (const auto *result{FindType(type)}) {
338     return result;
339   } else if (IsGlobal()) {
340     return nullptr;
341   } else {
342     return parent().FindInstantiatedDerivedType(spec, category);
343   }
344 }
345 
346 const Scope *Scope::GetDerivedTypeParent() const {
347   if (const Symbol * symbol{GetSymbol()}) {
348     if (const DerivedTypeSpec * parent{symbol->GetParentTypeSpec(this)}) {
349       return parent->scope();
350     }
351   }
352   return nullptr;
353 }
354 
355 const Scope &Scope::GetDerivedTypeBase() const {
356   const Scope *child{this};
357   for (const Scope *parent{GetDerivedTypeParent()}; parent != nullptr;
358        parent = child->GetDerivedTypeParent()) {
359     child = parent;
360   }
361   return *child;
362 }
363 
364 void Scope::InstantiateDerivedTypes(SemanticsContext &context) {
365   for (DeclTypeSpec &type : declTypeSpecs_) {
366     if (type.category() == DeclTypeSpec::TypeDerived ||
367         type.category() == DeclTypeSpec::ClassDerived) {
368       type.derivedTypeSpec().Instantiate(*this, context);
369     }
370   }
371 }
372 } // namespace Fortran::semantics
373