Here is an attempt at re-creating the visitor pattern in Fortran. Since Fortran does not allow forward references, I had to resort to the surrogate pattern. Compared to the C++ version I was following, the Fortran code is twice as long… I’m looking forward to learning any possible simplifications
Nasty details
module shape_proxy_
implicit none
private
public :: shape_proxy
! This stateless type serves only for purposes of extension
! by other types. In such a role, it can serve as a substitute for the
! child type when that type is inaccessible because of Fortran's
! prohibition against circular references
type, abstract :: shape_proxy
end type
end module
module visitor
! Substitute for shape_type
use shape_proxy_, only: shape_proxy
implicit none
private
public :: visitor_type, shape_proxy
type, abstract :: visitor_type
contains
procedure(visit_shape), nopass, deferred :: visit
end type
abstract interface
subroutine visit_shape(shape)
import shape_proxy
class(shape_proxy), intent(in) :: shape
end subroutine
end interface
end module
module shapes_
use shape_proxy_
use visitor, only: visitor_type
implicit none
type, abstract, extends(shape_proxy) :: shape_type
contains
procedure :: accept
end type
contains
subroutine accept(this,visitor)
class(shape_type), intent(in) :: this
class(visitor_type), intent(in) :: visitor
call visitor%visit(this)
end subroutine
end module
module circles
use shapes_
implicit none
private
public :: circle
type, extends(shape_type) :: circle
private
real :: radius_
contains
procedure :: radius
end type
interface circle
module procedure circle_new
end interface
contains
type(circle) function circle_new(radius)
real, intent(in) :: radius
circle_new%radius_ = radius
end function
real function radius(this)
class(circle), intent(in) :: this
radius = this%radius_
end function
end module
module squares
use shapes_
implicit none
private
public :: square
type, extends(shape_type) :: square
private
real :: side_
contains
procedure :: side
end type
interface square
module procedure square_new
end interface
contains
type(square) function square_new(side)
real, intent(in) :: side
square_new%side_ = side
end function
real function side(this)
class(square), intent(in) :: this
side = this%side_
end function
end module
module drawing
use visitor, only: visitor_type, shape_proxy
use circles, only: circle
use squares, only: square
implicit none
type, extends(visitor_type) :: draw_visit
contains
procedure, nopass :: visit
end type
contains
subroutine visit(shape)
class(shape_proxy), intent(in) :: shape
select type (s => shape)
class is (circle)
print *, "circle: radius = ", s%radius()
class is (square)
print *, "square: side = ", s%side()
end select
end subroutine
end module
module shapes
use shapes_, only: shape_type
use circles, only: circle
use squares, only: square
implicit none
private
! Types
public :: shape, circle, square
! Initializers
public :: create_circle
public :: create_square
! Methods
public :: draw
type :: shape
class(shape_type), allocatable :: s
end type
interface shape
module procedure shape_from_circle
module procedure shape_from_square
end interface
contains
impure elemental subroutine draw(s)
use drawing, only: draw_visit
type(shape), intent(in) :: s
! Here we use the shape_proxy
call s%s%accept(draw_visit())
end subroutine
subroutine create_circle(s,radius)
type(shape), intent(out) :: s
real, intent(in) :: radius
s%s = circle(radius)
end subroutine
subroutine create_square(s,side)
type(shape), intent(out) :: s
real, intent(in) :: side
s%s = square(side)
end subroutine
function shape_from_circle(x) result(s)
type(shape) :: s
type(circle), intent(in) :: x
s%s = x
end function
function shape_from_square(x) result(s)
type(shape) :: s
type(square), intent(in) :: x
s%s = x
end function
end module
Client-level result:
program main
use shapes
implicit none
type(shape), allocatable :: s(:)
allocate(s(3))
! Subroutine constructors
call create_circle(s(1), radius = 1.0)
call create_square(s(2), side = 5.0)
call create_circle(s(3), radius = 2.0)
call draw(s) ! impure elemental call
write(*,*)
! Or structure constructors
s(1) = shape(circle(radius=3.0))
s(2) = shape(circle(radius=4.0))
s(3) = shape(square(side=1.0))
call draw(s)
end program
Output:
$ ./main
circle: radius = 1.00000000
square: side = 5.00000000
circle: radius = 2.00000000
circle: radius = 3.00000000
circle: radius = 4.00000000
square: side = 1.00000000
Edit: a few reflections upon this exercise:
- The surrogate pattern as a (Fortran-specific) way of circumventing circular dependencies feels kind of complex and error-prone in comparison to forward references. Initially I wasn’t even sure whether it is the shape or visitor that needs the proxy and just made a lucky guess.
- I was impressed by the fact I didn’t need any loop. Instead an impure elemental procedure can be used to apply the draw method to either an array or a scalar instance.
- Deciding upon suitable names was irritating (both for modules and types); in the end I needed two abstract types
shape_proxyandshape_type, the concrete classescircleandsquare, and finally the container typeshape, just to implement a polymorphic container. Two more types were needed for the visitor. Not to mention also the interfaces. - Say I wanted to translate an array of shapes. The current visitor cannot mutate shapes, due to the interface:
I got the feeling that to implement a visitor which can modify the polymorphic entities, I would need a new abstractsubroutine visit_shape(shape) import shape_proxy class(shape_proxy), intent(in) :: shape end subroutinemutating_visitortype, wherein the visit procedure hasintent(inout)attribute for the proxy shape.