1 //===----------------------------------------------------------------------===//
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 "resolve-directives.h"
10 
11 #include "check-acc-structure.h"
12 #include "check-omp-structure.h"
13 #include "resolve-names-utils.h"
14 #include "flang/Common/idioms.h"
15 #include "flang/Evaluate/fold.h"
16 #include "flang/Parser/parse-tree-visitor.h"
17 #include "flang/Parser/parse-tree.h"
18 #include "flang/Parser/tools.h"
19 #include "flang/Semantics/expression.h"
20 #include <list>
21 #include <map>
22 
23 namespace Fortran::semantics {
24 
25 template <typename T> class DirectiveAttributeVisitor {
26 public:
27   explicit DirectiveAttributeVisitor(SemanticsContext &context)
28       : context_{context} {}
29 
30   template <typename A> bool Pre(const A &) { return true; }
31   template <typename A> void Post(const A &) {}
32 
33 protected:
34   struct DirContext {
35     DirContext(const parser::CharBlock &source, T d, Scope &s)
36         : directiveSource{source}, directive{d}, scope{s} {}
37     parser::CharBlock directiveSource;
38     T directive;
39     Scope &scope;
40     Symbol::Flag defaultDSA{Symbol::Flag::AccShared}; // TODOACC
41     std::map<const Symbol *, Symbol::Flag> objectWithDSA;
42     bool withinConstruct{false};
43     std::int64_t associatedLoopLevel{0};
44   };
45 
46   DirContext &GetContext() {
47     CHECK(!dirContext_.empty());
48     return dirContext_.back();
49   }
50   void PushContext(const parser::CharBlock &source, T dir) {
51     dirContext_.emplace_back(source, dir, context_.FindScope(source));
52   }
53   void PopContext() { dirContext_.pop_back(); }
54   void SetContextDirectiveSource(parser::CharBlock &dir) {
55     GetContext().directiveSource = dir;
56   }
57   Scope &currScope() { return GetContext().scope; }
58   void SetContextDefaultDSA(Symbol::Flag flag) {
59     GetContext().defaultDSA = flag;
60   }
61   void AddToContextObjectWithDSA(
62       const Symbol &symbol, Symbol::Flag flag, DirContext &context) {
63     context.objectWithDSA.emplace(&symbol, flag);
64   }
65   void AddToContextObjectWithDSA(const Symbol &symbol, Symbol::Flag flag) {
66     AddToContextObjectWithDSA(symbol, flag, GetContext());
67   }
68   bool IsObjectWithDSA(const Symbol &symbol) {
69     auto it{GetContext().objectWithDSA.find(&symbol)};
70     return it != GetContext().objectWithDSA.end();
71   }
72   void SetContextAssociatedLoopLevel(std::int64_t level) {
73     GetContext().associatedLoopLevel = level;
74   }
75   Symbol &MakeAssocSymbol(const SourceName &name, Symbol &prev, Scope &scope) {
76     const auto pair{scope.try_emplace(name, Attrs{}, HostAssocDetails{prev})};
77     return *pair.first->second;
78   }
79   Symbol &MakeAssocSymbol(const SourceName &name, Symbol &prev) {
80     return MakeAssocSymbol(name, prev, currScope());
81   }
82   static const parser::Name *GetDesignatorNameIfDataRef(
83       const parser::Designator &designator) {
84     const auto *dataRef{std::get_if<parser::DataRef>(&designator.u)};
85     return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
86   }
87   void AddDataSharingAttributeObject(SymbolRef object) {
88     dataSharingAttributeObjects_.insert(object);
89   }
90   void ClearDataSharingAttributeObjects() {
91     dataSharingAttributeObjects_.clear();
92   }
93   bool HasDataSharingAttributeObject(const Symbol &);
94   const parser::Name &GetLoopIndex(const parser::DoConstruct &);
95   const parser::DoConstruct *GetDoConstructIf(
96       const parser::ExecutionPartConstruct &);
97   Symbol *DeclarePrivateAccessEntity(
98       const parser::Name &, Symbol::Flag, Scope &);
99   Symbol *DeclarePrivateAccessEntity(Symbol &, Symbol::Flag, Scope &);
100   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
101 
102   SymbolSet dataSharingAttributeObjects_; // on one directive
103   SemanticsContext &context_;
104   std::vector<DirContext> dirContext_; // used as a stack
105 };
106 
107 class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
108 public:
109   explicit AccAttributeVisitor(SemanticsContext &context)
110       : DirectiveAttributeVisitor(context) {}
111 
112   template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
113   template <typename A> bool Pre(const A &) { return true; }
114   template <typename A> void Post(const A &) {}
115 
116   bool Pre(const parser::SpecificationPart &x) {
117     Walk(std::get<std::list<parser::OpenACCDeclarativeConstruct>>(x.t));
118     return false;
119   }
120 
121   bool Pre(const parser::OpenACCBlockConstruct &);
122   void Post(const parser::OpenACCBlockConstruct &) { PopContext(); }
123   bool Pre(const parser::OpenACCCombinedConstruct &);
124   void Post(const parser::OpenACCCombinedConstruct &) { PopContext(); }
125 
126   void Post(const parser::AccBeginBlockDirective &) {
127     GetContext().withinConstruct = true;
128   }
129 
130   bool Pre(const parser::OpenACCLoopConstruct &);
131   void Post(const parser::OpenACCLoopConstruct &) { PopContext(); }
132   void Post(const parser::AccLoopDirective &) {
133     GetContext().withinConstruct = true;
134   }
135 
136   bool Pre(const parser::OpenACCStandaloneConstruct &);
137   void Post(const parser::OpenACCStandaloneConstruct &) { PopContext(); }
138   void Post(const parser::AccStandaloneDirective &) {
139     GetContext().withinConstruct = true;
140   }
141 
142   void Post(const parser::AccDefaultClause &);
143 
144   bool Pre(const parser::AccClause::Copy &x) {
145     ResolveAccObjectList(x.v, Symbol::Flag::AccCopyIn);
146     ResolveAccObjectList(x.v, Symbol::Flag::AccCopyOut);
147     return false;
148   }
149 
150   bool Pre(const parser::AccClause::Create &x) {
151     const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
152     ResolveAccObjectList(objectList, Symbol::Flag::AccCreate);
153     return false;
154   }
155 
156   bool Pre(const parser::AccClause::Copyin &x) {
157     const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
158     ResolveAccObjectList(objectList, Symbol::Flag::AccCopyIn);
159     return false;
160   }
161 
162   bool Pre(const parser::AccClause::Copyout &x) {
163     const auto &objectList{std::get<parser::AccObjectList>(x.v.t)};
164     ResolveAccObjectList(objectList, Symbol::Flag::AccCopyOut);
165     return false;
166   }
167 
168   bool Pre(const parser::AccClause::Present &x) {
169     ResolveAccObjectList(x.v, Symbol::Flag::AccPresent);
170     return false;
171   }
172   bool Pre(const parser::AccClause::Private &x) {
173     ResolveAccObjectList(x.v, Symbol::Flag::AccPrivate);
174     return false;
175   }
176   bool Pre(const parser::AccClause::FirstPrivate &x) {
177     ResolveAccObjectList(x.v, Symbol::Flag::AccFirstPrivate);
178     return false;
179   }
180 
181   void Post(const parser::Name &);
182 
183 private:
184   std::int64_t GetAssociatedLoopLevelFromClauses(const parser::AccClauseList &);
185 
186   static constexpr Symbol::Flags dataSharingAttributeFlags{
187       Symbol::Flag::AccShared, Symbol::Flag::AccPrivate,
188       Symbol::Flag::AccPresent, Symbol::Flag::AccFirstPrivate,
189       Symbol::Flag::AccReduction};
190 
191   static constexpr Symbol::Flags dataMappingAttributeFlags{
192       Symbol::Flag::AccCreate, Symbol::Flag::AccCopyIn,
193       Symbol::Flag::AccCopyOut, Symbol::Flag::AccDelete};
194 
195   static constexpr Symbol::Flags accFlagsRequireNewSymbol{
196       Symbol::Flag::AccPrivate, Symbol::Flag::AccFirstPrivate,
197       Symbol::Flag::AccReduction};
198 
199   static constexpr Symbol::Flags accFlagsRequireMark{};
200 
201   void PrivatizeAssociatedLoopIndex(const parser::OpenACCLoopConstruct &);
202   void ResolveAccObjectList(const parser::AccObjectList &, Symbol::Flag);
203   void ResolveAccObject(const parser::AccObject &, Symbol::Flag);
204   Symbol *ResolveAcc(const parser::Name &, Symbol::Flag, Scope &);
205   Symbol *ResolveAcc(Symbol &, Symbol::Flag, Scope &);
206   Symbol *ResolveAccCommonBlockName(const parser::Name *);
207   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
208   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
209   void CheckMultipleAppearances(
210       const parser::Name &, const Symbol &, Symbol::Flag);
211 };
212 
213 // Data-sharing and Data-mapping attributes for data-refs in OpenMP construct
214 class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
215 public:
216   explicit OmpAttributeVisitor(SemanticsContext &context)
217       : DirectiveAttributeVisitor(context) {}
218 
219   template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
220   template <typename A> bool Pre(const A &) { return true; }
221   template <typename A> void Post(const A &) {}
222 
223   bool Pre(const parser::SpecificationPart &x) {
224     Walk(std::get<std::list<parser::OpenMPDeclarativeConstruct>>(x.t));
225     return false;
226   }
227 
228   bool Pre(const parser::OpenMPBlockConstruct &);
229   void Post(const parser::OpenMPBlockConstruct &) { PopContext(); }
230   void Post(const parser::OmpBeginBlockDirective &) {
231     GetContext().withinConstruct = true;
232   }
233 
234   bool Pre(const parser::OpenMPLoopConstruct &);
235   void Post(const parser::OpenMPLoopConstruct &) { PopContext(); }
236   void Post(const parser::OmpBeginLoopDirective &) {
237     GetContext().withinConstruct = true;
238   }
239   bool Pre(const parser::DoConstruct &);
240 
241   bool Pre(const parser::OpenMPSectionsConstruct &);
242   void Post(const parser::OpenMPSectionsConstruct &) { PopContext(); }
243 
244   bool Pre(const parser::OpenMPThreadprivate &);
245   void Post(const parser::OpenMPThreadprivate &) { PopContext(); }
246 
247   // 2.15.3 Data-Sharing Attribute Clauses
248   void Post(const parser::OmpDefaultClause &);
249   bool Pre(const parser::OmpClause::Shared &x) {
250     ResolveOmpObjectList(x.v, Symbol::Flag::OmpShared);
251     return false;
252   }
253   bool Pre(const parser::OmpClause::Private &x) {
254     ResolveOmpObjectList(x.v, Symbol::Flag::OmpPrivate);
255     return false;
256   }
257   bool Pre(const parser::OmpClause::Firstprivate &x) {
258     ResolveOmpObjectList(x.v, Symbol::Flag::OmpFirstPrivate);
259     return false;
260   }
261   bool Pre(const parser::OmpClause::Lastprivate &x) {
262     ResolveOmpObjectList(x.v, Symbol::Flag::OmpLastPrivate);
263     return false;
264   }
265 
266   void Post(const parser::Name &);
267 
268 private:
269   std::int64_t GetAssociatedLoopLevelFromClauses(const parser::OmpClauseList &);
270 
271   static constexpr Symbol::Flags dataSharingAttributeFlags{
272       Symbol::Flag::OmpShared, Symbol::Flag::OmpPrivate,
273       Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
274       Symbol::Flag::OmpReduction, Symbol::Flag::OmpLinear};
275 
276   static constexpr Symbol::Flags ompFlagsRequireNewSymbol{
277       Symbol::Flag::OmpPrivate, Symbol::Flag::OmpLinear,
278       Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
279       Symbol::Flag::OmpReduction};
280 
281   static constexpr Symbol::Flags ompFlagsRequireMark{
282       Symbol::Flag::OmpThreadprivate};
283 
284   // Predetermined DSA rules
285   void PrivatizeAssociatedLoopIndex(const parser::OpenMPLoopConstruct &);
286   void ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name &);
287 
288   void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag);
289   void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag);
290   Symbol *ResolveOmp(const parser::Name &, Symbol::Flag, Scope &);
291   Symbol *ResolveOmp(Symbol &, Symbol::Flag, Scope &);
292   Symbol *ResolveOmpCommonBlockName(const parser::Name *);
293   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
294   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
295   void CheckMultipleAppearances(
296       const parser::Name &, const Symbol &, Symbol::Flag);
297 };
298 
299 template <typename T>
300 bool DirectiveAttributeVisitor<T>::HasDataSharingAttributeObject(
301     const Symbol &object) {
302   auto it{dataSharingAttributeObjects_.find(object)};
303   return it != dataSharingAttributeObjects_.end();
304 }
305 
306 template <typename T>
307 const parser::Name &DirectiveAttributeVisitor<T>::GetLoopIndex(
308     const parser::DoConstruct &x) {
309   using Bounds = parser::LoopControl::Bounds;
310   return std::get<Bounds>(x.GetLoopControl()->u).name.thing;
311 }
312 
313 template <typename T>
314 const parser::DoConstruct *DirectiveAttributeVisitor<T>::GetDoConstructIf(
315     const parser::ExecutionPartConstruct &x) {
316   return parser::Unwrap<parser::DoConstruct>(x);
317 }
318 
319 template <typename T>
320 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity(
321     const parser::Name &name, Symbol::Flag flag, Scope &scope) {
322   if (!name.symbol) {
323     return nullptr; // not resolved by Name Resolution step, do nothing
324   }
325   name.symbol = DeclarePrivateAccessEntity(*name.symbol, flag, scope);
326   return name.symbol;
327 }
328 
329 template <typename T>
330 Symbol *DirectiveAttributeVisitor<T>::DeclarePrivateAccessEntity(
331     Symbol &object, Symbol::Flag flag, Scope &scope) {
332   if (object.owner() != currScope()) {
333     auto &symbol{MakeAssocSymbol(object.name(), object, scope)};
334     symbol.set(flag);
335     return &symbol;
336   } else {
337     object.set(flag);
338     return &object;
339   }
340 }
341 
342 bool AccAttributeVisitor::Pre(const parser::OpenACCBlockConstruct &x) {
343   const auto &beginBlockDir{std::get<parser::AccBeginBlockDirective>(x.t)};
344   const auto &blockDir{std::get<parser::AccBlockDirective>(beginBlockDir.t)};
345   switch (blockDir.v) {
346   case llvm::acc::Directive::ACCD_data:
347   case llvm::acc::Directive::ACCD_host_data:
348   case llvm::acc::Directive::ACCD_kernels:
349   case llvm::acc::Directive::ACCD_parallel:
350   case llvm::acc::Directive::ACCD_serial:
351     PushContext(blockDir.source, blockDir.v);
352     break;
353   default:
354     break;
355   }
356   ClearDataSharingAttributeObjects();
357   return true;
358 }
359 
360 bool AccAttributeVisitor::Pre(const parser::OpenACCLoopConstruct &x) {
361   const auto &beginDir{std::get<parser::AccBeginLoopDirective>(x.t)};
362   const auto &loopDir{std::get<parser::AccLoopDirective>(beginDir.t)};
363   const auto &clauseList{std::get<parser::AccClauseList>(beginDir.t)};
364   if (loopDir.v == llvm::acc::Directive::ACCD_loop) {
365     PushContext(loopDir.source, loopDir.v);
366   }
367   ClearDataSharingAttributeObjects();
368   SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
369   PrivatizeAssociatedLoopIndex(x);
370   return true;
371 }
372 
373 bool AccAttributeVisitor::Pre(const parser::OpenACCStandaloneConstruct &x) {
374   const auto &standaloneDir{std::get<parser::AccStandaloneDirective>(x.t)};
375   switch (standaloneDir.v) {
376   case llvm::acc::Directive::ACCD_cache:
377   case llvm::acc::Directive::ACCD_enter_data:
378   case llvm::acc::Directive::ACCD_exit_data:
379   case llvm::acc::Directive::ACCD_init:
380   case llvm::acc::Directive::ACCD_set:
381   case llvm::acc::Directive::ACCD_shutdown:
382   case llvm::acc::Directive::ACCD_update:
383     PushContext(standaloneDir.source, standaloneDir.v);
384     break;
385   default:
386     break;
387   }
388   ClearDataSharingAttributeObjects();
389   return true;
390 }
391 
392 bool AccAttributeVisitor::Pre(const parser::OpenACCCombinedConstruct &x) {
393   const auto &beginBlockDir{std::get<parser::AccBeginCombinedDirective>(x.t)};
394   const auto &combinedDir{
395       std::get<parser::AccCombinedDirective>(beginBlockDir.t)};
396   switch (combinedDir.v) {
397   case llvm::acc::Directive::ACCD_kernels_loop:
398   case llvm::acc::Directive::ACCD_parallel_loop:
399   case llvm::acc::Directive::ACCD_serial_loop:
400     PushContext(combinedDir.source, combinedDir.v);
401     break;
402   default:
403     break;
404   }
405   ClearDataSharingAttributeObjects();
406   return true;
407 }
408 
409 std::int64_t AccAttributeVisitor::GetAssociatedLoopLevelFromClauses(
410     const parser::AccClauseList &x) {
411   std::int64_t collapseLevel{0};
412   for (const auto &clause : x.v) {
413     if (const auto *collapseClause{
414             std::get_if<parser::AccClause::Collapse>(&clause.u)}) {
415       if (const auto v{EvaluateInt64(context_, collapseClause->v)}) {
416         collapseLevel = *v;
417       }
418     }
419   }
420 
421   if (collapseLevel) {
422     return collapseLevel;
423   }
424   return 1; // default is outermost loop
425 }
426 
427 void AccAttributeVisitor::PrivatizeAssociatedLoopIndex(
428     const parser::OpenACCLoopConstruct &x) {
429   std::int64_t level{GetContext().associatedLoopLevel};
430   if (level <= 0) { // collpase value was negative or 0
431     return;
432   }
433   Symbol::Flag ivDSA{Symbol::Flag::AccPrivate};
434 
435   const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
436   for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) {
437     // go through all the nested do-loops and resolve index variables
438     const parser::Name &iv{GetLoopIndex(*loop)};
439     if (auto *symbol{ResolveAcc(iv, ivDSA, currScope())}) {
440       symbol->set(Symbol::Flag::AccPreDetermined);
441       iv.symbol = symbol; // adjust the symbol within region
442       AddToContextObjectWithDSA(*symbol, ivDSA);
443     }
444 
445     const auto &block{std::get<parser::Block>(loop->t)};
446     const auto it{block.begin()};
447     loop = it != block.end() ? GetDoConstructIf(*it) : nullptr;
448   }
449   CHECK(level == 0);
450 }
451 
452 void AccAttributeVisitor::Post(const parser::AccDefaultClause &x) {
453   if (!dirContext_.empty()) {
454     switch (x.v) {
455     case parser::AccDefaultClause::Arg::Present:
456       SetContextDefaultDSA(Symbol::Flag::AccPresent);
457       break;
458     case parser::AccDefaultClause::Arg::None:
459       SetContextDefaultDSA(Symbol::Flag::AccNone);
460       break;
461     }
462   }
463 }
464 
465 // For OpenACC constructs, check all the data-refs within the constructs
466 // and adjust the symbol for each Name if necessary
467 void AccAttributeVisitor::Post(const parser::Name &name) {
468   auto *symbol{name.symbol};
469   if (symbol && !dirContext_.empty() && GetContext().withinConstruct) {
470     if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() &&
471         !IsObjectWithDSA(*symbol)) {
472       if (Symbol * found{currScope().FindSymbol(name.source)}) {
473         if (symbol != found) {
474           name.symbol = found; // adjust the symbol within region
475         } else if (GetContext().defaultDSA == Symbol::Flag::AccNone) {
476           // 2.5.14.
477           context_.Say(name.source,
478               "The DEFAULT(NONE) clause requires that '%s' must be listed in "
479               "a data-mapping clause"_err_en_US,
480               symbol->name());
481         }
482       }
483     }
484   } // within OpenACC construct
485 }
486 
487 Symbol *AccAttributeVisitor::ResolveAccCommonBlockName(
488     const parser::Name *name) {
489   if (!name) {
490     return nullptr;
491   } else if (auto *prev{
492                  GetContext().scope.parent().FindCommonBlock(name->source)}) {
493     name->symbol = prev;
494     return prev;
495   } else {
496     return nullptr;
497   }
498 }
499 
500 void AccAttributeVisitor::ResolveAccObjectList(
501     const parser::AccObjectList &accObjectList, Symbol::Flag accFlag) {
502   for (const auto &accObject : accObjectList.v) {
503     ResolveAccObject(accObject, accFlag);
504   }
505 }
506 
507 void AccAttributeVisitor::ResolveAccObject(
508     const parser::AccObject &accObject, Symbol::Flag accFlag) {
509   std::visit(
510       common::visitors{
511           [&](const parser::Designator &designator) {
512             if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
513               if (auto *symbol{ResolveAcc(*name, accFlag, currScope())}) {
514                 AddToContextObjectWithDSA(*symbol, accFlag);
515                 if (dataSharingAttributeFlags.test(accFlag)) {
516                   CheckMultipleAppearances(*name, *symbol, accFlag);
517                 }
518               }
519             } else {
520               // Array sections to be changed to substrings as needed
521               if (AnalyzeExpr(context_, designator)) {
522                 if (std::holds_alternative<parser::Substring>(designator.u)) {
523                   context_.Say(designator.source,
524                       "Substrings are not allowed on OpenACC "
525                       "directives or clauses"_err_en_US);
526                 }
527               }
528               // other checks, more TBD
529             }
530           },
531           [&](const parser::Name &name) { // common block
532             if (auto *symbol{ResolveAccCommonBlockName(&name)}) {
533               CheckMultipleAppearances(
534                   name, *symbol, Symbol::Flag::AccCommonBlock);
535               for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
536                 if (auto *resolvedObject{
537                         ResolveAcc(*object, accFlag, currScope())}) {
538                   AddToContextObjectWithDSA(*resolvedObject, accFlag);
539                 }
540               }
541             } else {
542               context_.Say(name.source,
543                   "COMMON block must be declared in the same scoping unit "
544                   "in which the OpenACC directive or clause appears"_err_en_US);
545             }
546           },
547       },
548       accObject.u);
549 }
550 
551 Symbol *AccAttributeVisitor::ResolveAcc(
552     const parser::Name &name, Symbol::Flag accFlag, Scope &scope) {
553   if (accFlagsRequireNewSymbol.test(accFlag)) {
554     return DeclarePrivateAccessEntity(name, accFlag, scope);
555   } else {
556     return DeclareOrMarkOtherAccessEntity(name, accFlag);
557   }
558 }
559 
560 Symbol *AccAttributeVisitor::ResolveAcc(
561     Symbol &symbol, Symbol::Flag accFlag, Scope &scope) {
562   if (accFlagsRequireNewSymbol.test(accFlag)) {
563     return DeclarePrivateAccessEntity(symbol, accFlag, scope);
564   } else {
565     return DeclareOrMarkOtherAccessEntity(symbol, accFlag);
566   }
567 }
568 
569 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
570     const parser::Name &name, Symbol::Flag accFlag) {
571   Symbol *prev{currScope().FindSymbol(name.source)};
572   if (!name.symbol || !prev) {
573     return nullptr;
574   } else if (prev != name.symbol) {
575     name.symbol = prev;
576   }
577   return DeclareOrMarkOtherAccessEntity(*prev, accFlag);
578 }
579 
580 Symbol *AccAttributeVisitor::DeclareOrMarkOtherAccessEntity(
581     Symbol &object, Symbol::Flag accFlag) {
582   if (accFlagsRequireMark.test(accFlag)) {
583     object.set(accFlag);
584   }
585   return &object;
586 }
587 
588 static bool WithMultipleAppearancesAccException(
589     const Symbol &symbol, Symbol::Flag flag) {
590   return false; // Place holder
591 }
592 
593 void AccAttributeVisitor::CheckMultipleAppearances(
594     const parser::Name &name, const Symbol &symbol, Symbol::Flag accFlag) {
595   const auto *target{&symbol};
596   if (accFlagsRequireNewSymbol.test(accFlag)) {
597     if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
598       target = &details->symbol();
599     }
600   }
601   if (HasDataSharingAttributeObject(*target) &&
602       !WithMultipleAppearancesAccException(symbol, accFlag)) {
603     context_.Say(name.source,
604         "'%s' appears in more than one data-sharing clause "
605         "on the same OpenACC directive"_err_en_US,
606         name.ToString());
607   } else {
608     AddDataSharingAttributeObject(*target);
609   }
610 }
611 
612 bool OmpAttributeVisitor::Pre(const parser::OpenMPBlockConstruct &x) {
613   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
614   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
615   switch (beginDir.v) {
616   case llvm::omp::Directive::OMPD_master:
617   case llvm::omp::Directive::OMPD_ordered:
618   case llvm::omp::Directive::OMPD_parallel:
619   case llvm::omp::Directive::OMPD_single:
620   case llvm::omp::Directive::OMPD_target:
621   case llvm::omp::Directive::OMPD_target_data:
622   case llvm::omp::Directive::OMPD_task:
623   case llvm::omp::Directive::OMPD_teams:
624   case llvm::omp::Directive::OMPD_workshare:
625   case llvm::omp::Directive::OMPD_parallel_workshare:
626   case llvm::omp::Directive::OMPD_target_teams:
627   case llvm::omp::Directive::OMPD_target_parallel:
628     PushContext(beginDir.source, beginDir.v);
629     break;
630   default:
631     // TODO others
632     break;
633   }
634   ClearDataSharingAttributeObjects();
635   return true;
636 }
637 
638 bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) {
639   const auto &beginLoopDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
640   const auto &beginDir{std::get<parser::OmpLoopDirective>(beginLoopDir.t)};
641   const auto &clauseList{std::get<parser::OmpClauseList>(beginLoopDir.t)};
642   switch (beginDir.v) {
643   case llvm::omp::Directive::OMPD_distribute:
644   case llvm::omp::Directive::OMPD_distribute_parallel_do:
645   case llvm::omp::Directive::OMPD_distribute_parallel_do_simd:
646   case llvm::omp::Directive::OMPD_distribute_simd:
647   case llvm::omp::Directive::OMPD_do:
648   case llvm::omp::Directive::OMPD_do_simd:
649   case llvm::omp::Directive::OMPD_parallel_do:
650   case llvm::omp::Directive::OMPD_parallel_do_simd:
651   case llvm::omp::Directive::OMPD_simd:
652   case llvm::omp::Directive::OMPD_target_parallel_do:
653   case llvm::omp::Directive::OMPD_target_parallel_do_simd:
654   case llvm::omp::Directive::OMPD_target_teams_distribute:
655   case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do:
656   case llvm::omp::Directive::OMPD_target_teams_distribute_parallel_do_simd:
657   case llvm::omp::Directive::OMPD_target_teams_distribute_simd:
658   case llvm::omp::Directive::OMPD_target_simd:
659   case llvm::omp::Directive::OMPD_taskloop:
660   case llvm::omp::Directive::OMPD_taskloop_simd:
661   case llvm::omp::Directive::OMPD_teams_distribute:
662   case llvm::omp::Directive::OMPD_teams_distribute_parallel_do:
663   case llvm::omp::Directive::OMPD_teams_distribute_parallel_do_simd:
664   case llvm::omp::Directive::OMPD_teams_distribute_simd:
665     PushContext(beginDir.source, beginDir.v);
666     break;
667   default:
668     break;
669   }
670   ClearDataSharingAttributeObjects();
671   SetContextAssociatedLoopLevel(GetAssociatedLoopLevelFromClauses(clauseList));
672   PrivatizeAssociatedLoopIndex(x);
673   return true;
674 }
675 
676 void OmpAttributeVisitor::ResolveSeqLoopIndexInParallelOrTaskConstruct(
677     const parser::Name &iv) {
678   auto targetIt{dirContext_.rbegin()};
679   for (;; ++targetIt) {
680     if (targetIt == dirContext_.rend()) {
681       return;
682     }
683     if (llvm::omp::parallelSet.test(targetIt->directive) ||
684         llvm::omp::taskGeneratingSet.test(targetIt->directive)) {
685       break;
686     }
687   }
688   if (auto *symbol{ResolveOmp(iv, Symbol::Flag::OmpPrivate, targetIt->scope)}) {
689     targetIt++;
690     symbol->set(Symbol::Flag::OmpPreDetermined);
691     iv.symbol = symbol; // adjust the symbol within region
692     for (auto it{dirContext_.rbegin()}; it != targetIt; ++it) {
693       AddToContextObjectWithDSA(*symbol, Symbol::Flag::OmpPrivate, *it);
694     }
695   }
696 }
697 
698 // 2.15.1.1 Data-sharing Attribute Rules - Predetermined
699 //   - A loop iteration variable for a sequential loop in a parallel
700 //     or task generating construct is private in the innermost such
701 //     construct that encloses the loop
702 bool OmpAttributeVisitor::Pre(const parser::DoConstruct &x) {
703   if (!dirContext_.empty() && GetContext().withinConstruct) {
704     if (const auto &iv{GetLoopIndex(x)}; iv.symbol) {
705       if (!iv.symbol->test(Symbol::Flag::OmpPreDetermined)) {
706         ResolveSeqLoopIndexInParallelOrTaskConstruct(iv);
707       } else {
708         // TODO: conflict checks with explicitly determined DSA
709       }
710     }
711   }
712   return true;
713 }
714 
715 std::int64_t OmpAttributeVisitor::GetAssociatedLoopLevelFromClauses(
716     const parser::OmpClauseList &x) {
717   std::int64_t orderedLevel{0};
718   std::int64_t collapseLevel{0};
719   for (const auto &clause : x.v) {
720     if (const auto *orderedClause{
721             std::get_if<parser::OmpClause::Ordered>(&clause.u)}) {
722       if (const auto v{EvaluateInt64(context_, orderedClause->v)}) {
723         orderedLevel = *v;
724       }
725     }
726     if (const auto *collapseClause{
727             std::get_if<parser::OmpClause::Collapse>(&clause.u)}) {
728       if (const auto v{EvaluateInt64(context_, collapseClause->v)}) {
729         collapseLevel = *v;
730       }
731     }
732   }
733 
734   if (orderedLevel && (!collapseLevel || orderedLevel >= collapseLevel)) {
735     return orderedLevel;
736   } else if (!orderedLevel && collapseLevel) {
737     return collapseLevel;
738   } // orderedLevel < collapseLevel is an error handled in structural checks
739   return 1; // default is outermost loop
740 }
741 
742 // 2.15.1.1 Data-sharing Attribute Rules - Predetermined
743 //   - The loop iteration variable(s) in the associated do-loop(s) of a do,
744 //     parallel do, taskloop, or distribute construct is (are) private.
745 //   - The loop iteration variable in the associated do-loop of a simd construct
746 //     with just one associated do-loop is linear with a linear-step that is the
747 //     increment of the associated do-loop.
748 //   - The loop iteration variables in the associated do-loops of a simd
749 //     construct with multiple associated do-loops are lastprivate.
750 //
751 // TODO: revisit after semantics checks are completed for do-loop association of
752 //       collapse and ordered
753 void OmpAttributeVisitor::PrivatizeAssociatedLoopIndex(
754     const parser::OpenMPLoopConstruct &x) {
755   std::int64_t level{GetContext().associatedLoopLevel};
756   if (level <= 0) {
757     return;
758   }
759   Symbol::Flag ivDSA;
760   if (!llvm::omp::simdSet.test(GetContext().directive)) {
761     ivDSA = Symbol::Flag::OmpPrivate;
762   } else if (level == 1) {
763     ivDSA = Symbol::Flag::OmpLinear;
764   } else {
765     ivDSA = Symbol::Flag::OmpLastPrivate;
766   }
767 
768   const auto &outer{std::get<std::optional<parser::DoConstruct>>(x.t)};
769   for (const parser::DoConstruct *loop{&*outer}; loop && level > 0; --level) {
770     // go through all the nested do-loops and resolve index variables
771     const parser::Name &iv{GetLoopIndex(*loop)};
772     if (auto *symbol{ResolveOmp(iv, ivDSA, currScope())}) {
773       symbol->set(Symbol::Flag::OmpPreDetermined);
774       iv.symbol = symbol; // adjust the symbol within region
775       AddToContextObjectWithDSA(*symbol, ivDSA);
776     }
777 
778     const auto &block{std::get<parser::Block>(loop->t)};
779     const auto it{block.begin()};
780     loop = it != block.end() ? GetDoConstructIf(*it) : nullptr;
781   }
782   CHECK(level == 0);
783 }
784 
785 bool OmpAttributeVisitor::Pre(const parser::OpenMPSectionsConstruct &x) {
786   const auto &beginSectionsDir{
787       std::get<parser::OmpBeginSectionsDirective>(x.t)};
788   const auto &beginDir{
789       std::get<parser::OmpSectionsDirective>(beginSectionsDir.t)};
790   switch (beginDir.v) {
791   case llvm::omp::Directive::OMPD_parallel_sections:
792   case llvm::omp::Directive::OMPD_sections:
793     PushContext(beginDir.source, beginDir.v);
794     break;
795   default:
796     break;
797   }
798   ClearDataSharingAttributeObjects();
799   return true;
800 }
801 
802 bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
803   PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate);
804   const auto &list{std::get<parser::OmpObjectList>(x.t)};
805   ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate);
806   return false;
807 }
808 
809 void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) {
810   if (!dirContext_.empty()) {
811     switch (x.v) {
812     case parser::OmpDefaultClause::Type::Private:
813       SetContextDefaultDSA(Symbol::Flag::OmpPrivate);
814       break;
815     case parser::OmpDefaultClause::Type::Firstprivate:
816       SetContextDefaultDSA(Symbol::Flag::OmpFirstPrivate);
817       break;
818     case parser::OmpDefaultClause::Type::Shared:
819       SetContextDefaultDSA(Symbol::Flag::OmpShared);
820       break;
821     case parser::OmpDefaultClause::Type::None:
822       SetContextDefaultDSA(Symbol::Flag::OmpNone);
823       break;
824     }
825   }
826 }
827 
828 // For OpenMP constructs, check all the data-refs within the constructs
829 // and adjust the symbol for each Name if necessary
830 void OmpAttributeVisitor::Post(const parser::Name &name) {
831   auto *symbol{name.symbol};
832   if (symbol && !dirContext_.empty() && GetContext().withinConstruct) {
833     if (!symbol->owner().IsDerivedType() && !symbol->has<ProcEntityDetails>() &&
834         !IsObjectWithDSA(*symbol)) {
835       // TODO: create a separate function to go through the rules for
836       //       predetermined, explicitly determined, and implicitly
837       //       determined data-sharing attributes (2.15.1.1).
838       if (Symbol * found{currScope().FindSymbol(name.source)}) {
839         if (symbol != found) {
840           name.symbol = found; // adjust the symbol within region
841         } else if (GetContext().defaultDSA == Symbol::Flag::OmpNone) {
842           context_.Say(name.source,
843               "The DEFAULT(NONE) clause requires that '%s' must be listed in "
844               "a data-sharing attribute clause"_err_en_US,
845               symbol->name());
846         }
847       }
848     }
849   } // within OpenMP construct
850 }
851 
852 Symbol *OmpAttributeVisitor::ResolveOmpCommonBlockName(
853     const parser::Name *name) {
854   if (auto *prev{name
855               ? GetContext().scope.parent().FindCommonBlock(name->source)
856               : nullptr}) {
857     name->symbol = prev;
858     return prev;
859   } else {
860     return nullptr;
861   }
862 }
863 
864 void OmpAttributeVisitor::ResolveOmpObjectList(
865     const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) {
866   for (const auto &ompObject : ompObjectList.v) {
867     ResolveOmpObject(ompObject, ompFlag);
868   }
869 }
870 
871 void OmpAttributeVisitor::ResolveOmpObject(
872     const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
873   std::visit(
874       common::visitors{
875           [&](const parser::Designator &designator) {
876             if (const auto *name{GetDesignatorNameIfDataRef(designator)}) {
877               if (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) {
878                 AddToContextObjectWithDSA(*symbol, ompFlag);
879                 if (dataSharingAttributeFlags.test(ompFlag)) {
880                   CheckMultipleAppearances(*name, *symbol, ompFlag);
881                 }
882               }
883             } else {
884               // Array sections to be changed to substrings as needed
885               if (AnalyzeExpr(context_, designator)) {
886                 if (std::holds_alternative<parser::Substring>(designator.u)) {
887                   context_.Say(designator.source,
888                       "Substrings are not allowed on OpenMP "
889                       "directives or clauses"_err_en_US);
890                 }
891               }
892               // other checks, more TBD
893             }
894           },
895           [&](const parser::Name &name) { // common block
896             if (auto *symbol{ResolveOmpCommonBlockName(&name)}) {
897               CheckMultipleAppearances(
898                   name, *symbol, Symbol::Flag::OmpCommonBlock);
899               // 2.15.3 When a named common block appears in a list, it has the
900               // same meaning as if every explicit member of the common block
901               // appeared in the list
902               for (auto &object : symbol->get<CommonBlockDetails>().objects()) {
903                 if (auto *resolvedObject{
904                         ResolveOmp(*object, ompFlag, currScope())}) {
905                   AddToContextObjectWithDSA(*resolvedObject, ompFlag);
906                 }
907               }
908             } else {
909               context_.Say(name.source, // 2.15.3
910                   "COMMON block must be declared in the same scoping unit "
911                   "in which the OpenMP directive or clause appears"_err_en_US);
912             }
913           },
914       },
915       ompObject.u);
916 }
917 
918 Symbol *OmpAttributeVisitor::ResolveOmp(
919     const parser::Name &name, Symbol::Flag ompFlag, Scope &scope) {
920   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
921     return DeclarePrivateAccessEntity(name, ompFlag, scope);
922   } else {
923     return DeclareOrMarkOtherAccessEntity(name, ompFlag);
924   }
925 }
926 
927 Symbol *OmpAttributeVisitor::ResolveOmp(
928     Symbol &symbol, Symbol::Flag ompFlag, Scope &scope) {
929   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
930     return DeclarePrivateAccessEntity(symbol, ompFlag, scope);
931   } else {
932     return DeclareOrMarkOtherAccessEntity(symbol, ompFlag);
933   }
934 }
935 
936 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
937     const parser::Name &name, Symbol::Flag ompFlag) {
938   Symbol *prev{currScope().FindSymbol(name.source)};
939   if (!name.symbol || !prev) {
940     return nullptr;
941   } else if (prev != name.symbol) {
942     name.symbol = prev;
943   }
944   return DeclareOrMarkOtherAccessEntity(*prev, ompFlag);
945 }
946 
947 Symbol *OmpAttributeVisitor::DeclareOrMarkOtherAccessEntity(
948     Symbol &object, Symbol::Flag ompFlag) {
949   if (ompFlagsRequireMark.test(ompFlag)) {
950     object.set(ompFlag);
951   }
952   return &object;
953 }
954 
955 static bool WithMultipleAppearancesOmpException(
956     const Symbol &symbol, Symbol::Flag flag) {
957   return (flag == Symbol::Flag::OmpFirstPrivate &&
958              symbol.test(Symbol::Flag::OmpLastPrivate)) ||
959       (flag == Symbol::Flag::OmpLastPrivate &&
960           symbol.test(Symbol::Flag::OmpFirstPrivate));
961 }
962 
963 void OmpAttributeVisitor::CheckMultipleAppearances(
964     const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
965   const auto *target{&symbol};
966   if (ompFlagsRequireNewSymbol.test(ompFlag)) {
967     if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
968       target = &details->symbol();
969     }
970   }
971   if (HasDataSharingAttributeObject(*target) &&
972       !WithMultipleAppearancesOmpException(symbol, ompFlag)) {
973     context_.Say(name.source,
974         "'%s' appears in more than one data-sharing clause "
975         "on the same OpenMP directive"_err_en_US,
976         name.ToString());
977   } else {
978     AddDataSharingAttributeObject(*target);
979   }
980 }
981 
982 void ResolveAccParts(
983     SemanticsContext &context, const parser::ProgramUnit &node) {
984   if (context.IsEnabled(common::LanguageFeature::OpenACC)) {
985     AccAttributeVisitor{context}.Walk(node);
986   }
987 }
988 
989 void ResolveOmpParts(
990     SemanticsContext &context, const parser::ProgramUnit &node) {
991   if (context.IsEnabled(common::LanguageFeature::OpenMP)) {
992     OmpAttributeVisitor{context}.Walk(node);
993     if (!context.AnyFatalError()) {
994       // The data-sharing attribute of the loop iteration variable for a
995       // sequential loop (2.15.1.1) can only be determined when visiting
996       // the corresponding DoConstruct, a second walk is to adjust the
997       // symbols for all the data-refs of that loop iteration variable
998       // prior to the DoConstruct.
999       OmpAttributeVisitor{context}.Walk(node);
1000     }
1001   }
1002 }
1003 
1004 } // namespace Fortran::semantics
1005