使用物件導向的Fortran實現通用數據結構

因為我們希望這個棧能用於任何資料物件，所以先定義一個不包含具體元素的抽象派生型別（即抽象類）

type, abstract :: stack_structure
contains
    procedure(copy), deferred :: copy ! copy object.
end type stack_structure
 
abstract interface
    subroutine copy(self, object)
        import :: stack_structure
        class(stack_structure), intent(in) :: self
        class(stack_structure), intent(out) :: object
    end subroutine copy
end interface

這裏的copy函式是用於pop資料時賦值的。因為我們後面傳給stack類的資料都是以支援多型的class(stack_structure)型別傳入，stack類並不知道里面的具體資料，因而無法直接賦值，需要迂迴一下。

這裏只實現兩個功能，push和pop。類的定義如下

type :: stack_class
    private
    class(stack_structure), pointer :: object => null()
    type(stack_class), pointer :: next => null()
contains
    procedure :: push => stack_push
    procedure :: pop => stack_pop
    final :: stack_cleanup
 end type stack_class

在類裏面定義了兩個私有變數。第一個是儲存的資料物件，用的是類指標，可以指向stack_structure及其任意子類，同時也能allocate成任何子類。第二個是指向下一個元素的指標。stack_cleanup是解構函式，用來釋放記憶體等。

先看一下pop函式

subroutine stack_push(self, object)
    class(stack_class), intent(inout), target :: self
    class(stack_structure), intent(in) :: object
    class(stack_class), pointer :: next
 
    if (associated(self%object)) then
        next => self%next
        allocate(self%next)
        self%next%object => self%object
        self%next%next => next
    end if
 
    allocate(self%object, source=object)
end subroutine stack_push

這裏比較關鍵的一句是

allocate(self%object, source=object)

函式傳入object的形參雖然是class(stack_structure)，但實參可以是任何stack_structure的子類，上面這句可以直接給self%object分配記憶體並賦值成object的實引數據，而不需要知道這個實參到底是什麼樣的。

再看pop

function stack_pop(self, object) result(success)
    class(stack_class), intent(inout), target :: self
    class(stack_structure), intent(out) :: object
    logical :: success
    class(stack_class), pointer :: next
 
    if (.not. associated(self%object)) then
        success = .false.
    else
        success = .true.
        call self%object%copy(object)
        deallocate(self%object)
    end if
 
    if (associated(self%next)) then
        next => self%next
        self%object => next%object
        self%next => next%next
        next%object => null()
        next%next => null()
        deallocate(next)
    end if
end function stack_pop

注意指標是否為空需要用associated來判斷，但是通過allocate分配記憶體的指標一定要通過deallocate來釋放，否則會記憶體洩漏。如上面所說，這裏使用了copy函式來實現賦值

call self%object%copy(object)

如果採用了對指標型別動態分配記憶體的方法，一定要記得釋放。這裏對類裡的變數可以通過解構函式來釋放

elemental subroutine stack_cleanup(self)
    type(stack_class), intent(inout) :: self
 
    if (associated(self%object)) then
        deallocate(self%object)
    end if
 
    if (associated(self%next)) then
        deallocate(self%next)
    end if
end subroutine stack_cleanup

type, extends(stack_structure) :: token_structure
    character(len=:), allocatable :: key
contains
    procedure :: copy => token_copy
end type token_structure
 
interface token_structure
    procedure :: token_create_object
end interface token_structure

這裏繼承了上面的stack_structure定義了一個token_structure，裏面存入一個變長字串。爲了方便的生成物件，還定義了建構函式，但不是必要的。

copy函式的實現如下

subroutine token_copy(self, object)
    class(token_structure), intent(in) :: self
    class(stack_structure), intent(out) :: object
 
    select type(object)
    class is(token_structure)
        object%key = self%key
    end select
end subroutine token_copy

注意object是以stack_structure的型別傳入的，必須要用select type判斷到token_structure才能賦值。

最後是建構函式

elemental function token_create_object(key) result(token)
    character(len=*), intent(in) :: key
    type(token_structure) :: token
 
    token%key = trim(adjustl(key))
end function token_create_object