disjoin_nfa Subroutine

public pure subroutine disjoin_nfa(graph, nfa_top, seg_list)

Arguments

Type IntentOptional Attributes Name
type(nfa_state_node_t), intent(inout) :: graph(:)
integer, intent(in) :: nfa_top
type(segment_t), intent(inout), allocatable :: seg_list(:)

Source Code

   pure subroutine disjoin_nfa(graph, nfa_top, seg_list)
      use :: forgex_priority_queue_m
      use :: forgex_segment_m
      use :: forgex_segment_disjoin_m
      implicit none
      type(nfa_state_node_t), intent(inout) :: graph(:)
      integer, intent(in) :: nfa_top
      type(segment_t), allocatable, intent(inout) :: seg_list(:)

      type(priority_queue_t) :: queue_f
      type(nfa_transition_t) :: ptr

      integer :: i, j, k, num_f

      ! Enqueue
      ! Traverse through all states and enqueue their segments into a priority queue.
      block
         do i = NFA_STATE_BASE, nfa_top ! Do not subtract 1 from nfa_top.

            do j = 1, graph(i)%forward_top -1

               ptr = graph(i)%forward(j)
               if (ptr%dst /= NFA_NULL_TRANSITION) then
                  do k = 1, graph(i)%forward(j)%c_top
                     if (ptr%c(k) /= SEG_INIT) then
                        call queue_f%enqueue(ptr%c(k))
                     end if
                  end do
               end if
            end do
         end do
      end block

      ! Dequeue
      ! Allocate memory for the segment list and dequeue all segments for the priority queue.
      block
         integer :: m
         type(segment_t) :: cache
         num_f = queue_f%number

         allocate(seg_list(num_f))
         m = 0
         do j = 1, num_f
            if (j == 1) then
               m = m + 1
               call queue_f%dequeue(seg_list(j))
               cycle
            end if

            call queue_f%dequeue(cache)
            if (seg_list(m) /= cache) then
               m = m + 1
               seg_list(m) = cache
            end if
         end do

         !-- The seg_list arrays are now sorted.
         seg_list = seg_list(:m) ! reallocation implicitly
      end block

      !==  At this point, seg_list is always allocated.  ==!

      ! Disjoin the segment lists to ensure no over laps
      call disjoin(seg_list)

      if (.not. allocated(seg_list)) then
         error stop "ERROR: Array that should have been disjoined is not allocated."
      end if

      ! Apply disjoining to all transitions over the NFA graph.

      ! do concurrent (i = NFA_STATE_BASE:nfa_top)
      !    do concurrent (j = 1:graph(1)%forward_top)
      do i = NFA_STATE_BASE, nfa_top

         if (allocated(graph(i)%forward)) then
            do j = 1, graph(i)%forward_top
               call disjoin_nfa_each_transition(graph(i)%forward(j), seg_list)
            end do
         end if

         if (allocated(graph(i)%backward)) then
            do j = 1, graph(i)%backward_top
               call disjoin_nfa_each_transition(graph(i)%backward(j), seg_list)
            end do
         end if

      end do

      ! deallocate the used priority queue.
      call queue_f%clear()
   end subroutine disjoin_nfa