module cubedag_walker
  use cubedag_messaging
  use cubedag_parameters
  use cubedag_node
  use cubedag_dag
  use cubedag_link_type
  use cubedag_node_type
  !
  integer(kind=4), parameter :: topomarker_null=0
  integer(kind=4), parameter :: topomarker_done=1
  type(cubedag_link_t) :: link
  integer(kind=entr_k) :: current
  !
  abstract interface
    subroutine callback_interface(par,chi,error)
      import cubedag_node_object_t
      class(cubedag_node_object_t), intent(in)    :: par
      class(cubedag_node_object_t), intent(in)    :: chi
      logical,                      intent(inout) :: error
    end subroutine callback_interface
    recursive subroutine getlink_interface(obj,callback,error)
      import cubedag_node_object_t,callback_interface
      class(cubedag_node_object_t), intent(in)    :: obj
      procedure(callback_interface)               :: callback
      logical,                      intent(inout) :: error
    end subroutine getlink_interface
  end interface
  !
  public :: cubedag_walker_null
  public :: cubedag_childwalker_reset,cubedag_childwalker_next
  public :: cubedag_parentwalker_reset,cubedag_parentwalker_next
  private
  !
contains
  !
  subroutine cubedag_childwalker_reset(start,callback,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: start
    procedure(callback_interface)               :: callback
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='CHILDWALKER>RESET'
    !
    call cubedag_walker_reset(cubedag_walker_getchildren,start,callback,error)
  end subroutine cubedag_childwalker_reset
  !
  subroutine cubedag_parentwalker_reset(start,callback,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: start
    procedure(callback_interface)               :: callback
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='PARENTWALKER>RESET'
    !
    call cubedag_walker_reset(cubedag_walker_getparent,start,callback,error)
  end subroutine cubedag_parentwalker_reset
  !
  subroutine cubedag_walker_reset(cubedag_walker_getlink,start,callback,error)
    !-------------------------------------------------------------------
    ! Set the current walker in memory to start from given commit
    ! The callback is called at load time, on each parent-child pair,
    ! with the signature:
    !    call callback(pid,cid,error)
    ! If the callback raises an error, the load stops and
    ! cubedag_walker_reset returns an error
    !-------------------------------------------------------------------
    procedure(getlink_interface)                     :: cubedag_walker_getlink
    procedure(callback_interface)                    :: callback
    class(cubedag_node_object_t), intent(in), target :: start
    logical,                      intent(inout)      :: error
    ! Local
    character(len=*), parameter :: rname='WALKER>RESET'
    !
    ! ZZZ Unclear if collection should be done here or at first
    !     cubedag_walker_next
    !
    call link%reallocate(ix%n,error)
    if (error)  return
    !
    ! Prepare topomarkers
    ix%flag(1:ix%n) = topomarker_null
    !
    ! Insert start point
    link%n = 1
    link%list(link%n)%p => start
    !
    ! ZZZ Might implement several sorting modes (like git_revwalk_sorting)
    call cubedag_walker_getlink(start,callback,error)
    if (error)  return
    !
    current = 0
  end subroutine cubedag_walker_reset
  !
  recursive subroutine cubedag_walker_getchildren(par,callback,error)
    !---------------------------------------------------------------------
    ! Recursive childwalking
    !---------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: par       ! Starting point (already in list)
    procedure(callback_interface)               :: callback
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='WALKER>GETCHILDREN'
    integer(kind=entr_k) :: first,last,ilist,cent
    class(cubedag_node_object_t), pointer :: chi
    !
    first = link%n+1
    do ilist=1,par%node%children%n
      chi => cubedag_node_ptr(par%node%children%list(ilist)%p,error)
      if (error)  return
      !
      call callback(par,chi,error)
      if (error)  return
      !
      cent = chi%node%ient
      if (ix%flag(cent).eq.topomarker_done)  cycle  ! Do not store duplicate nodes
      if (link%n.ge.size(link%list)) then
        call cubedag_message(seve%e,rname,'Internal error: list exhausted')
        error = .true.
        return
      endif
      link%n = link%n+1
      link%list(link%n)%p => chi
      ix%flag(cent) = topomarker_done
    enddo
    last = link%n
    !
    do ilist=first,last
      chi => cubedag_node_ptr(link%list(ilist)%p,error)
      if (error)  return
      call cubedag_walker_getchildren(chi,callback,error)
      if (error)  return
    enddo
  end subroutine cubedag_walker_getchildren
  !
  recursive subroutine cubedag_walker_getparent(chi,callback,error)
    !---------------------------------------------------------------------
    ! Recursive parentwalking
    !---------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: chi       ! Starting point (already in list)
    procedure(callback_interface)               :: callback
    logical,                      intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='WALKER>GETPARENT'
    integer(kind=entr_k) :: first,last,ilist,pent
    class(cubedag_node_object_t), pointer :: par
    !
    first = link%n+1
    do ilist=1,chi%node%parents%n
      par => cubedag_node_ptr(chi%node%parents%list(ilist)%p,error)
      if (error)  return
      !
      call callback(par,chi,error)
      if (error)  return
      !
      pent = par%node%ient
      if (ix%flag(pent).eq.topomarker_done)  cycle  ! Do not store duplicate nodes
      if (link%n.ge.size(link%list)) then
        call cubedag_message(seve%e,rname,'Internal error: list exhausted')
        error = .true.
        return
      endif
      link%n = link%n+1
      link%list(link%n)%p => par
      ix%flag(pent) = topomarker_done
    enddo
    last = link%n
    !
    do ilist=first,last
      par => cubedag_node_ptr(link%list(ilist)%p,error)
      if (error)  return
      call cubedag_walker_getparent(par,callback,error)
      if (error)  return
    enddo
  end subroutine cubedag_walker_getparent
  !
  function cubedag_childwalker_next(next)
    !-------------------------------------------------------------------
    ! Get the next commit ID. Evaluate to .false. if all done.
    !-------------------------------------------------------------------
    logical :: cubedag_childwalker_next
    class(cubedag_node_object_t), pointer :: next
    cubedag_childwalker_next = cubedag_walker_next(next)
  end function cubedag_childwalker_next
  !
  function cubedag_parentwalker_next(next)
    !-------------------------------------------------------------------
    ! Get the next commit ID. Evaluate to .false. if all done.
    !-------------------------------------------------------------------
    logical :: cubedag_parentwalker_next
    class(cubedag_node_object_t), pointer :: next
    cubedag_parentwalker_next = cubedag_walker_next(next)
  end function cubedag_parentwalker_next
  !
  function cubedag_walker_next(next)
    !-------------------------------------------------------------------
    ! Get the next commit ID. Evaluate to .false. if all done.
    !-------------------------------------------------------------------
    logical :: cubedag_walker_next
    class(cubedag_node_object_t), pointer :: next
    ! Local
    logical :: error
    !
    if (current.ge.link%n) then
      cubedag_walker_next = .false.
      next => null()
      return
    endif
    cubedag_walker_next = .true.
    current = current+1
    error = .false.
    next => cubedag_node_ptr(link%list(current)%p,error)
  end function cubedag_walker_next
  !
  function cubedag_walker_contains(link,obj)
    !-------------------------------------------------------------------
    ! Return .true. if the list contains the named ID
    ! ZZZ This is inefficient (N^2)
    !-------------------------------------------------------------------
    logical :: cubedag_walker_contains
    type(cubedag_link_t),         intent(in) :: link
    class(cubedag_node_object_t), pointer    :: obj
    ! Local
    integer(kind=entr_k) :: ilist
    do ilist=1,link%n
      if (associated(link%list(ilist)%p,obj)) then
        cubedag_walker_contains = .true.
        return
      endif
    enddo
    cubedag_walker_contains = .false.
  end function cubedag_walker_contains
  !
  subroutine cubedag_walker_null(par,chi,error)
    !-------------------------------------------------------------------
    ! Does nothing
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: par
    class(cubedag_node_object_t), intent(in)    :: chi
    logical,                      intent(inout) :: error
    !
    return
  end subroutine cubedag_walker_null
  !
end module cubedag_walker
