Re: How to construct a heterogenous list?

James Giles <jamesgiles@xxxxxxxxxxxxxxxx> wrote:

Richard Maine wrote:
Mark Morss <mfmorss@xxxxxxx> wrote:

Does anyone know how, in Fortran, to construct a linked list, the
elements of which are different sorts of data, e.g. different
intrinsic and user-defined types?

That's a textbook example of some of the object oriented stuff in
f2003. [...]

I'd like to see that actually.

Let's see... Yes, I have it here. The following code works with the
current NAG compiler (well, I guess it was 5.0 I tried it with; 5.1 is
out now). It was something I did while experimenting with NAG 5.0 as the
first compiler to implement some of this stuff. There are things here
that aren't quite as I'd really prefer to do them. Part of that is
because the NAG compiler still doesn't implement all of the related
features. For example, it doesn't yet allow allocatable scalars, which
turn out to be something that you want to use extensively in things like
this (at least I end up wanting to use them).

(Oh, and speaking of textboks, permission to use is granted, but I
wouldn't mind being cited as the source if this is copied verbatim.)

module poly_list

!-- Polymorphic lists using type extension.

implicit none

type, public :: node_type
private
class(node_type), pointer :: next => null()
end type node_type

type, public :: list_type
private
class(node_type), pointer :: head => null(), tail => null()
end type list_type

contains

subroutine append_node (list, new_node)

!-- Append a node to a list.
!-- Caller is responsible for allocating the node.

!---------- interface.

type(list_type), intent(inout) :: list
class(node_type), target :: new_node

!---------- executable code.

if (.not.associated(list%head)) list%head => new_node
if (associated(list%tail)) list%tail%next => new_node
list%tail => new_node
return
end subroutine append_node

function first_node (list)

!-- Get the first node of a list.

!---------- interface.

type(list_type), intent(in) :: list
class(node_type), pointer :: first_node

!---------- executable code.

first_node => list%head
return
end function first_node

function next_node (node)

!-- Step to the next node of a list.

!---------- interface.

class(node_type), target :: node
class(node_type), pointer :: next_node

!---------- executable code.

next_node => node%next
return
end function next_node

subroutine destroy_list (list)

!-- Delete (and deallocate) all the nodes of a list.

!---------- interface.
type(list_type), intent(inout) :: list

!---------- local.
class(node_type), pointer :: node, next

!---------- executable code.

node => list%head
do while (associated(node))
next => node%next
deallocate(node)
node => next
end do
nullify(list%head, list%tail)
return
end subroutine destroy_list

end module poly_list

program main

use poly_list

implicit none

type, extends(node_type) :: real_node_type
real :: x
end type real_node_type

type, extends(node_type) :: integer_node_type
integer :: i
end type integer_node_type

type, extends(node_type) :: character_node_type
character*1 :: c
end type character_node_type

type(list_type) :: list
class(node_type), pointer :: node
type(integer_node_type), pointer :: integer_node
type(real_node_type), pointer :: real_node
type(character_node_type), pointer :: character_node

!---------- executable code.

!----- Build the list.

allocate(real_node)
real_node%x = 1.23
call append_node(list, real_node)

allocate(integer_node)
integer_node%i = 42
call append_node(list, integer_node)

allocate(node)
call append_node(list, node)

allocate(character_node)
character_node%c = "z"
call append_node(list, character_node)

allocate(real_node)
real_node%x = 4.56
call append_node(list, real_node)

!----- Retrieve from it.

node => first_node(list)

do while (associated(node))
select type (node)
type is (real_node_type)
write (*,*) node%x
type is (integer_node_type)
write (*,*) node%i
type is (node_type)
write (*,*) "Node with no data."
class default
Write (*,*) "Some other node type."
end select

node => next_node(node)
end do

call destroy_list(list)
stop
end program main

--
Richard Maine | Good judgement comes from experience;
email: last name at domain . net | experience comes from bad judgement.
domain: summertriangle | -- Mark Twain
.

Relevant Pages

  • Re: Program Fails When Parameter Fixed Constants are Changed (F77) ??
    ... these lists so that they agree with those that use the other list. ... SUBROUTINE DCpZeros ... integer:: maxDIM! ... End Module CRT ...
    (comp.lang.fortran)
  • Re: Why does sort return undef in scalar context ?
    ... I usually prefer the term 'subroutine' because it emphasizes that this ... If sort would return pi in scalar context, ... The Perl sort isn't defined based on arrays but on lists and ...
    (comp.lang.perl.misc)
  • Re: Using unused variables
    ... subroutine itself uses a SELECT CASE to dispatch the initialization to ... arg1, ..., argN may be anything ... should store them in a derived type, ... I increasingly use keyword arguments to improve documentation, but I usually avoid incorporating relatively short argument lists in derived types because it forces setting of components on separate lines rather than directly in the argument list. ...
    (comp.lang.fortran)
  • Re: Hide macro List from Alt+F8 window.
    ... >> it like a subroutine and it won't appear in the Macro listing... ... My proposal to use a function assumed the function would take the place of the subroutine (macro) and be placed in the worksheet's code window as well. ... I don't believe it would show up in any lists. ...
    (microsoft.public.excel.programming)
  • Re: Avoiding interference with active list
    ... >> that will not interfere, by definition, with any other extant lists. ... and my subroutine then executes another select on a totally ... > EXECUTE "SELECT FILE1" ... > READNEXT KEY FROM LISTNO ELSE EXIT ...
    (comp.databases.pick)