1 //===-- lib/Semantics/semantics.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/semantics.h"
10 #include "assignment.h"
11 #include "canonicalize-acc.h"
12 #include "canonicalize-do.h"
13 #include "canonicalize-omp.h"
14 #include "check-acc-structure.h"
15 #include "check-allocate.h"
16 #include "check-arithmeticif.h"
17 #include "check-case.h"
18 #include "check-coarray.h"
19 #include "check-data.h"
20 #include "check-deallocate.h"
21 #include "check-declarations.h"
22 #include "check-do-forall.h"
23 #include "check-if-stmt.h"
24 #include "check-io.h"
25 #include "check-namelist.h"
26 #include "check-nullify.h"
27 #include "check-omp-structure.h"
28 #include "check-purity.h"
29 #include "check-return.h"
30 #include "check-select-rank.h"
31 #include "check-select-type.h"
32 #include "check-stop.h"
33 #include "compute-offsets.h"
34 #include "mod-file.h"
35 #include "resolve-labels.h"
36 #include "resolve-names.h"
37 #include "rewrite-parse-tree.h"
38 #include "flang/Common/default-kinds.h"
39 #include "flang/Parser/parse-tree-visitor.h"
40 #include "flang/Parser/tools.h"
41 #include "flang/Semantics/expression.h"
42 #include "flang/Semantics/scope.h"
43 #include "flang/Semantics/symbol.h"
44 #include "llvm/Support/raw_ostream.h"
45 
46 namespace Fortran::semantics {
47 
48 using NameToSymbolMap = std::multimap<parser::CharBlock, SymbolRef>;
49 static void DoDumpSymbols(llvm::raw_ostream &, const Scope &, int indent = 0);
50 static void PutIndent(llvm::raw_ostream &, int indent);
51 
52 static void GetSymbolNames(const Scope &scope, NameToSymbolMap &symbols) {
53   // Finds all symbol names in the scope without collecting duplicates.
54   for (const auto &pair : scope) {
55     symbols.emplace(pair.second->name(), *pair.second);
56   }
57   for (const auto &pair : scope.commonBlocks()) {
58     symbols.emplace(pair.second->name(), *pair.second);
59   }
60   for (const auto &child : scope.children()) {
61     GetSymbolNames(child, symbols);
62   }
63 }
64 
65 // A parse tree visitor that calls Enter/Leave functions from each checker
66 // class C supplied as template parameters. Enter is called before the node's
67 // children are visited, Leave is called after. No two checkers may have the
68 // same Enter or Leave function. Each checker must be constructible from
69 // SemanticsContext and have BaseChecker as a virtual base class.
70 template <typename... C> class SemanticsVisitor : public virtual C... {
71 public:
72   using C::Enter...;
73   using C::Leave...;
74   using BaseChecker::Enter;
75   using BaseChecker::Leave;
76   SemanticsVisitor(SemanticsContext &context)
77       : C{context}..., context_{context} {}
78 
79   template <typename N> bool Pre(const N &node) {
80     if constexpr (common::HasMember<const N *, ConstructNode>) {
81       context_.PushConstruct(node);
82     }
83     Enter(node);
84     return true;
85   }
86   template <typename N> void Post(const N &node) {
87     Leave(node);
88     if constexpr (common::HasMember<const N *, ConstructNode>) {
89       context_.PopConstruct();
90     }
91   }
92 
93   template <typename T> bool Pre(const parser::Statement<T> &node) {
94     context_.set_location(node.source);
95     Enter(node);
96     return true;
97   }
98   template <typename T> bool Pre(const parser::UnlabeledStatement<T> &node) {
99     context_.set_location(node.source);
100     Enter(node);
101     return true;
102   }
103   template <typename T> void Post(const parser::Statement<T> &node) {
104     Leave(node);
105     context_.set_location(std::nullopt);
106   }
107   template <typename T> void Post(const parser::UnlabeledStatement<T> &node) {
108     Leave(node);
109     context_.set_location(std::nullopt);
110   }
111 
112   bool Walk(const parser::Program &program) {
113     parser::Walk(program, *this);
114     return !context_.AnyFatalError();
115   }
116 
117 private:
118   SemanticsContext &context_;
119 };
120 
121 class MiscChecker : public virtual BaseChecker {
122 public:
123   explicit MiscChecker(SemanticsContext &context) : context_{context} {}
124   void Leave(const parser::EntryStmt &) {
125     if (!context_.constructStack().empty()) { // C1571
126       context_.Say("ENTRY may not appear in an executable construct"_err_en_US);
127     }
128   }
129   void Leave(const parser::AssignStmt &stmt) {
130     CheckAssignGotoName(std::get<parser::Name>(stmt.t));
131   }
132   void Leave(const parser::AssignedGotoStmt &stmt) {
133     CheckAssignGotoName(std::get<parser::Name>(stmt.t));
134   }
135 
136 private:
137   void CheckAssignGotoName(const parser::Name &name) {
138     if (context_.HasError(name.symbol)) {
139       return;
140     }
141     const Symbol &symbol{DEREF(name.symbol)};
142     auto type{evaluate::DynamicType::From(symbol)};
143     if (!IsVariableName(symbol) || symbol.Rank() != 0 || !type ||
144         type->category() != TypeCategory::Integer ||
145         type->kind() !=
146             context_.defaultKinds().GetDefaultKind(TypeCategory::Integer)) {
147       context_
148           .Say(name.source,
149               "'%s' must be a default integer scalar variable"_err_en_US,
150               name.source)
151           .Attach(symbol.name(), "Declaration of '%s'"_en_US, symbol.name());
152     }
153   }
154 
155   SemanticsContext &context_;
156 };
157 
158 using StatementSemanticsPass1 = ExprChecker;
159 using StatementSemanticsPass2 = SemanticsVisitor<AccStructureChecker,
160     AllocateChecker, ArithmeticIfStmtChecker, AssignmentChecker, CaseChecker,
161     CoarrayChecker, DataChecker, DeallocateChecker, DoForallChecker,
162     IfStmtChecker, IoChecker, MiscChecker, NamelistChecker, NullifyChecker,
163     OmpStructureChecker, PurityChecker, ReturnStmtChecker,
164     SelectRankConstructChecker, SelectTypeChecker, StopChecker>;
165 
166 static bool PerformStatementSemantics(
167     SemanticsContext &context, parser::Program &program) {
168   ResolveNames(context, program, context.globalScope());
169   RewriteParseTree(context, program);
170   ComputeOffsets(context, context.globalScope());
171   CheckDeclarations(context);
172   StatementSemanticsPass1{context}.Walk(program);
173   StatementSemanticsPass2 pass2{context};
174   pass2.Walk(program);
175   if (!context.AnyFatalError()) {
176     pass2.CompileDataInitializationsIntoInitializers();
177   }
178   return !context.AnyFatalError();
179 }
180 
181 SemanticsContext::SemanticsContext(
182     const common::IntrinsicTypeDefaultKinds &defaultKinds,
183     const common::LanguageFeatureControl &languageFeatures,
184     parser::AllCookedSources &allCookedSources)
185     : defaultKinds_{defaultKinds}, languageFeatures_{languageFeatures},
186       allCookedSources_{allCookedSources},
187       intrinsics_{evaluate::IntrinsicProcTable::Configure(defaultKinds_)},
188       globalScope_{*this}, intrinsicModulesScope_{globalScope_.MakeScope(
189                                Scope::Kind::IntrinsicModules, nullptr)},
190       foldingContext_{
191           parser::ContextualMessages{&messages_}, defaultKinds_, intrinsics_} {}
192 
193 SemanticsContext::~SemanticsContext() {}
194 
195 int SemanticsContext::GetDefaultKind(TypeCategory category) const {
196   return defaultKinds_.GetDefaultKind(category);
197 }
198 
199 const DeclTypeSpec &SemanticsContext::MakeNumericType(
200     TypeCategory category, int kind) {
201   if (kind == 0) {
202     kind = GetDefaultKind(category);
203   }
204   return globalScope_.MakeNumericType(category, KindExpr{kind});
205 }
206 const DeclTypeSpec &SemanticsContext::MakeLogicalType(int kind) {
207   if (kind == 0) {
208     kind = GetDefaultKind(TypeCategory::Logical);
209   }
210   return globalScope_.MakeLogicalType(KindExpr{kind});
211 }
212 
213 bool SemanticsContext::AnyFatalError() const {
214   return !messages_.empty() &&
215       (warningsAreErrors_ || messages_.AnyFatalError());
216 }
217 bool SemanticsContext::HasError(const Symbol &symbol) {
218   return errorSymbols_.count(symbol) > 0;
219 }
220 bool SemanticsContext::HasError(const Symbol *symbol) {
221   return !symbol || HasError(*symbol);
222 }
223 bool SemanticsContext::HasError(const parser::Name &name) {
224   return HasError(name.symbol);
225 }
226 void SemanticsContext::SetError(const Symbol &symbol, bool value) {
227   if (value) {
228     CheckError(symbol);
229     errorSymbols_.emplace(symbol);
230   }
231 }
232 void SemanticsContext::CheckError(const Symbol &symbol) {
233   if (!AnyFatalError()) {
234     std::string buf;
235     llvm::raw_string_ostream ss{buf};
236     ss << symbol;
237     common::die(
238         "No error was reported but setting error on: %s", ss.str().c_str());
239   }
240 }
241 
242 const Scope &SemanticsContext::FindScope(parser::CharBlock source) const {
243   return const_cast<SemanticsContext *>(this)->FindScope(source);
244 }
245 
246 Scope &SemanticsContext::FindScope(parser::CharBlock source) {
247   if (auto *scope{globalScope_.FindScope(source)}) {
248     return *scope;
249   } else {
250     common::die(
251         "SemanticsContext::FindScope(): invalid source location for '%s'",
252         source.ToString().c_str());
253   }
254 }
255 
256 void SemanticsContext::PopConstruct() {
257   CHECK(!constructStack_.empty());
258   constructStack_.pop_back();
259 }
260 
261 void SemanticsContext::CheckIndexVarRedefine(const parser::CharBlock &location,
262     const Symbol &variable, parser::MessageFixedText &&message) {
263   const Symbol &symbol{ResolveAssociations(variable)};
264   auto it{activeIndexVars_.find(symbol)};
265   if (it != activeIndexVars_.end()) {
266     std::string kind{EnumToString(it->second.kind)};
267     Say(location, std::move(message), kind, symbol.name())
268         .Attach(it->second.location, "Enclosing %s construct"_en_US, kind);
269   }
270 }
271 
272 void SemanticsContext::WarnIndexVarRedefine(
273     const parser::CharBlock &location, const Symbol &variable) {
274   CheckIndexVarRedefine(
275       location, variable, "Possible redefinition of %s variable '%s'"_en_US);
276 }
277 
278 void SemanticsContext::CheckIndexVarRedefine(
279     const parser::CharBlock &location, const Symbol &variable) {
280   CheckIndexVarRedefine(
281       location, variable, "Cannot redefine %s variable '%s'"_err_en_US);
282 }
283 
284 void SemanticsContext::CheckIndexVarRedefine(const parser::Variable &variable) {
285   if (const Symbol * entity{GetLastName(variable).symbol}) {
286     CheckIndexVarRedefine(variable.GetSource(), *entity);
287   }
288 }
289 
290 void SemanticsContext::CheckIndexVarRedefine(const parser::Name &name) {
291   if (const Symbol * entity{name.symbol}) {
292     CheckIndexVarRedefine(name.source, *entity);
293   }
294 }
295 
296 void SemanticsContext::ActivateIndexVar(
297     const parser::Name &name, IndexVarKind kind) {
298   CheckIndexVarRedefine(name);
299   if (const Symbol * indexVar{name.symbol}) {
300     activeIndexVars_.emplace(
301         ResolveAssociations(*indexVar), IndexVarInfo{name.source, kind});
302   }
303 }
304 
305 void SemanticsContext::DeactivateIndexVar(const parser::Name &name) {
306   if (Symbol * indexVar{name.symbol}) {
307     auto it{activeIndexVars_.find(ResolveAssociations(*indexVar))};
308     if (it != activeIndexVars_.end() && it->second.location == name.source) {
309       activeIndexVars_.erase(it);
310     }
311   }
312 }
313 
314 SymbolVector SemanticsContext::GetIndexVars(IndexVarKind kind) {
315   SymbolVector result;
316   for (const auto &[symbol, info] : activeIndexVars_) {
317     if (info.kind == kind) {
318       result.push_back(symbol);
319     }
320   }
321   return result;
322 }
323 
324 SourceName SemanticsContext::SaveTempName(std::string &&name) {
325   return {*tempNames_.emplace(std::move(name)).first};
326 }
327 
328 SourceName SemanticsContext::GetTempName(const Scope &scope) {
329   for (const auto &str : tempNames_) {
330     if (IsTempName(str)) {
331       SourceName name{str};
332       if (scope.find(name) == scope.end()) {
333         return name;
334       }
335     }
336   }
337   return SaveTempName(".F18."s + std::to_string(tempNames_.size()));
338 }
339 
340 bool SemanticsContext::IsTempName(const std::string &name) {
341   return name.size() > 5 && name.substr(0, 5) == ".F18.";
342 }
343 
344 Scope *SemanticsContext::GetBuiltinModule(const char *name) {
345   return ModFileReader{*this}.Read(SourceName{name, std::strlen(name)},
346       true /*intrinsic*/, nullptr, true /*silence errors*/);
347 }
348 
349 void SemanticsContext::UseFortranBuiltinsModule() {
350   if (builtinsScope_ == nullptr) {
351     builtinsScope_ = GetBuiltinModule("__fortran_builtins");
352     if (builtinsScope_) {
353       intrinsics_.SupplyBuiltins(*builtinsScope_);
354     }
355   }
356 }
357 
358 bool Semantics::Perform() {
359   // Implicitly USE the __Fortran_builtins module so that special types
360   // (e.g., __builtin_team_type) are available to semantics, esp. for
361   // intrinsic checking.
362   if (!program_.v.empty()) {
363     const auto *frontModule{std::get_if<common::Indirection<parser::Module>>(
364         &program_.v.front().u)};
365     if (frontModule &&
366         std::get<parser::Statement<parser::ModuleStmt>>(frontModule->value().t)
367                 .statement.v.source == "__fortran_builtins") {
368       // Don't try to read the builtins module when we're actually building it.
369     } else {
370       context_.UseFortranBuiltinsModule();
371     }
372   }
373   return ValidateLabels(context_, program_) &&
374       parser::CanonicalizeDo(program_) && // force line break
375       CanonicalizeAcc(context_.messages(), program_) &&
376       CanonicalizeOmp(context_.messages(), program_) &&
377       PerformStatementSemantics(context_, program_) &&
378       ModFileWriter{context_}.WriteAll();
379 }
380 
381 void Semantics::EmitMessages(llvm::raw_ostream &os) const {
382   context_.messages().Emit(os, context_.allCookedSources());
383 }
384 
385 void Semantics::DumpSymbols(llvm::raw_ostream &os) {
386   DoDumpSymbols(os, context_.globalScope());
387 }
388 
389 void Semantics::DumpSymbolsSources(llvm::raw_ostream &os) const {
390   NameToSymbolMap symbols;
391   GetSymbolNames(context_.globalScope(), symbols);
392   const parser::AllCookedSources &allCooked{context_.allCookedSources()};
393   for (const auto &pair : symbols) {
394     const Symbol &symbol{pair.second};
395     if (auto sourceInfo{allCooked.GetSourcePositionRange(symbol.name())}) {
396       os << symbol.name().ToString() << ": " << sourceInfo->first.file.path()
397          << ", " << sourceInfo->first.line << ", " << sourceInfo->first.column
398          << "-" << sourceInfo->second.column << "\n";
399     } else if (symbol.has<semantics::UseDetails>()) {
400       os << symbol.name().ToString() << ": "
401          << symbol.GetUltimate().owner().symbol()->name().ToString() << "\n";
402     }
403   }
404 }
405 
406 void DoDumpSymbols(llvm::raw_ostream &os, const Scope &scope, int indent) {
407   PutIndent(os, indent);
408   os << Scope::EnumToString(scope.kind()) << " scope:";
409   if (const auto *symbol{scope.symbol()}) {
410     os << ' ' << symbol->name();
411   }
412   if (scope.alignment().has_value()) {
413     os << " size=" << scope.size() << " alignment=" << *scope.alignment();
414   }
415   if (scope.derivedTypeSpec()) {
416     os << " instantiation of " << *scope.derivedTypeSpec();
417   }
418   os << '\n';
419   ++indent;
420   for (const auto &pair : scope) {
421     const auto &symbol{*pair.second};
422     PutIndent(os, indent);
423     os << symbol << '\n';
424     if (const auto *details{symbol.detailsIf<GenericDetails>()}) {
425       if (const auto &type{details->derivedType()}) {
426         PutIndent(os, indent);
427         os << *type << '\n';
428       }
429     }
430   }
431   if (!scope.equivalenceSets().empty()) {
432     PutIndent(os, indent);
433     os << "Equivalence Sets:";
434     for (const auto &set : scope.equivalenceSets()) {
435       os << ' ';
436       char sep = '(';
437       for (const auto &object : set) {
438         os << sep << object.AsFortran();
439         sep = ',';
440       }
441       os << ')';
442     }
443     os << '\n';
444   }
445   if (!scope.crayPointers().empty()) {
446     PutIndent(os, indent);
447     os << "Cray Pointers:";
448     for (const auto &[pointee, pointer] : scope.crayPointers()) {
449       os << " (" << pointer->name() << ',' << pointee << ')';
450     }
451   }
452   for (const auto &pair : scope.commonBlocks()) {
453     const auto &symbol{*pair.second};
454     PutIndent(os, indent);
455     os << symbol << '\n';
456   }
457   for (const auto &child : scope.children()) {
458     DoDumpSymbols(os, child, indent);
459   }
460   --indent;
461 }
462 
463 static void PutIndent(llvm::raw_ostream &os, int indent) {
464   for (int i = 0; i < indent; ++i) {
465     os << "  ";
466   }
467 }
468 } // namespace Fortran::semantics
469