Japanese Subgroup GENERIC proposal

I keep tabs on the J3 site, but am not in the habit of checking WG5. I was interested to see the Japanese subgroup has proposed a facility for generic programming. See document N2217 at https://wg5-fortran.org/.

To me it looks very much like a proposal to standardize the sort of “loop over all relevant TKR” that is typically done with preprocessors nowadays. Compared to the US proposal, it seems narrower but simpler at first blush. I find that appealing, but I have not really thought it through. I’m opening this thread so others who do not regularly check WG5 are aware of this proposal and can discuss it’s merits. Cheers.

7 Likes

The Japanese proposal is being actively discussed in WG5, but what we want to avoid is “Fortran has two ways of expressing generics/templates”. It is clear that the proposal fulfils a need and is simpler than the main proposal underway, but in itself isn’t broad enough for the uses some people say they need. I’m hoping there can be some sort of integration.

Comments here are of course welcome.

Steve, can you give an example of a use case that the Japanese proposal would not support. Based on a quick look at N2217, it appears to support about 100% of the cases where I need better generics than what exists today. While I applaud the work being done by the U.S. group, my initial impression is that its overly complicated for what most Fortran users need. It appears to me (like a lot of things that have been added to Fortran in recent years) to be focused on people writing libraries (commercial or otherwise) and less on folks writing standalone applications. I prefer solutions that (to coin a phrase) “let Fortran be Fortran and not try to make it C++”. To me the Japanese proposal meets that criterion and the U.S. proposal less so.

Just my 2 cents

3 Likes

I can’t, myself, but I’ve never been an applications programmer. I’ve heard from others that the Japanese proposal is orthogonal to the J3 Generics subgroup proposal but have not explored it in detail. I expect this will come out over the next year.

I had a glance through the Japanese proposal some time ago, and it looked very similar to what I had improvised here based my frequent use cases, which feels quite pragmatic, concise, and useful for the majority of use cases. But I also agree with the US committee subgroup to develop a comprehensive solution that covers all corners and then add simplified, concise syntax for more common use cases. What I strongly disagree with the US committee, as a user, is delaying the introduction of the simplified syntax until yet another unknown future standard in the late 2030s, effectively 15-20 years from now. That is just too late.

4 Likes

@shahmoradi yes, the simpler syntax must be designed and implemented today, it cannot be postponed. In fact, just today @luthfan submitted a PR that implements a simpler syntax in LFortran:

https://github.com/lfortran/lfortran/pull/2457

The syntax looks as follows for now:

! given a templated function
pure function generic_sum {T, add, cast} (arr) result(res)
    requires operator_r(T, T, T, add)
    requires cast_r(T, cast)
    type(T), intent(in) :: arr(:)
    type(T) :: res
    integer :: n, i
    n = size(arr)
    res = cast(0)
    if (n > 0) then
        res = arr(1)
        do i=2,n
            res = add(res, arr(i))
        end do
    end if
end function

! the above function can be instantiated with
integer :: a_i(10), i, s_i
do i = 1, size(a_i)
    a_i(i) = i
    !a_r(i) = i
end do
s_i = generic_sum{integer, operator(+), cast_integer}(a_i)

Any feedback is welcome. This is an iterative process, but we are slowly converging towards something that should be usable.

1 Like

Fantastic. Thank you and others involved for your efforts to bring this to reality fast.

1 Like

Why do you think that? Nobody is delaying anything. Japan’s proposal is tagged JP01 and will be voted on at the 2024 WG5 meeting when we nail down the work item list for the next revision, currently planned for 2028.

Not my words, I heard it from either Tom Clune or Brad Richardson that this is the tentative plan. Maybe the plan changed or I misunderstood. Either way, I am glad to hear otherwise.

I don’t know whether the “simplified syntax” proposal will be accepted. I’d hope that the Generics subgroup that Tom Clune heads has been discussing it - I’m not a part of that. (Brad is here, maybe he can comment?) I hope to hear a lot more about this at next month’s J3 meeting - I will certainly ask if it doesn’t come up. The Generics subgroup has been working for several years on their proposal, which is looking really good. It would be great if the Japanese proposal could be integrated into it.

1 Like

The thing we like about the Japanese proposal is the “looping” mechanism over the desired types, kinds and ranks. Subgroup would prefer that “looping” mechanism be enabled on the instantiation side, rather than directly within the template. The other thing we like about the proposal is the simpler syntax for these single procedure cases. Like @certik illustrated above, we think our existing design can accommodate a “shorthand” in that case.

The Japanese proposal does have a few downsides. One (which is I think easily solved) is the syntax is ambiguous in the case of derived types with multiple length or kind parameters. I.e.

type :: mytype(k1, k2)
  integer, kind :: k1, k2
end type
generic function foo(x)
  ! does the following expand to 2, 4 and 2, 6 
  ! or 2, 6 and 4, 6
  type(mytype(2, 4, 6)), intent(in) :: x 
  integer :: foo
  ...
end function

The other thing is it lacks many of the features necessary to satisfy our use cases. Namely it does not enable

  • templated containers (i.e. lists, sets, dictionaries, etc.) or other derived types
  • nested templates (i.e. for “optional” functionality)
  • procedures as template parameters
  • templates for procedures that are not distinguishable in a generic interface

We have not stated that we are delaying such a feature until 203Z. What we have stated is that we will design such a feature after we have our initial design that enables all the use cases. We still have (presumably) 5 years to do both and think we can. We figured it would be better to have a holistic, consistent design than to try and piecemeal it in a way that could end up with duplicated, overlapping, or inconsistent language features.

5 Likes

Yes, I didn’t mention it, but the simplified syntax in LFortran is effectively just syntactic sugar for the full generics, so far it complements the full proposal very well.

I agree with everything you said, but want to add a small but very important clarification: This 5 years is the timeline to the next standard. However in order to deliver both full and simplified syntax, it has to be prototyped in a compiler today (a big feature like this really requires at least two independent compiler implementations), and over the next year or so we have to get it to the point of being usable enough to gain experience using it, and in two years we really need to have all the details figured out both for general and simplified syntax, and get the community and committee on board, the goal must be that most people here in Discourse (say over 80%) will look at the generics, and say, “this is solid!”. Currently we are still far from that.

As an example what not to do (I know you are not arguing for that, but I want to be very clear): if we wait 3 more years, and only then start designing the simpler syntax, we will fail. Because only when the simpler syntax is in place (in a compiler!) and people start using it, we can figure out whether everything fits together and is usable in practice.

8 Likes

Question. Has anyone involved in the Generics development process taken the time to survey existing C++ codes in areas formerly dominated by Fortran (CFD, Finite Elements, Climate-Weather-Ocean (CWO) modeling, Computational Finance, Computational Physics etc) to see just how templates are used in those codes? As I alluded to in my previous post, I worry that we will end up with something that supports the needs of a few people or groups writing libraries and not something that supports the larger user community needs. With all due respect to Brad, “our use cases” are probably not my use cases. A detailed survey of current template use might just reveal that “our use cases” are really corner cases in real world applications. I also think the committee is striving for perfection and forgetting the old saying that “Perfection is the enemy of Good Enough”. Just give us users a simple easy to use facility that addresses the way templates are currently used in the real world. Frankly, if there was a standard facility that provided ADTs (lists, sets, etc) as an integral part of the language on par with arrays and was common to all compilers ala the STL is in C++, I would have no need for templates.

4 Likes

This note implies to me a dual syntax regimen toward Generics in Fortran, I hope I am completely wrong.

Generics is critically important for the future of Fortran and Fortranners need simple, compact, and a single form of syntax, period.

The current path by Generics subgroup in J3 is fully immersed in complexity of semantics and syntax that is not going to be palatable and usable for many Fortranners and has me extremely, extremely concerned and worried for Fortran.


Note: syntax below is illustrative only, readers please do not get hung up on that aspect.

Consider the following:

generic function foo(x)
  ! does the following expand to 2, 4 and 2, 6 
  ! or 2, 6 and 4, 6
  type(mytype(k1=<2,4,6>,k2=<2,4,6>)), intent(in) :: x 
  integer :: foo
  ...

can imply it expands to both k1 and k2 being 2, 4, and 6

whereas the following

generic function foo(x)
  ! does the following expand to 2, 4 and 2, 6 
  ! or 2, 6 and 4, 6
  type(mytype(k1=<2,4>,k2=<2,6>)), intent(in) :: x 
  integer :: foo
  ...

can imply the generic procedure expands to k1 kinds of 2 and 4 and k2 kinds of 2 and 6.

And so forth.

The larger essence with the “Japanese” proposal is there is a certain level of simplicity to it.

This essence around simplicity must be the foundation of all effort toward Generics.

@rwmsu LFortran has support for high performance lists, sets, dicts as part of the compiler itself (needed and used by LPython), although it’s not exposed yet in the LFortran frontend. That’s a whole different discussion what the best syntax should be for that.

@FortranFan the big issue that we’ll need to tackle in generics is this: currently the design is procedure based. You currently can’t call methods on the template T (although the design can be extended to allow that). I actually think the current design can be a great fit for Fortran, since many (but not all!) Fortran codes are written in a procedural style. However, the procedural style generics require you to pass all the “procedures” as part of the parameter list. For example in the above, you can see generic_sum{integer, operator(+), cast_integer}(a_i), where we need to pass all the operations explicitly, in this case the “+” operation and the integer casting operation. The compiler of course will be able to infer many of these automatically, but the question is if the overall experience is good enough. It’s not clear! We can’t now from a whiteboard. We need to implement it and start using it and see if the syntax and semantics can be simplified enough to be nicely ergonomic. The answer might very well be it can’t. In that case, we need to do class based generics, see below.

What the full generics syntax allows is to only specify this (long) parameter list once, so it becomes a lot easier if you have a lot of functions, all of which accept almost the same parameter list. So you can think of it in an “inverted” way: the main syntax is the simple generics, but once you have a lot of functions, you might want to use the “full” syntax, which actually becomes simpler in that case.

Now: the design can be extended to support classes (when I say “class”, I mean derived type with type bound procedures). In this design, you would call methods on the class inside your generic code, so then you don’t need to expose all operations via parameter list. This greatly simplifies usage and instantiation. The class operations can be defined with an “interface” block, and this whole thing can be done in a way that merges the various “traits” proposals floating around here. These class based generics have downsides too, it’s not as simple to compose different generic codes together, it’s in some ways limiting what you can do with it as a user, since you are required to always provide a user class type with the prescribed methods. The current procedure based generics are more flexible in this regard.

Hopefully the above shows the main issue that we still need to tackle. And why we need to tackle it right now, not wait 3 years, as this requires a prototype and many iterations of the design. However, I don’t see any complete blocker, we just need to get a usable procedure based generics out there as quickly as we can, those will always be useful. And then if the ergonomic can’t be made nice enough, we need to also design and implement the class based generics.

LFortran has support for high performance lists, sets, dicts as part of the compiler itself

Wow thats great and reinforces my belief that LFortran might just be the “last best hope” for saving Fortran from extinction. Keep up the great work and hopefully I live long enough to see LFortran become the dominant compiler in the Fortran world.

1 Like

From my perspective, “iterating over kinds” is too little to make any difference for the language. The HPC landscape has changed, as I said many times – multiplying numbers is not a big deal in 2023. To make Fortran survive, you need it be more attractive for those writing libraries. Fortran is critically missing both templating and trait system, which the “US” proposal would both resolve, hopefully making the language more attractive to be still supported by companies like intel and nvidia, and hopefully see it being picked up by the ML/data science community. Lack of these two features are what I repeatedly run into in my Fortran work, both scientific and private. So really keeping fingers crossed for this one, and that is is not blocked from approval in (hopefully sooner than) 2028 for no reason.

1 Like

Valid point, and I agree. We are doing our best to make progress as quick as is reasonable. I think we can hit that goal for a general design and syntax. The bulk of the grunt work is figuring out the edits to the standard, which comes after.

Not explicitly as far as I know. I would definitely welcome any such evaluation if anyone would be willing to provide it.

A reasonable point. Our initial paper outlining use cases can be found here. I’ll admit they are rather general. I would again welcome any contributions.

I think our aim is to learn from and avoid the mistakes of other languages’ designs. I think at this point it is well understood that C++'s lack of type-safety and interface checking inside templates is a shortcoming. Bjarne admitted as much, lamenting the fact they didn’t see a solution to that problem, in an interview I recently watched. Our goal is to avoid that mistake as best we can, taking note of the fact that many languages developed since then seem to have managed to.

I think there’s a tension between simplicity and capability in some cases, and where to draw that line is a bit hard to know. I think our worry is that we’ll end up with something “simple”, like the kind system and its extension into PDTs, that doesn’t quite work out to be as capable as everyone would have hoped. We really want to make sure we don’t limit ourselves for future improvements.

It’s important to note that the C++ STL was not initially a language facility. Rather the facilities of the language were sufficient for lots of exploration and eventually a set of template libraries were standardized. I think this was the right way to do it, and I’m hoping we can enable and emulate that evolution.

1 Like

Could the Japanese generics be extended to polymorphic entities? This could potentially be useful for situations where unions (C) or std::variant (C++) are used.

Say I want to have an array of different shapes. The options one has in Fortran now are

  • inheritance hierarchies
  • unlimited polymorphic entities
  • pair of an integer enumerator and a type(c_ptr) value (the good ol’ C solution)
type :: circle
  real :: radius = 1.0
end type

type :: square
  real :: width = 1.0
end type

! container type
type :: any_shape 
  class(*), allocatable :: s
end type

type(any_shape), allocatable :: my_shapes(:)

my_shapes = [any_shape(circle()), &
             any_shape(square(2.0)), &
             any_shape("not a shape!")]

! Process shapes
do i = 1, size(my_shapes)
  select type(s => my_shapes(i)%s)
  type is (circle)
    print *, "Circle with radius = " s%radius
  type is (square)
    print *, "Square with width = " s%width
  class default
     error stop "Expected shape, but got something else"
  end select
end do

Instead it would be convenient if one could do the following, without the need to introduce a container type:

class(circle,square), allocatable :: my_shapes

! For convenience we may introduce a variant syntax
! 
!   variant :: shape => circle, square
!
! or repurpose the one for procedures
!
!   generic :: shape => circle, square

my_shapes = [circle(), square(2.0), circle(3.0)]

! Process shapes
do i = 1, size(my_shapes)
  select type(s => my_shapes(i))
  type is (circle)
    print *, "Circle with radius = " s%radius
  type is (square)
    print *, "Square with width = " s%width
  class default
     ! This clause is unreachable and the compiler knows it
  end select
end do

Addendum: here is how an analogous program looks like in C++20:

// shape.cpp
//
// compile with: clang++ -std=c++20 -Wall shape.cpp

#include <variant>
#include <iostream>
#include <vector>

struct circle {
    float radius = 1.0;
};
struct square {
    float width = 1.0;
};

// helper constant for the visitor #3
template<class>
inline constexpr bool always_false_v = false;

using shape = std::variant<circle,square>;
 
int main() {
    
    std::vector<shape> my_shapes;

    my_shapes.emplace_back(circle{1.0});
    my_shapes.emplace_back(square{2.0});
    my_shapes.emplace_back(circle{3.0});

    for (auto &s: my_shapes) {
        
        std::visit([](auto && arg){

            using T = std::decay_t<decltype(arg)>;
        
            if constexpr (std::is_same_v<T,circle>)
                std::cout << "Circle with radius " << arg.radius << '\n';
            else if constexpr (std::is_same_v<T,square>)
                std::cout << "Square with width " << arg.width << '\n';
            else
                static_assert(always_false_v<T>, "non-exhaustive visitor!");
        }, s);
    }

}