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, context_);
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(), SymbolSourcePositionCompare{});
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) const {
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 const DeclTypeSpec *Scope::GetType(const SomeExpr &expr) {
206   if (auto dyType{expr.GetType()}) {
207     if (dyType->IsAssumedType()) {
208       return &MakeTypeStarType();
209     } else if (dyType->IsUnlimitedPolymorphic()) {
210       return &MakeClassStarType();
211     } else {
212       switch (dyType->category()) {
213       case TypeCategory::Integer:
214       case TypeCategory::Real:
215       case TypeCategory::Complex:
216         return &MakeNumericType(dyType->category(), KindExpr{dyType->kind()});
217       case TypeCategory::Character:
218         if (const ParamValue * lenParam{dyType->charLengthParamValue()}) {
219           return &MakeCharacterType(
220               ParamValue{*lenParam}, KindExpr{dyType->kind()});
221         } else {
222           auto lenExpr{dyType->GetCharLength()};
223           if (!lenExpr) {
224             lenExpr =
225                 std::get<evaluate::Expr<evaluate::SomeCharacter>>(expr.u).LEN();
226           }
227           if (lenExpr) {
228             return &MakeCharacterType(
229                 ParamValue{SomeIntExpr{std::move(*lenExpr)},
230                     common::TypeParamAttr::Len},
231                 KindExpr{dyType->kind()});
232           }
233         }
234         break;
235       case TypeCategory::Logical:
236         return &MakeLogicalType(KindExpr{dyType->kind()});
237       case TypeCategory::Derived:
238         return &MakeDerivedType(dyType->IsPolymorphic()
239                 ? DeclTypeSpec::ClassDerived
240                 : DeclTypeSpec::TypeDerived,
241             DerivedTypeSpec{dyType->GetDerivedTypeSpec()});
242       }
243     }
244   }
245   return nullptr;
246 }
247 
248 Scope::ImportKind Scope::GetImportKind() const {
249   if (importKind_) {
250     return *importKind_;
251   }
252   if (symbol_ && !symbol_->attrs().test(Attr::MODULE)) {
253     if (auto *details{symbol_->detailsIf<SubprogramDetails>()}) {
254       if (details->isInterface()) {
255         return ImportKind::None; // default for non-mod-proc interface body
256       }
257     }
258   }
259   return ImportKind::Default;
260 }
261 
262 std::optional<parser::MessageFixedText> Scope::SetImportKind(ImportKind kind) {
263   if (!importKind_) {
264     importKind_ = kind;
265     return std::nullopt;
266   }
267   bool hasNone{kind == ImportKind::None || *importKind_ == ImportKind::None};
268   bool hasAll{kind == ImportKind::All || *importKind_ == ImportKind::All};
269   // Check C8100 and C898: constraints on multiple IMPORT statements
270   if (hasNone || hasAll) {
271     return hasNone
272         ? "IMPORT,NONE must be the only IMPORT statement in a scope"_err_en_US
273         : "IMPORT,ALL must be the only IMPORT statement in a scope"_err_en_US;
274   } else if (kind != *importKind_ &&
275       (kind != ImportKind::Only || kind != ImportKind::Only)) {
276     return "Every IMPORT must have ONLY specifier if one of them does"_err_en_US;
277   } else {
278     return std::nullopt;
279   }
280 }
281 
282 void Scope::add_importName(const SourceName &name) {
283   importNames_.insert(name);
284 }
285 
286 // true if name can be imported or host-associated from parent scope.
287 bool Scope::CanImport(const SourceName &name) const {
288   if (IsGlobal() || parent_.IsGlobal()) {
289     return false;
290   }
291   switch (GetImportKind()) {
292     SWITCH_COVERS_ALL_CASES
293   case ImportKind::None:
294     return false;
295   case ImportKind::All:
296   case ImportKind::Default:
297     return true;
298   case ImportKind::Only:
299     return importNames_.count(name) > 0;
300   }
301 }
302 
303 const Scope *Scope::FindScope(parser::CharBlock source) const {
304   return const_cast<Scope *>(this)->FindScope(source);
305 }
306 
307 Scope *Scope::FindScope(parser::CharBlock source) {
308   bool isContained{sourceRange_.Contains(source)};
309   if (!isContained && !IsGlobal() && !IsModuleFile()) {
310     return nullptr;
311   }
312   for (auto &child : children_) {
313     if (auto *scope{child.FindScope(source)}) {
314       return scope;
315     }
316   }
317   return isContained ? this : nullptr;
318 }
319 
320 void Scope::AddSourceRange(const parser::CharBlock &source) {
321   for (auto *scope{this}; !scope->IsGlobal(); scope = &scope->parent()) {
322     scope->sourceRange_.ExtendToCover(source);
323   }
324 }
325 
326 llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Scope &scope) {
327   os << Scope::EnumToString(scope.kind()) << " scope: ";
328   if (auto *symbol{scope.symbol()}) {
329     os << *symbol << ' ';
330   }
331   if (scope.derivedTypeSpec_) {
332     os << "instantiation of " << *scope.derivedTypeSpec_ << ' ';
333   }
334   os << scope.children_.size() << " children\n";
335   for (const auto &pair : scope.symbols_) {
336     const Symbol &symbol{*pair.second};
337     os << "  " << symbol << '\n';
338   }
339   if (!scope.equivalenceSets_.empty()) {
340     os << "  Equivalence Sets:\n";
341     for (const auto &set : scope.equivalenceSets_) {
342       os << "   ";
343       for (const auto &object : set) {
344         os << ' ' << object.AsFortran();
345       }
346       os << '\n';
347     }
348   }
349   for (const auto &pair : scope.commonBlocks_) {
350     const Symbol &symbol{*pair.second};
351     os << "  " << symbol << '\n';
352   }
353   return os;
354 }
355 
356 bool Scope::IsStmtFunction() const {
357   return symbol_ && symbol_->test(Symbol::Flag::StmtFunction);
358 }
359 
360 bool Scope::IsParameterizedDerivedType() const {
361   if (!IsDerivedType()) {
362     return false;
363   }
364   if (const Scope * parent{GetDerivedTypeParent()}) {
365     if (parent->IsParameterizedDerivedType()) {
366       return true;
367     }
368   }
369   for (const auto &pair : symbols_) {
370     if (pair.second->has<TypeParamDetails>()) {
371       return true;
372     }
373   }
374   return false;
375 }
376 
377 const DeclTypeSpec *Scope::FindInstantiatedDerivedType(
378     const DerivedTypeSpec &spec, DeclTypeSpec::Category category) const {
379   DeclTypeSpec type{category, spec};
380   if (const auto *result{FindType(type)}) {
381     return result;
382   } else if (IsGlobal()) {
383     return nullptr;
384   } else {
385     return parent().FindInstantiatedDerivedType(spec, category);
386   }
387 }
388 
389 const Scope *Scope::GetDerivedTypeParent() const {
390   if (const Symbol * symbol{GetSymbol()}) {
391     if (const DerivedTypeSpec * parent{symbol->GetParentTypeSpec(this)}) {
392       return parent->scope();
393     }
394   }
395   return nullptr;
396 }
397 
398 const Scope &Scope::GetDerivedTypeBase() const {
399   const Scope *child{this};
400   for (const Scope *parent{GetDerivedTypeParent()}; parent != nullptr;
401        parent = child->GetDerivedTypeParent()) {
402     child = parent;
403   }
404   return *child;
405 }
406 
407 void Scope::InstantiateDerivedTypes() {
408   for (DeclTypeSpec &type : declTypeSpecs_) {
409     if (type.category() == DeclTypeSpec::TypeDerived ||
410         type.category() == DeclTypeSpec::ClassDerived) {
411       type.derivedTypeSpec().Instantiate(*this);
412     }
413   }
414 }
415 } // namespace Fortran::semantics
416