无限多态链表 - Fortran Coder

[Fortran] 纯文本查看 复制代码
module anylist_m

  implicit none

  private

  public :: anylist, anyitem, newitem



  type anylist !（任意类型）链表类

    class(anyitem), pointer, private :: firstptr => null() !头指针

  contains

    procedure, non_overridable :: append !尾部增加节点

    procedure, non_overridable :: count_list !节点个数

    procedure, non_overridable :: delete_list !删除所有节点

    procedure, non_overridable :: first !头节点

    procedure, non_overridable :: last !尾节点

    procedure, non_overridable :: prepend !将当前节点前置到链表头部

    procedure, non_overridable :: print_list !打印链表

  end type



  type anyitem !（任意类型）节点类  双向环形链表

    class(*), allocatable            :: value !无限多态类型

    class(anyitem), pointer, private :: nextptr => null(), prevptr => null() !后指针与前指针

    class(anylist), pointer, private :: upptr => null() !节点所在的链表指针

  contains

    procedure, non_overridable :: change !节点改值

    procedure, non_overridable :: delete !删除节点并释放其内存

    procedure, non_overridable :: list !返回节点所在的链表

    procedure, non_overridable :: next !后一个节点

    procedure, non_overridable :: prev !前一个节点

    procedure                  :: print !打印节点 允许子类重载该方法

    procedure, non_overridable :: remove !将该节点从链表中删除，但仍保留该节点和其值

  end type

contains

  function newitem(something) !节点创建函数

    class(*), intent(in)    :: something !无限多态类型

    class(anyitem), pointer :: newitem

    allocate (newitem)

    allocate (newitem%value, source=something) !节点分配内存并赋值

    newitem%prevptr => newitem !节点前置指针指向节点本身

  end function



  subroutine append(list, item) !尾部增加节点

    class(anylist), intent(inout), target :: list

    class(anyitem), target                :: item

    class(anyitem), pointer               :: last



    if (associated(item%upptr)) call remove(item) !如果节点属于某个链表  脱离从属关系

    item%upptr => list !节点属于新的链表

    if (associated(list%firstptr)) then !不是空链表

      last => list%firstptr%prevptr !last为链表尾节点

      last%nextptr => item !尾部插入新节点

      item%prevptr => last !新节点与原尾节点建立链接

      list%firstptr%prevptr => item !item为新的尾节点

    else !空链表 item为第一个节点

      list%firstptr => item

      item%prevptr => item !item%nextptr => null()

    end if

  end subroutine



  integer function count_list(list) !链表节点个数

    class(anylist), intent(in) :: list

    class(anyitem), pointer :: p !遍历指针

    count_list = 0 !累加器

    p => list%firstptr !指向头节点

    do

      if (.not.associated(p)) exit !指针为空退出循环

      count_list = count_list + 1

      p => p%nextptr !下一个节点

    end do

  end function



  subroutine delete_list(list) !删除链表所有节点

    class(anylist), intent(inout) :: list

    do

      if (.not.associated(list%firstptr)) exit !指针为空退出循环

      call delete(list%firstptr) !总是删除头节点

    end do

  end subroutine



  function first(list) !链表头节点

    class(anylist), intent(in) :: list

    class(anyitem), pointer :: first

    first => list%firstptr

  end function



  function last(list) !链表尾节点

    class(anylist), intent(in) :: list

    class(anyitem), pointer :: last

    last => list%firstptr

    if (associated(last)) last => last%prevptr !头节点的上一个位置即尾节点

  end function



  subroutine prepend(list, item) !将节点前置到链表头部

    class(anylist), intent(inout), target :: list

    class(anyitem), target                :: item

    if (associated(item%upptr)) call remove(item) !隔绝节点与原链表的联系

    item%upptr => list !节点属于新链表

    if (associated(list%firstptr)) then !不是空链表

      item%prevptr => list%firstptr%prevptr !将节点前置到链表头部

      item%nextptr => list%firstptr

      list%firstptr%prevptr => item

    else !空链表

      item%prevptr => item

    end if

    list%firstptr => item !链表的头指针指向前置节点

  end subroutine



  subroutine print_list(list, show_item_numbers, show_empty_list) !打印链表

    class(anylist), intent(in) :: list

    logical, intent(in), optional :: show_item_numbers, show_empty_list

    class(anyitem), pointer :: p !遍历指针

    integer :: i

    logical :: show_numbers !是否显示节点序号

    if (present(show_item_numbers)) then

      show_numbers = show_item_numbers

    else

      show_numbers = .true. !是否显示节点序号 默认为真

    end if

    p => list%firstptr !从头开始

    if (.not.associated(p)) then !空链表

      if (present(show_empty_list)) then

        if (show_empty_list) print *, 'List is empty.'

      else

        print *, 'List is empty.'!空链表默认显示

      end if

    else !不是空链表

      do i=1, huge(i)-1 !huge(i)为最大整数

        if (show_numbers) write (*, 1, advance='no') i !显示节点序号

1       format(1x, 'Item ', i0, ':')

        call p%print !打印节点

        p => p%nextptr !下一个节点

        if (.not.associated(p)) exit !空链表退出循环

      end do

    end if

  end subroutine



  subroutine change(item, newvalue) !节点改值

    class(anyitem), intent(inout) :: item

    class(*), intent(in)          :: newvalue !无限多态类型



    deallocate (item%value) !释放原节点内存

    allocate (item%value, source=newvalue) !新节点分配内存并赋值

  end subroutine



  subroutine delete(item) !删除节点并释放其内存

    class(anyitem), target  :: item

    class(anyitem), pointer :: temp

    temp => item

    call remove(item) !将该节点从链表中删除，但仍保留该节点和其值

    deallocate (temp) !释放内存

  end subroutine



  function list(item) !返回节点所在的链表

    class(anyitem), intent(in) :: item

    class(anylist), pointer :: list

    list => item%upptr

  end function



  function next(item) !下一个节点

    class(anyitem), intent(in) :: item

    class(anyitem), pointer :: next

    next => item%nextptr

  end function



  function prev(item) !上一个节点

    class(anyitem), intent(in) :: item

    class(anyitem), pointer :: prev

    prev => item%prevptr

  end function



  subroutine print(this) !打印该节点

    class(anyitem), intent(in) :: this

    integer length

    select type (v=>this%value)

    type is (character(*)) !字符串

      length = len(v) !字符串长度

      if (length>40) then

        print 1, length, v(:36) !打印前36个字符

1       format(1x, 'character(len=', i0, ') = "', a, '"...')

      else

        print *, 'character = "', v, '"' !打印全部字符

      end if

    type is (complex) !单精度复数

      print *, 'complex', v

    type is (complex(kind(0d0))) !双精度复数

      print 2, kind(v), v

2     format(1x, 'complex(kind=', i0, ') = (', es23.16, ', ', es23.16, ')')

    type is (real(kind(0d0))) !双精度浮点数

      print 3, kind(v), v

3     format(1x, 'real(kind=', i0, ') = ', es23.16)

    type is (integer) !整数

      print *, 'integer = ', v

    type is (real) !单精度浮点数

      print *, 'real = ', v

    type is (logical) !逻辑变量

      print *, 'logical = ', v

    class default !未定义类型

      print *, 'unrecognised item type - cannot display value'

    end select

  end subroutine



  subroutine remove(item) !将该节点从链表中删除，但仍保留该节点和其值

    class(anyitem), intent(inout), target :: item

    class(anylist), pointer :: list

    list => item%upptr !节点所在的链表

    if (associated(list)) then !不是空链表

      if (associated(item%prevptr, item)) then !链表中唯一的节点

        ! Single item in list.

        nullify(list%firstptr) !链表头指针置空

      else if (.not.associated(item%nextptr)) then !链表尾节点

        ! Last item in list.

        list%firstptr%prevptr => item%prevptr !尾节点上移

        nullify(item%prevptr%nextptr) !尾节点的标志为后指针为空

      else if (associated(list%firstptr, item)) then !链表头节点

        ! First item in list.

        list%firstptr => item%nextptr         ! first = next. 头节点下移

        item%nextptr%prevptr => item%prevptr  ! next%prev = last.

      else !中间节点

        item%prevptr%nextptr => item%nextptr  ! last%next = item%next.

        item%nextptr%prevptr => item%prevptr  ! next%prev = item%last.

      end if

      item%prevptr => item

    end if

    nullify(item%upptr) !此时节点不属于任何链表

  end subroutine

end module