Fortran の Generics

Fortran 202Y での導入が目指されている Generics ですが、LFortran で試験的な実装がなされ、試してみることが可能になりました。ここで Fortran 202Y とは次期規格の Fortran 202X のさらに次の規格という意味です。また Fortran 202X は、先年 X = 3 にすることが決まっています。

We implemented an initial prototype of Generics into LFortran from the Fortran Generics Subcommittee's draft. It works online as well. If you are interested in generics in Fortran, please go ahead and test it out. Instructions and more details:https://t.co/X9hgUx5yFx
— LFortran (@lfortranorg) 2022年11月5日

fortran-lang.discourse.group

LFortran は WEB 上で試すことが出来ます。

dev.lfortran.org

試行例

LFortran はユーザー定義派生型や operator overload などがまだ実装されていないので、あまり多くは試せません。

twitter にあった例題を改変して、単項演算子と二項演算子を試してみました。思ったより長々グチャグチャになり、定義位置や定義順もイマイチぴんと来ない感があります。また Fortran は case insensitive なので、Template と普通の具象名が渾然混沌区別がつかぬ感もします。

プログラム

requirement の中の function 名が漏れ出して、多重定義エラーになってしまうので名前を F0 に変えました。

module template_test_m
    implicit none
    private
    public :: unary_t, binary_t
    
    

    requirement S(T, F0) 
        type :: T; end type
        function F0(x) result(z)
            type(T), intent(in) :: x
            type(T) :: z
        end function
    end requirement

    template unary_t(T, F0)
        requires S(T, F0)
        private
        public :: unary_generic
    contains
        function unary_generic(x) result(z)
            type(T), intent(in) :: x
            type(T) :: z
            z = F0(x)
        end function
    end template
    
    
    
    
    requirement R(T, F) 
        type :: T; end type
        function F(x, y) result(z)
            type(T), intent(in) :: x, y
            type(T) :: z
        end function
    end requirement

    template binary_t(T, F)
        requires R(T, F)
        private
        public :: binary_generic
    contains
        function binary_generic(x, y) result(z)
            type(T), intent(in) :: x, y
            type(T) :: z
            z = F(x, y)
        end function
    end template


contains


    real function func_minus_real(x) result(z)
        real, intent(in) :: x
        z = -x
    end function

    
    real function func_add_real(x, y) result(z)
        real, intent(in) :: x, y
        z = x + y
    end function

    real function func_sub_real(x, y) result(z)
        real, intent(in) :: x, y
        z = x - y
    end function

    real function func_mul_real(x, y) result(z)
        real, intent(in) :: x, y
        z = x * y
    end function

    real function func_div_real(x, y) result(z)
        real, intent(in) :: x, y
        z = x / y
    end function 
    


    subroutine test_template()
        instantiate unary_t(real, func_minus_real), only: minus_real => unary_generic

        instantiate binary_t(real, func_add_real), only: add_real => binary_generic
        instantiate binary_t(real, func_sub_real), only: sub_real => binary_generic       
        instantiate binary_t(real, func_mul_real), only: mul_real => binary_generic       
        instantiate binary_t(real, func_div_real), only: div_real => binary_generic       
        
        real :: x, y
        x = 5.1
        y = 7.2

        print*, "The result is ", minus_real(x)
        if (abs(minus_real(x) + x) > 1e-5) error stop


        print*, "The result is ", add_real(x, y)
        if (abs(add_real(x, y) - 12.3) > 1e-5) error stop

        print*, "The result is ", sub_real(x, y)
        if (abs(sub_real(x, y) + 2.1) > 1e-5) error stop

        print*, "The result is ", mul_real(x, y)
       if (abs(mul_real(x, y) - 36.72) > 1e-2) error stop

        print*, "The result is ", div_real(x, y)
        if (abs(div_real(x, y) - 0.7083333) > 1e-6) error stop
    end subroutine
end module

program template_test
    use template_test_m
    implicit none

    call test_template()

end program template_test

The result is  -5.099999904632568
The result is  12.299999237060547
The result is  -2.0999999046325684
The result is  36.71999740600586
The result is  0.7083333134651184