【メモ帳】forpy 用 tuple, list 代入

昨日の続き

tuple のみならず list も代入できるようにしてみました。また tuple や list, object 型も要素として代入できるようにしてみました。

OO化すれば、終了処理も自動化できるし便利かも。

forpy 恐るべしｗ
github.com

[追記]
しかし、Fortran の関数値の代入は、Deep Copy になるので、destroy 処理がちゃんとなされていない可能性がある。 type(c_ptr) が基底にあるので、変数に代入した場合は大丈夫かもしれないが、要素として無名のまま代入した場合はダメかもｗ

実行結果

代入操作 tuple と list

        type(tuple) :: tu1, tu2
        type(list)  :: lst 
        tu1 = t_tuple(1, 2.0, 'sun')
        tu2 = t_tuple('one', 2, 3.0, 4.0d0, tu1)

        lst = t_list('a', 2, 3.0, '5', 6.0d0, tu2, t_list('uno', 'dos', 'windows'))

D:\Git\Python\forpy-master>asstup
3
5
(1, 2.0, 'sun')
('one', 2, 3.0, 4.0, (1, 2.0, 'sun'))
　
['a', 2, 3.0, '5', 6.0, ('one', 2, 3.0, 4.0, (1, 2.0, 'sun')), ['uno', 'dos', 'windows']]
D:\Git\Python\forpy-master>

プログラム

    module m_tuple
        use, intrinsic :: iso_fortran_env
        use forpy_mod
        implicit none
    contains
        subroutine tup_assign(tup, i, c)
            type(tuple), intent(in out) :: tup
            integer , intent(in) :: i
            class(*), intent(in) :: c
            integer :: ierr
            select type (c)
            type is (integer(int32))
                ierr = tup%setitem(i, c)
            type is (integer(int64))
                ierr = tup%setitem(i, c)
            type is (real(real32))
                ierr = tup%setitem(i, c)
            type is (real(real64))
                ierr = tup%setitem(i, c)
            type is (character(*))
                ierr = tup%setitem(i, c)
            type is (tuple)
                ierr = tup%setitem(i, c)
            type is (list)
                ierr = tup%setitem(i, c)
            type is (object)
                ierr = tup%setitem(i, c)
            class default
                stop 'error tup_assign'
            end select
        end subroutine tup_assign
        
        type(tuple) function t_tuple(c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15) result(tup)
            class(*), intent(in), optional :: c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15
            integer :: ierr, n
            n = 0
            if (present(c0 )) n = 1
            if (present(c1 )) n = n + 1
            if (present(c2 )) n = n + 1
            if (present(c3 )) n = n + 1
            if (present(c4 )) n = n + 1
            if (present(c5 )) n = n + 1
            if (present(c6 )) n = n + 1
            if (present(c7 )) n = n + 1
            if (present(c8 )) n = n + 1
            if (present(c9 )) n = n + 1
            if (present(c10)) n = n + 1
            if (present(c11)) n = n + 1
            if (present(c12)) n = n + 1
            if (present(c13)) n = n + 1
            if (present(c14)) n = n + 1
            if (present(c15)) n = n + 1
            ierr = tuple_create(tup, n)

            if (present(c0 )) call tup_assign(tup,  0, c0)
            if (present(c1 )) call tup_assign(tup,  1, c1)
            if (present(c2 )) call tup_assign(tup,  2, c2)
            if (present(c3 )) call tup_assign(tup,  3, c3)
            if (present(c4 )) call tup_assign(tup,  4, c4)
            if (present(c5 )) call tup_assign(tup,  5, c5)
            if (present(c6 )) call tup_assign(tup,  6, c6)
            if (present(c7 )) call tup_assign(tup,  7, c7)
            if (present(c8 )) call tup_assign(tup,  8, c8)
            if (present(c9 )) call tup_assign(tup,  9, c8)
            if (present(c10)) call tup_assign(tup, 10, c0)
            if (present(c11)) call tup_assign(tup, 11, c1)
            if (present(c12)) call tup_assign(tup, 12, c2)
            if (present(c13)) call tup_assign(tup, 13, c3)
            if (present(c14)) call tup_assign(tup, 14, c4)
            if (present(c15)) call tup_assign(tup, 15, c5)
        end function t_tuple
    
        subroutine lis_append(lst, c)
            type(list), intent(in out) :: lst
            class(*), intent(in) :: c
            integer :: ierr
            select type (c)
            type is (integer(int32))
                ierr = lst%append(c)
            type is (integer(int64))
                ierr = lst%append(c)
            type is (real(real32))
                ierr = lst%append(c)
            type is (real(real64))
                ierr = lst%append(c)
            type is (character(*))
                ierr = lst%append(c)
            type is (tuple)
                ierr = lst%append(c)
            type is (list)
                ierr = lst%append(c)
            type is (object)
                ierr = lst%append(c)
            class default
                stop 'error lis_append'
            end select
        end subroutine lis_append
        
        type(list) function t_list(c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15) result(lst)
            class(*), intent(in), optional :: c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15
            integer :: ierr
            ierr = list_create(lst)
            if (present(c0 )) call lis_append(lst,  c0)
            if (present(c1 )) call lis_append(lst,  c1)
            if (present(c2 )) call lis_append(lst,  c2)
            if (present(c3 )) call lis_append(lst,  c3)
            if (present(c4 )) call lis_append(lst,  c4)
            if (present(c5 )) call lis_append(lst,  c5)
            if (present(c6 )) call lis_append(lst,  c6)
            if (present(c7 )) call lis_append(lst,  c7)
            if (present(c8 )) call lis_append(lst,  c8)
            if (present(c9 )) call lis_append(lst,  c9)
            if (present(c10)) call lis_append(lst, c10)
            if (present(c11)) call lis_append(lst, c11)
            if (present(c12)) call lis_append(lst, c12)
            if (present(c13)) call lis_append(lst, c13)
            if (present(c14)) call lis_append(lst, c14)
            if (present(c15)) call lis_append(lst, c15)
        end function t_list
    end module m_tuple

    program test
        use m_tuple
        integer :: ierr
        type(tuple) :: tu1, tu2
        type(list)  :: lst 
        integer :: len_tu
        ierr = forpy_initialize()
        tu1 = t_tuple(1, 2.0, 'sun')
        ierr = tu1%len(len_tu)
        print *, len_tu

        tu2 = t_tuple('one', 2, 3.0, 4.0d0, tu1)
        ierr = tu2%len(len_tu)
        print *, len_tu
        ierr = print_py(tu1)
        ierr = print_py(tu2)
        
        print *
        lst = t_list('a', 2, 3.0, '5', 6.0d0, tu2, t_list('uno', 'dos', 'windows'))
        ierr = print_py(lst)
        
        call lst%destroy()
        call tu1%destroy()
        call tu2%destroy()
        call forpy_finalize()
    end program test

少し書き直してみた [H30.8.31]

Fortran には、ポインタの配列はないので、ポインタを要素と持つ派生型を定義して、その派生型の配列を作る必要がある。ポインタを配列っぽく書いても、それは配列へのポインタであってポインタの配列にはならない。

    module m_tuple
        use, intrinsic :: iso_fortran_env
        use forpy_mod
        implicit none
        type :: t_c
            class(*), pointer :: p => null()
        end type t_c
    contains
        subroutine tup_assign(tup, i, c)
            type(tuple), intent(in out) :: tup
            integer , intent(in) :: i
            class(*), intent(in) :: c
            integer :: ierr
            select type (c)
            type is (integer(int32))
                ierr = tup%setitem(i, c)
            type is (integer(int64))
                ierr = tup%setitem(i, c)
            type is (real(real32))
                ierr = tup%setitem(i, c)
            type is (real(real64))
                ierr = tup%setitem(i, c)
            type is (character(*))
                ierr = tup%setitem(i, c)
            type is (tuple)
                ierr = tup%setitem(i, c)
            type is (list)
                ierr = tup%setitem(i, c)
            type is (object)
                ierr = tup%setitem(i, c)
            class default
                stop 'error tup_assign'
            end select
        end subroutine tup_assign
        
        type(tuple) function t_tuple(c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15) result(tup)
            class(*), intent(in), optional, target :: c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15
            integer :: ierr, i, n
            type(t_c) :: c(0:15) 
            if (present(c0 )) c( 0)%p => c0
            if (present(c1 )) c( 1)%p => c1
            if (present(c2 )) c( 2)%p => c2
            if (present(c3 )) c( 3)%p => c3
            if (present(c4 )) c( 4)%p => c4
            if (present(c5 )) c( 5)%p => c5
            if (present(c6 )) c( 6)%p => c6
            if (present(c7 )) c( 7)%p => c7
            if (present(c8 )) c( 8)%p => c8
            if (present(c9 )) c( 9)%p => c9
            if (present(c10)) c(10)%p => c10
            if (present(c11)) c(11)%p => c11
            if (present(c12)) c(12)%p => c12
            if (present(c13)) c(13)%p => c13
            if (present(c14)) c(14)%p => c14
            if (present(c15)) c(15)%p => c15
            n = 0
            do i = 0, 15
                if (associated(c(i)%p)) n = n + 1            
            end do
            ierr = tuple_create(tup, n)
            do i = 0, 15
                if (associated(c(i)%p)) call tup_assign(tup, i, c(i)%p)
            end do
            forall (i = 0:15) c(i)%p => null()
        end function t_tuple
    
        subroutine lis_append(lst, c)
            type(list), intent(in out) :: lst
            class(*), intent(in) :: c
            integer :: ierr
            select type (c)
            type is (integer(int32))
                ierr = lst%append(c)
            type is (integer(int64))
                ierr = lst%append(c)
            type is (real(real32))
                ierr = lst%append(c)
            type is (real(real64))
                ierr = lst%append(c)
            type is (character(*))
                ierr = lst%append(c)
            type is (tuple)
                ierr = lst%append(c)
            type is (list)
                ierr = lst%append(c)
            type is (object)
                ierr = lst%append(c)
            class default
                stop 'error lis_append'
            end select
        end subroutine lis_append
        
        type(list) function t_list(c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15) result(lst)
            class(*), intent(in), optional, target :: c0, c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12, c13, c14, c15
            integer :: ierr, i
            type(t_c) :: c(0:15) 
            if (present(c0 )) c( 0)%p => c0
            if (present(c1 )) c( 1)%p => c1
            if (present(c2 )) c( 2)%p => c2
            if (present(c3 )) c( 3)%p => c3
            if (present(c4 )) c( 4)%p => c4
            if (present(c5 )) c( 5)%p => c5
            if (present(c6 )) c( 6)%p => c6
            if (present(c7 )) c( 7)%p => c7
            if (present(c8 )) c( 8)%p => c8
            if (present(c9 )) c( 9)%p => c9
            if (present(c10)) c(10)%p => c10
            if (present(c11)) c(11)%p => c11
            if (present(c12)) c(12)%p => c12
            if (present(c13)) c(13)%p => c13
            if (present(c14)) c(14)%p => c14
            if (present(c15)) c(15)%p => c15
            ierr = list_create(lst)
            do i = 0, 15
               if (associated(c(i)%p)) call lis_append(lst, c(i)%p)
            end do
            forall (i = 0:15) c(i)%p => null()
        end function t_list
    end module m_tuple

    program test
        use m_tuple
        integer :: ierr
        type(tuple) :: tu1, tu2
        type(list)  :: lst 
        integer :: len_tu
        ierr = forpy_initialize()
        tu1 = t_tuple(1, 2.0, 'sun')
        ierr = tu1%len(len_tu)
        print *, len_tu

        tu2 = t_tuple('one', 2, 3.0, 4.0d0, tu1)
        ierr = tu2%len(len_tu)
        print *, len_tu
        ierr = print_py(tu1)
        ierr = print_py(tu2)
        
        print *
        lst = t_list('a', 2, 3.0, '5', 6.0d0, tu2, t_list('uno', 'dos', 'windows'))
        ierr = print_py(lst)
        
        call lst%destroy()
        call tu1%destroy()
        call tu2%destroy()
        call forpy_finalize()
    end program test