1 //===-- lib/Semantics/symbol.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/symbol.h"
10 #include "flang/Common/idioms.h"
11 #include "flang/Evaluate/expression.h"
12 #include "flang/Semantics/scope.h"
13 #include "flang/Semantics/semantics.h"
14 #include "flang/Semantics/tools.h"
15 #include "llvm/Support/raw_ostream.h"
16 #include <string>
17 
18 namespace Fortran::semantics {
19 
20 template <typename T>
21 static void DumpOptional(llvm::raw_ostream &os, const char *label, const T &x) {
22   if (x) {
23     os << ' ' << label << ':' << *x;
24   }
25 }
26 template <typename T>
27 static void DumpExpr(llvm::raw_ostream &os, const char *label,
28     const std::optional<evaluate::Expr<T>> &x) {
29   if (x) {
30     x->AsFortran(os << ' ' << label << ':');
31   }
32 }
33 
34 static void DumpBool(llvm::raw_ostream &os, const char *label, bool x) {
35   if (x) {
36     os << ' ' << label;
37   }
38 }
39 
40 static void DumpSymbolVector(llvm::raw_ostream &os, const SymbolVector &list) {
41   char sep{' '};
42   for (const Symbol &elem : list) {
43     os << sep << elem.name();
44     sep = ',';
45   }
46 }
47 
48 static void DumpType(llvm::raw_ostream &os, const Symbol &symbol) {
49   if (const auto *type{symbol.GetType()}) {
50     os << *type << ' ';
51   }
52 }
53 static void DumpType(llvm::raw_ostream &os, const DeclTypeSpec *type) {
54   if (type) {
55     os << ' ' << *type;
56   }
57 }
58 
59 template <typename T>
60 static void DumpList(llvm::raw_ostream &os, const char *label, const T &list) {
61   if (!list.empty()) {
62     os << ' ' << label << ':';
63     char sep{' '};
64     for (const auto &elem : list) {
65       os << sep << elem;
66       sep = ',';
67     }
68   }
69 }
70 
71 const Scope *ModuleDetails::parent() const {
72   return isSubmodule_ && scope_ ? &scope_->parent() : nullptr;
73 }
74 const Scope *ModuleDetails::ancestor() const {
75   return isSubmodule_ && scope_ ? FindModuleContaining(*scope_) : nullptr;
76 }
77 void ModuleDetails::set_scope(const Scope *scope) {
78   CHECK(!scope_);
79   bool scopeIsSubmodule{scope->parent().kind() == Scope::Kind::Module};
80   CHECK(isSubmodule_ == scopeIsSubmodule);
81   scope_ = scope;
82 }
83 
84 llvm::raw_ostream &operator<<(
85     llvm::raw_ostream &os, const SubprogramDetails &x) {
86   DumpBool(os, "isInterface", x.isInterface_);
87   DumpExpr(os, "bindName", x.bindName_);
88   if (x.result_) {
89     DumpType(os << " result:", x.result());
90     os << x.result_->name();
91     if (!x.result_->attrs().empty()) {
92       os << ", " << x.result_->attrs();
93     }
94   }
95   if (x.entryScope_) {
96     os << " entry";
97     if (x.entryScope_->symbol()) {
98       os << " in " << x.entryScope_->symbol()->name();
99     }
100   }
101   char sep{'('};
102   os << ' ';
103   for (const Symbol *arg : x.dummyArgs_) {
104     os << sep;
105     sep = ',';
106     if (arg) {
107       DumpType(os, *arg);
108       os << arg->name();
109     } else {
110       os << '*';
111     }
112   }
113   os << (sep == '(' ? "()" : ")");
114   if (x.stmtFunction_) {
115     os << " -> " << x.stmtFunction_->AsFortran();
116   }
117   return os;
118 }
119 
120 void EntityDetails::set_type(const DeclTypeSpec &type) {
121   CHECK(!type_);
122   type_ = &type;
123 }
124 
125 void AssocEntityDetails::set_rank(int rank) { rank_ = rank; }
126 void EntityDetails::ReplaceType(const DeclTypeSpec &type) { type_ = &type; }
127 
128 void ObjectEntityDetails::set_shape(const ArraySpec &shape) {
129   CHECK(shape_.empty());
130   for (const auto &shapeSpec : shape) {
131     shape_.push_back(shapeSpec);
132   }
133 }
134 void ObjectEntityDetails::set_coshape(const ArraySpec &coshape) {
135   CHECK(coshape_.empty());
136   for (const auto &shapeSpec : coshape) {
137     coshape_.push_back(shapeSpec);
138   }
139 }
140 
141 ProcEntityDetails::ProcEntityDetails(EntityDetails &&d) : EntityDetails(d) {
142   if (type()) {
143     interface_.set_type(*type());
144   }
145 }
146 
147 UseErrorDetails::UseErrorDetails(const UseDetails &useDetails) {
148   add_occurrence(useDetails.location(), *GetUsedModule(useDetails).scope());
149 }
150 UseErrorDetails &UseErrorDetails::add_occurrence(
151     const SourceName &location, const Scope &module) {
152   occurrences_.push_back(std::make_pair(location, &module));
153   return *this;
154 }
155 
156 void GenericDetails::AddSpecificProc(
157     const Symbol &proc, SourceName bindingName) {
158   specificProcs_.push_back(proc);
159   bindingNames_.push_back(bindingName);
160 }
161 void GenericDetails::set_specific(Symbol &specific) {
162   CHECK(!specific_);
163   CHECK(!derivedType_);
164   specific_ = &specific;
165 }
166 void GenericDetails::set_derivedType(Symbol &derivedType) {
167   CHECK(!specific_);
168   CHECK(!derivedType_);
169   derivedType_ = &derivedType;
170 }
171 void GenericDetails::AddUse(const Symbol &use) {
172   CHECK(use.has<UseDetails>());
173   uses_.push_back(use);
174 }
175 
176 const Symbol *GenericDetails::CheckSpecific() const {
177   return const_cast<GenericDetails *>(this)->CheckSpecific();
178 }
179 Symbol *GenericDetails::CheckSpecific() {
180   if (specific_) {
181     for (const Symbol &proc : specificProcs_) {
182       if (&proc == specific_) {
183         return nullptr;
184       }
185     }
186     return specific_;
187   } else {
188     return nullptr;
189   }
190 }
191 
192 void GenericDetails::CopyFrom(const GenericDetails &from) {
193   CHECK(specificProcs_.size() == bindingNames_.size());
194   CHECK(from.specificProcs_.size() == from.bindingNames_.size());
195   kind_ = from.kind_;
196   if (from.derivedType_) {
197     CHECK(!derivedType_ || derivedType_ == from.derivedType_);
198     derivedType_ = from.derivedType_;
199   }
200   for (std::size_t i{0}; i < from.specificProcs_.size(); ++i) {
201     if (std::find_if(specificProcs_.begin(), specificProcs_.end(),
202             [&](const Symbol &mySymbol) {
203               return &mySymbol == &*from.specificProcs_[i];
204             }) == specificProcs_.end()) {
205       specificProcs_.push_back(from.specificProcs_[i]);
206       bindingNames_.push_back(from.bindingNames_[i]);
207     }
208   }
209 }
210 
211 // The name of the kind of details for this symbol.
212 // This is primarily for debugging.
213 std::string DetailsToString(const Details &details) {
214   return std::visit(
215       common::visitors{
216           [](const UnknownDetails &) { return "Unknown"; },
217           [](const MainProgramDetails &) { return "MainProgram"; },
218           [](const ModuleDetails &) { return "Module"; },
219           [](const SubprogramDetails &) { return "Subprogram"; },
220           [](const SubprogramNameDetails &) { return "SubprogramName"; },
221           [](const EntityDetails &) { return "Entity"; },
222           [](const ObjectEntityDetails &) { return "ObjectEntity"; },
223           [](const ProcEntityDetails &) { return "ProcEntity"; },
224           [](const DerivedTypeDetails &) { return "DerivedType"; },
225           [](const UseDetails &) { return "Use"; },
226           [](const UseErrorDetails &) { return "UseError"; },
227           [](const HostAssocDetails &) { return "HostAssoc"; },
228           [](const GenericDetails &) { return "Generic"; },
229           [](const ProcBindingDetails &) { return "ProcBinding"; },
230           [](const NamelistDetails &) { return "Namelist"; },
231           [](const CommonBlockDetails &) { return "CommonBlockDetails"; },
232           [](const TypeParamDetails &) { return "TypeParam"; },
233           [](const MiscDetails &) { return "Misc"; },
234           [](const AssocEntityDetails &) { return "AssocEntity"; },
235       },
236       details);
237 }
238 
239 const std::string Symbol::GetDetailsName() const {
240   return DetailsToString(details_);
241 }
242 
243 void Symbol::set_details(Details &&details) {
244   CHECK(CanReplaceDetails(details));
245   details_ = std::move(details);
246 }
247 
248 bool Symbol::CanReplaceDetails(const Details &details) const {
249   if (has<UnknownDetails>()) {
250     return true; // can always replace UnknownDetails
251   } else {
252     return std::visit(
253         common::visitors{
254             [](const UseErrorDetails &) { return true; },
255             [&](const ObjectEntityDetails &) { return has<EntityDetails>(); },
256             [&](const ProcEntityDetails &) { return has<EntityDetails>(); },
257             [&](const SubprogramDetails &) {
258               return has<SubprogramNameDetails>() || has<EntityDetails>();
259             },
260             [&](const DerivedTypeDetails &) {
261               const auto *derived{this->detailsIf<DerivedTypeDetails>()};
262               return derived && derived->isForwardReferenced();
263             },
264             [&](const UseDetails &x) {
265               const auto *use{this->detailsIf<UseDetails>()};
266               return use && use->symbol() == x.symbol();
267             },
268             [](const auto &) { return false; },
269         },
270         details);
271   }
272 }
273 
274 // Usually a symbol's name is the first occurrence in the source, but sometimes
275 // we want to replace it with one at a different location (but same characters).
276 void Symbol::ReplaceName(const SourceName &name) {
277   CHECK(name == name_);
278   name_ = name;
279 }
280 
281 void Symbol::SetType(const DeclTypeSpec &type) {
282   std::visit(common::visitors{
283                  [&](EntityDetails &x) { x.set_type(type); },
284                  [&](ObjectEntityDetails &x) { x.set_type(type); },
285                  [&](AssocEntityDetails &x) { x.set_type(type); },
286                  [&](ProcEntityDetails &x) { x.interface().set_type(type); },
287                  [&](TypeParamDetails &x) { x.set_type(type); },
288                  [](auto &) {},
289              },
290       details_);
291 }
292 
293 bool Symbol::IsFuncResult() const {
294   return std::visit(
295       common::visitors{[](const EntityDetails &x) { return x.isFuncResult(); },
296           [](const ObjectEntityDetails &x) { return x.isFuncResult(); },
297           [](const ProcEntityDetails &x) { return x.isFuncResult(); },
298           [](const HostAssocDetails &x) { return x.symbol().IsFuncResult(); },
299           [](const auto &) { return false; }},
300       details_);
301 }
302 
303 bool Symbol::IsObjectArray() const {
304   const auto *details{std::get_if<ObjectEntityDetails>(&details_)};
305   return details && details->IsArray();
306 }
307 
308 bool Symbol::IsSubprogram() const {
309   return std::visit(
310       common::visitors{
311           [](const SubprogramDetails &) { return true; },
312           [](const SubprogramNameDetails &) { return true; },
313           [](const GenericDetails &) { return true; },
314           [](const UseDetails &x) { return x.symbol().IsSubprogram(); },
315           [](const auto &) { return false; },
316       },
317       details_);
318 }
319 
320 bool Symbol::IsFromModFile() const {
321   return test(Flag::ModFile) ||
322       (!owner_->IsGlobal() && owner_->symbol()->IsFromModFile());
323 }
324 
325 ObjectEntityDetails::ObjectEntityDetails(EntityDetails &&d)
326     : EntityDetails(d) {}
327 
328 llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const EntityDetails &x) {
329   DumpBool(os, "dummy", x.isDummy());
330   DumpBool(os, "funcResult", x.isFuncResult());
331   if (x.type()) {
332     os << " type: " << *x.type();
333   }
334   DumpExpr(os, "bindName", x.bindName_);
335   return os;
336 }
337 
338 llvm::raw_ostream &operator<<(
339     llvm::raw_ostream &os, const ObjectEntityDetails &x) {
340   os << *static_cast<const EntityDetails *>(&x);
341   DumpList(os, "shape", x.shape());
342   DumpList(os, "coshape", x.coshape());
343   DumpExpr(os, "init", x.init_);
344   return os;
345 }
346 
347 llvm::raw_ostream &operator<<(
348     llvm::raw_ostream &os, const AssocEntityDetails &x) {
349   os << *static_cast<const EntityDetails *>(&x);
350   if (auto assocRank{x.rank()}) {
351     os << " rank: " << *assocRank;
352   }
353   DumpExpr(os, "expr", x.expr());
354   return os;
355 }
356 
357 llvm::raw_ostream &operator<<(
358     llvm::raw_ostream &os, const ProcEntityDetails &x) {
359   if (auto *symbol{x.interface_.symbol()}) {
360     os << ' ' << symbol->name();
361   } else {
362     DumpType(os, x.interface_.type());
363   }
364   DumpExpr(os, "bindName", x.bindName());
365   DumpOptional(os, "passName", x.passName());
366   if (x.init()) {
367     if (const Symbol * target{*x.init()}) {
368       os << " => " << target->name();
369     } else {
370       os << " => NULL()";
371     }
372   }
373   return os;
374 }
375 
376 llvm::raw_ostream &operator<<(
377     llvm::raw_ostream &os, const DerivedTypeDetails &x) {
378   DumpBool(os, "sequence", x.sequence_);
379   DumpList(os, "components", x.componentNames_);
380   return os;
381 }
382 
383 llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const GenericDetails &x) {
384   os << ' ' << x.kind().ToString();
385   DumpBool(os, "(specific)", x.specific() != nullptr);
386   DumpBool(os, "(derivedType)", x.derivedType() != nullptr);
387   if (const auto &uses{x.uses()}; !uses.empty()) {
388     os << " (uses:";
389     char sep{' '};
390     for (const Symbol &use : uses) {
391       const Symbol &ultimate{use.GetUltimate()};
392       os << sep << ultimate.name() << "->"
393          << ultimate.owner().GetName().value();
394       sep = ',';
395     }
396     os << ')';
397   }
398   os << " procs:";
399   DumpSymbolVector(os, x.specificProcs());
400   return os;
401 }
402 
403 llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Details &details) {
404   os << DetailsToString(details);
405   std::visit( //
406       common::visitors{
407           [&](const UnknownDetails &) {},
408           [&](const MainProgramDetails &) {},
409           [&](const ModuleDetails &x) {
410             if (x.isSubmodule()) {
411               os << " (";
412               if (x.ancestor()) {
413                 auto ancestor{x.ancestor()->GetName().value()};
414                 os << ancestor;
415                 if (x.parent()) {
416                   auto parent{x.parent()->GetName().value()};
417                   if (ancestor != parent) {
418                     os << ':' << parent;
419                   }
420                 }
421               }
422               os << ")";
423             }
424           },
425           [&](const SubprogramNameDetails &x) {
426             os << ' ' << EnumToString(x.kind());
427           },
428           [&](const UseDetails &x) {
429             os << " from " << x.symbol().name() << " in "
430                << GetUsedModule(x).name();
431           },
432           [&](const UseErrorDetails &x) {
433             os << " uses:";
434             char sep{':'};
435             for (const auto &[location, module] : x.occurrences()) {
436               os << sep << " from " << module->GetName().value() << " at "
437                  << location;
438               sep = ',';
439             }
440           },
441           [](const HostAssocDetails &) {},
442           [&](const ProcBindingDetails &x) {
443             os << " => " << x.symbol().name();
444             DumpOptional(os, "passName", x.passName());
445           },
446           [&](const NamelistDetails &x) {
447             os << ':';
448             DumpSymbolVector(os, x.objects());
449           },
450           [&](const CommonBlockDetails &x) {
451             if (x.alignment()) {
452               os << " alignment=" << x.alignment();
453             }
454             os << ':';
455             for (const auto &object : x.objects()) {
456               os << ' ' << object->name();
457             }
458           },
459           [&](const TypeParamDetails &x) {
460             DumpOptional(os, "type", x.type());
461             os << ' ' << common::EnumToString(x.attr());
462             DumpExpr(os, "init", x.init());
463           },
464           [&](const MiscDetails &x) {
465             os << ' ' << MiscDetails::EnumToString(x.kind());
466           },
467           [&](const auto &x) { os << x; },
468       },
469       details);
470   return os;
471 }
472 
473 llvm::raw_ostream &operator<<(llvm::raw_ostream &o, Symbol::Flag flag) {
474   return o << Symbol::EnumToString(flag);
475 }
476 
477 llvm::raw_ostream &operator<<(
478     llvm::raw_ostream &o, const Symbol::Flags &flags) {
479   std::size_t n{flags.count()};
480   std::size_t seen{0};
481   for (std::size_t j{0}; seen < n; ++j) {
482     Symbol::Flag flag{static_cast<Symbol::Flag>(j)};
483     if (flags.test(flag)) {
484       if (seen++ > 0) {
485         o << ", ";
486       }
487       o << flag;
488     }
489   }
490   return o;
491 }
492 
493 llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Symbol &symbol) {
494   os << symbol.name();
495   if (!symbol.attrs().empty()) {
496     os << ", " << symbol.attrs();
497   }
498   if (!symbol.flags().empty()) {
499     os << " (" << symbol.flags() << ')';
500   }
501   if (symbol.size_) {
502     os << " size=" << symbol.size_ << " offset=" << symbol.offset_;
503   }
504   os << ": " << symbol.details_;
505   return os;
506 }
507 
508 // Output a unique name for a scope by qualifying it with the names of
509 // parent scopes. For scopes without corresponding symbols, use the kind
510 // with an index (e.g. Block1, Block2, etc.).
511 static void DumpUniqueName(llvm::raw_ostream &os, const Scope &scope) {
512   if (!scope.IsGlobal()) {
513     DumpUniqueName(os, scope.parent());
514     os << '/';
515     if (auto *scopeSymbol{scope.symbol()};
516         scopeSymbol && !scopeSymbol->name().empty()) {
517       os << scopeSymbol->name();
518     } else {
519       int index{1};
520       for (auto &child : scope.parent().children()) {
521         if (child == scope) {
522           break;
523         }
524         if (child.kind() == scope.kind()) {
525           ++index;
526         }
527       }
528       os << Scope::EnumToString(scope.kind()) << index;
529     }
530   }
531 }
532 
533 // Dump a symbol for UnparseWithSymbols. This will be used for tests so the
534 // format should be reasonably stable.
535 llvm::raw_ostream &DumpForUnparse(
536     llvm::raw_ostream &os, const Symbol &symbol, bool isDef) {
537   DumpUniqueName(os, symbol.owner());
538   os << '/' << symbol.name();
539   if (isDef) {
540     if (!symbol.attrs().empty()) {
541       os << ' ' << symbol.attrs();
542     }
543     if (!symbol.flags().empty()) {
544       os << " (" << symbol.flags() << ')';
545     }
546     os << ' ' << symbol.GetDetailsName();
547     DumpType(os, symbol.GetType());
548   }
549   return os;
550 }
551 
552 const DerivedTypeSpec *Symbol::GetParentTypeSpec(const Scope *scope) const {
553   if (const Symbol * parentComponent{GetParentComponent(scope)}) {
554     const auto &object{parentComponent->get<ObjectEntityDetails>()};
555     return &object.type()->derivedTypeSpec();
556   } else {
557     return nullptr;
558   }
559 }
560 
561 const Symbol *Symbol::GetParentComponent(const Scope *scope) const {
562   if (const auto *dtDetails{detailsIf<DerivedTypeDetails>()}) {
563     if (const Scope * localScope{scope ? scope : scope_}) {
564       return dtDetails->GetParentComponent(DEREF(localScope));
565     }
566   }
567   return nullptr;
568 }
569 
570 void DerivedTypeDetails::add_component(const Symbol &symbol) {
571   if (symbol.test(Symbol::Flag::ParentComp)) {
572     CHECK(componentNames_.empty());
573   }
574   componentNames_.push_back(symbol.name());
575 }
576 
577 const Symbol *DerivedTypeDetails::GetParentComponent(const Scope &scope) const {
578   if (auto extends{GetParentComponentName()}) {
579     if (auto iter{scope.find(*extends)}; iter != scope.cend()) {
580       if (const Symbol & symbol{*iter->second};
581           symbol.test(Symbol::Flag::ParentComp)) {
582         return &symbol;
583       }
584     }
585   }
586   return nullptr;
587 }
588 
589 const Symbol *DerivedTypeDetails::GetFinalForRank(int rank) const {
590   for (const auto &pair : finals_) {
591     const Symbol &symbol{*pair.second};
592     if (const auto *details{symbol.detailsIf<SubprogramDetails>()}) {
593       if (details->dummyArgs().size() == 1) {
594         if (const Symbol * arg{details->dummyArgs().at(0)}) {
595           if (const auto *object{arg->detailsIf<ObjectEntityDetails>()}) {
596             if (rank == object->shape().Rank() || object->IsAssumedRank() ||
597                 symbol.attrs().test(Attr::ELEMENTAL)) {
598               return &symbol;
599             }
600           }
601         }
602       }
603     }
604   }
605   return nullptr;
606 }
607 
608 void TypeParamDetails::set_type(const DeclTypeSpec &type) {
609   CHECK(!type_);
610   type_ = &type;
611 }
612 
613 bool GenericKind::IsIntrinsicOperator() const {
614   return Is(OtherKind::Concat) || Has<common::LogicalOperator>() ||
615       Has<common::NumericOperator>() || Has<common::RelationalOperator>();
616 }
617 
618 bool GenericKind::IsOperator() const {
619   return IsDefinedOperator() || IsIntrinsicOperator();
620 }
621 
622 std::string GenericKind::ToString() const {
623   return std::visit(
624       common::visitors {
625         [](const OtherKind &x) { return EnumToString(x); },
626             [](const DefinedIo &x) { return EnumToString(x); },
627 #if !__clang__ && __GNUC__ == 7 && __GNUC_MINOR__ == 2
628             [](const common::NumericOperator &x) {
629               return common::EnumToString(x);
630             },
631             [](const common::LogicalOperator &x) {
632               return common::EnumToString(x);
633             },
634             [](const common::RelationalOperator &x) {
635               return common::EnumToString(x);
636             },
637 #else
638             [](const auto &x) { return common::EnumToString(x); },
639 #endif
640       },
641       u);
642 }
643 
644 bool GenericKind::Is(GenericKind::OtherKind x) const {
645   const OtherKind *y{std::get_if<OtherKind>(&u)};
646   return y && *y == x;
647 }
648 
649 } // namespace Fortran::semantics
650