collections.f90

 
 
module collections
    use iso_fortran_env
    use ferror
    implicit none
    private
    public :: list
    public :: linked_list
 
! ------------------------------------------------------------------------------
    integer(int32), parameter :: FL_NO_ERROR = 0
    integer(int32), parameter :: FL_INVALID_ARGUMENT_ERROR = 1000
    integer(int32), parameter :: FL_OUT_OF_MEMORY_ERROR = 1001
    integer(int32), parameter :: FL_INDEX_OUT_OF_RANGE_ERROR = 1002
    integer(int32), parameter :: FL_INVALID_ITERATOR_ERROR = 1003
 
! ------------------------------------------------------------------------------
    type container
        ! A pointer to an unlimited polymorphic variable allowing storage of
        ! any type.
        class(*), private, pointer :: m_item => null()
        ! Set to true to delete @ref item when this container object goes out
        ! of scope; else, set to false to persist.
        logical, private :: m_delete = .true.
 
    contains
        procedure, public :: get => c_get
        procedure, public :: delete_on_cleanup => c_get_delete
        final :: c_destroy
        procedure, public :: free => c_cleanup
    end type
 
    type, extends(container) :: node
        type(node), private, pointer :: next => null()
        type(node), private, pointer :: previous => null()
    end type
 
    ! collections_container.f90
    interface
        module function c_get(this) result(rst)
            class(container), intent(in) :: this
            class(*), pointer :: rst
        end function
 
        pure module function c_get_delete(this) result(rst)
            class(container), intent(in) :: this
            logical :: rst
        end function
 
        module subroutine c_destroy(this)
            type(container), intent(inout) :: this
        end subroutine
 
        module subroutine c_cleanup(this)
            class(container), intent(inout) :: this
        end subroutine
    end interface
 
    type list
        ! A collection of container objects.
        type(container), private, allocatable, dimension(:) :: m_list
        ! The actual number of items in m_list.
        integer(int32), private :: m_count = 0
    contains
        procedure, public :: count => list_get_count
        procedure, public :: get_capacity => list_get_capacity
        procedure, public :: set_capacity => list_set_capacity
        procedure, public :: push => list_push
        procedure, public :: pop => list_pop
        procedure, public :: get => list_get
        procedure, public :: set => list_set
        procedure, public :: insert => list_insert
        procedure, public :: remove => list_remove
        procedure, public :: clear => list_clear
    end type
 
    ! collections_list.f90
    interface
        pure module function list_get_count(this) result(rst)
            class(list), intent(in) :: this
            integer(int32) :: rst
        end function
 
        pure module function list_get_capacity(this) result(rst)
            class(list), intent(in) :: this
            integer(int32) :: rst
        end function
 
        module subroutine list_set_capacity(this, n, err)
            class(list), intent(inout) :: this
            integer(int32), intent(in) :: n
            class(errors), intent(inout), optional, target :: err
        end subroutine
 
        module subroutine list_push(this, x, manage, err)
            class(list), intent(inout) :: this
            class(*), intent(in), target :: x
            logical, intent(in), optional :: manage
            class(errors), intent(inout), optional, target :: err
        end subroutine
 
        module subroutine list_pop(this)
            class(list), intent(inout) :: this
        end subroutine
 
        module function list_get(this, i, err) result(rst)
            class(list), intent(in) :: this
            integer(int32), intent(in) :: i
            class(errors), intent(inout), optional, target :: err
            class(*), pointer :: rst
        end function
 
        module subroutine list_set(this, i, x, manage, err)
            class(list), intent(inout) :: this
            integer(int32), intent(in) :: i
            class(*), intent(in), target :: x
            logical, intent(in), optional :: manage
            class(errors), intent(inout), optional, target :: err
        end subroutine
 
        module subroutine list_insert(this, i, x, manage, err)
            class(list), intent(inout) :: this
            integer(int32) :: i
            class(*), intent(in) :: x
            logical, intent(in), optional :: manage
            class(errors), intent(inout), optional, target :: err
        end subroutine
 
        module subroutine list_remove(this, i, err)
            class(list), intent(inout) :: this
            integer(int32) :: i
            class(errors), intent(inout), optional, target :: err
        end subroutine
 
        module subroutine list_clear(this)
            class(list), intent(inout) :: this
        end subroutine
    end interface
 
! ------------------------------------------------------------------------------
    type linked_list
        ! The number of nodes in the container.
        integer(int32), private :: m_count = 0
        ! A pointer to the first node in the container.
        type(node), private, pointer :: m_first => null()
        ! A pointer to the last node in the container.
        type(node), private, pointer :: m_last => null()
        ! A pointer to the current node selected by the user.
        type(node), private, pointer :: m_current => null()
    contains
        procedure, public :: count => ll_count
        procedure, public :: move_to_first => ll_move_to_first
        procedure, public :: move_to_last => ll_move_to_last
        procedure, public :: next => ll_move_to_next
        procedure, public :: previous => ll_move_to_previous
        procedure, public :: get => ll_get
        procedure, public :: set => ll_set
        procedure, public :: push => ll_push
        procedure, public :: pop => ll_pop
        procedure, public :: clear => ll_clear
        final :: ll_destroy
    end type
 
    ! collections_linked_list.f90
    interface
        pure module function ll_count(this) result(rst)
            class(linked_list), intent(in) :: this
            integer(int32) :: rst
        end function
 
        module subroutine ll_move_to_first(this)
            class(linked_list), intent(inout) :: this
        end subroutine
 
        module subroutine ll_move_to_last(this)
            class(linked_list), intent(inout) :: this
        end subroutine
 
        module function ll_move_to_next(this) result(rst)
            class(linked_list), intent(inout) :: this
            logical :: rst
        end function
 
        module function ll_move_to_previous(this) result(rst)
            class(linked_list), intent(inout) :: this
            logical :: rst
        end function
 
        module function ll_get(this) result(rst)
            class(linked_list), intent(in) :: this
            class(*), pointer :: rst
        end function
 
        module subroutine ll_set(this, x, manage, err)
            class(linked_list), intent(inout) :: this
            class(*), intent(in), target :: x
            logical, intent(in), optional :: manage
            class(errors), intent(inout), optional, target :: err
        end subroutine
 
        module subroutine ll_push(this, x, manage, err)
            class(linked_list), intent(inout) :: this
            class(*), intent(in), target :: x
            logical, intent(in), optional :: manage
            class(errors), intent(inout), optional, target :: err
        end subroutine
 
        module subroutine ll_pop(this)
            class(linked_list), intent(inout) :: this
        end subroutine
 
        module subroutine ll_clear(this)
            class(linked_list), intent(inout) :: this
        end subroutine
 
        module subroutine ll_destroy(this)
            type(linked_list), intent(inout) :: this
        end subroutine
    end interface
end module