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