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