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