linked_list.f90 Source File


Contents

Source Code


Source Code

module linked_list
    public
    
    type llist
        private
        type(llist_node), pointer :: begin => null()
        type(llist_node), pointer :: end => null()
    contains
        procedure                 :: iterate => iterate_ll
    end type llist
  
    type llist_node
        private
        character(len=:), allocatable :: data
        type(llist_node), pointer :: next => null()
    end type llist_node

    ! Interface for functions being applied to each list element in turn
    ! when iterating
    abstract interface
        subroutine command_fun(command, ok)
            character(*), intent(in) :: command
            logical, intent(out)     :: ok ! Exit the loop if not true
        end subroutine command_fun
    end interface

    
contains

    function iterate_ll(this, f) result(r)
        class(llist), intent(inout), target :: this
        procedure(command_fun)              :: f
        logical :: r
        type(llist_node), pointer :: token
        token => this%begin
        do
            if (.not. associated(token)) exit
            call f(trim(token%data), r)
            if (.not. r) then
                exit
            end if
            token => token%next
        end do
    end function iterate_ll
       
    subroutine append(lst, data)
      type(llist), intent(inout) :: lst
      character(*), intent(in)    :: data
      if (.not. associated(lst%begin)) then
         allocate(lst%begin)
         lst%begin%data = data
         lst%end => lst%begin
      else
         allocate(lst%end%next)
         lst%end%next%data = data
         lst%end => lst%end%next
      end if
    end subroutine append

    subroutine print(lst)
      type(llist), intent(in) :: lst
      type(llist_node), pointer :: next
      write(*,'(a)') 'Tokens:'
      next => lst%begin
      do
         if (.not. associated(next)) exit
         write(*,'(4x,a)') next%data
         next => next%next
      end do
    end subroutine print

    integer function size(lst)
      type(llist), intent(inout) :: lst
      type(llist_node), pointer  :: this
      size = 0
      this => lst%begin
      do
         if (.not. associated(this)) exit
         size = size + 1
         this => this%next
      end do
    end function size

    subroutine clear(lst)
      type(llist), intent(inout) :: lst
      type(llist_node), pointer  :: this, next
      this => lst%begin
      do
         if (.not. associated(this)) exit
         next => this%next
         deallocate(this)
         this => next
      end do
      nullify(lst%end)
      nullify(lst%begin)
    end subroutine clear
end module linked_list