Can `use` from module be used for `typedef`ing?

I’ve just found that the following behavior is allowed by all major compilers:

module m
   ! My templated derived type
   type :: a32
      real :: x = 0.0
   end type a32
   type :: a64
      double precision :: x = 0.d0
   end type
end module

module params
   use m, only: a => a32
   private
   public :: a
end module params

program p
   use params, only: a
   use m, only: a32

   type(a) :: my_var
   type(a32) :: my2

   print *, my_var ! 0.0

   ! This also works
   my2 = my_var

end program  

How has this not been discussed before? It’s an amazing way to typedef derived types in Fortran by giving them alternative names! :smile:

1 Like

Type aliases are possible at the use time. I wish creating aliases for types within the same module as the type definition’s host was also possible.

1 Like

Intel compiler ifort used to have a bug for PDT aliases at module use time. It may have been resolved in ifx by now.

Nice PDT usage btw! Do you feel safe using them across your code with gfortran? Last time I tried them (for some multi-precision geometric expansions that contained variable-length arrays) the code would crash, and the debugging information was very limited. It looks like you restrict PDT usage to kinds only? I would love to hear what rules do you stick to to ensure “smooth” PDT usage across compilers.

The len type parameter of PDTs is not worth using, given the current low-performance implementations. However, the kind type parameter is really essential for developing generic interfaces that work with compound data structures, at least until generics and templates appear in Fortran 202Y. Intel compilers readily handle most PDT syntax and run the code gracefully. Gfortran’s current implementation of PDTs is severely limited and ridden with compile-time and runtime bugs. I know one of the original gfortran volunteers, Paul Thomas(?) used to work on a complete revamp of gfortran’s PDT implementation. For now, I fence all PDT blocks in codes with an FPP flag #if PDT_ENABLED, which is disabled when the compiler is gfortran. It’s a mess, but it’s the only compiler-portability solution. It’s a shame that the utilities of the compile-time kind type parameter of PDTs are limited by the complexities and inadequacies of the len type parameter implementation in the compilers.

1 Like

The rename upon import is also handy when using “poor man’s templates”. Sometimes it just isn’t worth reaching for an external processor like Fypp.

module sorting

interface :: sort
   module procedure sort_dp
   module procedure sort_sp
end interface

contains

   subroutine sort_sp(x)
      use kinds, only: wp => sp
      include "sort_impl.fi"
   end subroutine
   subroutine sort_dp(x)
      use kinds, only: wp => dp
      include "sort_impl.fi"
   end subroutine

end module

Obviously, instead of templating purely on kind, you can also use this for type-based templates.

It is also useful when combined with preprocessor switched. For instance when developing an optimization code, you may want to switch on/off simplifications of a mathematical model. I’ve used this before within a block construct:

block
#if SIMPLE_CASE
  use simple_model, only: c1 => linearized_constraint
#else
  use complex_model, only: c1 => full_nonlinear_constraint
#end if
  ires = nlopt_add_inequality_constraint(opt,c_funloc(c1),c_loc(prog),0.001_wp)
end block

Or to turn on optimized vendor libraries:

program test

#if USING_MKL
   use mkl, only: batch_lu_factorization => dgetrf_batch_strided   
#else
   use homebrewed_factorizations, only: batch_lu_factorization
#endif

! ...

call batch_lu_factorization(...)

end program
3 Likes

I think the main purpose for this feature is to resolve type name conflicts when multiple modules are used. For example, if you are combining the capabilities of two linear algebra libraries, they might both have some common derived type names, so the user of those libraries can rename the types and also keep straight which type goes with which library.

2 Likes

If you want to rename a procedure within the same module an interface
block might suffice… I use that primarily when I rename a procedure
and want the old name to still be available for backward compatibility, and a
few times to have an alternate name for intrinsic functions

Aside from renaming on the USE statement and the old wrapper procedure
method, procedure pointers and generic interfaces (with only one module
procedure) can be used as aliases.

Procedure pointers are usually OK as well, but there are some obscure
limitations on procedure pointers (mostly when passing the procedure name)
that might cause an issue.

You would think something like

PUBLIC    :: ALIAS => EXISTING_NAME
PROCEDURE :: ALIAS => EXISTING_NAME

might work, but they do not. I think the natural place for a new feature
would be the PUBLIC statement.

When I was playing around with renaming intrinsics I made a little example program
to remind me the next time I wanted to rename something:

module M_aliases
implicit none
private
intrinsic sin, cos, tan
public :: tan, wrapper, sine, cosine
interface sine
   procedure sin
end interface sine
procedure(real),pointer :: cosine => cos
contains
real function wrapper(x)
real,intent(in) :: x
intrinsic sin
wrapper=sin(x)
end function wrapper
end module M_aliases
program main
use M_aliases, only: tangent=> tan, sine, wrapper, cosine
implicit none
  write(*,*)'on use statement ',tangent(1.0)
  write(*,*)'wrapper          ',wrapper(1.0)
  write(*,*)'interface        ',sine(1.0)
  write(*,*)'procedure pointer',cosine(1.0)
end program main

It seems gfortran doesn’t support it yet, but eventually you’ll be able to do:

generic, public :: alias => existing_name

ifort/ifx does support the generic-stmt, although it had issues dealing with the public attribute over multiple modules —I haven’t checked the latest ifx yet.

1 Like

Just one more word than I was thinking would be the most intuitive syntax. Happens temporarily only on machine with gfortran but will give that a try with ifx when I can. Thanks
for the info. Missed that that was coming.

It worked in LFortran too (using your link at godbolt itself), very happy about it. :slight_smile:

3 Likes

Oh I see. For a moment, I hoped I could see a production code using PDTs with gfortran! Of course I’m not complaining, each of us can contribute their code to open source compilers to make them better.

Thanks for the info. In the case of multi-precision expansion, the len parameter was exactly what I was looking for, as you want to do something like:

! Add two multi-precision expansions: a+b=c
elemental function expansion_sum(a,b) result(c)
   type(expansion(*)), intent(in) :: a,b
   type(expansion(a%n+b%n)) :: c      
   ... 
end function expansion_sum

and the critical part is that you want all the PDTs placed on the stack for speed.

Exactly! which is what I typically use the feature for. However, I had never foresought the application extended to whole derived types. For example, I can have my own type(library_sparse) etc. used everywhere in the library, just aliased once in the library constants module. So even a library with complex derived types can be built easily for say, 32- or 64-bit versions. This is very nice and I had never thought it was possible in Fortran!

I have never seen this syntax, what is the difference from an interface block? It looks like a new Fortran way to do an alias (potentially to multiple targets)?

as I have said, is allowed by all major compilers :grinning:

3 Likes

Fortran 2003 (?) introduced a type-bound-generic-stmt for derived types. So you could have:

type :: t
contains
    generic :: g => s1, s2  ! OOP style
    procedure :: s1, s2
end type

interface g  ! procedural style
    module procedure s1
    module procedure s2
end interface

Fortran 2018 added a generic-stmt that uses that same syntax (sans derived type specific attributes) as an alternative to the generic interface block:

type :: t
contains
    generic :: g => s1, s2  ! OOP style
    procedure :: s1, s2
end type

generic :: g => s1, s2  ! procedural style, not limited to TBPs

The interface block is somewhat crowded in terms of meaning, so this was a nice addition imho.

1 Like

Thanks! So from what I understand, it’s an alternative usage to an interface block, for the specific case where it only wraps module procedures? (that would be a subset of the possible interface purposes).

You can also have an external procedure within your generic overload set, but it needs to have an explicit interface:

subroutine print_int(i)
    integer :: i
    print *, i
end subroutine

module a
    private
    public :: my_print

    interface
        subroutine print_int(i)
            integer :: i
        end subroutine
    end interface
    generic :: my_print => print_real, print_int
contains
    subroutine print_real(r)
        real :: r
        print *, r
    end subroutine
end module

program test
    use a
    call my_print(20)
    call my_print(40.)
end program

In other words, you are not limited to procedures defined within the contains section.

2 Likes

I always thought it’s primary function was to provide a way to avoid name conflicts between public variables in a module and local variable names in a procedure. Also, it was not uncommon in Olden Days to have different variable names for the same memory location(s)/positions in a named COMMON list in different procedures so this provided a way to keep the local variable names when you replaced COMMON variables with module variables.

2 Likes

I worked on code from CERN where the names of variables in a common block were based on the nationality of the person working on the code, e.g. clef in French and key in English, mot in French and word in English.