Fortranで何でも入れて取り出せる型を作る

概要

代入演算子=を介して，任意の型の値を代入でき，任意の型の変数に値を代入できる型を作ります．

無限多相的データ要素

任意の型の値を代入でき，その値を参照できる機能は，Fortran規格で既に存在します．
型指定子class(*)で宣言された要素（変数）は無限多相的とされ，宣言時に型をもつとは見なされませんが，全てのデータ要素と型が適合します．簡単に言えば，ユーザ定義の派生型を含むどんな型でも代入できるということです．

型指定子class(*)で宣言された要素（変数）について，規格ではどう呼ぶかは明確に定義されていないので，本記事では無限多相的データ要素と呼ぶことにします．無限多相的データ要素は，class(*), allocatableとして宣言します．手続の仮引数にする場合は，allocatable属性は不要です．

class(*), allocatable :: any

any = 127_int8
any = 32767_int16
any = huge(0._real32)

任意の型を代入したいという要望はこれで叶えられますが，無限多相的データ要素は値を参照するときが面倒です．無限多相的データ要素の値を参照する場合は，無限多相的データ要素に代入されている実際の値の型に基づいて処理を行う必要があり，その実際の型に基づく処理の選択には，select type構文を用います．

class(*), allocatable :: any

! any に値を代入する．

select type(any)
type is (integer(int8))
    ! この中ではinteger(int8) :: anyとして扱われる
    print *, any

type is (integer(int16))
    ! この中ではinteger(int16) :: anyとして扱われる
    print *, any

type is (real(real32))
    ! この中ではreal(real32) :: anyとして扱われる
    print *, any

class default
    ! どの型にも適合しない場合

end select

上の例では，1バイト整数，2バイト整数，4バイト実数を無限多相的データ要素に代入していましたが，その値を参照する処理も含めて書くと，下のようになります．

program main
    use, intrinsic :: iso_fortran_env
    implicit none

    class(*), allocatable :: any

    integer(int8) :: i8
    integer(int16) :: i16
    real(real32) :: r32

    ! 代入
    any = huge(i8)
    ! 参照
    select type (any)
    type is (integer(int8))
        i8 = any
    end select
    print *, i8

    ! 代入
    any = huge(i16)
    ! 参照
    select type (any)
    type is (integer(int16))
        i16 = any
    end select
    print *, i16

    ! 代入
    any = huge(r32)
    ! 参照
    select type (any)
    type is (real(real32))
        r32 = any
    end select
    print *, r32
end program main

代入の簡便さとはうってかわって，値の参照が非常に面倒であることがわかります．値の参照を簡単にできるようにしようというのが本記事の狙いです．

無限多相的データ要素から値を取り出して返す手続を作る事もできますが，参照に際して手続を選ぶ一手間が必要です．

i8 = as_int8(any)
i16 = as_int16(any)

function as_int8(val) result(i8)
    class(*), allocatable :: val
    integer(int8) :: i8

    select type (val)
    type is (integer(int8))
        i8 = val
    end select
end function as_int8

function as_int16(val) result(i16)
    class(*), allocatable :: val
    integer(int16) :: i16
    select type (val)
    type is (integer(int16))
        i16 = val
    end select
end function as_int16

Fortranには総称名と呼ばれる機能があり，異なる手続を一つの共通した名前で呼び出せるようにできます．しかし，総称名は，仮引数の型が異なっている必要があるため，上記のように仮引数の型が同じ関数に対して，総称名を適用することはできません．

何でも入れて取り出せる派生型

無限多相的データ要素（class(*), allocatableの変数）に対して何とかしようというのは諦めて，無限多相的データ要素を成分に持つ派生型any_typeを作る事にします．

type, public :: any_type
    class(*), private, allocatable :: val
end type any_type

総称名は，仮引数の型が異なっている手続を一つの共通した名前で呼び出せる機能であることは述べました．関数の場合，どうしても仮引数の型が共通になってしまいますが，subroutineであれば，代入先の変数の型が異なるため，総称名を用いる事ができるようになります．

! 引数の型が同じ
i8 = as_int8(any)
i16 = as_int16(any)

! 第1引数の型が異なる
call assign_to_int8(lhs=i8, rhs=any)
call assign_to_int16(lhs=i16, rhs=any)

加えて，派生型に対して定義したそれらのsubroutineは，代入演算子のオーバーロードに利用できます．代入演算子をオーバーロードすれば，変換したい型の変数に値を代入する処理を書くだけで，無限多相的データ要素の値が参照できるようになります．

any_typeへの値の代入は，無限多相的データ要素を仮引数として利用すれば，実装するsubroutineは一つだけですみます．

pure subroutine assign(lhs, rhs)
    type(any_type), intent(inout) :: lhs
    class(*), intent(in) :: rhs

    lhs%val = rhs
end subroutine assign

any_typeの値の参照は，代入したい型に対応するsubroutineを書く必要はありますが，書く内容はほとんど同じです．そのため，fypp等のメタプログラミングツールを用いるで自動生成することも可能でしょう．

pure subroutine assign_to_int8(lhs, rhs)
    integer(int8), intent(out) :: lhs
    type(any_type), intent(in) :: rhs

    select type (val => rhs%val); type is (integer(int8))
        lhs = val
    end select
end subroutine assign_to_int8

pure subroutine assign_to_int16(lhs, rhs)
    integer(int16), intent(out) :: lhs
    type(any_type), intent(in) :: rhs

    select type (val => rhs%val); type is (integer(int16))
        lhs = val
    end select
end subroutine assign_to_int16

pure subroutine assign_to_real32(lhs, rhs)
    real(real32), intent(out) :: lhs
    type(any_type), intent(in) :: rhs

    select type (val => rhs%val); type is (real(real32))
        lhs = val
    end select
end subroutine assign_to_real32

最後に，interfaceを用いて代入演算子をオーバーロードすれば完了です．

interface assignment(=)
    procedure :: assign
    procedure :: assign_to_int8
    procedure :: assign_to_int16
    procedure :: assign_to_real32
end interface

any_typeを用いると，値の代入と参照は非常に簡単になります．

program main
    use, intrinsic :: iso_fortran_env
    use :: any_t
    implicit none

    type(any_type) :: any
    integer(int8) :: i8
    integer(int16) :: i16
    real(real32) :: r32

    any = huge(i8)
    i8 = any
    print *, i8

    any = huge(i16)
    i16 = any
    print *, i16

    any = huge(r32)
    r32 = any
    print *, r32
end program main

any_tモジュールは次のように定義されています．

any_tモジュール

module any_t
    use, intrinsic :: iso_fortran_env
    implicit none
    private
    public :: assignment(=)

    type, public :: any_type
        class(*), private, allocatable :: val
    contains
        procedure, public, pass :: get
    end type any_type

    interface assignment(=)
        procedure :: assign
        procedure :: assign_to_int8
        procedure :: assign_to_int16
        procedure :: assign_to_real32
    end interface
contains
    function get(this) result(val)
        class(any_type), intent(in) :: this
        class(*), allocatable :: val
        val = this%val
    end function get

    pure subroutine assign(lhs, rhs)
        type(any_type), intent(inout) :: lhs
        class(*), intent(in) :: rhs

        lhs%val = rhs
    end subroutine assign

    pure subroutine assign_to_int8(lhs, rhs)
        integer(int8), intent(out) :: lhs
        type(any_type), intent(in) :: rhs

        select type (val => rhs%val); type is (integer(int8))
            lhs = val
        end select
    end subroutine assign_to_int8

    pure subroutine assign_to_int16(lhs, rhs)
        integer(int16), intent(out) :: lhs
        type(any_type), intent(in) :: rhs

        select type (val => rhs%val); type is (integer(int16))
            lhs = val
        end select
    end subroutine assign_to_int16

    pure subroutine assign_to_real32(lhs, rhs)
        real(real32), intent(out) :: lhs
        type(any_type), intent(in) :: rhs

        select type (val => rhs%val); type is (real(real32))
            lhs = val
        end select
    end subroutine assign_to_real32
end module any_t

ユーザ定義派生型を参照する場合

題名には

何でも入れて取り出せる

と書かれています．しかし，実際にany_typeを定義する段階では，全ての型，特にユーザが独自に定義するユーザ定義定義派生型を参照できるようにするのは不可能です．

any_typeを介してユーザ定義派生型の値を参照する場合は，派生型を定義する際に参照するsubroutineの定義と代入演算子のオーバーロードを行う必要があります．any_typeの定義において，成分を返すだけの手続getを定義しているのはそのためです．

例えば，成分にx, yをもつユーザ定義の2次元ベクトル型vector2d_typeを，any_typeを介して参照したい場合は，vector2d_typeを定義するモジュール内で下記のように代入演算を行うsubroutineを追加し，代入演算子をオーバーロードするのが最も手間が少ないと思われます．

module vector2d
    use, intrinsic :: iso_fortran_env
    use :: any_t
    implicit none
    private
    public :: assignment(=)

    type, public :: vector2d_type
        real(real32), public :: x, y
    end type vector2d_type

    interface assignment(=)
        procedure :: assign_to_vector2d
    end interface
contains
    subroutine assign_to_vector2d(lhs, rhs)
        type(vector2d_type), intent(out) :: lhs
        type(any_type), intent(in) :: rhs

        class(*), allocatable :: val
        val = rhs%get()

        select type (val); type is (vector2d_type)
            lhs = val
        end select
    end subroutine assign_to_vector2d
end module vector2d

program main
    use, intrinsic :: iso_fortran_env
    use :: any_t
    use :: vector2d
    implicit none

    type(any_type) :: any
    type(vector2d_type) :: vec

    vec = vector2d_type(1.0, 2.0)
    any = vec
    vec = vector2d_type(0.0, 0.0)
    vec = any
    print *, vec ! anyの値を参照できていなければ，0.0 0.0が表示される
end program main

まとめ

無限多相的データ要素を成分に持つ派生型を利用する事で，何でも入れて取り出せる型を作りました．

全ての組込型や配列次元をサポートしようとすると，定義が大変になりますが，一度実装してしまえば，select type構文を排除できるのでかなり便利に利用できます．

本記事での実装では配列に対応できませんが，any_typeの成分としてclass(*), allocatableの配列データ要素を設けて代入演算を記述すれば，対応可能です．