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