[flang] [OpenMP] Canonicalization framework (flang-compiler/f18#599)

* [OpenMP] Canonicalization framework

This is mainly designed for loop association work but can be used for others,
and `CanonicalizeOmp` must be after `CanonicalizeDo`.

At the `Block` level, recognize legal sequence of `OpenMPLoopConstruct`,
`DoConstruct`, and `OmpEndLoopDirective`. Move available `DoConstruct`
and optional `OmpEndLoopDirective` into `OpenMPLoopConstruct`. Throw error
messages if:
 1. `DoConstruct` is not following `OpenMPLoopConstruct`
 2. `OmpEndLoopDirective` is not following associated do-loop

Once this pass this done, Semantics will not proceed if error exists.

* Update on reviews

1. extract matching and move part into its own function (once `DoConstruct`
   is moved, see whether `OpenMPEndLoopDirective` is available)

2. Use a template function to access construct from ExecutionPartConstruct.

3. Move this code into namespace semantics

Original-commit: flang-compiler/f18@52979f1e93
Reviewed-on: https://github.com/flang-compiler/f18/pull/599

flang/lib/parser/unparse.cc

@@ -2339,6 +2339,8 @@ public:
     Walk(std::get<OmpBeginLoopDirective>(x.t));
     Put("\n");
     EndOpenMP();
+    Walk(std::get<std::optional<DoConstruct>>(x.t));
+    Walk(std::get<std::optional<OmpEndLoopDirective>>(x.t));
   }
   void Unparse(const BasedPointer &x) {
     Put('('), Walk(std::get<0>(x.t)), Put(","), Walk(std::get<1>(x.t));

flang/lib/semantics/CMakeLists.txt

@@ -16,6 +16,7 @@ add_library(FortranSemantics
   assignment.cc
   attr.cc
   canonicalize-do.cc
+  canonicalize-omp.cc
   check-allocate.cc
   check-arithmeticif.cc
   check-coarray.cc

flang/lib/semantics/canonicalize-omp.cc

@@ -0,0 +1,122 @@
+// Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+//     http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#include "canonicalize-omp.h"
+#include "../parser/parse-tree-visitor.h"
+
+// After Loop Canonicalization, rewrite OpenMP parse tree to make OpenMP
+// Constructs more structured which provide explicit scopes for later
+// structural checks and semantic analysis.
+//   1. move structured DoConstruct and OmpEndLoopDirective into
+//      OpenMPLoopConstruct. Compilation will not proceed in case of errors
+//      after this pass.
+//   2. TBD
+namespace Fortran::semantics {
+
+using namespace parser::literals;
+
+class CanonicalizationOfOmp {
+public:
+  template<typename T> bool Pre(T &) { return true; }
+  template<typename T> void Post(T &) {}
+  CanonicalizationOfOmp(parser::Messages &messages) : messages_{messages} {}
+
+  void Post(parser::Block &block) {
+    for (auto it{block.begin()}; it != block.end(); ++it) {
+      if (auto *ompCons{GetConstructIf<parser::OpenMPConstruct>(*it)}) {
+        // OpenMPLoopConstruct
+        if (auto *ompLoop{
+                std::get_if<parser::OpenMPLoopConstruct>(&ompCons->u)}) {
+          RewriteOpenMPLoopConstruct(*ompLoop, block, it);
+        }
+      } else if (auto *endDir{
+                     GetConstructIf<parser::OmpEndLoopDirective>(*it)}) {
+        // Unmatched OmpEndLoopDirective
+        auto &dir{std::get<parser::OmpLoopDirective>(endDir->t)};
+        messages_.Say(dir.source,
+            "The %s directive must follow the DO loop associated with the "
+            "loop construct"_err_en_US,
+            parser::ToUpperCaseLetters(dir.source.ToString()));
+      }
+    }  // Block list
+  }
+
+private:
+  template<typename T> T *GetConstructIf(parser::ExecutionPartConstruct &x) {
+    if (auto *y{std::get_if<parser::ExecutableConstruct>(&x.u)}) {
+      if (auto *z{std::get_if<common::Indirection<T>>(&y->u)}) {
+        return &z->value();
+      }
+    }
+    return nullptr;
+  }
+
+  void RewriteOpenMPLoopConstruct(parser::OpenMPLoopConstruct &x,
+      parser::Block &block, parser::Block::iterator it) {
+    // Check the sequence of DoConstruct and OmpEndLoopDirective
+    // in the same iteration
+    //
+    // Original:
+    //   ExecutableConstruct -> OpenMPConstruct -> OpenMPLoopConstruct
+    //     OmpBeginLoopDirective
+    //   ExecutableConstruct -> DoConstruct
+    //   ExecutableConstruct -> OmpEndLoopDirective (if available)
+    //
+    // After rewriting:
+    //   ExecutableConstruct -> OpenMPConstruct -> OpenMPLoopConstruct
+    //     OmpBeginLoopDirective
+    //     DoConstruct
+    //     OmpEndLoopDirective (if available)
+    parser::Block::iterator nextIt;
+    auto &beginDir{std::get<parser::OmpBeginLoopDirective>(x.t)};
+    auto &dir{std::get<parser::OmpLoopDirective>(beginDir.t)};
+
+    nextIt = it;
+    if (++nextIt != block.end()) {
+      if (auto *doCons{GetConstructIf<parser::DoConstruct>(*nextIt)}) {
+        if (doCons->GetLoopControl().has_value()) {
+          // move DoConstruct
+          std::get<std::optional<parser::DoConstruct>>(x.t) =
+              std::move(*doCons);
+          nextIt = block.erase(nextIt);
+
+          // try to match OmpEndLoopDirective
+          if (auto *endDir{
+                  GetConstructIf<parser::OmpEndLoopDirective>(*nextIt)}) {
+            std::get<std::optional<parser::OmpEndLoopDirective>>(x.t) =
+                std::move(*endDir);
+            nextIt = block.erase(nextIt);
+          }
+        } else {
+          messages_.Say(dir.source,
+              "DO loop after the %s directive must have loop control"_err_en_US,
+              parser::ToUpperCaseLetters(dir.source.ToString()));
+        }
+        return;  // found do-loop
+      }
+    }
+    messages_.Say(dir.source,
+        "A DO loop must follow the %s directive"_err_en_US,
+        parser::ToUpperCaseLetters(dir.source.ToString()));
+  }
+
+  parser::Messages &messages_;
+};
+
+bool CanonicalizeOmp(parser::Messages &messages, parser::Program &program) {
+  CanonicalizationOfOmp omp{messages};
+  Walk(program, omp);
+  return !messages.AnyFatalError();
+}
+}

flang/lib/semantics/canonicalize-omp.h

@@ -0,0 +1,27 @@
+// Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+//     http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#ifndef FORTRAN_SEMANTICS_CANONICALIZE_OMP_H_
+#define FORTRAN_SEMANTICS_CANONICALIZE_OMP_H_
+
+namespace Fortran::parser {
+struct Program;
+class Messages;
+}
+
+namespace Fortran::semantics {
+bool CanonicalizeOmp(parser::Messages &messages, parser::Program &program);
+}
+
+#endif  // FORTRAN_SEMANTICS_CANONICALIZE_OMP_H_

flang/lib/semantics/semantics.cc

@@ -15,6 +15,7 @@
 #include "semantics.h"
 #include "assignment.h"
 #include "canonicalize-do.h"
+#include "canonicalize-omp.h"
 #include "check-allocate.h"
 #include "check-arithmeticif.h"
 #include "check-coarray.h"
@@ -170,6 +171,7 @@ Scope &SemanticsContext::FindScope(parser::CharBlock source) {
 bool Semantics::Perform() {
   return ValidateLabels(context_, program_) &&
       parser::CanonicalizeDo(program_) &&  // force line break
+      CanonicalizeOmp(context_.messages(), program_) &&
       PerformStatementSemantics(context_, program_) &&
       ModFileWriter{context_}.WriteAll();
 }

flang/test/semantics/CMakeLists.txt

@@ -147,6 +147,7 @@ set(ERROR_TESTS
   expr-errors01.f90
   null01.f90
   omp-clause-validity01.f90
+  omp-loop-association.f90
 #  omp-nested01.f90
   omp-declarative-directive.f90
   omp-atomic.f90

flang/test/semantics/omp-loop-association.f90

@@ -0,0 +1,140 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! OPTIONS: -fopenmp
+
+! Check the association between OpenMPLoopConstruct and DoConstruct
+
+  integer :: b = 128
+  integer :: c = 32
+  integer, parameter :: num = 16
+  N = 1024
+
+! Different DO loops
+
+  !$omp parallel
+  !$omp do
+  do 10 i=1, N
+     a = 3.14
+10   print *, a
+  !$omp end parallel
+
+  !$omp parallel do
+  DO CONCURRENT (i = 1:N)
+     a = 3.14
+  END DO
+
+  !$omp parallel do simd
+  outer: DO WHILE (c > 1)
+     inner: do while (b > 100)
+        a = 3.14
+        b = b - 1
+     enddo inner
+     c = c - 1
+  END DO outer
+
+  c = 16
+  !ERROR: DO loop after the PARALLEL DO directive must have loop control
+  !$omp parallel do
+  do
+     a = 3.14
+     c = c - 1
+     if (c < 1) exit
+  enddo
+
+! Loop association check
+
+  ! If an end do directive follows a do-construct in which several DO
+  ! statements share a DO termination statement, then a do directive
+  ! can only be specified for the outermost of these DO statements.
+  do 100 i=1, N
+     !$omp do
+     do 100 j=1, N
+        a = 3.14
+100     continue
+    !ERROR: The ENDDO directive must follow the DO loop associated with the loop construct
+    !$omp enddo
+
+  !$omp parallel do copyin(a)
+  do i = 1, N
+     !$omp parallel do
+     do j = 1, i
+     enddo
+     !$omp end parallel do
+     a = 3.
+  enddo
+  !$omp end parallel do
+
+  !$omp parallel do
+  do i = 1, N
+  enddo
+  !$omp end parallel do
+  !ERROR: The END PARALLEL DO directive must follow the DO loop associated with the loop construct
+  !$omp end parallel do
+
+  !$omp parallel
+  a = 3.0
+  !$omp do simd
+  do i = 1, N
+  enddo
+  !$omp end do simd
+
+  !$omp parallel do copyin(a)
+  do i = 1, N
+  enddo
+  !$omp end parallel
+
+  a = 0.0
+  !ERROR: The END PARALLEL DO directive must follow the DO loop associated with the loop construct
+  !$omp end parallel do
+  !$omp parallel do private(c)
+  do i = 1, N
+     do j = 1, N
+        !ERROR: A DO loop must follow the PARALLEL DO directive
+        !$omp parallel do shared(b)
+        a = 3.14
+     enddo
+     !ERROR: The END PARALLEL DO directive must follow the DO loop associated with the loop construct
+     !$omp end parallel do
+  enddo
+  a = 1.414
+  !ERROR: The END PARALLEL DO directive must follow the DO loop associated with the loop construct
+  !$omp end parallel do
+
+  do i = 1, N
+     !$omp parallel do
+     do j = 2*i*N, (2*i+1)*N
+        a = 3.14
+     enddo
+  enddo
+  !ERROR: The END PARALLEL DO directive must follow the DO loop associated with the loop construct
+  !$omp end parallel do
+
+  !ERROR: A DO loop must follow the PARALLEL DO directive
+  !$omp parallel do private(c)
+5 FORMAT (1PE12.4, I10)
+  do i=1, N
+     a = 3.14
+  enddo
+  !ERROR: The END PARALLEL DO directive must follow the DO loop associated with the loop construct
+  !$omp end parallel do
+
+  !$omp parallel do simd
+  do i = 1, N
+     a = 3.14
+  enddo
+  !$omp end parallel do simd
+  !ERROR: The END PARALLEL DO SIMD directive must follow the DO loop associated with the loop construct
+  !$omp end parallel do simd
+end