# Attempting type erasure in Fortran

**URL:** <https://fortran-lang.discourse.group/t/attempting-type-erasure-in-fortran/4402>\
**Category:** Help\
**Created:** [September 25, 2022, 3:32am UTC](https://fortran-lang.discourse.group/t/attempting-type-erasure-in-fortran/4402 "2022-09-25T03:32:06Z")\
**Posts on this page:** 8\
**Page:** 1

<div class="post-metadata">

**Author:** ![ivanpribec](https://yyz2.discourse-cdn.com/free1/user_avatar/fortran-lang.discourse.group/ivanpribec/32/3290_2.png) [@ivanpribec](https://fortran-lang.discourse.group/u/ivanpribec)\
**Post date:** [September 25, 2022, 3:32am UTC](https://fortran-lang.discourse.group/t/attempting-type-erasure-in-fortran/4402/1 "2022-09-25T03:32:07Z")

</div>

Yesterday evening I watched a presentation by Klaus Iglberger on [Breaking Dependencies: Type Erasure - A Design Analysis](https://www.youtube.com/watch?v=4eeESJQk-mw) from CppCon 2021. In C++, [type erasure](https://en.wikipedia.org/wiki/Type_erasure) can be implemented with a cumbersome template pattern using a base class that contains two private structure templates, and a public constructor function template. Once the pieces fall together you are quite astonished how simple the client code looks (but the template machinery behind it is scary…):

```cpp
int main()
{
   using Shapes = std::vector<Shape>;

   // Creating some Shapes
   Shapes shapes;

   shapes.emplace_back( Circle{ 2.0 } ):
   shapes.emplace_back( Square{ 1.5 } ):
   shapes.emplace_back( Circle{ 4.2 } ):

   // Drawing all shapes
   drawAllShapes( shapes );
}

```

Anyways, this got me wondering, how close can we get in Fortran. The example in Klaus’ talk are geometric shapes. The goal is to draw/serialize the shape while preserving value semantics as far as possible. While over-simplified, you can imagine the shapes as a simplified X Window Server (e.g. you have to render windows and communicate their state with a remote system).

Following his talk, I implemented four different patterns, shown in the folded boxes below. All four are able to run on gfortran 11.1 and ifort 2021.5. In the process of writing the code I also found two or three ifort internal compiler errors.

> **Naive inheritance**
>
> ```fortran
> !> shapes_naive_inheritance.f90
> 
> module shape_base_module
> 
> implicit none
> private
> 
> public :: shape_base
> 
> type, abstract :: shape_base
> contains
> procedure(draw_shape), deferred :: draw
> procedure(serialize_shape), deferred :: serialize
> end type
> 
> abstract interface
> impure elemental subroutine draw_shape(shape)
> import shape_base
> class(shape_base), intent(in) :: shape
> end subroutine
> impure elemental subroutine serialize_shape(shape)
> import shape_base
> class(shape_base), intent(in) :: shape
> end subroutine
> end interface
> 
> end module
> 
> module shape_circle_module
> 
> use shape_base_module
> implicit none
> 
> type, extends(shape_base) :: shape_circle
> real :: radius
> contains
> procedure :: draw => draw_circle
> procedure :: serialize => serialize_circle
> end type
> 
> contains
> 
> impure elemental subroutine draw_circle(shape)
> class(shape_circle), intent(in) :: shape 
> ! ... implementation ...
> end subroutine
> 
> impure elemental subroutine serialize_circle(shape)
> class(shape_circle), intent(in) :: shape 
> print *, "CIRCLE ", shape%radius
> end subroutine
> 
> end module
> 
> module shape_rectangle_module
> 
> use shape_base_module
> implicit none
> 
> type, extends(shape_base) :: shape_rectangle
> real :: width, heigth
> contains
> procedure :: draw => draw_rectangle
> procedure :: serialize => serialize_rectangle
> end type
> 
> contains
> 
> impure elemental subroutine draw_rectangle(shape)
> class(shape_rectangle), intent(in) :: shape 
> ! ... implementation ...
> end subroutine
> 
> impure elemental subroutine serialize_rectangle(shape)
> class(shape_rectangle), intent(in) :: shape 
> print *, "RECTANGLE ",shape%width, shape%heigth
> end subroutine
> 
> end module
> 
> !> Public-facing shape module
> !>
> !> - Provide single entry point to the entire type hierarchy
> !> - Make names more manageable by renaming
> !>
> module shapes
> 
> !> The abstract base type
> use shape_base_module, only: shape => shape_base
> 
> !> The concrete child types
> use shape_circle_module, only: circle => shape_circle
> use shape_rectangle_module, only: rectangle => shape_rectangle
> 
> end module
> 
> program process_shapes
> 
> use shapes
> implicit none
> 
> write(*,*) "Process Circles"
> call process_circles()
> 
> write(*,*) "Process Circles and Rectangles"
> call process_circles_and_rectangles()
> 
> contains
> 
> subroutine process_circles()
> class(shape), allocatable :: collage(:)
> integer :: i
> 
> ! We can allocate an array of 3 circles
> allocate( circle :: collage(3))
>   
> ! it could also be rectangles, e.g.
> ! allocate( rectangle :: collage(5))
> ! but it seems we can't mix both shapes, even though they
> ! are part of the same hierarchy...
> 
> ! How do we initialize them?
> !
> ! a) by assignment? (gfortran doesn't allow this, ifort does!)
> !
> 
> !collage(1) = circle(12.)
> !collage(2) = circle(13.)
> !collage(3) = circle(14.)
> !call collage%serialize()
> !print '()'
> 
> !
> ! b) using select_type?
> !
> do i = 1, 3
> associate(item => collage(i))
> select type(item)
> type is (circle)
> item%radius = i*5
> end select
> end associate
> end do
> 
> call collage%serialize() ! But it's nice that the 
> ! elemental attribute works!
> 
> end subroutine
> 
> subroutine process_circles_and_rectangles()
> 
> !> If we want a list of mixed items, we need to encapsulate
> !> the polymorphic variable.
> 
> type :: shape_item
> class(shape), allocatable :: item
> contains
> end type
> 
> type(shape_item), allocatable :: items(:)
> integer :: i
> 
> allocate(items(5))
> 
> allocate(items(1)%item, source=circle(1.0))
> allocate(items(2)%item, source=circle(2.0))
> allocate(items(3)%item, source=circle(3.0))
> allocate(items(4)%item, source=rectangle(3.,4.))
> allocate(items(5)%item, source=rectangle(5.,7.))
> 
> !^^^ this look terrible 
> ! If we want to make this nicer, we need functions which will convert
> ! a shape to a shape_item. 
> 
> ! Also the type-bound procedures are now one level deeper.
> ! We need to loop through them, or add the type bound procedures
> ! to our new shape_item that wraps the polymorphic class...
> 
> do i = 1, size(items)
> call items(i)%item%serialize()  
> end do
> 
> ! Let's go back to the drawing board, and try the 
> ! _strategy pattern_ instead
> 
> end subroutine
> 
> end program
> 
> ```

> **Strategy pattern (via inheritance)**
>
> ```fortran
> !> shapes_strategy.f90
> !>
> !> Shape (Strategy pattern using abstract base class)
> !>
> module shape_base_module
> 
> implicit none
> private
> 
> public :: shape_base
> public :: shape_base_set_strategies
> 
> ! The inheritance hierarchy was getting a bit wild already, even with two shapes
> ! and two procedures.
> !
> ! Let's try composition instead of inheritance. 
> ! We will keep the abstract base class, but this time it will
> !
> type, abstract :: shape_base
> private
> !
> ! The base class now contains two strategies; any child class
> ! will initialize these pointers to null, so statements such as
> ! allocate will not work correctly...
> !
> procedure(draw_strategy), pointer, pass(shape) :: draw_doit => null()
> procedure(serialize_strategy), pointer, pass(shape) :: serialize_doit => null()
> contains
> ! The two concrete procedures only perform the 
> ! job of calling the strategies.
> procedure, non_overridable, public :: draw => draw_shape_base
> procedure, non_overridable, public :: serialize => serialize_shape_base
> end type
> 
> abstract interface
> ! These can't be elemental, since they will be pointer targets
> subroutine draw_strategy(shape)
> import shape_base
> class(shape_base), intent(in) :: shape
> end subroutine
> subroutine serialize_strategy(shape)
> import shape_base
> class(shape_base), intent(in) :: shape
> end subroutine
> end interface
> 
> contains
> 
> ! But these are still elemental.
> impure elemental subroutine draw_shape_base(shape)
> class(shape_base), intent(in) :: shape
> call shape%draw_doit()
> end subroutine
> impure elemental subroutine serialize_shape_base(shape)
> class(shape_base), intent(in) :: shape
> call shape%serialize_doit()
> end subroutine
> 
> subroutine shape_base_set_strategies(shape,draw,serialize)
> class(shape_base), intent(inout) :: shape
> procedure(draw_strategy) :: draw
> procedure(serialize_strategy) :: serialize
> 
> shape%draw_doit => draw
> shape%serialize_doit => serialize
> end subroutine
> 
> end module
> 
> module shape_circle_module
> 
> use shape_base_module, set_strategies => shape_base_set_strategies
> implicit none
> private
> 
> public :: shape_circle
> 
> type, extends(shape_base) :: shape_circle
> real :: radius
> end type
> 
> interface shape_circle
> module procedure :: shape_circle_new
> end interface
> 
> contains
> 
> function shape_circle_new(radius) result(circle)
> real, intent(in) :: radius
> type(shape_circle) :: circle
>     
> call set_strategies(circle, &
> draw_circle, &
> serialize_circle)
> 
> circle%radius = radius
>   
> end function
> 
> subroutine draw_circle(shape)
> class(shape_base), intent(in) :: shape 
> ! ... implementation ...
> select type(shape)
> type is (shape_circle)
> print *, "Drawing circle ..."
> end select
> 
> end subroutine
> 
> subroutine serialize_circle(shape)
> class(shape_base), intent(in) :: shape
> 
> ! Suddenly, we need to use select type here !!!
> 
> select type(shape)
> type is (shape_circle)
> print *, "CIRCLE ", shape%radius
> end select
> 
> end subroutine
> 
> ! In all procedures we will need to use select_type, because
> ! the procedure pointer in the base class expects an
> ! object of class(shape_base)... 
> 
> end module
> 
> module shape_rectangle_module
> 
> use shape_base_module, set_strategies => shape_base_set_strategies
> implicit none
> private
> 
> public :: shape_rectangle
> 
> type, extends(shape_base) :: shape_rectangle
> real :: width, heigth
> end type
> 
> interface shape_rectangle
> module procedure :: shape_rectangle_new
> end interface
> 
> contains
> 
> function shape_rectangle_new(width,heigth) result(rectangle)
> real, intent(in) :: width, heigth
> type(shape_rectangle) :: rectangle
>     
> call set_strategies(rectangle, &
> draw_rectangle, &
> serialize_rectangle)
> 
> rectangle%width = width
> rectangle%heigth = heigth
>   
> end function
> 
> subroutine draw_rectangle(shape)
> class(shape_base), intent(in) :: shape 
> ! ... implementation ...
> select type (shape)
> type is (shape_rectangle)
> print *, "Drawing rectangle ..."
> end select
> end subroutine
> 
> subroutine serialize_rectangle(shape)
> class(shape_base), intent(in) :: shape
> select type (shape)
> type is (shape_rectangle)
> print *, "RECTANGLE ",shape%width, shape%heigth
> end select
> end subroutine
> 
> end module
> 
> module shapes
> 
> !> The abstract base type
> use shape_base_module, only: shape => shape_base
> 
> !> The concrete child types
> use shape_circle_module, only: circle => shape_circle
> use shape_rectangle_module, only: rectangle => shape_rectangle
> 
> implicit none
> public
> 
> end module
> 
> program process_shapes
> 
> use shapes
> implicit none
> 
> write(*,*) "Process Circles"
> call process_circles()
> 
> contains
> 
> subroutine process_circles()
> 
> class(shape), allocatable :: collage(:)
> integer :: i
> 
> ! Allocation like this works, however the strategy pointers
> ! are still set to null...
> allocate( circle :: collage(3))
>   
> ! it could also be rectangles, e.g.
> ! allocate( rectangle :: collage(5))
> ! but it seems we can't mix both shapes, even though they
> ! are part of the same hierarchy...
> 
> ! How do we initialize them? We need to combine
> ! select type and our overloaded structure constructor,
> ! using the keyword argument to select the only one - weird...
> !
> do i = 1, 3
> select type (collage)
> type is (circle)
> collage(i) = circle(radius=5*i)
> end select
> end do
> 
> call collage%serialize() ! The elemental routines, still works, hooray!
> 
> end subroutine
> 
> ! Overall, we don't seem to by doing any better than the
> ! hierarchy version. The client code needs select_type, we still can't
> ! mix different items of the same child types.
> 
> end program
> 
> ```

> **Bridge pattern (Pimpl)**
>
> ```fortran
> !> shapes_strategy_pimpl.f90
> 
> !> This is what a Fortran progammer who has never heard of 
> !> inheritance, polymorphism, or pointers mights do.
> !> Instead, we rely exclusively on compostion and allocatable arrays
> !>
> module shape_implementation
>   
> implicit none
> private
> 
> public :: shape_storage
> 
> type :: shape_storage
> integer :: ishape = -1
> real, allocatable :: data(:)
> end type
> 
> !> Different shapes are tightly coupled with the shape storage
> public :: circle_storage
> public :: rectangle_storage
> 
> !> The "strategies", this time as static procedures. 
> public :: draw_program
> public :: serialize_program
> 
> integer, parameter :: IEMPTY = -1
> integer, parameter :: ICIRCLE = 1
> integer, parameter :: IRECTANGLE = 2
> integer, parameter :: ITRIANGLE = 4
> ! ...
> 
> contains
> 
> !> Constructor functions
> !> All share same data representation
> 
> function circle_storage(radius) result(str)
> real, intent(in) :: radius
> type(shape_storage) :: str
> str = shape_storage( &
> ICIRCLE, &
> [radius] &
> )
> end function
> 
> function rectangle_storage(width,heigth) result(str)
> real, intent(in) :: width, heigth
> type(shape_storage) :: str
> str = shape_storage( &
> IRECTANGLE, &
> [width, heigth] &
> )
> end function
> 
> impure elemental subroutine draw_program(str)
> type(shape_storage), intent(in) :: str
> 
> select case(str%ishape)
> case(ICIRCLE)
> print *, "Drawing circle ..."
> case(IRECTANGLE)
> print *, "Drawing rectangle ..."
> case default
> error stop "Shape not available..."
> end select
> end subroutine
> 
> !> The implementations are placed in the same subprogram, because they 
> !> share the same storage. Potentially you could introduce a 
> !> sub-module to hide the implementation details and use more natural
> !> dummy argument names. But the switch statement will remain no 
> !> matter what we do, because the storage type is static.
> !>
> impure elemental subroutine serialize_program(str)
> type(shape_storage), intent(in) :: str
> 
> select case(str%ishape)
> case(ICIRCLE)
> call serialize_circle(str%data(1))
> case(IRECTANGLE)
> call serialize_rectangle(str%data(1),str%data(2))
> case default
> error stop "Shape not available..."
> end select
> 
> contains
> 
> subroutine serialize_circle(radius)
> real, intent(in) :: radius
> print *, "CIRCLE ", radius
> end subroutine
> 
> subroutine serialize_rectangle(width,heigth)
> real, intent(in) :: width, heigth
> print *, "RECTANGLE ", width, heigth
> end subroutine
> 
> end subroutine
> 
> end module
> 
> !>
> !> Shape strategy (this time using pImpl idiom, with static procedures)
> !>
> module shape_base_module
> 
> use shape_implementation
> 
> implicit none
> private
> 
> public :: shape_base, circle, rectangle
> 
> type :: shape_base
> private
> ! Essentially our "pointer to implementation" or pImpl
> ! Since it is allocatable, guaranteed memory safe.
> type(shape_storage), allocatable :: storage
> contains
> !> The type-bound procedures just wrap the strategies
> procedure, public :: draw => draw_shape
> procedure, public :: serialize => serialize_shape
> end type
> 
> contains
> 
> !> 
> impure elemental subroutine draw_shape(shape)
> class(shape_base), intent(in) :: shape
> call draw_program(shape%storage)
> end subroutine
> impure elemental subroutine serialize_shape(shape)
> class(shape_base), intent(in) :: shape
> call serialize_program(shape%storage)
> end subroutine
> 
> function circle(radius) result(s)
> real, intent(in) :: radius
> type(shape_base) :: s
> s%storage = circle_storage(radius)
> end function
> 
> function rectangle(width,heigth) result(s)
> real, intent(in) :: width,heigth
> type(shape_base) :: s
> s%storage = rectangle_storage(width,heigth)
> end function
> 
> end module
> 
> !> Public-facing shape module
> !>
> !> - Provide single entry point to the entire type hierarchy
> !> - Make names more manageable by renaming
> !>
> module shapes
> 
> !> The base type (not abstract this time)
> use shape_base_module, only: shape => shape_base
> 
> !> The child types are really just "functions", the implementation
> !> of these are tightly coupled with the shape_base storage
> !> representation. Also these are not type names anymore, but functions
> use shape_base_module, only: circle
> use shape_base_module, only: rectangle
> 
> end module
> 
> program process_shapes
> 
> use shapes
> implicit none
> 
> write(*,*) "Process shapes"
> call process_mixed_shapes()
> 
> contains
> 
> subroutine process_mixed_shapes()
> 
> type(shape), allocatable :: collage(:)
> 
> ! Look what has happened, we can have an array of mixed types :)
> ! Ain't that nice?
> 
> collage = [ &
> circle(12.), &
> rectangle(12.,10.), &
> circle(6.) &
> ]
> 
> call collage%serialize() ! The elemental routines, still works, hooray!
> 
> ! The price we've paid is the shape implementations are
> ! tightly coupled and rigid. 
> 
> end subroutine
> 
> end program
> 
> ```

> **(Pseudo) Type Erasure**
>
> ```fortran
> !> shapes_type_erasure.F90
> 
> !!
> !! Shapes, but this time with something closer to type erasure
> !!
> 
> ! Instead of the top-down hierarchy originating from inheritance,
> ! we start bottom up this time.
> !
> ! The shape modules are defined completely independently, and
> ! can also be used independently. No polymorphism or pointers, just
> ! plain derived types and procedures.
> !
> module shape_circle
> implicit none
> private
> public :: circle, draw, serialize
> type :: circle
> real :: radius
> end type
> interface draw
> module procedure draw_circle
> end interface
> interface serialize
> module procedure serialize_circle
> end interface
> contains
> subroutine draw_circle(c)
> type(circle), intent(in) :: c
> write(*,'(A,G0,A)') "Drawing CIRCLE: { R = ", c%radius, "}"
> end subroutine
> subroutine serialize_circle(c)
> type(circle), intent(in) :: c
> print *, "CIRCLE ", c%radius
> end subroutine
> end module
> 
> module shape_rectangle
> implicit none
> private
> public :: rectangle, draw, serialize
> type :: rectangle
> real :: width, heigth
> end type
> interface draw
> module procedure draw_rectangle
> end interface
> interface serialize
> module procedure serialize_rectangle
> end interface
> contains
> subroutine draw_rectangle(r)
> type(rectangle), intent(in) :: r
> write(*,'(A,G0,A,G0,A)') "Drawing RECTANGLE { W = ", r%width, &
> ", H = ", r%heigth, "}"
> 
> end subroutine
> subroutine serialize_rectangle(r)
> type(rectangle), intent(in) :: r
> print *, "RECTANGLE ", r%width, r%heigth
> end subroutine
> end module
> 
> ! We would still like to operate on collections of shapes,
> ! but let's try something different -> type-erasure (not quite, but close)
> ! 
> module shapes
> 
> use shape_circle
> use shape_rectangle
>    
> implicit none
> private
> 
> !> "Generic" shape type
> public :: shape
> 
> !> Concrete types
> public :: circle, rectangle
> 
> !> Operations
> public :: serialize
> public :: draw
> 
> type :: shape
> !private
> class(*), allocatable :: value
> contains
> procedure :: serialize => serialize_generic
> procedure :: draw => draw_generic
> end type
> 
> !> We should be able to call the same procedures on the
> !> generic shape, as we do on the simple primitives
> 
> interface serialize
> module procedure serialize_generic
> end interface
> 
> interface draw
> module procedure draw_generic
> end interface
> 
> !> To build a generic shape we overload the structure constructor
> !> (this is also needed due to the private declaration)
> !
> #ifdef __GFORTRAN__
> interface shape
> module procedure shape_from_circle
> module procedure shape_from_rectangle
> module procedure shape_from_shape
> end interface
> #endif
> 
> interface operator(.shape.)
> module procedure shape_from_circle
> module procedure shape_from_rectangle
> module procedure shape_from_shape
> end interface
> 
> contains
> 
> !> We need these functions to convert the specific shapes
> !> into unlimited polymorphic variables
> !>
> !> Actually, ifort doesn't even need these, but gfortran does.
> !>
> pure function shape_from_circle(c) result(s)
> type(circle), intent(in) :: c
> type(shape) :: s
> s%value = c
> end function
> pure function shape_from_rectangle(r) result(s)
> type(rectangle), intent(in) :: r
> type(shape) :: s
> s%value = r
> end function
> pure function shape_from_shape(s) result(res)
> type(shape), intent(in) :: s
> type(shape) :: res
> res = s
> end function
> 
> !> We can't avoid select type, however instead of having to 
> !> use select_type in the client code, the select types are now
> !> all in one place, and not in separate files.
> !> If you had many primite types, you could easily write a Fypp macro
> !> to do the unrolling for you.
> !>
> impure elemental subroutine serialize_generic(s)
> class(shape), intent(in) :: s
> associate(value => s%value)
> select type (value)
> type is (circle)
> call serialize(value)
> type is (rectangle)
> call serialize(value)
> ! type is (shape)
> ! call serialize(value) ! nvfortran - recursive subroutine error
> class default
> !> In the present module, it should be impossible to
> !> reach this block.
> !> You could however use this block to your advantage if 
> !> you have a shape which doesn't support serialization.
> error stop "Sorry, don't know how to serialize that..."
> end select
> end associate
> end subroutine
> 
> impure elemental subroutine draw_generic(s)
> class(shape), intent(in) :: s
> associate(value => s%value)
> select type (value)
> type is (circle)
> call draw(value)
> type is (rectangle)
> call draw(value)
> ! type is (shape)
> ! call draw(value) ! nvfortran, recursive subroutine error 
> class default
> error stop "Sorry, don't know how to draw that..."
> end select
> end associate
> end subroutine
> 
> end module
> 
> !> Let's see where the use of interfaces and generics 
> !> have brought us
> 
> program process_shapes
> 
> use shapes
> implicit none
> 
> call demo1()
> call demo2()
> 
> contains
> 
> subroutine demo1()
> type(shape) :: shape_scalar
> type(shape) :: shape_array(3)
> 
> write(*,'(A,/)') "Demo 1"
> 
> !> We can construct a scalar shape by chaining the structure
> !> constuctors
> shape_scalar = shape(circle(42.))
> call serialize(shape_scalar)
> 
> !> To construct an array of shapes, it would be nice if we could
> !> use an an array constructor with automatic conversion:
> !
> ! shape_array = [ shape :: &
> ! circle(10.), &
> ! rectangle(4.,5.), &
> ! circle(12.)]
> !
> !> Unfortunately, this doesn't work currently, and leads the the
> !> following errors:
> !> gfortran - Error: Cannot convert TYPE(circle) to TYPE(shape)
> !> ifort - Catastrophic error: **Internal compiler error**
> 
> ! So instead we just assign the shapes one by one
> ! (again it would be nice to have an implicit conversion)
> shape_array(1) = shape(circle(10.))
> shape_array(2) = shape(circle(5.))
> shape_array(3) = shape(rectangle(width=12.,heigth=14.))
>       
> ! Since the procedure is elemental, we can easily serialize
> ! the whole array
> call serialize(shape_array)
> ! or
> call shape_array%serialize()
> 
> ! We can copy an existing shape, preserving the shape
> shape_scalar = shape_array(1)
> call serialize(shape_scalar)
> 
> ! And we can also instantiate a shape from another shape
> ! (on the condition we overloaded the structure constructor)
> shape_scalar = shape(shape_array(3))
> call serialize(shape_scalar)
> end subroutine
> 
> subroutine demo2()
> 
> type(shape), allocatable :: scrapbook(:)
> 
> write(*,'(/,A,/)') "Demo 2"
> 
> scrapbook = [shape(circle(10.0))]
> scrapbook = [scrapbook, shape(rectangle(12.,12.))]
> 
> call draw(scrapbook)
> 
> end subroutine
> 
> end program
> 
> ```

Here’s what the final Fortran program looks like for the “type erasure” version:

```auto
program draw_shapes
use shapes
implicit none

type(shape), allocatable :: s(:)

allocate(s(3))

s(1) = (.shape. circle(2.0))
s(2) = (.shape. rectangle(1.5,1.5))
s(3) = (.shape. circle(4.2))

call draw(s)

deallocate(s)

end program

```

```nohighlight
$ gfortran -o draw_shapes draw_shapes.F90 
$ ./draw_shapes 
Drawing CIRCLE: { R = 2.00000000}
Drawing RECTANGLE { W = 1.50000000, H = 1.50000000}
Drawing CIRCLE: { R = 4.19999981}

```

I was quite surprised how easily the “Type Erasure” version came together. No inheritance at all. The shapes are completely decoupled from each other. The only short-coming is that in Fortran, adding a new shape requires adding a new section to the `select type` construct for each operation/interface you’d like to support. In C++ on the other hand, the template machinery takes care of this automatically, i.e. adding a new concrete shape requires zero changes of the _generic_ `Shape` class.

The NVIDIA HPC SDK Fortran compiler (v22.7) compiles three out of four examples, however only one of them works correctly which, to my surprise, is the “Naive inheritance”. It seems to have some problems with structure constructors

I think there is a some potential to enhance the unlimited polymorphic variables in Fortran to enable easier and safer generic programming.

---

<div class="post-metadata">

**Author:** ![FedericoPerini](https://yyz2.discourse-cdn.com/free1/user_avatar/fortran-lang.discourse.group/federicoperini/32/1750_2.png) [@FedericoPerini](https://fortran-lang.discourse.group/u/FedericoPerini)\
**Post date:** [September 25, 2022, 8:13am UTC](https://fortran-lang.discourse.group/t/attempting-type-erasure-in-fortran/4402/2 "2022-09-25T08:13:28Z")

</div>

Nice example! with the caveat that all `shape`s have the same interface, I think you can remove most of the boilerplate using a hybrid of your first and last approaches:

```fortran
module shapes
   use iso_fortran_env
   implicit none
   private

   type, public, abstract :: shape_base
       contains
       procedure(shape_base_draw), deferred :: draw
       procedure(shape_base_ser), deferred :: serialize
   end type shape_base

   type, public, extends(shape_base) :: shape
      class(shape_base), allocatable :: value
   contains
      procedure :: serialize => shape_serialize
      procedure :: draw => shape_draw
      procedure, private :: shape_assign
      generic :: assignment(=) => shape_assign
   end type shape

   ! The basic shapes
   type, public, extends(shape_base) :: circle
       real(real64) :: radius
       contains
       procedure :: draw => draw_circle
       procedure :: serialize => serialize_circle
   end type circle

   type, public, extends(shape_base) :: rectangle
       real(real64) :: width,height
       contains
       procedure :: draw => draw_rectangle
       procedure :: serialize => serialize_rectangle
   end type rectangle

   abstract interface
       subroutine shape_base_draw(c)
          import shape_base
          class(shape_base), intent(in) :: c
       end subroutine
       impure elemental subroutine shape_base_ser(c)
          import shape_base
          class(shape_base), intent(in) :: c
       end subroutine
   end interface

   interface shape
      module procedure shape_new
   end interface

contains
   subroutine draw_circle(c)
      class(circle), intent(in) :: c
      write(*,'(A,G0,A)') "Drawing CIRCLE: { R = ", c%radius, "}"
   end subroutine
   impure elemental subroutine serialize_circle(c)
      class(circle), intent(in) :: c
      print *, "CIRCLE ", c%radius
   end subroutine

   subroutine draw_rectangle(c)
      class(rectangle), intent(in) :: c
      write(*,'(A,G0,A,G0,A)') "Drawing RECTANGLE { W = ", c%width, &
                                       ", H = ", c%height, "}"
   end subroutine
   impure elemental subroutine serialize_rectangle(c)
      class(rectangle), intent(in) :: c
      print *, "RECTANGLE ", c%width, c%height
   end subroutine

   subroutine shape_draw(c)
      class(shape), intent(in) :: c
      if (allocated(c%value)) then
         call c%value%draw()
      else
         stop 'trying to draw an empty shape'
      endif
   end subroutine

   impure elemental subroutine shape_serialize(c)
      class(shape), intent(in) :: c
      if (allocated(c%value)) then
         call c%value%serialize()
      else
         print *, "EMPTY "
      endif
   end subroutine

   ! Shape initializer
   subroutine shape_assign(lhs,rhs)
       class(shape), intent(inout) :: lhs
       class(shape_base), intent(in) :: rhs
       if (allocated(lhs%value))deallocate(lhs%value)
       allocate(lhs%value,source=rhs)
   end subroutine shape_assign

   ! Shape initializer
   type(shape) function shape_new(rhs) result(lhs)
       class(shape_base), intent(in) :: rhs
       allocate(lhs%value,source=rhs)
   end function shape_new

end module shapes

!> Let's see where the use of interfaces and generics
!> have brought us

program process_shapes

   use shapes
   implicit none

   call demo1()
   call demo2()

contains

   subroutine demo1()
      type(shape) :: shape_scalar
      type(shape) :: shape_array(3)

      write(*,'(A,/)') "Demo 1"

      !> We can construct a scalar shape by chaining the structure
      !> constuctors
      shape_scalar = circle(42.)
      call shape_scalar%serialize()

      !> To construct an array of shapes, it would be nice if we could
      !> use an an array constructor with automatic conversion:
      !
      ! shape_array = [ shape :: &
      ! circle(10.), &
      ! rectangle(4.,5.), &
      ! circle(12.)]
      !
      !> Unfortunately, this doesn't work currently, and leads the the
      !> following errors:
      !> gfortran - Error: Cannot convert TYPE(circle) to TYPE(shape_base)
      !> ifort - Catastrophic error: **Internal compiler error**

      ! So instead we just assign the shapes one by one
      ! (again it would be nice to have an implicit conversion)
      shape_array(1) = circle(10.)
      shape_array(2) = circle(5.)
      shape_array(3) = rectangle(width=12.,height=14.)

      ! Since the procedure is elemental, we can easily serialize
      ! the whole array
      call shape_array%serialize()

      ! We can copy an existing shape, preserving the shape
      shape_scalar = shape_array(1)
      call shape_scalar%serialize()

      ! And we can also instantiate a shape from another shape
      ! (on the condition we overloaded the structure constructor)
      shape_scalar = shape_array(3)
      call shape_scalar%serialize()
   end subroutine

   subroutine demo2()

      type(shape), allocatable :: scrapbook(:)

      write(*,'(/,A,/)') "Demo 2"

      scrapbook = [shape(circle(10.0))]
      scrapbook = [scrapbook, shape(rectangle(12.,12.))]

      call scrapbook%serialize()
   end subroutine

end program

```

- Full inheritance =\> no need to keep redefining interfaces or using `select type`s
- Just a bit verbose array constructor (at least with gfortran)

\*\*\* EDIT \*\*\*

Small improvement: to prevent unwanted nested types, without loss of generality, the assignment routine can be modified as

```fortran
   subroutine shape_assign(lhs,rhs)
       class(shape), intent(inout) :: lhs
       class(shape_base), intent(in) :: rhs
       if (allocated(lhs%value))deallocate(lhs%value)
       ! Prevent nested derived type
       select type (rhsT=>rhs)
          class is (shape); if (allocated(rhsT%value)) allocate(lhs%value,source=rhsT%value)
          class default; allocate(lhs%value,source=rhsT)
       end select
   end subroutine shape_assign

```

Array handling also works:

```fortran
   subroutine demo3()

     type(shape), allocatable :: array(:),chunk(:)
     integer :: i

     write(*,'(/,A,/)') "Demo 3"

     allocate(array(0))
     do i=1,10
        array = [array,shape(circle(real(i)))]
     end do

     chunk = array(2:8:2)
     call chunk%serialize()

   end subroutine demo3

```

produces

```auto
Demo 3

 CIRCLE 2.0000000000000000     
 CIRCLE 4.0000000000000000     
 CIRCLE 6.0000000000000000     
 CIRCLE 8.0000000000000000     

```

---

<div class="post-metadata">

**Author:** ![ivanpribec](https://yyz2.discourse-cdn.com/free1/user_avatar/fortran-lang.discourse.group/ivanpribec/32/3290_2.png) [@ivanpribec](https://fortran-lang.discourse.group/u/ivanpribec)\
**Post date:** [September 25, 2022, 4:28pm UTC](https://fortran-lang.discourse.group/t/attempting-type-erasure-in-fortran/4402/3 "2022-09-25T16:28:11Z")

</div>

Thanks Federico for your additional example. If I understand correctly, the core design choice is to encapsulate the the abstract base class in the extendable base class (I guess in C++ they would call this a pointer (`unique_ptr`) to an abstract base class).

From past C++ courses, I have observed one needs to be very careful when he chooses to overload assignment. Especially if the types contain pointers, it can become a nightmare to reason about. I’d prefer to rely on intrinsic assignment if possible. I can see the benefit, by overloading assignment, no explicit conversion (construction) is needed to assign the polymorphic shape items:

```fortran
      shape_array(1) = circle(10.)
      shape_array(2) = circle(5.)
      shape_array(3) = rectangle(width=12.,height=14.)

```

These type of exercises are valuable to discover the pros and cons of different patterns, both in terms of coupling, boilerplate, and performance. I guess all languages have a degree of isomorphism, there are multiple ways to achieve the same thing. I’m not sure how strict the Fortran standard is in terms the processor following the syntax strictly, or weather it is allowed to take “shortcuts” as long as the observable behavior remains the same.

I think the cool feature of the type-erasure pattern is there is no inheritance at all. The ugly part is the need for “manual” [reificiation](https://en.wikipedia.org/wiki/Reification_(computer_science)), that is, re-establishing the type from the unlimited polymorphic variable. It looks even weirder, given that once we are in the block where the type is known, we use a generic interface… I feel like something is missing in the language, so that this could be simplified. I’m curious if the generic committee have seen or put this pattern to use before (cc @everythingfunctional, @certik).

If the number of shapes and operations became large, to save some effort from writing boilerplate, a preprocessor template (e.g. using [Fypp](https://fypp.readthedocs.io/en/stable/fypp.html#)) can be used instead:

```nohighlight
#! Print subroutine attributes such as impure and elemental
#!
#:def subroutine_preamble(**kwargs)
#:if kwargs.get("impure")
impure &
#:endif
#:if kwargs.get("elemental")
elemental &
#:endif
#:enddef

#! Generic shape subroutine
#!
#! Use this template to instantiate subroutines for a set of derived types
#! describing shapes, and the shared operations specified by a generic 
#! procedure interface.
#!
#:def generic_subroutine(operation,*types,**kwargs)
!>
!> Generic operation - ${operation}$
!>
$:subroutine_preamble(**kwargs)
subroutine ${operation}$_generic(s)
   class(shape), intent(in) :: s
   associate(value => s%value)
   select type(value)
#:for t in types
   type is (${t}$)
      call ${operation}$(value)
#:endfor
   class default
      error stop "ERROR: don't know how to ${operation}$ received shape"
   end select
   end associate
end subroutine
#:enddef

```

The actual procedure generation loop is now:

```nohighlight
#:set shapes = ["circle", "rectangle"]
#:set subroutines = ["draw", "serialize"]

#:for sub in subroutines
$:generic_subroutine(sub,*shapes, &
    impure=True, &
    elemental=True)
#:endfor

```

The expanded templates are displayed in the drop-down box:

> **Generic subprograms via preprocessing**
>
> ```fortran
> !>
> !> Generic operation - draw
> !>
> impure &
> elemental &
> subroutine draw_generic(s)
> class(shape), intent(in) :: s
> associate(value => s%value)
> select type(value)
> type is (circle)
> call draw(value)
> type is (rectangle)
> call draw(value)
> class default
> error stop "ERROR: don't know how to draw received shape"
> end select
> end associate
> end subroutine
> !>
> !> Generic operation - serialize
> !>
> impure &
> elemental &
> subroutine serialize_generic(s)
> class(shape), intent(in) :: s
> associate(value => s%value)
> select type(value)
> type is (circle)
> call serialize(value)
> type is (rectangle)
> call serialize(value)
> class default
> error stop "ERROR: don't know how to serialize received shape"
> end select
> end associate
> end subroutine
> 
> ```

---

<div class="post-metadata">

**Author:** ![FedericoPerini](https://yyz2.discourse-cdn.com/free1/user_avatar/fortran-lang.discourse.group/federicoperini/32/1750_2.png) [@FedericoPerini](https://fortran-lang.discourse.group/u/FedericoPerini)\
**Post date:** [September 25, 2022, 5:07pm UTC](https://fortran-lang.discourse.group/t/attempting-type-erasure-in-fortran/4402/4 "2022-09-25T17:07:44Z")

</div>

I don’t know, I’m no computer scientist but I think the cool idea is to have an extended derived type that contains an allocatable component of the abstract class. In this way, the “container” type is completely interchangeable with all others defined types, so you can define it `type(shape)` and use all the cool Fortran array facilities that you otherwise couldn’t.

On the drawback side, it won’t be super fast if you keep changing data, because of the allocations.

On the interesting side, there may be cool applications in lists with key/value pair types which could use the recursive definition.

---

<div class="post-metadata">

**Author:** ![ivanpribec](https://yyz2.discourse-cdn.com/free1/user_avatar/fortran-lang.discourse.group/ivanpribec/32/3290_2.png) [@ivanpribec](https://fortran-lang.discourse.group/u/ivanpribec)\
**Post date:** [September 25, 2022, 5:19pm UTC](https://fortran-lang.discourse.group/t/attempting-type-erasure-in-fortran/4402/5 "2022-09-25T17:19:20Z")

</div>

At the time I didn’t have a name for, but a [past post](https://fortran-lang.discourse.group/t/programming-challenge-19th-century-writers/2299/13) from @Arjen also fits under the spirit of type erasure. In that thread the challenge was to write a generic “reverse” subroutine.

Reversing an array, only requires that the types are assignable so you can swap their contents:

```auto
subroutine reverse( array, assign )
    class(*), dimension(:), intent(inout), pointer :: array  
       ! (25/9/2022, is pointer attribute needed?)
    interface
        subroutine assign( a, b )
            class(*), intent(out) :: a
            class(*), intent(in) :: b
        end subroutine assign
    end interface

    class(*), allocatable :: tmp
    integer :: i, j

    allocate( tmp, mold=array(1) )

    do i = 1,size(array)/2
        j = size(array) + 1 - i
        call assign( tmp, array(i) )
        call assign( array(i), array(j) )
        call assign( array(j), tmp )
    enddo
end subroutine reverse
end module reverse_array

```

For each type you’d like to swap, you need a subroutine such as:

```fortran
subroutine assign_person( a, b )
    class(*), intent(out) :: a
    class(*), intent(in) :: b
    select type( a )
        type is (person)
            select type( b )
                type is (person)
                    a = b
            end select
    end select
end subroutine assign_person

```

It’s not difficult to see, you just replace `person` with any type, and you can reuse the `reverse` routine. It seems very close to what C++20 [concepts](https://en.cppreference.com/w/cpp/language/constraints) are for:

```cpp
// reverse.cpp

#include<concepts>
#include<vector>
#include<iostream>
#include<string>

template<typename T>
concept Assignable = requires(T a, T b) {
    a = b;
};

template<Assignable T>
void reverse(std::vector<T> &array) {

    int n = array.size();
    for (int i = 0; i < n/2; ++i) {
        int j = n - i - 1;
        T tmp = array[i];
        array[i] = array[j];
        array[j] = tmp;
    }    
}

template<class Array>
void show(std::string title, Array c) {
    std::cout << title << " = [ ";
    for(int i = 0; i < c.size(); ++i) {
        std::cout << c[i] << " ";
    }
    std::cout << "]\n";
}

int main(int argc, char const *argv[]) {

    std::vector<int> arr{1,2,3,4,5};
    
    show(" initial",arr);
    reverse(arr);    
    show("after reverse",arr);

    return 0;
}

```

---

<div class="post-metadata">

**Author:** ![ivanpribec](https://yyz2.discourse-cdn.com/free1/user_avatar/fortran-lang.discourse.group/ivanpribec/32/3290_2.png) [@ivanpribec](https://fortran-lang.discourse.group/u/ivanpribec)\
**Post date:** [September 25, 2022, 5:26pm UTC](https://fortran-lang.discourse.group/t/attempting-type-erasure-in-fortran/4402/6 "2022-09-25T17:26:35Z")

</div>

> [@FedericoPerini](#):
>
> I don’t know, I’m no computer scientist but I think the cool idea is to have an extended derived type that contains an allocatable component of the abstract class. In this way, the “container” type is completely interchangeable with all others defined types, so you can define it `type(shape)` and use all the cool Fortran array facilities that you otherwise couldn’t.

Well put. That’s the essence of it - you can build on the built-in array semantics, but with polymorphic items.

> [@FedericoPerini](#):
>
> On the drawback side, it won’t be super fast if you keep changing data, because of the allocations.

Klaus Iglberger mentions something about this; if you are working with small objects then value-semantics are your friend. If you are working with large objects (e.g. huge arrays of doubles) and you need to avoid expensive copies, then reference-semantics are unavoidable. The language gives you both, but you need to use them for the right purpose.

---

<div class="post-metadata">

**Author:** ![ivanpribec](https://yyz2.discourse-cdn.com/free1/user_avatar/fortran-lang.discourse.group/ivanpribec/32/3290_2.png) [@ivanpribec](https://fortran-lang.discourse.group/u/ivanpribec)\
**Post date:** [September 25, 2022, 11:19pm UTC](https://fortran-lang.discourse.group/t/attempting-type-erasure-in-fortran/4402/7 "2022-09-25T23:19:31Z")

</div>

> [@FedericoPerini](#):
>
> ```fortran
> ! Shape initializer
> subroutine shape_assign(lhs,rhs)
> class(shape), intent(inout) :: lhs
> class(shape_base), intent(in) :: rhs
> if (allocated(lhs%value))deallocate(lhs%value)
> allocate(lhs%value,source=rhs)
> end subroutine shape_assign
> 
> ```

According to section 15.5 in Metcalf, Reid, Cohen (the “red book”), you can achieve the same thing with intrinsic assignment:

```fortran
lhs%value = rhs

```

with the benefit that if the `lhs%value` is already allocated with the same type (and shape and other parameters), no reallocation is done (i.e. only the values are copied). This can potentially improve performance. (A fictive example, say you process shapes in batches, when you receive the second or further batches the virtual tables and containers already exist and don’t need to be allocated, but you just overwrite the old values with the newly received batch).

---

<div class="post-metadata">

**Author:** ![everythingfunctional](https://yyz2.discourse-cdn.com/free1/user_avatar/fortran-lang.discourse.group/everythingfunctional/32/176_2.png) [@everythingfunctional](https://fortran-lang.discourse.group/u/everythingfunctional)\
**Post date:** [September 26, 2022, 2:16pm UTC](https://fortran-lang.discourse.group/t/attempting-type-erasure-in-fortran/4402/8 "2022-09-26T14:16:16Z")

</div>

I’ve got an example of the “shapes idea” that I used in a course once [here](https://gitlab.com/everythingfunctional/heterogeneous_list/-/tree/implement_area_filter).

I’m not sure I’ve fully understood the type-erasure pattern, but I suspect it won’t be possible in Fortran the way they seem to be able to do it in C++, even with the upcoming template features. It’s worth some exploration though. The thing is that Fortran can’t do generic resolution at run-time, and if you’ve “erased” the type, it has nothing to go on for the generic resolution at compile-time either, so you’re kind of forced to use inheritance.