! dc_STRING_LIST.f90 - 任意個の文字列を収納するスタック
! Copyright (C) GFD Dennou Club, 2000.  All rights reserved
! vi: set sw=4:

module DCSTRING_LIST

    use dcstring_base
    implicit none
    private
    public:: STRING_LIST, init, clear, dispose, assignment(=)
    public:: push, pop, shift, unshift
    public:: len, extract, element, split
  
    type STRING_NODE
        type(VSTRING):: body
        type(STRING_NODE), pointer:: next
    end type

    type STRING_LIST
        private
        type(STRING_NODE), pointer:: head
    end type

    interface init;  module procedure init_vs;  end interface
    interface clear;  module procedure clear_vs;  end interface
    interface dispose;  module procedure dispose_vs;  end interface
    interface len;  module procedure len_vs;  end interface
    interface push;  module procedure push_vs, push_vc;  end interface
    interface pop;  module procedure pop_vs;  end interface
    interface shift;  module procedure shift_vs;  end interface
    interface unshift;  module procedure unshift_vs;  end interface
    interface extract;  module procedure extract_vs;  end interface
    interface element;  module procedure element_vs;  end interface
    interface copy;  module procedure copy_vs;  end interface

    interface split
        module procedure CharSplit
        module procedure VstSplit
    end interface

contains

    subroutine init_vs(vs)
        type(STRING_LIST), intent(out):: vs
    continue
        nullify(vs%head)
    end subroutine

    subroutine copy_vs(lhs, rhs, items)
        type(STRING_LIST), intent(inout):: lhs
        type(STRING_LIST), intent(in):: rhs
        integer, intent(in), optional:: items
        type(STRING_NODE), pointer:: rhs_cursor
        type(STRING_NODE), pointer:: lhs_cursor
        integer:: c, ncopy
    continue
        ncopy = huge(ncopy)
        if (present(items)) ncopy = items
        rhs_cursor => rhs%head
        if (.not. associated(rhs_cursor)) then
            nullify(lhs%head)
            return
        endif
        allocate(lhs%head)
        lhs_cursor => lhs%head
        c = 0
        do
            c = c + 1
            lhs_cursor%body = rhs_cursor%body
            if (c == ncopy .or. .not. associated(rhs_cursor%next)) then
                nullify(lhs_cursor%next)
                return
            endif
            rhs_cursor => rhs_cursor%next
            allocate(lhs_cursor%next)
            lhs_cursor => lhs_cursor%next
        enddo
    end subroutine

    subroutine clear_vs(vs)
        type(STRING_LIST), intent(inout):: vs
    continue
        nullify(vs%head)
    end subroutine

    subroutine dispose_vs(vs)
        type(STRING_LIST), intent(inout):: vs
        type(STRING_NODE), pointer:: cursor
        type(STRING_NODE), pointer:: nextp
    continue
        cursor => vs%head
        do
            if (.not. associated(cursor)) exit
            nextp => cursor%next
            cursor%body = ""
            deallocate(cursor)
            cursor => nextp
        enddo
    end subroutine

    integer function len_vs(vs) result(result)
        type(STRING_LIST), intent(in):: vs
        type(STRING_NODE), pointer:: cursor
    continue
        result = 0
        cursor => vs%head
        do
            if (.not. associated(cursor)) exit
            result = result + 1
            cursor => cursor%next
        enddo
    end function

    type(VSTRING) function element_vs(vs, pos) result(result)
        type(STRING_LIST), intent(in):: vs
        type(STRING_NODE), pointer:: cursor
        integer, intent(in):: pos
        integer:: c
    continue
        c = 0
        cursor = vs%head
        do
            if (.not. associated(cursor)) exit
            c = c + 1
            if (c == pos) then
                result = cursor%body
                return
            endif
            cursor => cursor%next
        enddo
        result = ""
    end function

    ! deep copy を作る
    function extract_vs(vs, start, finish) result(result)
        type(STRING_LIST):: result
        type(STRING_LIST), intent(in):: vs
        integer, intent(in), optional:: start, finish
        type(STRING_LIST):: shallow_copy
        type(STRING_NODE), pointer:: cursor
        integer:: c, first, items
    continue
        first = 1
        if (present(start)) first = max(start, first)
        c = 0
        cursor = vs%head
        do
            if (.not. associated(cursor)) then
                nullify(result%head)
                return
            endif
            c = c + 1
            if (c == first) then
                shallow_copy%head => cursor
                exit
            endif
            cursor => cursor%next
        enddo
        items = HUGE(1)
        if (present(finish)) items = finish - first
        call copy_vs(result, shallow_copy, items)
    end function

    subroutine push_vs(vs, string)
        type(STRING_LIST), intent(inout):: vs
        type(VSTRING), intent(in):: string
        type(STRING_NODE), pointer:: cursor
    continue
        if (.not. associated(vs%head)) then
            allocate(vs%head)
            vs%head%body = string
            nullify(vs%head%next)
            return
        endif
        cursor => vs%head
        do
            if (.not. associated(cursor%next)) exit
            cursor => cursor%next
        enddo
        allocate(cursor%next)
        cursor%next%body = string
        nullify(cursor%next%next)
    end subroutine

    subroutine push_vc(vs, string)
        type(STRING_LIST), intent(inout):: vs
        character(len = *), intent(in):: string
        type(STRING_NODE), pointer:: cursor
    continue
        cursor => vs%head
        if (.not. associated(cursor)) then
            allocate(vs%head)
            nullify(vs%head%next)
            vs%head%body = string
            return
        endif
        do
            if (.not. associated(cursor%next)) exit
            cursor => cursor%next
        enddo
        allocate(cursor%next)
        cursor => cursor%next
        cursor%body = string
        nullify(cursor%next)
    end subroutine

    type(VSTRING) function pop_vs(vs) result(result)
        type(STRING_LIST), intent(inout):: vs
        type(STRING_NODE), pointer:: cursor
    continue
        cursor => vs%head
        if (.not. associated(cursor)) then
            result = ""
        else if (.not. associated(cursor%next)) then
            result = cursor%body
            deallocate(cursor)
            nullify(vs%head)
        else
            do
                if (.not. associated(cursor%next%next)) exit
                cursor => cursor%next
            enddo
            result = cursor%next%body
            deallocate(cursor%next)
        endif
    end function

    type(VSTRING) function shift_vs(vs) result(result)
        type(STRING_LIST), intent(inout):: vs
        type(STRING_NODE), pointer:: cursor
    continue
        if (associated(vs%head)) then
            result = vs%head%body
        else
            result = ""
            return
        endif
        cursor => vs%head%next
        deallocate(vs%head)
        vs%head => cursor
    end function

    subroutine unshift_vs(vs, string)
        type(STRING_LIST), intent(inout):: vs
        type(VSTRING), intent(in):: string
        type(STRING_NODE), pointer:: cursor
    continue
        cursor => vs%head
        allocate(vs%head)
        vs%head%body = string
        vs%head%next => cursor
    end subroutine

    ! --- Split ---
    !
    ! fs で文字列を分解して STRING_LIST に格納する。
    ! このとき分解された語の先頭の空白は無視される。

    subroutine VstSplit(LIST, string, fs)
        type(STRING_LIST), intent(out):: LIST
        type(VSTRING), intent(in):: string
        character(len = *), intent(in):: FS
        integer:: ifind
        type(VSTRING):: watch
    continue
        call init(LIST)
        watch = string
        do
            ! watch に空白文字があるなら除去
            ifind = vverify(watch, " ")
            if (ifind == 0) exit
            watch = extract(watch, ifind)
            ! FS に含まれる最初の文字の直前か、それがなければ文末を取り出す
            ifind = vscan(watch, FS)
            if (ifind == 0) then
                call push(LIST, watch)
                exit
            endif
            call push(LIST, extract(watch, 1, ifind - 1))
            watch = extract(watch, ifind + 1)
        enddo
    end subroutine

    subroutine CharSplit(list, string, fs)
        type(STRING_LIST), intent(out):: list
        character(len = *), intent(in):: string
        character(len = *), intent(in):: FS
        integer:: istart, iend, ifind
    continue
        call init(list)
        istart = 1
        do
            ! istart 以降に空白でない文字があるか?
            ifind = verify(string(istart: ), " ")
            if (ifind == 0) exit
            istart = istart + ifind - 1
            ! FS に含まれる最初の文字の直前か、それがなければ文末を取り出す
            ifind = scan(string(istart: ), FS)
            if (ifind == 0) then
                iend = len(string)
            else
                iend = istart + ifind - 1
            endif
            call push(list, string(istart:iend))
            ! もし文字が残っていれば継続
            istart = iend + 2
            if (istart > len(string)) exit
        enddo
    end subroutine

end module
