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