Prototype implementation of Fortran generics in LFortran

This is great. I’m eager to start playing with it. I will report that the first change to the syntax is that type :: T; end type is now type, deferred :: T, so that can be updated. I’ll go submit an issue (assuming it’s not already). Where can I submit new examples and find a collection of existing ones? We have several in the j3-fortran/generics repository at various stages in the evolution of the feature, but it would be nice if LFortran had a collection of ones that “worked” and provided some impetus to keep them updated as we finalise the proposals.

2 Likes

Thanks @kargl for the feedback. Makes sense, I think that’s what we’ll do.

@everythingfunctional right now we have only one working example which is here: lfortran/template_add.f90 at 45264807b02cf138632c36ba2617379ac5e347f5 · lfortran/lfortran · GitHub, we can add the others there, perhaps in a subdirectory “generics”. If you want, go ahead and submit a PR against LFortran and add them there. I agree, as we iterate on this, we will ensure that the source code works and is consistent with the formal proposals to the committee.

2 Likes

@shahmoradi I have an answer to you that @everythingfunctional and @tom_clune gave me on a call today.

Instead of

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

    subroutine test_template()
        instantiate add_t(real, func_arg_real), only: add_real => add_generic
        real :: x, y
        integer :: a, b
        x = 5.1
        y = 7.2
        print*, "The result is ", add_real(x, y)
    end subroutine

You will be able to write just:

    subroutine test_template()
        instantiate add_t(real, operator(+)), only: add_real => add_generic
        real :: x, y
        integer :: a, b
        x = 5.1
        y = 7.2
        print*, "The result is ", add_real(x, y)
    end subroutine

And the compiler would simply use real (as requested in the instantiate line) and it would use operator(+) on it (which it knows how to do) to create the implementation for the requirement F in template add_t(T, F).

So this already is a lot cleaner. I am quite sure one could continue in this direction and make it even simpler, but we’ll figure it out as we gain more experience with generics.

5 Likes

Really cool to see generics taking shape!

A trivial question (I don’t want to divert the discussion), but why do we need the only clause here? Can

instantiate add_t(real, func_arg_real)

actually instantiate more then one thing from which we then select one via only)? If not, wouldn’t

instantiate add_t(real, func_arg_real) as add_real

be more self-explaining?

2 Likes

@certik @tom_clune @everythingfunctional thanks again for your work on the generics, and forgive me for tagging (the benefits of a clarification outweighed the risks of bugging you with explicit tags).

Consider the trivial scenario where an addition procedure should accept all possible real kinds. To achieve the goal, I need to write five separate procedures under a generic interface name. Every time this problem appears, I wish I could write,

function add(a,b) result(sum)
   real(*), intent(in) :: a
   real(kind(a)), intent(in) :: b
   real(kind(a)) :: sum
   sum = a + b
end

where (*) implies any real kind supported by the compiler. If only certain kinds must be supported (e.g., real32, real64), then I wish to be able to write,

function add(a,b) result(sum)
   use, iso_fortran_env, only: real32, real64
   real({real32, real64}), intent(in) :: a
   real(kind(a)), intent(in) :: b
   real(kind(a)) :: sum
   sum = a + b
end

where {} implies the collection of specified kinds (from the set theory notation).
Should the function work for all numeric types and kinds, then I wish to write,

function add(a,b) result(sum)
   use, iso_fortran_env, only: real32, real64
   numeric(*), intent(in) :: a
   numeric(kind(a)), intent(in) :: b
   numeric(kind(a)) :: sum
   sum = a + b
end

where numeric would be a new intrinsic type that implies all intrinsic numeric types in the language (integer, complex, real).

Should this functionality be extended to the character and logical kinds, I wish to be able to write something like,

function add(a,b) result(sum)
   use, iso_fortran_env, only: real32, real64
   type({numeric(*), character(*,*), logical(*)}), intent(in) :: a
   type(typeof(a)), intent(in) :: b
   type(typeof(a)) :: sum
   select type a
   type is (numeric(*))
       sum = a + b
   type is (logical(*))
       sum = a .or. b
   type is (character(*,*))
       sum = a//b
   end select
end

This would still be a compile-time resolution and provide a fast custom implementation of sum for all supported types and kinds under a single generic function name.

If such a simplex syntax were possible, the size of our codebase would reduce by more than 5 fold (there are currently five kinds supported by most compilers). I can reduce it to half with the help of preprocessing, but the interfaces within a generic interface name cannot be reduced via the preprocessor (unless some more advanced preprocessing tool is used).

I improvised these examples within the past 5 minutes. I am pretty sure there are holes in this simplistic syntax proposal. But the such concise syntax is what I have longed for several years.

4 Likes

The instantiate statement creates a concrete instance of the whole template, and then brings the entities within it into scope like use association. Thus we basically just reuse the use statement syntax, so the only part is optional. I.e.

instantiate add_t(real, func_arg_real), add_real => add_generic

would work, or just leave the rename off and use the original name within the rest of the code.

I appreciate that our design does require quite a bit of verbosity. I mentioned in another thread that we do intend to explore semantics and syntax for simpler cases, but that we wanted to enable all use cases first.

I understand that this was meant as an example, so forgive me, but it really is overly trivial. The intrinsic operator(+) already supports addition for all numeric types, and the language already allows one to define operator(+) for other types. So the attempt to define a generic add procedure is somewhat of a tautological one. For example, the fully generic one would be:

requirement binary_op(T, U, V, op)
  type, deferred :: T, U, V
  function op(x, y) result(z)
    type(T), intent(in) :: x
    type(U), intent(in) :: y
    type(V) :: z
  end function
end requirement

template add_tmpl(T, U, V, op)
  requires binary_op(T, U, V, op)
  private
  public :: add
  generic :: operator(+) => op
  generic :: add => add_
contains
  function add_(x, y) result(z)
    type(T), intent(in) :: x
    type(U), intent(in) :: y
    type(V) :: z

    z = x + y
  end function
end template

and would be used like

instantiate add_tmpl(real, real, real, operator(+))
instantiate add_tmpl(real, integer, real, operator(+))

but as you can see, you already had the thing you’re trying to create. Of course if you really did want overload + to be .or. for logical, you could do

instantiate add_tmpl(logical, logical, logical, operator(.or.)), operator(+) => add

and while you might be tempted to try it for strings, you’ll now actually see the issue that your example missed.

instantiate add_tmpl(character(len=1), character(len=2), character(len=3), operator(//))

It turns out the length type parameters are actually part of the type-spec, and so the result of the operator is actually not the same type as its operands, but your example trying illustrate it managed to gloss over that point.

So, it turns out the power of generics isn’t in writing generic versions of trivial things, it’s in being able to assume the trivial things will work in more contexts.

1 Like

Thanks, @everythingfunctional, for the example. The example you have posted still feels too complex for me as an end user. I understand that there may be more complex scenarios for template usage than a simple single operation. But >95% of template use cases in my applications and >1,000,000 lines of Fortran code that I have written fall in the category of examples I mentioned. From a user’s perspective, I strongly feel there should be much simpler, more concise syntax in Fortran templates beside the advanced verbose solutions currently in the proposal.
Another issue I often encounter in my codes is that a particular algorithm of 1000s of lines has to be written for both complex and real arguments, while the algorithm itself is different merely in a few lines within the 1000s of lines. Currently, I can avoid code duplication via preprocessor fences. How would this situation be handled with the current templates proposal?
Thanks again for sharing your wisdom and knowledge of templates.

6 Likes

This is exactly the kind of situation where we think templates will work well. Where “the algorithm itself is different merely in a few lines” does make it slightly more complicated than simple copy-paste into a template, it’s not too bad. The transformation will look something like

subroutine algorithm(arg1, arg2, ...)
#if for_real
  real :: arg1,...
#elseif for_complex
  complex :: arg1,...
#endif

! All the common stuff
#if for_real
  ! How it's done for real
#elseiffor_complex
  ! How it's done for complex
#endif
!The rest of the common stuff
end subroutine

Where the declarations are replaced with deferred types, and the type-specific stuff is replaced with a template procedure parameter, kind of like

template algorithm_tmpl(T, ..., type_specific)
  requires type_specific_part(T, type_specific)
contains
  subroutine algorithm(arg1, arg2, ...)
    type(T) :: arg1, ...

    ! All the common stuff
    call type_specific(...)
    ! The rest of the common stuff
  end subroutine
end template

The downside is that you’ll have to be specific about all the operations your template uses. The upside is that once you’ve done it, anybody can use your algorithm for their own numeric types, say for instance a derived type that handles arbitrary precision, so long as they can come up with sensible implementations of all the operations you use, including the type_specific part.

Now I’ve glossed over the tricky part so far. What does the interface to type_specific look like? Depends on your algorithm. If it’s simple and obvious, congratulations, you really do have a pretty generic algorithm, and now it’s clear how it’s parameterised. If it’s hard to figure that out, that could be a sign that your algorithm isn’t as generic as you thought, but now at least that fact has been revealed.

1 Like

@everythingfunctional , @certik et al.,

To state the obvious, with an example reasonably simple yet with enough “content”, if it can be illustrated side-by-side how one might achieve a generics algorithm with current facilities, say unlimited polymorphism (to be avoided preferably moving forward), or preprocessors (FYPP, etc.) versus templates in Fortran 202Y, that will be greatly helpful for the Community.

That’s why I made the 1-D sort example above, one that works with current compilers for a reasonably broad set of different cases.

If you can take such a case or others like it i.e, beyond the simple x+1 and the complicated math examples, and a working prototype with LFortran, it will be of great help. @certik, here don’t need to worry about polymorphism if that’s lacking in LFortran now, other compilers can help illustrate that. The key is the new facility intended for 202Y revision.

2 Likes

Here is the generic sort example that @everythingfunctional submitted to LFortran (thank you!): lfortran/sort.f90 at 524b9579bb9846d2c01ad40a65cba2acb14c2568 · lfortran/lfortran · GitHub. We have associate, but I just realized it might not work for arrays like this yet. We’ll implement of course all that in due time, but for now I’ll try to strip that sort down to be bare bones Fortran 90 style, with LFortran can handle, and then we’ll try to get it working.

Yeah, thought I’d start by setting the bar high, but I’d be very happy with it working even without using associate.

I will note one other feature that may not have been immediately obvious, but which is crucial to the algorithm, vector subscripts for arrays. Without that the whole idea doesn’t work, or at least becomes much more verbose/complex and with poor performance. Like I said, setting the bar high.

2 Likes

I think we don’t have those either yet.

I agree with @FortranFan that we must provide ample examples and side-by-side comparisons with 1) preprocessor implementations, 2) using existing language facilities, and 3) equivalent implementations in other languages before making a final decision on the template proposal. I am not a committee member, but as an avid user, I am vocally expressing my concerns over the potential excessive verbosity of the current template proposal.

With the current proposal, I do not see any gains from converting the >50,000 preprocessor fences in our codebase to Fortran templates (other than full standard conformance). I may be wrong, so I feel numerous examples with side-by-side inter- and intra- language comparisons are essential.

7 Likes

I agree with @shahmoradi. We need to get further along in the prototype, and ask for feedback like I did in this thread, and discuss as a community, iterate etc.

I agree we should not be putting into the standard syntax and semantics that we do not have community agreement and experience on.

3 Likes

I agree, and will be happy to provide help to anyone interested putting forth example use cases.

1 Like

@everythingfunctional ,

So instead of another sort algorithm in @certik’s comment above, can you please take the “user” code in the reply to the original post upthread and provide your take using your own mental compiler of a minimal replacement you would suggest for the user’s generic code?

In actual circumstances circa 203X when hopefully conforming processors toward Fortran 202Y are available, coders might seek a minimalist refactoring of their existing codes that achieve genericity via some means, whether it be unlimited polymorphism or preprocessing or whatever. The example I provided uses the former of course. As I mentioned, the side-by-side comparison of interest to coders will be maintaining the same algorithm but refactoring to 202Y TEMPLATEs. That’s when can comprehend the change i.e., side-by-side, apples-to-apples comparison.

Sure one can tell me to go do it by myself, but that will be error-prone at this stage and likely be misleading. Hence this request.

Forgive me for not also re-implementing your string type.

module swap_m
    implicit none
    private
    public :: swap_tmpl

    template swap_tmpl(T)
        type, deferred :: T
        private
        public :: swap
        generic :: swap => swap_
    contains
        pure subroutine swap_(a, b)
            type(T), intent(inout) :: a, b
            type(T) :: tmp

            tmp = a
            a = b
            b = tmp
        end subroutine
    end template
end module

module QsortC_m
    implicit none
    private
    public :: QsortC_tmpl

    requirement comparable(T, lte, gte)
        type, deferred :: T
        pure function lte(lhs, rhs)
            type(T), intent(in) :: lhs, rhs
            logical :: lte
        end function
        pure function gte(lhs, rhs)
            type(T), intent(in) :: lhs, rhs
            logical :: lte
        end function
    end requirement

    template QsortC_tmpl(T, lte, gte)
        requires comparable(T, lte, gte)
        private
        public :: QsortC
        generic :: QsortC => QsortC_
    contains
        pure recursive subroutine QsortC_(A)
            type(T), intent(inout) :: A(:)

            integer :: iq

            if (size(A) > 1) then
                call partition(A, iq)
                call QsortC(A(:iq-1))
                call QsortC(A(iq:))
            end if
        end subroutine

        pure subroutine partition(A, marker)
            use swap_m, only: swap_tmpl
            instantiate swap_tmpl(T), only: swap
            generic :: operator(<=) => lte
            generic :: operator(>=) => gte
            type(T), intent(inout) :: A(:)
            integer, intent(out) :: marker

            integer :: i, j

            i = 0
            j = size(A) + 1

            do
                j = j -1
                do
                    if (A(j) <= A(1)) exit
                    j = j - 1
                end do
                i = i + 1
                do
                    if (A(i) >= A(1)) exit
                    i = i + 1
                end do
                if (i < j) then
                    call swap(A(i), A(j))
                else if (i == j) then
                    marker = i + 1
                    return
                else
                    marker = i
                    return
                end if
            end do
        end subroutine
    end template
end module

program p
    use QsortC_m, only: QsortC_tmpl

    character(len=*), parameter :: fmtg = "(*(g0.3,1x))"
    integer, parameter :: r = 6

    block
        instantiate QsortC_tmpl(integer, operator(<=), operator(>=)), only: QsortC
        integer :: x(r)

        print fmtg, "Block 1"
        x = [42, 999, -1, 0, 50, 12]
        print fmtg, "initial array is", x
        call QsortC(x)
        print fmtg, "sorted array is ", x
    end block

    print *

    block
        double precision :: x(r)
        integer, parameter :: dp = kind(x)
        instantiate QsortC_tmpl(real(dp), operator(<=), operator(>=)), only: QsortC

        print fmtg, "Block 2"
        call random_number(x)
        x = real(int(x*100.0_dp), kind=dp)
        print fmtg, "initial array is", x
        call QsortC(x)
        print fmtg, "sorted array is ", x
    end block

    print *

    block
        instantiate QsortC_tmpl(character(len=1), operator(<=), operator(>=)), only: QsortC
        character(len=1) :: x(r)

        print fmtg, "Block 3"
        x = [character(len=1) :: "q", "w", "e", "r", "t", "y"]
        print fmtg, "initial array is", x
        call QsortC(x)
        print fmtg, "sorted array is ", x
    end block

    print *

    block
        instantiate QsortC_tmpl(character(len=6), operator(<=), operator(>=)), only: QsortC
        character(len=6), allocatable :: s(:)

        print fmtg, "Block 4"
        s = [character(len=6) :: "Mary", "had", "a", "little", "lamb"]
        print fmtg, "initial array is", s
        call QsortC(s)
        print fmtg, "sorted array is ", s
    end block

    print *

    block
        use string_m, only: string_t, operator(<=), operator(>=)
        instantiate QsortC_tmpl(string_t, operator(<=), operator(>=)), only: QsortC
        character(len=*), parameter :: fmts = "(*(dt,1x))"
        string_t, allocatable :: s(:)

        print fmtg, "Block 5"
        s = string_t([character(len=6) :: "Mary", "had", "a", "little", "lamb"])
        print fmtg, "initial array is"
        print fmts, s
        call QsortC(s)
        print fmtg, "sorted array is "
        print fmts, s
    end block
end program

The things of particular note here are that one no longer needs all the select type blocks and helper procedures. This has saved many lines of code. You’ll get much better performance, feedback at compile time instead of run time about mismatched or unsupported types, and no longer need to extend from some base type.

The downsides are that your example of an allocatable array of deferred length character no longer works as is. This provides strong motivation for the string type, but I am of the opinion there already was sufficiently strong motivation for it. Also, the comparison operators can no longer be type bound and must not use class(string) for their arguments, or at least specific procedure needed for the template must not be. You could still provide both and implement one in terms of the other, but that’s a matter of whether you still need to support both styles.

4 Likes

Luthfan and I are now doing a generic sum (as an intermediate step towards a sorting algorithm): lfortran/sum.f90 at 4c333fb4e794e7065efbaaa318cb0e0989d56a27 · lfortran/lfortran · GitHub, @everythingfunctional does the code look good?

It’s certainly sufficient for demonstration purposes. Eventually we plan to be able to properly emulate the intrinsics exactly, but there’s lots of work to do in the rank agnostic stuff before that will be feasible. This is a good first step.

2 Likes