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