First there is nothing to stop the Committee from making C_INT the same value as INT32. Its that way now in most implementations of ISO_C_BINDING. If you have the Intel compiler installed, there are source files for ISO_FORTRAN_ENV and ISO_C_BINDING (on my Linux system they are in /opt/intel/oneapi/compiler/2023.2.0/linux/compiler/include) Take a look at them.
Second, I’ve been writing C interop code for about 18 years now and I’ve never had a need to do
if (C_INT == INT32)
Unless you are using a 30 or so year old 16 bit version of Windows or an old CRAY vector machine (where Integer is 64 bits) C_INT will be INT32.
Also, note that C_INT is defined on the Fortran side and ASSUMES an interoperable value for the “companion processor” exists. Its up to the programmer to verify that which requires a knowledge of the target C compiler and OS. I think in most cases its assumed that the “companion” C compiler is from the same vendor as the Fortran compiler but there is nothing in the standard that requires it to be. Most compilers will let you link with code compiled by gcc.
If you have fortran code written with INT32 (or with some other parameter value), and you want to interoperate with C code that uses C_INT, then what is a better way to verify that the two types match?
Very true, but what I meant by the example is that instantiation be inline just like in C++, like the example below (taken from my previous comment above, slightly modified here):
generic function has_nan{T,N}(x) result(ans)
use :: ieee_arithmetic, only : ieee_is_nan
integer, constant :: N
type, deferred :: T
type(T), rank(N), intent(in) :: x
logical :: ans
ans = (N == 0 ? ieee_is_nan(x): any(ieee_is_nan(x)))
end function has_nan
in the above example I am using {} inplace of C++ <> and we use them as needed no instantiate statement list
use :: iso_fortran_env, only : wp => real64
real(wp) :: x
! do something
print *, has_nan{T:real(wp), N:0}(x) ! or has_nan{real(wp),0}(x)
! may be something like this can be done
! print *, has_nan{T:typeof(x), N:0}(x)
In this example, this statement is an error – an integer argument is being associated with an argument of an intrinsic function that instead requires a real argument. My question is when would this error be reported by the processor, at compile time or at run time?
This also raises the question about these two approaches to generics.
In one case, the declarations are all self-contained within the subroutine, and the compiler generates all the specifics associated with the combinations of those types. In this case, associating an integer argument x with the ieee_is_nan() intrinsic would generate the error as the generic subroutine is being compiled.
In the other case, the specific subroutine would not be compiled until it was referenced (or instantiated, if that is done separately). So in this latter case, the argument mismatch error would not exist until the subroutine was referenced, at which time the actual code would be compiled and it could then recognize the argument mismatch error. But if the argument mismatch is not detected at this point, it would then only give some kind of error at run time.
Thank you @RonShepard and @sblionel.
A more obvious case is when the programmer want to modify legacy code to call a C function. Legacy code is often written to work on multiple platforms with only a few modifications, as follows:
subroutine sub(a, n)
real, parameter :: k = 4 !! for some compilers
! real, parameter :: k = 1 !! for some others
integer, intent(in) :: n
real(k), intent(in) :: a(n)
...
In this program, “IF ( k == REAL32 ) …” will not make sense if the value of REAL32 is changed.
I agree with the view that the current representation of the KIND parameters is chaotic for historical reasons. However, I think that changing or increasing the values of kind parameters would have more disadvantages than advantages. It implies changes in language specifications (e.g., what is “same kind”) and modifications in compilers (selection rules for specific procedures) and intrinsic functions (e.g., KIND, SELECTED_INT_KIND).
Is your question about the interpretation of “real(wp)”? If not, please ignore the following explanation.
In email discussions with the Generic subgroup, I was informed that the following interpretation is given for the template construct. It is probably the same interpretation can be adoupted to this template.
“real(wp)” can be interpreted either as an expression (referrence to the intrinsic function REAL) or as a type specifier (REAL type with the kind parameter wp). Which interpretation is selected depends on whether the corresponding dummy argument of the template is a constant or a type name. In this case, the first dummy argument T is a type name (bacause which is declared as “type, deffered”), so the first argument of the actual argument is also interpreted as expressing a type “REAL(wp)”.
This should be defined as a new name association rule, which has not existed in Fortran so far.
I know Generics subgroup proposed the compact version template just like in C++ (23-187).
These fragments of a program
generic function has_nan{T,N}(x) result(ans)
use :: ieee_arithmetic, only : ieee_is_nan
integer, constant :: N
type, deferred :: T
type(T), rank(N), intent(in) :: x
logical :: ans
ans = (N == 0 ? ieee_is_nan(x): any(ieee_is_nan(x)))
end function has_nan
and
use :: iso_fortran_env, only : wp => real64
real(wp) :: x
! do something
print *, has_nan{T:real(wp), N:0}(x) ! or has_nan{real(wp),0}(x)
! may be something like this can be done
! print *, has_nan{T:typeof(x), N:0}(x)
are corresponding to the followings.
generic function has_nan(x) result(ans)
use :: iso_fortran_env, only : wp => real64
use :: ieee_arithmetic, only : ieee_is_nan
real(wp), rank(:), intent(in) :: x
logical :: ans
ans = (rank(x) == 0 ? ieee_is_nan(x): any(ieee_is_nan(x)))
end function has_nan
and
use :: iso_fortran_env, only : wp => real64
integer, parameter :: N = 0
real(wp), rank(N) :: x
! do something
print *, has_nan(x)
The points are:
Generic supprograms do not use template parameters. A specific procedure is selected from the types, kinds and ranks of the actual arguments of the procedure referrence.
“rank(:)” represents all ranks supported by the compiler and specific procedures for all the ranks will be created by the compiler.
I can see that restricting the argument type like this might be useful in many cases, but in this particular case it should not be necessary. The compiler already has enough information to detect that an integer is being used as an argument to a subprogram that it knows must be of a real type. I think the only question is how and when the error should be detected. That is, should the error be detected at compile time when has_nan() is referenced, or should it be later at run time when ieee_is_nan() is referenced with the argument of incorrect type? Or should ieee_is_nan() be called with the integer argument without error detection, relying on the programmer to put the correct bits (mimicking a real value) into the integer variable so that a result can be obtained?
Much of the nature of generic programming and generic containers seems to involve ignoring type safety, at least temporarily. Any time a procedure is supposed to treat the data as an anonymous string of bits means that, at least at that moment, types are ignored. It will be interesting to see how these generic proposals manage to enforce type safety before and after this anonymous bit string step.
This is a very important point (perhaps the most important): the proposal from the subcommittee as well as our “simplified generics” in LFortran are allways 100% typed all the time, type safety is never ignored, not even temporarily.
This is achieved due to “strong concepts”, which you can think of as providing types for the templates.
I’ve been watching this discussion about generics from the sidelines and
wondering about how a compiler might handle generic variables in practice.
As I understand it, the idea is to allow functions like ‘matmul’ to be created
by the Fortran programmer and used for a variety of input types. For example,
the input arrays to matmul can be logical, integer, real or complex in all(?)
combinations and precisions.
Fair enough, but suppose I create a function like:
function f(a,b,..,c) result(x)
type(int16, int32, real32, real64, complex32, complex64), &
intent(in) :: a(:),b(:),...,c(:)
type(int16, int32, real32, real64, complex32, complex64) :: x(:)
...
end function
… how should a compiler be expected to handle this? There seems to be three ways:
Create machine code for every possible combination of input types.
Investigate the rest of the code and decide which types are used and only
create machine code for those.
Create machine code for a few basic combinations, convert input variables
to those without losing precision, and finally convert the output to the
required type.
Each way seems to have its problems:
Could require very large numbers of combinations, resulting in excessive
and redundant machine code.
Would be problematic for a compiler to decide based on code analysis
which combinations will be required, and impossible to write libraries based
on this.
This seems the best option, but could incur inefficiencies particularly if
the function has parts which can be performed in lower precision without
overall precision loss. It may also require the compiler to create temporary
arrays which may exhaust the stack space or require internal
allocations and deallocations.
How are generics currently envisaged from the point of how the compiler would
be required to generate machine code?
Both of the proposals, the one from the J3 Generics subgroup and the one from Japan, are fully type-safe. The Japanese proposal achieves this by:
Thus, type checking is performed for every possible combination at the time the compiler is processing the generic procedure. The US proposal achieves this by requiring that every procedure referenced with a “generic type” argument be a template argument (strong concepts), so that type checking can be done without regards to any specific types. It is then the template user’s responsibility to instantiate the template with the types and procedures they require. Meaning
is not required to be done by the compiler to achieve
A fourth way is to defer the actual compilation of the generic procedure until it is referenced. The actual arguments then determine the types of the dummy arguments, so the specific procedure is then compiled accordingly. This is called “instantiation” in this discussion. Once a specific version of the generic has been created, it is then added somehow to a list so that future references with that same combination of arguments can reuse that same compiled code. Thus each specific routine only needs to be compiled once, and only those specific routines that are required are actually compiled. This approach could result in, for example, a single statement in a program triggering the compilation of many thousands of lines of specific code, as one generic routine references the next down the call sequence.
This approach is used by C++ for example, and indeed you cannot create precompiled libraries, you must distribute the source code.
Swift and Go I believe figured out some way to actually compile this and handle the generics at runtime, if needed. But I think it’s not easy to implement and might be slower to run, so perhaps not worth doing?
Regarding:
Would be problematic for a compiler to decide based on code analysis
which combinations will be required
We have quite a decent implementation of the subcommittee generics as well as the simple generics in LFortran and it doesn’t seem to be an issue. Can you elaborate why you think it’s problematic?