Add dll and type-bound-procedures Python inspired

This is unfinished and untested WIP

README.md

@@ -1,26 +1,20 @@
-# list
+# List
 Fortran List
 
-An easy-to-use implementation of Python-like lists in Fortran
+An easy-to-use implementation of lists in Fortran
 
 WIP
 
-# Methods
-- constructor
+## Contains
+* 'dllnode_mod' for nodes of a double-linked list
+
+* `dll_mod' for a list with Python like methods
+
+## Methods
+- constructor (WIP)
 
 '''python
 thislist = list(("apple", "banana", "cherry")) # note the double round-brackets
 print(thislist)
 '''
 
-- append() Adds an element at the end of the list
-- clear() Removes all the elements from the list
-- copy() Returns a copy of the list
-- count() Returns the number of elements with the specified value
-- extend() Add the elements of a list (or any iterable), to the end of the current list
-- index() Returns the index of the first element with the specified value
-- insert() Adds an element at the specified position
-- pop() Removes the element at the specified position
-- remove() Removes the first item with the specified value
-- reverse() Reverses the order of the list
-- sort() Sorts the list

src/dll_mod.f90

@@ -0,0 +1,199 @@
+!TODO
+!ISSUES:
+! - [ ] When passing pointer to a node using type-bounded-procedures, it is not
+! enforced, that the specified node is part of the specified list.
+! How to enforce this, while avoid traversing the list?
+!
+! A possible solution is to add a DEBUG mode that can be enabled/disabled 
+! that would make the checks...
+!
+
+module dll_mod
+ !* Here we define the double-linked list and provide Python-like methods to operate with the
+ ! list
+ !
+ use dllnode_mod
+ implicit none
+ private
+
+ type, public :: dll_t
+ private
+ type(dllnode_t), pointer :: head => null()
+ type(dllnode_t), pointer :: tail => null()
+ integer :: n = 0
+ contains
+ procedure :: append => dll_append
+ procedure :: clear => dll_clear
+ procedure, pass(this) :: copy => dll_copy
+ procedure :: count => dll_count
+ procedure :: extend => dll_extend
+ procedure :: index => dll_find
+ procedure :: insert => dll_insert
+ procedure :: pop => dll_pop
+ procedure :: remove => dll_remove
+ procedure :: reverse => dll_reverse
+ procedure :: sort => dll_sort
+ procedure :: firstnode => dll_firstnode
+ end type dll_t
+ interface dll_t
+ module procedure dll_import
+ end interface dll_t
+
+contains
+
+ function dll_import(arr) result(new)
+ !! Make list using rank-2 array for node values
+ integer(DATA_KIND), intent(in) :: arr(:,:)
+ type(dll_t) :: new
+error stop 'not-implemented'
+ end function dll_import
+
+
+ subroutine dll_append(this, value)
+ !! Append an element to the end of the list
+ class(dll_t), intent(inout) :: this
+ integer(DATA_KIND), intent(in) :: value(:)
+
+ type(dllnode_t), pointer :: new
+
+ call dllnode_insertbehind(this%tail, dllnode_t(value), new)
+ if (.not. associated(this%head)) this%head => new
+ this%tail => new
+ this%n = this%n+1
+ end subroutine dll_append
+
+
+ subroutine dll_clear(this)
+ !! Remove elements from a list
+ class(dll_t), intent(inout) :: this
+
+ call dllnode_freechain(this%head)
+ this%head => null()
+ this%tail => null()
+ this%n = 0
+ end subroutine dll_clear
+
+
+ subroutine dll_copy(copy, this)
+ !! Make a copy of the list
+ type(dll_t), intent(inout) :: copy
+ class(dll_t), intent(in) :: this
+error stop 'not-implemented'
+ end subroutine dll_copy
+
+
+ function dll_count(this, value) result(n)
+ !! Return the number of elements with the specified value
+ class(dll_t), intent(in) :: this
+ integer(DATA_KIND), intent(in) :: value(:)
+ integer :: n
+
+ type(dllnode_t), pointer :: current
+
+ n = 0
+ current => this%head
+ do
+ if (.not. associated(current)) exit
+ if (all(value==dllnode_read(current))) n = n+1
+ current => current%gonext()
+ end do
+ end function dll_count
+
+
+! TODO allow another list or number of elements
+ subroutine dll_extend(this, items)
+ !! At the list elements to the end of current list
+ class(dll_t), intent(inout) :: this
+ type(dll_t), intent(in) :: items
+error stop 'not-implemented'
+ end subroutine dll_extend
+
+
+ function dll_find(this, value) result(found)
+ !! Return a pointer to the first occurrence of the specified value
+ class(dll_t), intent(in) :: this
+ integer(DATA_KIND), intent(in) :: value(:)
+ type(dllnode_t), pointer :: found
+
+ found => dllnode_find(this%head, value)
+ end function dll_find
+
+
+ subroutine dll_insert(this, where, value)
+ !! Insert the specified value in front of specified node
+ class(dll_t), intent(inout) :: this
+ type(dllnode_t), intent(in), pointer :: where
+ integer(DATA_KIND), intent(in) :: value(:)
+
+ type(dllnode_t), pointer :: output
+
+ if (.not. associated(where)) &
+ error stop 'dll_insert ERROR: where is null pointer'
+
+ call dllnode_inesrinfrontof(where, dllnode_t(value), output)
+ if (associated(where,this%head)) this%head => output
+ this%n = this%n + 1
+ end subroutine dll_insert
+
+
+ subroutine dll_pop(this, what)
+ !! Remove the specified node
+ class(dll_t), intent(inout) :: this
+ type(dllnode_t), intent(in), pointer :: what
+
+ type(dllnode_t), pointer :: deleted, next_in_chain
+
+ if (.not. associated(what)) &
+ error stop 'dll_pop ERROR: null pointer'
+ call dllnode_remove(what, deleted, next_in_chain)
+ if (associated(deleted, this%head)) this%head => next_in_chain
+ if (associated(deleted, this%tail)) this%tail => next_in_chain
+ this%n = this%n - 1
+ call dllnode_free(deleted)
+ end subroutine dll_pop
+
+
+ subroutine dll_remove(this, value)
+ !! Remove the first occurence of the element with the specified value
+ class(dll_t), intent(inout) :: this
+ integer(DATA_KIND), intent(in) :: value(:)
+
+ type(dllnode_t), pointer :: found, deleted, next_in_chain
+
+ found => dllnode_find(this%head, value)
+ if (.not. associated(found)) return
+ call dllnode_remove(found, deleted, next_in_chain)
+ if (associated(deleted, this%head)) this%head => next_in_chain
+ if (associated(deleted, this%tail)) this%tail => next_in_chain
+ this%n = this%n - 1
+ call dllnode_free(deleted)
+ end subroutine dll_remove
+
+
+ subroutine dll_reverse(this)
+ !! Reverse the sorting order of the elements
+ class(dll_t), intent(inout) :: this
+
+ this%tail => this%head
+ this%head => dllnode_reverse(this%head)
+ end subroutine dll_reverse
+
+
+ subroutine dll_sort(this, cfun)
+ !! Sort the list using the provided comparison function `cfun`
+ class(dll_t), intent(inout) :: this
+ procedure(compare_fun) :: cfun
+
+ this%head => dllnode_mergesort(this%head, cfun)
+ this%tail => dllnode_tail(this%head)
+ end subroutine dll_sort
+
+
+ function dll_firstnode(this) result(head)
+ class(dll_t), intent(in) :: this
+ type(dllnode_t), pointer :: head
+ head => this%head
+ end function dll_firstnode
+
+
+end module dll_mod