Merge pull request #57 from sourceryinstitute/concurrent-topo-sort

Simplified concurrent topological sort

Author: Damian Rouson

src/dag_s.f90

@@ -14,6 +14,10 @@
 
   implicit none
 
+  type searched_and_ordered_t
+    integer, allocatable, dimension(:) :: s, o
+  end type 
+
 contains
 
   module procedure construct_from_components
@@ -30,50 +34,44 @@ pure module function topological_sort(dag) result(order)
     call assert(all(dag%vertices(:)%edges_allocated()), "dag_s topological_sort: all(dag%vertices(:)%edges_allocated())")
 
     block
-      integer, allocatable :: discovered(:), searched(:)
+      type(searched_and_ordered_t) searched_and_ordered
       integer v
 
-      allocate(discovered(0), order(0), searched(0))
+      searched_and_ordered = searched_and_ordered_t(s = [integer::], o = [integer::])
 
-      do v = 1, size(dag%vertices)
-        if (.not. any(v == searched)) then
-          call depth_first_search(v, [integer::], searched, order)
-          discovered = [discovered, searched]
-          searched = discovered
-        end if
+      do concurrent(v = 1:size(dag%vertices))
+        if (.not. any(v == searched_and_ordered%s)) &
+          searched_and_ordered = depth_first_search(v, [integer::], searched_and_ordered%o)
       end do
+      order = searched_and_ordered%o
     end block
 
   contains
 
-    pure recursive subroutine depth_first_search(v, d, s, o)
-      integer, intent(in) :: v, d(:)
-      integer, intent(out), allocatable :: s(:)
-      integer, intent(inout), allocatable :: o(:)
+    pure recursive function depth_first_search(v, d, o) result(hybrid)
+      integer, intent(in) :: v
+      integer, intent(in), dimension(:) :: d, o
+      type(searched_and_ordered_t) hybrid
 
       call assert(.not. any(v == d), "depth_first_search: cycle detected", intrinsic_array_t([v,d]))
 
-      block
-        integer, allocatable :: dependencies(:), s_local(:), d_local(:)
-        integer w
-
-        dependencies = dag%depends_on(v)
+      hybrid = searched_and_ordered_t(s = [integer::], o = o)
 
-        allocate(s_local(0), d_local(0))
+      associate(dependencies => dag%depends_on(v))
+        block
+          integer w
+          do concurrent(w = 1:size(dependencies))
+            associate(w_dependencies => dependencies(w))
+              if (.not. any(w_dependencies == hybrid%s)) hybrid = depth_first_search(w_dependencies, [d, v], hybrid%o)
+            end associate
+          end do
+        end block
+      end associate
 
-        do w = 1, size(dependencies)
-          if (.not. any(dependencies(w) == s_local)) then
-            call depth_first_search(dependencies(w), [d, v], s_local, o)
-            d_local = [d_local, s_local]
-            s_local = d_local
-          end if
-        end do
-
-        if (.not. any(v == o)) o = [v, o]
-        s = [v, s_local]
-      end block
+      if (.not. any(v == hybrid%o)) hybrid%o = [v, hybrid%o]
+      hybrid = searched_and_ordered_t(s = [v, hybrid%s], o = hybrid%o)
 
-    end subroutine
+    end function
 
   end function topological_sort