A generic linked list in Fortran 95
Jason Blevins
lists, and transfer and I've put together a simple example linked list
module in standard Fortran 95 which is capable of storing arbitrary user
defined data types (or pointers to such types). It uses transfer to get
the data in and out of the list in a way that I think minimizes the
ugliness of it all (only one call to transfer is needed for each 'put'
or 'get' operation). Wrapper functions for specific types would help
clean this up, but they would need to be created by the user.
This code was influenced heavily by Arjen Markus's generic linked list
in FLIBS at http://flibs.sf.net/ and Richard Maine's discussion of the
pointer transfer trick in previous threads on clf, for example, here:
Recasting Fortran pointers (14 Nov 2001):
http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/31248d9246bec7da
I'm posting it here for the benefit of others and for discussion. I've
also posted a slightly more detailed version on the wiki, so feel free
to comment on or improve it here:
http://fortranwiki.org/fortran/show/gen_list
The linked list module, an example derived type data_t for storing
arbitrary data (and a corresponding pointer container data_ptr), and an
example control program are listed below. The program illustrates how
to initialize and free the list and how to store and retrieve pointers
to data_t objects using transfer.
A caveat: while the list manages its own memory, used for storing the
'encoded' objects you place in it, if you allocate an object and store a
pointer to it in the list, you are still responsible for deallocating
the object itself (that is, only the memory used to store the _pointer_
will be automatically deallocated upon calling list_free).
----------
! A generic linked list object
module list
implicit none
private
public :: list_t, list_data, list_init, list_free, list_insert
public :: list_get, list_next
! A public variable to use as a MOLD for transfer()
integer, dimension(:), allocatable :: list_data
! Linked list node data type
type :: list_t
private
integer, dimension(:), pointer :: data => null()
type(list_t), pointer :: next => null()
end type list_t
contains
! Initialize a head node SELF and optionally store the provided DATA.
subroutine list_init(self, data)
type(list_t), pointer :: self
integer, dimension(:), intent(in), optional :: data
allocate(self)
nullify(self%next)
if (present(data)) then
allocate(self%data(size(data)))
self%data = data
else
nullify(self%data)
end if
end subroutine list_init
! Free the entire list and all data, beginning at SELF
subroutine list_free(self)
type(list_t), pointer :: self
type(list_t), pointer :: current
type(list_t), pointer :: next
current => self
do while (associated(current))
next => current%next
if (associated(current%data)) then
deallocate(current%data)
nullify(self%data)
end if
deallocate(current)
nullify(current)
current => next
end do
end subroutine list_free
! Return the next node after SELF
function list_next(self) result(next)
type(list_t), pointer :: self
type(list_t), pointer :: next
next => self%next
end function list_next
! Insert a list node after SELF containing DATA (optional)
subroutine list_insert(self, data)
type(list_t), pointer :: self
integer, dimension(:), intent(in), optional :: data
type(list_t), pointer :: next
allocate(next)
if (present(data)) then
allocate(next%data(size(data)))
next%data = data
else
nullify(next%data)
end if
next%next => self%next
self%next => next
end subroutine list_insert
! Return the DATA stored in the node SELF
function list_get(self) result(data)
type(list_t), pointer :: self
integer, dimension(:), pointer :: data
data => self%data
end function list_get
end module list
! A derived type for storing data.
module data
implicit none
private
public :: data_t
public :: data_ptr
! Data is stored in data_t
type :: data_t
real :: x
end type data_t
! A trick to allow us to store pointers in the list
type :: data_ptr
type(data_t), pointer :: p
end type data_ptr
end module data
! A simple generic linked list test program
program list_test
use list
use data
implicit none
type(list_t), pointer :: ll => null()
type(data_t), target :: dat_a
type(data_t), target :: dat_b
type(data_ptr) :: ptr
! Initialize two data objects
dat_a%x = 17.5
dat_b%x = 3.0
! Initialize the list with dat_a
ptr%p => dat_a
call list_init(ll, DATA=transfer(ptr, list_data))
print *, 'Initializing list with data:', ptr%p
! Insert dat_b into the list
ptr%p => dat_b
call list_insert(ll, DATA=transfer(ptr, list_data))
print *, 'Inserting node with data:', ptr%p
! Get the head node
ptr = transfer(list_get(ll), ptr)
print *, 'Head node data:', ptr%p
! Get the next node
ptr = transfer(list_get(list_next(ll)), ptr)
print *, 'Second node data:', ptr%p
! Free the list
call list_free(ll)
end program list_test
----------
Output:
% gfortran -o list -std=f95 -Wall list.f90
% ./list
Initializing list with data: 17.500000
Inserting node with data: 3.0000000
Head node data: 17.500000
Second node data: 3.0000000
--
Jason Blevins
Ph.D. Candidate, Department of Economics, Duke University
http://jblevins.org/
Richard Maine
> I've been reading some old threads about generic programming, linked
> lists, and transfer and I've put together a simple example linked list
> module in standard Fortran 95 which is capable of storing arbitrary user
> defined data types (or pointers to such types). It uses transfer to get
> the data in and out of the list in a way that I think minimizes the
> ugliness of it all (only one call to transfer is needed for each 'put'
> or 'get' operation).
[code elided]
Neat trick. On reading the claim about only one call to transfer, I
skipped the rest of the intro text and immediately went skimming for one
of the more usual errors (assuming that all pointers were the same
size). That's where some of the ugliest bits come in. Not finding such
an error at first glance, I went back to look a little more carefully
and I see how you managed to avoid it. Aha! You've put the nasty case as
an actual argument expression, where the compiler generates the
appropriate-sized temporary for you, avoiding the need for you to have
done a preliminary one to determine the size. I'd not have thought of
that.
--
Richard Maine | Good judgment comes from experience;
email: last name at domain . net | experience comes from bad judgment.
domain: summertriangle | -- Mark Twain
Jason Blevins
> Jason Blevins <jrbl...@sdf.lonestar.org> wrote:
>
>> I've been reading some old threads about generic programming, linked
>> lists, and transfer and I've put together a simple example linked list
>> module in standard Fortran 95 which is capable of storing arbitrary user
>> defined data types (or pointers to such types). It uses transfer to get
>> the data in and out of the list in a way that I think minimizes the
>> ugliness of it all (only one call to transfer is needed for each 'put'
>> or 'get' operation).
> [code elided]
>
Thanks! :)
> You've put the nasty case as an actual argument expression, where the
> compiler generates the appropriate-sized temporary for you, avoiding
> the need for you to have done a preliminary one to determine the
> size. [...]
That's right, and you stated it much more clearly than I could have.
The word temporary always worries me a bit, because usually when I see
it, it's because I've created an unnecessary temporary (e.g., a
non-contiguous array slice). In this case though, I think using a
temporary is actually more efficient. It eliminates one call each to
transfer and size while the temporary just substitutes for the manually
allocated array used in the usual method.
Trường Đặng
Right now I am thinking about a way to delete an arbitrary node of the generic linked list, because in the FLIBS's generic linked list, it has that feature in subroutine list_delete_element( list, elem ).
Below is my test code on the link I gave above:
! generic_list.f90 -- A Generic Linked List Implementation in Fortran 95
!
! Copyright (C) 2009, 2012 Jason R. Blevins
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
! Revision History:
!
! 1. July 21, 2012: In the list_free subroutine, line 11 should read
! nullify(current%data) instead of nullify(self%data). Thanks to
! Michael Quinlan.
module data
implicit none
private
public :: data_t
public :: data_ptr
! Data is stored in data_t
type :: data_t
end type data_t
! A container for storing data_t pointers
type(data_t), pointer :: p
end type data_ptr
end module data
implicit none
private
public :: list_node_t, list_data
public :: list_init, list_free
public :: list_insert, list_put, list_get, list_next
! A public variable used as a MOLD for transfer()
! Linked list node
integer, dimension(:), pointer :: data => null()
end type list_node_t
contains
! Initialize a head node SELF and optionally store the provided DATA.
subroutine list_init(self, data)
allocate(self)
nullify(self%next)
if (present(data)) then
allocate(self%data(size(data)))
self%data = data
else
nullify(self%data)
end if
end subroutine list_init
! Free the entire list and all data, beginning at SELF
subroutine list_free(self)
type(list_node_t), pointer :: current
type(list_node_t), pointer :: next
current => self
do while (associated(current))
next => current%next
if (associated(current%data)) then
deallocate(current%data)
deallocate(current)
nullify(current)
current => next
end do
end subroutine list_free
subroutine list_insert(self, data)
allocate(next)
if (present(data)) then
allocate(next%data(size(data)))
next%data = data
else
nullify(next%data)
end if
next%next => self%next
self%next => next
!seft => next
end subroutine list_insert
! Store the encoded DATA in list node SELF
subroutine list_put(self, data)
type(list_node_t), pointer :: self
integer, dimension(:), intent(in) :: data
if (associated(self%data)) then
deallocate(self%data)
nullify(self%data)
end if
self%data = data
end subroutine list_put
! Return the DATA stored in the node SELF
function list_get(self) result(data)
data => self%data
end function list_get
function list_next(self)
type(list_node_t), pointer :: list_next
list_next => self%next
end function list_next
end module generic_list
! Written: DANG Truong
! Date: 12-17-2016
! Updated: 01-08-2017
program test_list
use generic_list
use data
implicit none
type(list_node_t), pointer :: list => null()
type(data_ptr) :: ptr
integer :: i, k
! i = 1
!
! ! Allocate a new data element
! allocate(ptr%p)
! ptr%p%n = i
!
! ! Initialize the list with the first data element
! call list_init(list, transfer(ptr, list_data))
! print *, 'Initializing list with data:', ptr%p%n
!! deallocate(ptr%p)
!
! i = 2
! do while (associated(list))
! ! Allocate second to sixth data elements
! allocate(ptr%p)
! ptr%p%n = i
!
! ! Insert data element into the list
! call list_insert(list, transfer(ptr, list_data))
!
! print *, 'Inserting node with data:', ptr%p%n
! ptr = transfer(list_get(list_next(list)), ptr)
! print *, 'Retrieve data:', ptr%p%n
! i = i + 1
! if (i==7) goto 123
!
!
! end do
!123 continue
do i = 1, 5
allocate(ptr%p)
ptr%p%n = i
if (.not.associated(list)) then
call list_init(list,transfer(ptr,list_data))
else
call list_insert(list,transfer(ptr,list_data))
endif
enddo
print*,'*****************************'
print*,'Linked list:'
do while (associated(list))
ptr=transfer(list_get(list),ptr)
k = ptr%p%n
print*,k
list => list_next(list)
end do
! Free the list
call list_free(list)
end program test_list