module cubedag_walker_types
  use cubedag_messaging
  use cubedag_parameters
  use cubedag_dag_buffer
  use cubedag_link_type
  use cubedag_node_class
  !
  public :: parentwalker_t,childwalker_t
  public :: cubedag_walker_null
  private
  !
  integer(kind=1), parameter :: topomarker_null=0
  integer(kind=1), parameter :: topomarker_done=1
  !
  type, abstract :: walker_t
    integer(kind=1), allocatable :: topomarker(:)  !
    type(cubedag_link_t)         :: link           ! List of collected objects
    integer(kind=entr_k)         :: current        ! Index in iterated list
  contains
    procedure,                              public  :: reset => cubedag_walker_reset
    procedure(getlink_interface), deferred, private :: getlink
    procedure,                              public  :: next  => cubedag_walker_next
  end type walker_t
  !
  type, extends(walker_t) :: parentwalker_t
  contains
    procedure, private :: getlink => cubedag_parentwalker_getlink
  end type parentwalker_t
  !
  type, extends(walker_t) :: childwalker_t
  contains
    procedure, private :: getlink => cubedag_childwalker_getlink
  end type childwalker_t
  !
  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(walker,obj,callback,error)
      import walker_t,cubedag_node_object_t,callback_interface
      class(walker_t),              intent(inout) :: walker
      class(cubedag_node_object_t), intent(in)    :: obj
      procedure(callback_interface)               :: callback
      logical,                      intent(inout) :: error
    end subroutine getlink_interface
  end interface
  !
contains
  !
  subroutine cubedag_walker_reset(walker,start,callback,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! 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
    !-------------------------------------------------------------------
    class(walker_t),              intent(inout)      :: walker
    procedure(callback_interface)                    :: callback
    class(cubedag_node_object_t), intent(in), target :: start
    logical,                      intent(inout)      :: error
    !
    integer(kind=4) :: ier
    character(len=*), parameter :: rname='WALKER>RESET'
    !
    ! ZZZ Unclear if collection should be done here or at first
    !     cubedag_walker_next
    !
    ! Prepare topomarkers
    allocate(walker%topomarker(ix%n),stat=ier)
    if (failed_allocate(rname,'topomarker array',ier,error)) return
    walker%topomarker(:) = topomarker_null
    !
    ! Insert start point
    call walker%link%final(error)
    if (error)  return
    call walker%link%associate(start,error)
    if (error)  return
    !
    ! ZZZ Might implement several sorting modes (like git_revwalk_sorting)
    call walker%getlink(start,callback,error)
    if (error)  return
    !
    walker%current = 0
  end subroutine cubedag_walker_reset
  !
  recursive subroutine cubedag_childwalker_getlink(walker,obj,callback,error)
    !---------------------------------------------------------------------
    ! Recursive childwalking
    !---------------------------------------------------------------------
    class(childwalker_t),         intent(inout) :: walker
    class(cubedag_node_object_t), intent(in)    :: obj       ! 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 = walker%link%n+1
    do ilist=1,obj%node%links%children%n
      chi => cubedag_node_ptr(obj%node%links%children%list(ilist)%p,error)
      if (error)  return
      !
      call callback(obj,chi,error)
      if (error)  return
      !
      cent = chi%node%ient
      if (walker%topomarker(cent).eq.topomarker_done)  cycle  ! Do not store duplicate nodes
      call walker%link%associate(chi,error)
      if (error)  return
      walker%topomarker(cent) = topomarker_done
    enddo
    last = walker%link%n
    !
    do ilist=first,last
      chi => cubedag_node_ptr(walker%link%list(ilist)%p,error)
      if (error)  return
      call cubedag_childwalker_getlink(walker,chi,callback,error)
      if (error)  return
    enddo
  end subroutine cubedag_childwalker_getlink
  !
  recursive subroutine cubedag_parentwalker_getlink(walker,obj,callback,error)
    !---------------------------------------------------------------------
    ! Recursive parentwalking
    !---------------------------------------------------------------------
    class(parentwalker_t),        intent(inout) :: walker
    class(cubedag_node_object_t), intent(in)    :: obj       ! 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 = walker%link%n+1
    do ilist=1,obj%node%links%parents%n
      par => cubedag_node_ptr(obj%node%links%parents%list(ilist)%p,error)
      if (error)  return
      !
      call callback(par,obj,error)
      if (error)  return
      !
      pent = par%node%ient
      if (walker%topomarker(pent).eq.topomarker_done)  cycle  ! Do not store duplicate nodes
      call walker%link%associate(par,error)
      if (error)  return
      walker%topomarker(pent) = topomarker_done
    enddo
    last = walker%link%n
    !
    do ilist=first,last
      par => cubedag_node_ptr(walker%link%list(ilist)%p,error)
      if (error)  return
      call cubedag_parentwalker_getlink(walker,par,callback,error)
      if (error)  return
    enddo
  end subroutine cubedag_parentwalker_getlink
  !
  function cubedag_walker_next(walker,next)
    !-------------------------------------------------------------------
    ! Get the next commit ID. Evaluate to .false. if all done.
    !-------------------------------------------------------------------
    logical :: cubedag_walker_next
    class(walker_t),              intent(inout) :: walker
    class(cubedag_node_object_t), pointer       :: next
    ! Local
    logical :: error
    !
    if (walker%current.ge.walker%link%n) then
      cubedag_walker_next = .false.
      next => null()
      return
    endif
    cubedag_walker_next = .true.
    walker%current = walker%current+1
    error = .false.
    next => cubedag_node_ptr(walker%link%list(walker%current)%p,error)
  end function cubedag_walker_next
  !
  subroutine cubedag_walker_null(par,obj,error)
    !-------------------------------------------------------------------
    ! Does nothing. Can be used as neutral callback function.
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: par
    class(cubedag_node_object_t), intent(in)    :: obj
    logical,                      intent(inout) :: error
    !
    return
  end subroutine cubedag_walker_null
  !
end module cubedag_walker_types
