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-cuda.h" |
20 | #include "check-data.h" |
21 | #include "check-deallocate.h" |
22 | #include "check-declarations.h" |
23 | #include "check-do-forall.h" |
24 | #include "check-if-stmt.h" |
25 | #include "check-io.h" |
26 | #include "check-namelist.h" |
27 | #include "check-nullify.h" |
28 | #include "check-omp-structure.h" |
29 | #include "check-purity.h" |
30 | #include "check-return.h" |
31 | #include "check-select-rank.h" |
32 | #include "check-select-type.h" |
33 | #include "check-stop.h" |
34 | #include "compute-offsets.h" |
35 | #include "mod-file.h" |
36 | #include "resolve-labels.h" |
37 | #include "resolve-names.h" |
38 | #include "rewrite-parse-tree.h" |
39 | #include "flang/Common/default-kinds.h" |
40 | #include "flang/Parser/parse-tree-visitor.h" |
41 | #include "flang/Parser/tools.h" |
42 | #include "flang/Semantics/expression.h" |
43 | #include "flang/Semantics/scope.h" |
44 | #include "flang/Semantics/symbol.h" |
45 | #include "llvm/Support/raw_ostream.h" |
46 | #include "llvm/TargetParser/Host.h" |
47 | #include "llvm/TargetParser/Triple.h" |
48 | |
49 | namespace Fortran::semantics { |
50 | |
51 | using NameToSymbolMap = std::multimap<parser::CharBlock, SymbolRef>; |
52 | static void DoDumpSymbols(llvm::raw_ostream &, const Scope &, int indent = 0); |
53 | static void PutIndent(llvm::raw_ostream &, int indent); |
54 | |
55 | static void GetSymbolNames(const Scope &scope, NameToSymbolMap &symbols) { |
56 | // Finds all symbol names in the scope without collecting duplicates. |
57 | for (const auto &pair : scope) { |
58 | symbols.emplace(pair.second->name(), *pair.second); |
59 | } |
60 | for (const auto &pair : scope.commonBlocks()) { |
61 | symbols.emplace(pair.second->name(), *pair.second); |
62 | } |
63 | for (const auto &child : scope.children()) { |
64 | GetSymbolNames(child, symbols); |
65 | } |
66 | } |
67 | |
68 | // A parse tree visitor that calls Enter/Leave functions from each checker |
69 | // class C supplied as template parameters. Enter is called before the node's |
70 | // children are visited, Leave is called after. No two checkers may have the |
71 | // same Enter or Leave function. Each checker must be constructible from |
72 | // SemanticsContext and have BaseChecker as a virtual base class. |
73 | template <typename... C> |
74 | class SemanticsVisitor : public virtual BaseChecker, public virtual C... { |
75 | public: |
76 | using BaseChecker::Enter; |
77 | using BaseChecker::Leave; |
78 | using C::Enter...; |
79 | using C::Leave...; |
80 | SemanticsVisitor(SemanticsContext &context) |
81 | : C{context}..., context_{context} {} |
82 | |
83 | template <typename N> bool Pre(const N &node) { |
84 | if constexpr (common::HasMember<const N *, ConstructNode>) { |
85 | context_.PushConstruct(node); |
86 | } |
87 | Enter(node); |
88 | return true; |
89 | } |
90 | template <typename N> void Post(const N &node) { |
91 | Leave(node); |
92 | if constexpr (common::HasMember<const N *, ConstructNode>) { |
93 | context_.PopConstruct(); |
94 | } |
95 | } |
96 | |
97 | template <typename T> bool Pre(const parser::Statement<T> &node) { |
98 | context_.set_location(node.source); |
99 | Enter(node); |
100 | return true; |
101 | } |
102 | template <typename T> bool Pre(const parser::UnlabeledStatement<T> &node) { |
103 | context_.set_location(node.source); |
104 | Enter(node); |
105 | return true; |
106 | } |
107 | template <typename T> void Post(const parser::Statement<T> &node) { |
108 | Leave(node); |
109 | context_.set_location(std::nullopt); |
110 | } |
111 | template <typename T> void Post(const parser::UnlabeledStatement<T> &node) { |
112 | Leave(node); |
113 | context_.set_location(std::nullopt); |
114 | } |
115 | |
116 | bool Walk(const parser::Program &program) { |
117 | parser::Walk(program, *this); |
118 | return !context_.AnyFatalError(); |
119 | } |
120 | |
121 | private: |
122 | SemanticsContext &context_; |
123 | }; |
124 | |
125 | class MiscChecker : public virtual BaseChecker { |
126 | public: |
127 | explicit MiscChecker(SemanticsContext &context) : context_{context} {} |
128 | void Leave(const parser::EntryStmt &) { |
129 | if (!context_.constructStack().empty()) { // C1571 |
130 | context_.Say("ENTRY may not appear in an executable construct"_err_en_US ); |
131 | } |
132 | } |
133 | void Leave(const parser::AssignStmt &stmt) { |
134 | CheckAssignGotoName(name: std::get<parser::Name>(stmt.t)); |
135 | } |
136 | void Leave(const parser::AssignedGotoStmt &stmt) { |
137 | CheckAssignGotoName(name: std::get<parser::Name>(stmt.t)); |
138 | } |
139 | |
140 | private: |
141 | void CheckAssignGotoName(const parser::Name &name) { |
142 | if (context_.HasError(name.symbol)) { |
143 | return; |
144 | } |
145 | const Symbol &symbol{DEREF(name.symbol)}; |
146 | auto type{evaluate::DynamicType::From(symbol)}; |
147 | if (!IsVariableName(symbol) || symbol.Rank() != 0 || !type || |
148 | type->category() != TypeCategory::Integer || |
149 | type->kind() != |
150 | context_.defaultKinds().GetDefaultKind(TypeCategory::Integer)) { |
151 | context_ |
152 | .Say(name.source, |
153 | "'%s' must be a default integer scalar variable"_err_en_US , |
154 | name.source) |
155 | .Attach(symbol.name(), "Declaration of '%s'"_en_US , symbol.name()); |
156 | } |
157 | } |
158 | |
159 | SemanticsContext &context_; |
160 | }; |
161 | |
162 | using StatementSemanticsPass1 = ExprChecker; |
163 | using StatementSemanticsPass2 = SemanticsVisitor<AllocateChecker, |
164 | ArithmeticIfStmtChecker, AssignmentChecker, CaseChecker, CoarrayChecker, |
165 | DataChecker, DeallocateChecker, DoForallChecker, IfStmtChecker, IoChecker, |
166 | MiscChecker, NamelistChecker, NullifyChecker, PurityChecker, |
167 | ReturnStmtChecker, SelectRankConstructChecker, SelectTypeChecker, |
168 | StopChecker>; |
169 | |
170 | static bool PerformStatementSemantics( |
171 | SemanticsContext &context, parser::Program &program) { |
172 | ResolveNames(context, program, context.globalScope()); |
173 | RewriteParseTree(context, program); |
174 | ComputeOffsets(context, context.globalScope()); |
175 | CheckDeclarations(context); |
176 | StatementSemanticsPass1{context}.Walk(program); |
177 | StatementSemanticsPass2 pass2{context}; |
178 | pass2.Walk(program); |
179 | if (context.languageFeatures().IsEnabled(common::LanguageFeature::OpenACC)) { |
180 | SemanticsVisitor<AccStructureChecker>{context}.Walk(program); |
181 | } |
182 | if (context.languageFeatures().IsEnabled(common::LanguageFeature::OpenMP)) { |
183 | SemanticsVisitor<OmpStructureChecker>{context}.Walk(program); |
184 | } |
185 | if (context.languageFeatures().IsEnabled(common::LanguageFeature::CUDA)) { |
186 | SemanticsVisitor<CUDAChecker>{context}.Walk(program); |
187 | } |
188 | if (!context.AnyFatalError()) { |
189 | pass2.CompileDataInitializationsIntoInitializers(); |
190 | } |
191 | return !context.AnyFatalError(); |
192 | } |
193 | |
194 | /// This class keeps track of the common block appearances with the biggest size |
195 | /// and with an initial value (if any) in a program. This allows reporting |
196 | /// conflicting initialization and warning about appearances of a same |
197 | /// named common block with different sizes. The biggest common block size and |
198 | /// initialization (if any) can later be provided so that lowering can generate |
199 | /// the correct symbol size and initial values, even when named common blocks |
200 | /// appears with different sizes and are initialized outside of block data. |
201 | class CommonBlockMap { |
202 | private: |
203 | struct CommonBlockInfo { |
204 | // Common block symbol for the appearance with the biggest size. |
205 | SymbolRef biggestSize; |
206 | // Common block symbol for the appearance with the initialized members (if |
207 | // any). |
208 | std::optional<SymbolRef> initialization; |
209 | }; |
210 | |
211 | public: |
212 | void MapCommonBlockAndCheckConflicts( |
213 | SemanticsContext &context, const Symbol &common) { |
214 | const Symbol *isInitialized{CommonBlockIsInitialized(common)}; |
215 | // Merge common according to the name they will have in the object files. |
216 | // This allows merging BIND(C) and non BIND(C) common block instead of |
217 | // later crashing. This "merge" matches what ifort/gfortran/nvfortran are |
218 | // doing and what a linker would do if the definition were in distinct |
219 | // files. |
220 | std::string commonName{ |
221 | GetCommonBlockObjectName(common, context.underscoring())}; |
222 | auto [it, firstAppearance] = commonBlocks_.insert(x: {commonName, |
223 | isInitialized ? CommonBlockInfo{common, common} |
224 | : CommonBlockInfo{common, std::nullopt}}); |
225 | if (!firstAppearance) { |
226 | CommonBlockInfo &info{it->second}; |
227 | if (isInitialized) { |
228 | if (info.initialization.has_value() && |
229 | &**info.initialization != &common) { |
230 | // Use the location of the initialization in the error message because |
231 | // common block symbols may have no location if they are blank |
232 | // commons. |
233 | const Symbol &previousInit{ |
234 | DEREF(CommonBlockIsInitialized(common: **info.initialization))}; |
235 | context |
236 | .Say(isInitialized->name(), |
237 | "Multiple initialization of COMMON block /%s/"_err_en_US , |
238 | common.name()) |
239 | .Attach(previousInit.name(), |
240 | "Previous initialization of COMMON block /%s/"_en_US , |
241 | common.name()); |
242 | } else { |
243 | info.initialization = common; |
244 | } |
245 | } |
246 | if (common.size() != info.biggestSize->size() && !common.name().empty() && |
247 | context.ShouldWarn(common::LanguageFeature::DistinctCommonSizes)) { |
248 | context |
249 | .Say(common.name(), |
250 | "A named COMMON block should have the same size everywhere it appears (%zd bytes here)"_port_en_US , |
251 | common.size()) |
252 | .Attach(info.biggestSize->name(), |
253 | "Previously defined with a size of %zd bytes"_en_US , |
254 | info.biggestSize->size()); |
255 | } |
256 | if (common.size() > info.biggestSize->size()) { |
257 | info.biggestSize = common; |
258 | } |
259 | } |
260 | } |
261 | |
262 | CommonBlockList GetCommonBlocks() const { |
263 | CommonBlockList result; |
264 | for (const auto &[_, blockInfo] : commonBlocks_) { |
265 | result.emplace_back( |
266 | std::make_pair(blockInfo.initialization ? *blockInfo.initialization |
267 | : blockInfo.biggestSize, |
268 | blockInfo.biggestSize->size())); |
269 | } |
270 | return result; |
271 | } |
272 | |
273 | private: |
274 | /// Return the symbol of an initialized member if a COMMON block |
275 | /// is initalized. Otherwise, return nullptr. |
276 | static Symbol *CommonBlockIsInitialized(const Symbol &common) { |
277 | const auto &commonDetails = |
278 | common.get<Fortran::semantics::CommonBlockDetails>(); |
279 | |
280 | for (const auto &member : commonDetails.objects()) { |
281 | if (IsInitialized(*member)) { |
282 | return &*member; |
283 | } |
284 | } |
285 | |
286 | // Common block may be initialized via initialized variables that are in an |
287 | // equivalence with the common block members. |
288 | for (const Fortran::semantics::EquivalenceSet &set : |
289 | common.owner().equivalenceSets()) { |
290 | for (const Fortran::semantics::EquivalenceObject &obj : set) { |
291 | if (!obj.symbol.test( |
292 | Fortran::semantics::Symbol::Flag::CompilerCreated)) { |
293 | if (FindCommonBlockContaining(obj.symbol) == &common && |
294 | IsInitialized(obj.symbol)) { |
295 | return &obj.symbol; |
296 | } |
297 | } |
298 | } |
299 | } |
300 | return nullptr; |
301 | } |
302 | |
303 | std::map<std::string, CommonBlockInfo> commonBlocks_; |
304 | }; |
305 | |
306 | SemanticsContext::SemanticsContext( |
307 | const common::IntrinsicTypeDefaultKinds &defaultKinds, |
308 | const common::LanguageFeatureControl &languageFeatures, |
309 | parser::AllCookedSources &allCookedSources) |
310 | : defaultKinds_{defaultKinds}, languageFeatures_{languageFeatures}, |
311 | allCookedSources_{allCookedSources}, |
312 | intrinsics_{evaluate::IntrinsicProcTable::Configure(defaultKinds_)}, |
313 | globalScope_{*this}, intrinsicModulesScope_{globalScope_.MakeScope( |
314 | Scope::Kind::IntrinsicModules, nullptr)}, |
315 | foldingContext_{parser::ContextualMessages{&messages_}, defaultKinds_, |
316 | intrinsics_, targetCharacteristics_, languageFeatures_, tempNames_} {} |
317 | |
318 | SemanticsContext::~SemanticsContext() {} |
319 | |
320 | int SemanticsContext::GetDefaultKind(TypeCategory category) const { |
321 | return defaultKinds_.GetDefaultKind(category); |
322 | } |
323 | |
324 | const DeclTypeSpec &SemanticsContext::MakeNumericType( |
325 | TypeCategory category, int kind) { |
326 | if (kind == 0) { |
327 | kind = GetDefaultKind(category); |
328 | } |
329 | return globalScope_.MakeNumericType(category, KindExpr{kind}); |
330 | } |
331 | const DeclTypeSpec &SemanticsContext::MakeLogicalType(int kind) { |
332 | if (kind == 0) { |
333 | kind = GetDefaultKind(TypeCategory::Logical); |
334 | } |
335 | return globalScope_.MakeLogicalType(KindExpr{kind}); |
336 | } |
337 | |
338 | bool SemanticsContext::AnyFatalError() const { |
339 | return !messages_.empty() && |
340 | (warningsAreErrors_ || messages_.AnyFatalError()); |
341 | } |
342 | bool SemanticsContext::HasError(const Symbol &symbol) { |
343 | return errorSymbols_.count(symbol) > 0; |
344 | } |
345 | bool SemanticsContext::HasError(const Symbol *symbol) { |
346 | return !symbol || HasError(*symbol); |
347 | } |
348 | bool SemanticsContext::HasError(const parser::Name &name) { |
349 | return HasError(name.symbol); |
350 | } |
351 | void SemanticsContext::SetError(const Symbol &symbol, bool value) { |
352 | if (value) { |
353 | CheckError(symbol); |
354 | errorSymbols_.emplace(symbol); |
355 | } |
356 | } |
357 | void SemanticsContext::CheckError(const Symbol &symbol) { |
358 | if (!AnyFatalError()) { |
359 | std::string buf; |
360 | llvm::raw_string_ostream ss{buf}; |
361 | ss << symbol; |
362 | common::die( |
363 | "No error was reported but setting error on: %s" , ss.str().c_str()); |
364 | } |
365 | } |
366 | |
367 | bool SemanticsContext::ScopeIndexComparator::operator()( |
368 | parser::CharBlock x, parser::CharBlock y) const { |
369 | return x.begin() < y.begin() || |
370 | (x.begin() == y.begin() && x.size() > y.size()); |
371 | } |
372 | |
373 | auto SemanticsContext::SearchScopeIndex(parser::CharBlock source) |
374 | -> ScopeIndex::iterator { |
375 | if (!scopeIndex_.empty()) { |
376 | auto iter{scopeIndex_.upper_bound(source)}; |
377 | auto begin{scopeIndex_.begin()}; |
378 | do { |
379 | --iter; |
380 | if (iter->first.Contains(source)) { |
381 | return iter; |
382 | } |
383 | } while (iter != begin); |
384 | } |
385 | return scopeIndex_.end(); |
386 | } |
387 | |
388 | const Scope &SemanticsContext::FindScope(parser::CharBlock source) const { |
389 | return const_cast<SemanticsContext *>(this)->FindScope(source); |
390 | } |
391 | |
392 | Scope &SemanticsContext::FindScope(parser::CharBlock source) { |
393 | if (auto iter{SearchScopeIndex(source)}; iter != scopeIndex_.end()) { |
394 | return iter->second; |
395 | } else { |
396 | common::die( |
397 | "SemanticsContext::FindScope(): invalid source location for '%s'" , |
398 | source.ToString().c_str()); |
399 | } |
400 | } |
401 | |
402 | void SemanticsContext::UpdateScopeIndex( |
403 | Scope &scope, parser::CharBlock newSource) { |
404 | if (scope.sourceRange().empty()) { |
405 | scopeIndex_.emplace(newSource, scope); |
406 | } else if (!scope.sourceRange().Contains(newSource)) { |
407 | auto iter{SearchScopeIndex(scope.sourceRange())}; |
408 | CHECK(iter != scopeIndex_.end()); |
409 | while (&iter->second != &scope) { |
410 | CHECK(iter != scopeIndex_.begin()); |
411 | --iter; |
412 | } |
413 | scopeIndex_.erase(iter); |
414 | scopeIndex_.emplace(newSource, scope); |
415 | } |
416 | } |
417 | |
418 | bool SemanticsContext::IsInModuleFile(parser::CharBlock source) const { |
419 | for (const Scope *scope{&FindScope(source)}; !scope->IsGlobal(); |
420 | scope = &scope->parent()) { |
421 | if (scope->IsModuleFile()) { |
422 | return true; |
423 | } |
424 | } |
425 | return false; |
426 | } |
427 | |
428 | void SemanticsContext::PopConstruct() { |
429 | CHECK(!constructStack_.empty()); |
430 | constructStack_.pop_back(); |
431 | } |
432 | |
433 | void SemanticsContext::CheckIndexVarRedefine(const parser::CharBlock &location, |
434 | const Symbol &variable, parser::MessageFixedText &&message) { |
435 | const Symbol &symbol{ResolveAssociations(variable)}; |
436 | auto it{activeIndexVars_.find(symbol)}; |
437 | if (it != activeIndexVars_.end()) { |
438 | std::string kind{EnumToString(it->second.kind)}; |
439 | Say(location, std::move(message), kind, symbol.name()) |
440 | .Attach(it->second.location, "Enclosing %s construct"_en_US , kind); |
441 | } |
442 | } |
443 | |
444 | void SemanticsContext::WarnIndexVarRedefine( |
445 | const parser::CharBlock &location, const Symbol &variable) { |
446 | CheckIndexVarRedefine(location, variable, |
447 | "Possible redefinition of %s variable '%s'"_warn_en_US ); |
448 | } |
449 | |
450 | void SemanticsContext::CheckIndexVarRedefine( |
451 | const parser::CharBlock &location, const Symbol &variable) { |
452 | CheckIndexVarRedefine( |
453 | location, variable, "Cannot redefine %s variable '%s'"_err_en_US ); |
454 | } |
455 | |
456 | void SemanticsContext::CheckIndexVarRedefine(const parser::Variable &variable) { |
457 | if (const Symbol * entity{GetLastName(variable).symbol}) { |
458 | CheckIndexVarRedefine(variable.GetSource(), *entity); |
459 | } |
460 | } |
461 | |
462 | void SemanticsContext::CheckIndexVarRedefine(const parser::Name &name) { |
463 | if (const Symbol * entity{name.symbol}) { |
464 | CheckIndexVarRedefine(name.source, *entity); |
465 | } |
466 | } |
467 | |
468 | void SemanticsContext::ActivateIndexVar( |
469 | const parser::Name &name, IndexVarKind kind) { |
470 | CheckIndexVarRedefine(name); |
471 | if (const Symbol * indexVar{name.symbol}) { |
472 | activeIndexVars_.emplace( |
473 | ResolveAssociations(*indexVar), IndexVarInfo{name.source, kind}); |
474 | } |
475 | } |
476 | |
477 | void SemanticsContext::DeactivateIndexVar(const parser::Name &name) { |
478 | if (Symbol * indexVar{name.symbol}) { |
479 | auto it{activeIndexVars_.find(ResolveAssociations(*indexVar))}; |
480 | if (it != activeIndexVars_.end() && it->second.location == name.source) { |
481 | activeIndexVars_.erase(it); |
482 | } |
483 | } |
484 | } |
485 | |
486 | SymbolVector SemanticsContext::GetIndexVars(IndexVarKind kind) { |
487 | SymbolVector result; |
488 | for (const auto &[symbol, info] : activeIndexVars_) { |
489 | if (info.kind == kind) { |
490 | result.push_back(symbol); |
491 | } |
492 | } |
493 | return result; |
494 | } |
495 | |
496 | SourceName SemanticsContext::SaveTempName(std::string &&name) { |
497 | return {*tempNames_.emplace(std::move(name)).first}; |
498 | } |
499 | |
500 | SourceName SemanticsContext::GetTempName(const Scope &scope) { |
501 | for (const auto &str : tempNames_) { |
502 | if (IsTempName(str)) { |
503 | SourceName name{str}; |
504 | if (scope.find(name) == scope.end()) { |
505 | return name; |
506 | } |
507 | } |
508 | } |
509 | return SaveTempName(".F18."s + std::to_string(tempNames_.size())); |
510 | } |
511 | |
512 | bool SemanticsContext::IsTempName(const std::string &name) { |
513 | return name.size() > 5 && name.substr(0, 5) == ".F18." ; |
514 | } |
515 | |
516 | Scope *SemanticsContext::GetBuiltinModule(const char *name) { |
517 | return ModFileReader{*this}.Read(SourceName{name, std::strlen(name)}, |
518 | true /*intrinsic*/, nullptr, /*silent=*/true); |
519 | } |
520 | |
521 | void SemanticsContext::UseFortranBuiltinsModule() { |
522 | if (builtinsScope_ == nullptr) { |
523 | builtinsScope_ = GetBuiltinModule("__fortran_builtins" ); |
524 | if (builtinsScope_) { |
525 | intrinsics_.SupplyBuiltins(*builtinsScope_); |
526 | } |
527 | } |
528 | } |
529 | |
530 | void SemanticsContext::UsePPCBuiltinTypesModule() { |
531 | if (ppcBuiltinTypesScope_ == nullptr) { |
532 | ppcBuiltinTypesScope_ = GetBuiltinModule("__ppc_types" ); |
533 | } |
534 | } |
535 | |
536 | const Scope &SemanticsContext::GetCUDABuiltinsScope() { |
537 | if (!cudaBuiltinsScope_) { |
538 | cudaBuiltinsScope_ = GetBuiltinModule("__cuda_builtins" ); |
539 | CHECK(cudaBuiltinsScope_.value() != nullptr); |
540 | } |
541 | return **cudaBuiltinsScope_; |
542 | } |
543 | |
544 | void SemanticsContext::UsePPCBuiltinsModule() { |
545 | if (ppcBuiltinsScope_ == nullptr) { |
546 | ppcBuiltinsScope_ = GetBuiltinModule("__ppc_intrinsics" ); |
547 | } |
548 | } |
549 | |
550 | parser::Program &SemanticsContext::SaveParseTree(parser::Program &&tree) { |
551 | return modFileParseTrees_.emplace_back(std::move(tree)); |
552 | } |
553 | |
554 | bool Semantics::Perform() { |
555 | // Implicitly USE the __Fortran_builtins module so that special types |
556 | // (e.g., __builtin_team_type) are available to semantics, esp. for |
557 | // intrinsic checking. |
558 | if (!program_.v.empty()) { |
559 | const auto *frontModule{std::get_if<common::Indirection<parser::Module>>( |
560 | &program_.v.front().u)}; |
561 | if (frontModule && |
562 | (std::get<parser::Statement<parser::ModuleStmt>>(frontModule->value().t) |
563 | .statement.v.source == "__fortran_builtins" || |
564 | std::get<parser::Statement<parser::ModuleStmt>>( |
565 | frontModule->value().t) |
566 | .statement.v.source == "__ppc_types" )) { |
567 | // Don't try to read the builtins module when we're actually building it. |
568 | } else if (frontModule && |
569 | (std::get<parser::Statement<parser::ModuleStmt>>(frontModule->value().t) |
570 | .statement.v.source == "__ppc_intrinsics" || |
571 | std::get<parser::Statement<parser::ModuleStmt>>( |
572 | frontModule->value().t) |
573 | .statement.v.source == "mma" )) { |
574 | // The derived type definition for the vectors is needed. |
575 | context_.UsePPCBuiltinTypesModule(); |
576 | } else { |
577 | context_.UseFortranBuiltinsModule(); |
578 | llvm::Triple targetTriple{llvm::Triple( |
579 | llvm::Triple::normalize(llvm::sys::getDefaultTargetTriple()))}; |
580 | // Only use __ppc_intrinsics module when targetting PowerPC arch |
581 | if (context_.targetCharacteristics().isPPC()) { |
582 | context_.UsePPCBuiltinTypesModule(); |
583 | context_.UsePPCBuiltinsModule(); |
584 | } |
585 | } |
586 | } |
587 | return ValidateLabels(context_, program_) && |
588 | parser::CanonicalizeDo(program_) && // force line break |
589 | CanonicalizeAcc(context_.messages(), program_) && |
590 | CanonicalizeOmp(context_.messages(), program_) && |
591 | CanonicalizeCUDA(program_) && |
592 | PerformStatementSemantics(context_, program_) && |
593 | ModFileWriter{context_}.WriteAll(); |
594 | } |
595 | |
596 | void Semantics::EmitMessages(llvm::raw_ostream &os) const { |
597 | context_.messages().Emit(os, context_.allCookedSources()); |
598 | } |
599 | |
600 | void Semantics::DumpSymbols(llvm::raw_ostream &os) { |
601 | DoDumpSymbols(os, context_.globalScope()); |
602 | } |
603 | |
604 | void Semantics::DumpSymbolsSources(llvm::raw_ostream &os) const { |
605 | NameToSymbolMap symbols; |
606 | GetSymbolNames(context_.globalScope(), symbols); |
607 | const parser::AllCookedSources &allCooked{context_.allCookedSources()}; |
608 | for (const auto &pair : symbols) { |
609 | const Symbol &symbol{pair.second}; |
610 | if (auto sourceInfo{allCooked.GetSourcePositionRange(symbol.name())}) { |
611 | os << symbol.name().ToString() << ": " << sourceInfo->first.path << ", " |
612 | << sourceInfo->first.line << ", " << sourceInfo->first.column << "-" |
613 | << sourceInfo->second.column << "\n" ; |
614 | } else if (symbol.has<semantics::UseDetails>()) { |
615 | os << symbol.name().ToString() << ": " |
616 | << symbol.GetUltimate().owner().symbol()->name().ToString() << "\n" ; |
617 | } |
618 | } |
619 | } |
620 | |
621 | void DoDumpSymbols(llvm::raw_ostream &os, const Scope &scope, int indent) { |
622 | PutIndent(os, indent); |
623 | os << Scope::EnumToString(scope.kind()) << " scope:" ; |
624 | if (const auto *symbol{scope.symbol()}) { |
625 | os << ' ' << symbol->name(); |
626 | } |
627 | if (scope.alignment().has_value()) { |
628 | os << " size=" << scope.size() << " alignment=" << *scope.alignment(); |
629 | } |
630 | if (scope.derivedTypeSpec()) { |
631 | os << " instantiation of " << *scope.derivedTypeSpec(); |
632 | } |
633 | os << " sourceRange=" << scope.sourceRange().size() << " bytes\n" ; |
634 | ++indent; |
635 | for (const auto &pair : scope) { |
636 | const auto &symbol{*pair.second}; |
637 | PutIndent(os, indent); |
638 | os << symbol << '\n'; |
639 | if (const auto *details{symbol.detailsIf<GenericDetails>()}) { |
640 | if (const auto &type{details->derivedType()}) { |
641 | PutIndent(os, indent); |
642 | os << *type << '\n'; |
643 | } |
644 | } |
645 | } |
646 | if (!scope.equivalenceSets().empty()) { |
647 | PutIndent(os, indent); |
648 | os << "Equivalence Sets:" ; |
649 | for (const auto &set : scope.equivalenceSets()) { |
650 | os << ' '; |
651 | char sep = '('; |
652 | for (const auto &object : set) { |
653 | os << sep << object.AsFortran(); |
654 | sep = ','; |
655 | } |
656 | os << ')'; |
657 | } |
658 | os << '\n'; |
659 | } |
660 | if (!scope.crayPointers().empty()) { |
661 | PutIndent(os, indent); |
662 | os << "Cray Pointers:" ; |
663 | for (const auto &[pointee, pointer] : scope.crayPointers()) { |
664 | os << " (" << pointer->name() << ',' << pointee << ')'; |
665 | } |
666 | } |
667 | for (const auto &pair : scope.commonBlocks()) { |
668 | const auto &symbol{*pair.second}; |
669 | PutIndent(os, indent); |
670 | os << symbol << '\n'; |
671 | } |
672 | for (const auto &child : scope.children()) { |
673 | DoDumpSymbols(os, child, indent); |
674 | } |
675 | --indent; |
676 | } |
677 | |
678 | static void PutIndent(llvm::raw_ostream &os, int indent) { |
679 | for (int i = 0; i < indent; ++i) { |
680 | os << " " ; |
681 | } |
682 | } |
683 | |
684 | void SemanticsContext::MapCommonBlockAndCheckConflicts(const Symbol &common) { |
685 | if (!commonBlockMap_) { |
686 | commonBlockMap_ = std::make_unique<CommonBlockMap>(); |
687 | } |
688 | commonBlockMap_->MapCommonBlockAndCheckConflicts(*this, common); |
689 | } |
690 | |
691 | CommonBlockList SemanticsContext::GetCommonBlocks() const { |
692 | if (commonBlockMap_) { |
693 | return commonBlockMap_->GetCommonBlocks(); |
694 | } |
695 | return {}; |
696 | } |
697 | |
698 | } // namespace Fortran::semantics |
699 | |