Yesterday evening I watched a presentation by Klaus Iglberger on Breaking Dependencies: Type Erasure - A Design Analysis from CppCon 2021. In C++, 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…):
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
!> 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)
!> 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)
!> 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
!> 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:
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
$ 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.