1 //===-- lib/Semantics/check-directive-structure.h ---------------*- C++ -*-===//
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 // Directive structure validity checks common to OpenMP, OpenACC and other
10 // directive language.
11 
12 #ifndef FORTRAN_SEMANTICS_CHECK_DIRECTIVE_STRUCTURE_H_
13 #define FORTRAN_SEMANTICS_CHECK_DIRECTIVE_STRUCTURE_H_
14 
15 #include "flang/Common/enum-set.h"
16 #include "flang/Semantics/semantics.h"
17 #include "flang/Semantics/tools.h"
18 #include <unordered_map>
19 
20 namespace Fortran::semantics {
21 
22 template <typename C, std::size_t ClauseEnumSize> struct DirectiveClauses {
23   const common::EnumSet<C, ClauseEnumSize> allowed;
24   const common::EnumSet<C, ClauseEnumSize> allowedOnce;
25   const common::EnumSet<C, ClauseEnumSize> allowedExclusive;
26   const common::EnumSet<C, ClauseEnumSize> requiredOneOf;
27 };
28 
29 // Generic branching checker for invalid branching out of OpenMP/OpenACC
30 // directive.
31 // typename D is the directive enumeration.
32 template <typename D> class NoBranchingEnforce {
33 public:
34   NoBranchingEnforce(SemanticsContext &context,
35       parser::CharBlock sourcePosition, D directive,
36       std::string &&upperCaseDirName)
37       : context_{context}, sourcePosition_{sourcePosition},
38         upperCaseDirName_{std::move(upperCaseDirName)},
39         currentDirective_{directive}, numDoConstruct_{0} {}
40   template <typename T> bool Pre(const T &) { return true; }
41   template <typename T> void Post(const T &) {}
42 
43   template <typename T> bool Pre(const parser::Statement<T> &statement) {
44     currentStatementSourcePosition_ = statement.source;
45     return true;
46   }
47 
48   bool Pre(const parser::DoConstruct &) {
49     numDoConstruct_++;
50     return true;
51   }
52   void Post(const parser::DoConstruct &) { numDoConstruct_--; }
53   void Post(const parser::ReturnStmt &) { EmitBranchOutError("RETURN"); }
54   void Post(const parser::ExitStmt &exitStmt) {
55     if (const auto &exitName{exitStmt.v}) {
56       CheckConstructNameBranching("EXIT", exitName.value());
57     } else {
58       CheckConstructNameBranching("EXIT");
59     }
60   }
61   void Post(const parser::CycleStmt &cycleStmt) {
62     if (const auto &cycleName{cycleStmt.v}) {
63       CheckConstructNameBranching("CYCLE", cycleName.value());
64     } else {
65       switch ((llvm::omp::Directive)currentDirective_) {
66       // exclude directives which do not need a check for unlabelled CYCLES
67       case llvm::omp::Directive::OMPD_do:
68       case llvm::omp::Directive::OMPD_simd:
69       case llvm::omp::Directive::OMPD_parallel_do:
70       case llvm::omp::Directive::OMPD_parallel_do_simd:
71       case llvm::omp::Directive::OMPD_distribute_parallel_do:
72       case llvm::omp::Directive::OMPD_distribute_parallel_do_simd:
73       case llvm::omp::Directive::OMPD_distribute_parallel_for:
74       case llvm::omp::Directive::OMPD_distribute_simd:
75       case llvm::omp::Directive::OMPD_distribute_parallel_for_simd:
76         return;
77       default:
78         break;
79       }
80       CheckConstructNameBranching("CYCLE");
81     }
82   }
83 
84 private:
85   parser::MessageFormattedText GetEnclosingMsg() const {
86     return {"Enclosing %s construct"_en_US, upperCaseDirName_};
87   }
88 
89   void EmitBranchOutError(const char *stmt) const {
90     context_
91         .Say(currentStatementSourcePosition_,
92             "%s statement is not allowed in a %s construct"_err_en_US, stmt,
93             upperCaseDirName_)
94         .Attach(sourcePosition_, GetEnclosingMsg());
95   }
96 
97   inline void EmitUnlabelledBranchOutError(const char *stmt) {
98     context_
99         .Say(currentStatementSourcePosition_,
100             "%s to construct outside of %s construct is not allowed"_err_en_US,
101             stmt, upperCaseDirName_)
102         .Attach(sourcePosition_, GetEnclosingMsg());
103   }
104 
105   void EmitBranchOutErrorWithName(
106       const char *stmt, const parser::Name &toName) const {
107     const std::string branchingToName{toName.ToString()};
108     context_
109         .Say(currentStatementSourcePosition_,
110             "%s to construct '%s' outside of %s construct is not allowed"_err_en_US,
111             stmt, branchingToName, upperCaseDirName_)
112         .Attach(sourcePosition_, GetEnclosingMsg());
113   }
114 
115   // Current semantic checker is not following OpenACC/OpenMP constructs as they
116   // are not Fortran constructs. Hence the ConstructStack doesn't capture
117   // OpenACC/OpenMP constructs. Apply an inverse way to figure out if a
118   // construct-name is branching out of an OpenACC/OpenMP construct. The control
119   // flow goes out of an OpenACC/OpenMP construct, if a construct-name from
120   // statement is found in ConstructStack.
121   void CheckConstructNameBranching(
122       const char *stmt, const parser::Name &stmtName) {
123     const ConstructStack &stack{context_.constructStack()};
124     for (auto iter{stack.cend()}; iter-- != stack.cbegin();) {
125       const ConstructNode &construct{*iter};
126       const auto &constructName{MaybeGetNodeName(construct)};
127       if (constructName) {
128         if (stmtName.source == constructName->source) {
129           EmitBranchOutErrorWithName(stmt, stmtName);
130           return;
131         }
132       }
133     }
134   }
135 
136   // Check branching for unlabelled CYCLES and EXITs
137   void CheckConstructNameBranching(const char *stmt) {
138     // found an enclosing looping construct for the unlabelled EXIT/CYCLE
139     if (numDoConstruct_ > 0) {
140       return;
141     }
142     // did not found an enclosing looping construct within the OpenMP/OpenACC
143     // directive
144     EmitUnlabelledBranchOutError(stmt);
145   }
146 
147   SemanticsContext &context_;
148   parser::CharBlock currentStatementSourcePosition_;
149   parser::CharBlock sourcePosition_;
150   std::string upperCaseDirName_;
151   D currentDirective_;
152   int numDoConstruct_; // tracks number of DoConstruct found AFTER encountering
153                        // an OpenMP/OpenACC directive
154 };
155 
156 // Generic structure checker for directives/clauses language such as OpenMP
157 // and OpenACC.
158 // typename D is the directive enumeration.
159 // tyepname C is the clause enumeration.
160 // typename PC is the parser class defined in parse-tree.h for the clauses.
161 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
162 class DirectiveStructureChecker : public virtual BaseChecker {
163 protected:
164   DirectiveStructureChecker(SemanticsContext &context,
165       std::unordered_map<D, DirectiveClauses<C, ClauseEnumSize>>
166           directiveClausesMap)
167       : context_{context}, directiveClausesMap_(directiveClausesMap) {}
168   virtual ~DirectiveStructureChecker() {}
169 
170   using ClauseMapTy = std::multimap<C, const PC *>;
171   struct DirectiveContext {
172     DirectiveContext(parser::CharBlock source, D d)
173         : directiveSource{source}, directive{d} {}
174 
175     parser::CharBlock directiveSource{nullptr};
176     parser::CharBlock clauseSource{nullptr};
177     D directive;
178     common::EnumSet<C, ClauseEnumSize> allowedClauses{};
179     common::EnumSet<C, ClauseEnumSize> allowedOnceClauses{};
180     common::EnumSet<C, ClauseEnumSize> allowedExclusiveClauses{};
181     common::EnumSet<C, ClauseEnumSize> requiredClauses{};
182 
183     const PC *clause{nullptr};
184     ClauseMapTy clauseInfo;
185     std::list<C> actualClauses;
186     Symbol *loopIV{nullptr};
187   };
188 
189   void SetLoopIv(Symbol *symbol) { GetContext().loopIV = symbol; }
190 
191   // back() is the top of the stack
192   DirectiveContext &GetContext() {
193     CHECK(!dirContext_.empty());
194     return dirContext_.back();
195   }
196 
197   DirectiveContext &GetContextParent() {
198     CHECK(dirContext_.size() >= 2);
199     return dirContext_[dirContext_.size() - 2];
200   }
201 
202   void SetContextClause(const PC &clause) {
203     GetContext().clauseSource = clause.source;
204     GetContext().clause = &clause;
205   }
206 
207   void ResetPartialContext(const parser::CharBlock &source) {
208     CHECK(!dirContext_.empty());
209     SetContextDirectiveSource(source);
210     GetContext().allowedClauses = {};
211     GetContext().allowedOnceClauses = {};
212     GetContext().allowedExclusiveClauses = {};
213     GetContext().requiredClauses = {};
214     GetContext().clauseInfo = {};
215     GetContext().loopIV = {nullptr};
216   }
217 
218   void SetContextDirectiveSource(const parser::CharBlock &directive) {
219     GetContext().directiveSource = directive;
220   }
221 
222   void SetContextDirectiveEnum(D dir) { GetContext().directive = dir; }
223 
224   void SetContextAllowed(const common::EnumSet<C, ClauseEnumSize> &allowed) {
225     GetContext().allowedClauses = allowed;
226   }
227 
228   void SetContextAllowedOnce(
229       const common::EnumSet<C, ClauseEnumSize> &allowedOnce) {
230     GetContext().allowedOnceClauses = allowedOnce;
231   }
232 
233   void SetContextAllowedExclusive(
234       const common::EnumSet<C, ClauseEnumSize> &allowedExclusive) {
235     GetContext().allowedExclusiveClauses = allowedExclusive;
236   }
237 
238   void SetContextRequired(const common::EnumSet<C, ClauseEnumSize> &required) {
239     GetContext().requiredClauses = required;
240   }
241 
242   void SetContextClauseInfo(C type) {
243     GetContext().clauseInfo.emplace(type, GetContext().clause);
244   }
245 
246   void AddClauseToCrtContext(C type) {
247     GetContext().actualClauses.push_back(type);
248   }
249 
250   // Check if the given clause is present in the current context
251   const PC *FindClause(C type) { return FindClause(GetContext(), type); }
252 
253   // Check if the given clause is present in the given context
254   const PC *FindClause(DirectiveContext &context, C type) {
255     auto it{context.clauseInfo.find(type)};
256     if (it != context.clauseInfo.end()) {
257       return it->second;
258     }
259     return nullptr;
260   }
261 
262   // Check if the given clause is present in the parent context
263   const PC *FindClauseParent(C type) {
264     auto it{GetContextParent().clauseInfo.find(type)};
265     if (it != GetContextParent().clauseInfo.end()) {
266       return it->second;
267     }
268     return nullptr;
269   }
270 
271   std::pair<typename ClauseMapTy::iterator, typename ClauseMapTy::iterator>
272   FindClauses(C type) {
273     auto it{GetContext().clauseInfo.equal_range(type)};
274     return it;
275   }
276 
277   DirectiveContext *GetEnclosingDirContext() {
278     CHECK(!dirContext_.empty());
279     auto it{dirContext_.rbegin()};
280     if (++it != dirContext_.rend()) {
281       return &(*it);
282     }
283     return nullptr;
284   }
285 
286   void PushContext(const parser::CharBlock &source, D dir) {
287     dirContext_.emplace_back(source, dir);
288   }
289 
290   DirectiveContext *GetEnclosingContextWithDir(D dir) {
291     CHECK(!dirContext_.empty());
292     auto it{dirContext_.rbegin()};
293     while (++it != dirContext_.rend()) {
294       if (it->directive == dir) {
295         return &(*it);
296       }
297     }
298     return nullptr;
299   }
300 
301   bool CurrentDirectiveIsNested() { return dirContext_.size() > 1; };
302 
303   void SetClauseSets(D dir) {
304     dirContext_.back().allowedClauses = directiveClausesMap_[dir].allowed;
305     dirContext_.back().allowedOnceClauses =
306         directiveClausesMap_[dir].allowedOnce;
307     dirContext_.back().allowedExclusiveClauses =
308         directiveClausesMap_[dir].allowedExclusive;
309     dirContext_.back().requiredClauses =
310         directiveClausesMap_[dir].requiredOneOf;
311   }
312   void PushContextAndClauseSets(const parser::CharBlock &source, D dir) {
313     PushContext(source, dir);
314     SetClauseSets(dir);
315   }
316 
317   void SayNotMatching(const parser::CharBlock &, const parser::CharBlock &);
318 
319   template <typename B> void CheckMatching(const B &beginDir, const B &endDir) {
320     const auto &begin{beginDir.v};
321     const auto &end{endDir.v};
322     if (begin != end) {
323       SayNotMatching(beginDir.source, endDir.source);
324     }
325   }
326   // Check illegal branching out of `Parser::Block` for `Parser::Name` based
327   // nodes (example `Parser::ExitStmt`)
328   void CheckNoBranching(const parser::Block &block, D directive,
329       const parser::CharBlock &directiveSource);
330 
331   // Check that only clauses in set are after the specific clauses.
332   void CheckOnlyAllowedAfter(C clause, common::EnumSet<C, ClauseEnumSize> set);
333 
334   void CheckRequireAtLeastOneOf();
335 
336   void CheckAllowed(C clause);
337 
338   void CheckAtLeastOneClause();
339 
340   void CheckNotAllowedIfClause(
341       C clause, common::EnumSet<C, ClauseEnumSize> set);
342 
343   std::string ContextDirectiveAsFortran();
344 
345   void RequiresConstantPositiveParameter(
346       const C &clause, const parser::ScalarIntConstantExpr &i);
347 
348   void RequiresPositiveParameter(const C &clause,
349       const parser::ScalarIntExpr &i, llvm::StringRef paramName = "parameter");
350 
351   void OptionalConstantPositiveParameter(
352       const C &clause, const std::optional<parser::ScalarIntConstantExpr> &o);
353 
354   virtual llvm::StringRef getClauseName(C clause) { return ""; };
355 
356   virtual llvm::StringRef getDirectiveName(D directive) { return ""; };
357 
358   SemanticsContext &context_;
359   std::vector<DirectiveContext> dirContext_; // used as a stack
360   std::unordered_map<D, DirectiveClauses<C, ClauseEnumSize>>
361       directiveClausesMap_;
362 
363   std::string ClauseSetToString(const common::EnumSet<C, ClauseEnumSize> set);
364 };
365 
366 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
367 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckNoBranching(
368     const parser::Block &block, D directive,
369     const parser::CharBlock &directiveSource) {
370   NoBranchingEnforce<D> noBranchingEnforce{
371       context_, directiveSource, directive, ContextDirectiveAsFortran()};
372   parser::Walk(block, noBranchingEnforce);
373 }
374 
375 // Check that only clauses included in the given set are present after the given
376 // clause.
377 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
378 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckOnlyAllowedAfter(
379     C clause, common::EnumSet<C, ClauseEnumSize> set) {
380   bool enforceCheck = false;
381   for (auto cl : GetContext().actualClauses) {
382     if (cl == clause) {
383       enforceCheck = true;
384       continue;
385     } else if (enforceCheck && !set.test(cl)) {
386       auto parserClause = GetContext().clauseInfo.find(cl);
387       context_.Say(parserClause->second->source,
388           "Clause %s is not allowed after clause %s on the %s "
389           "directive"_err_en_US,
390           parser::ToUpperCaseLetters(getClauseName(cl).str()),
391           parser::ToUpperCaseLetters(getClauseName(clause).str()),
392           ContextDirectiveAsFortran());
393     }
394   }
395 }
396 
397 // Check that at least one clause is attached to the directive.
398 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
399 void DirectiveStructureChecker<D, C, PC,
400     ClauseEnumSize>::CheckAtLeastOneClause() {
401   if (GetContext().actualClauses.empty()) {
402     context_.Say(GetContext().directiveSource,
403         "At least one clause is required on the %s directive"_err_en_US,
404         ContextDirectiveAsFortran());
405   }
406 }
407 
408 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
409 std::string
410 DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::ClauseSetToString(
411     const common::EnumSet<C, ClauseEnumSize> set) {
412   std::string list;
413   set.IterateOverMembers([&](C o) {
414     if (!list.empty())
415       list.append(", ");
416     list.append(parser::ToUpperCaseLetters(getClauseName(o).str()));
417   });
418   return list;
419 }
420 
421 // Check that at least one clause in the required set is present on the
422 // directive.
423 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
424 void DirectiveStructureChecker<D, C, PC,
425     ClauseEnumSize>::CheckRequireAtLeastOneOf() {
426   if (GetContext().requiredClauses.empty())
427     return;
428   for (auto cl : GetContext().actualClauses) {
429     if (GetContext().requiredClauses.test(cl))
430       return;
431   }
432   // No clause matched in the actual clauses list
433   context_.Say(GetContext().directiveSource,
434       "At least one of %s clause must appear on the %s directive"_err_en_US,
435       ClauseSetToString(GetContext().requiredClauses),
436       ContextDirectiveAsFortran());
437 }
438 
439 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
440 std::string DirectiveStructureChecker<D, C, PC,
441     ClauseEnumSize>::ContextDirectiveAsFortran() {
442   return parser::ToUpperCaseLetters(
443       getDirectiveName(GetContext().directive).str());
444 }
445 
446 // Check that clauses present on the directive are allowed clauses.
447 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
448 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckAllowed(
449     C clause) {
450   if (!GetContext().allowedClauses.test(clause) &&
451       !GetContext().allowedOnceClauses.test(clause) &&
452       !GetContext().allowedExclusiveClauses.test(clause) &&
453       !GetContext().requiredClauses.test(clause)) {
454     context_.Say(GetContext().clauseSource,
455         "%s clause is not allowed on the %s directive"_err_en_US,
456         parser::ToUpperCaseLetters(getClauseName(clause).str()),
457         parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
458     return;
459   }
460   if ((GetContext().allowedOnceClauses.test(clause) ||
461           GetContext().allowedExclusiveClauses.test(clause)) &&
462       FindClause(clause)) {
463     context_.Say(GetContext().clauseSource,
464         "At most one %s clause can appear on the %s directive"_err_en_US,
465         parser::ToUpperCaseLetters(getClauseName(clause).str()),
466         parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
467     return;
468   }
469   if (GetContext().allowedExclusiveClauses.test(clause)) {
470     std::vector<C> others;
471     GetContext().allowedExclusiveClauses.IterateOverMembers([&](C o) {
472       if (FindClause(o)) {
473         others.emplace_back(o);
474       }
475     });
476     for (const auto &e : others) {
477       context_.Say(GetContext().clauseSource,
478           "%s and %s clauses are mutually exclusive and may not appear on the "
479           "same %s directive"_err_en_US,
480           parser::ToUpperCaseLetters(getClauseName(clause).str()),
481           parser::ToUpperCaseLetters(getClauseName(e).str()),
482           parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
483     }
484     if (!others.empty()) {
485       return;
486     }
487   }
488   SetContextClauseInfo(clause);
489   AddClauseToCrtContext(clause);
490 }
491 
492 // Enforce restriction where clauses in the given set are not allowed if the
493 // given clause appears.
494 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
495 void DirectiveStructureChecker<D, C, PC,
496     ClauseEnumSize>::CheckNotAllowedIfClause(C clause,
497     common::EnumSet<C, ClauseEnumSize> set) {
498   if (std::find(GetContext().actualClauses.begin(),
499           GetContext().actualClauses.end(),
500           clause) == GetContext().actualClauses.end()) {
501     return; // Clause is not present
502   }
503 
504   for (auto cl : GetContext().actualClauses) {
505     if (set.test(cl)) {
506       context_.Say(GetContext().directiveSource,
507           "Clause %s is not allowed if clause %s appears on the %s directive"_err_en_US,
508           parser::ToUpperCaseLetters(getClauseName(cl).str()),
509           parser::ToUpperCaseLetters(getClauseName(clause).str()),
510           ContextDirectiveAsFortran());
511     }
512   }
513 }
514 
515 // Check the value of the clause is a constant positive integer.
516 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
517 void DirectiveStructureChecker<D, C, PC,
518     ClauseEnumSize>::RequiresConstantPositiveParameter(const C &clause,
519     const parser::ScalarIntConstantExpr &i) {
520   if (const auto v{GetIntValue(i)}) {
521     if (*v <= 0) {
522       context_.Say(GetContext().clauseSource,
523           "The parameter of the %s clause must be "
524           "a constant positive integer expression"_err_en_US,
525           parser::ToUpperCaseLetters(getClauseName(clause).str()));
526     }
527   }
528 }
529 
530 // Check the value of the clause is a constant positive parameter.
531 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
532 void DirectiveStructureChecker<D, C, PC,
533     ClauseEnumSize>::OptionalConstantPositiveParameter(const C &clause,
534     const std::optional<parser::ScalarIntConstantExpr> &o) {
535   if (o != std::nullopt) {
536     RequiresConstantPositiveParameter(clause, o.value());
537   }
538 }
539 
540 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
541 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::SayNotMatching(
542     const parser::CharBlock &beginSource, const parser::CharBlock &endSource) {
543   context_
544       .Say(endSource, "Unmatched %s directive"_err_en_US,
545           parser::ToUpperCaseLetters(endSource.ToString()))
546       .Attach(beginSource, "Does not match directive"_en_US);
547 }
548 
549 // Check the value of the clause is a positive parameter.
550 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
551 void DirectiveStructureChecker<D, C, PC,
552     ClauseEnumSize>::RequiresPositiveParameter(const C &clause,
553     const parser::ScalarIntExpr &i, llvm::StringRef paramName) {
554   if (const auto v{GetIntValue(i)}) {
555     if (*v < 0) {
556       context_.Say(GetContext().clauseSource,
557           "The %s of the %s clause must be "
558           "a positive integer expression"_err_en_US,
559           paramName.str(),
560           parser::ToUpperCaseLetters(getClauseName(clause).str()));
561     }
562   }
563 }
564 
565 } // namespace Fortran::semantics
566 
567 #endif // FORTRAN_SEMANTICS_CHECK_DIRECTIVE_STRUCTURE_H_
568