Implementing abstract interface with multiple polymorphic arguments

Help
1

Hello,

I have been trying to make a small program to develop my understanding of the SOLID principles, as well as get a better understanding of OOP in modern Fortran.

To do this I have made an abstract class that represents a number, and will then implement various categories of number. So far I am struggling with correctly specifying the correct abstract interface for addition.

This is the best I have come up:

module number_mod
    implicit none

    type, abstract :: NumberClass
        private
    contains
        procedure(addNumberInterface), deferred :: add
    end type

    abstract interface
        function addNumberInterface(self, other) result(answer)
            import NumberClass, RealClass
            class(NumberClass), intent(in) :: self
            class(*), intent(in) :: other
            class(RealClass), allocatable :: answer
        end function addNumberInterface
    end interface


    type, extends(NumberClass) :: RealClass
        real :: real_part
    contains
        procedure :: add => addReal
        generic, public :: operator(+) => add
    end type

contains
    function addReal(self, other) result(answer)
        class(RealClass), intent(in) :: self
        class(*), intent(in) :: other
        class(RealClass), allocatable :: answer

        select type(other)
        type is(RealClass)
            allocate(RealClass :: answer)
            select type(answer)
            type is(RealClass)
                answer = RealClass(self%real_part + other%real_part)
            end select
        type is (real)
            allocate(RealClass :: answer)
            select type(answer)
            type is(RealClass)
                answer = RealClass(self%real_part + other)
            end select
        class default
            print *, "UHOH"
        end select
    end function addReal

It allows for other to have multiple types, but it also allows addReal to be called with other being any type. For example:

class(RealClass) :: a, b, c

a = RealClass(3)
b = RealClass(4)
c = a + b ! I want this case to be valid and the compiler is happy with it
c = a + 3 ! I do not want this case to be valid but the compiler is happy with it due to class(*)
c = a + "hello" ! I do not want this case to be valid either

In addition addNumberInterface is still not correct as if I were to create type, extends(NumberClass) :: ComplexClass then addNumberInterface would mean the procedure that overloads add would return type RealClass whereas I would like it to return ComplexClass.

Can any one help?

1 Like
2

Here’s a solution to your problem (note: you need to provide defined assignments, in addition to implementations of the addition operator, for each implementing class):

module number_class

   type, abstract :: NumberClass
   contains
      procedure(asn), deferred :: asn
      procedure(add), deferred :: add
      generic, public :: assignment(=) => asn
      generic, public :: operator(+)   => add
   end type NumberClass
   
   abstract interface
      subroutine asn(self,other)
         import :: NumberClass
         class(NumberClass), intent(out) :: self
         class(NumberClass), intent(in)  :: other
      end subroutine asn
      function add(self,other) result (res)
         import :: NumberClass
         class(NumberClass), intent(in)  :: self, other
         class(NumberClass), allocatable :: res
      end function add
   end interface

end module number_class

module real_class

   use number_class, only: NumberClass
   
   type, extends(NumberClass) :: RealClass
      real :: some_real
   contains
      procedure :: asn
      procedure :: add
   end type RealClass

contains

   subroutine asn(self,other)
      class(RealClass),   intent(out) :: self
      class(NumberClass), intent(in)  :: other
      select type (other)
      type is (RealClass)
         self%some_real = other%some_real
      end select
   end subroutine asn
   
   function add(self,other) result(res)
      class(RealClass),   intent(in)  :: self
      class(NumberClass), intent(in)  :: other
      class(NumberClass), allocatable :: res
      select type (other)
      type is (RealClass)
         allocate(RealClass :: res)
         select type (res)
         type is (RealClass)
            res%some_real = self%some_real + other%some_real
         end select
      end select
   end function add

end module real_class

module complex_class

   use number_class, only: NumberClass
   
   type, extends(NumberClass) :: ComplexClass
      complex :: some_comp
   contains
      procedure :: asn
      procedure :: add
   end type ComplexClass

contains

   subroutine asn(self,other)
      class(ComplexClass), intent(out) :: self
      class(NumberClass),  intent(in)  :: other
      select type (other)
      type is (ComplexClass)
         self%some_comp = other%some_comp
      end select
   end subroutine asn
   
   function add(self,other) result(res)
      class(ComplexClass), intent(in)  :: self
      class(NumberClass),  intent(in)  :: other
      class(NumberClass),  allocatable :: res
      select type (other)
      type is (ComplexClass)
         allocate(ComplexClass :: res)
         select type (res)
         type is (ComplexClass)
            res%some_comp = self%some_comp + other%some_comp
         end select
      end select
   end function add

end module complex_class

program test_numbers
   
   use real_class,    only: RealClass
   use complex_class, only: ComplexClass

   type(RealClass)    :: a, b, c
   type(ComplexClass) :: d, e, f

   a = RealClass(3.)
   b = RealClass(4.)
   c = a + b
   print '(f0.0)', c%some_real

   d = ComplexClass( (3.,1.) )
   e = ComplexClass( (4.,1.) )
   f = d + e
   print '(f0.0,sp,f0.0,"i")', f%some_comp
   
end program test_numbers

You can easily check that the cases which you don’t want to be valid are now rejected by the compiler.

3

Hi and welcome.

The class(*) declaration-type-spec in the dummy argument is called unlimited polymorphic (emphasis on unlimited). Think of any if you’re familiar with other programming languages.

So you’re basically telling the compiler that for the operator, the right-hand side can be anything, and it will be handled at runtime (through select type).

You can restrict the behavior by doing

type, extends(NumberClass) :: RealClass
        real :: real_part
    contains
        generic, public :: operator(+) => realclass_plus_real, realclass_plus_int, &
            real_plus_realclass, int_plus_realclass
        procedure :: realclass_plus_real, realclass_plus_int
        procedure, pass(rhs) :: real_plus_realclass, int_plus_realclass
    end type
...
contains
    function realclass_plus_real(lhs, rhs) result(res)
        class(RealClass), intent(in) :: lhs
        real, intent(in) :: rhs
        ...
    end function
    ...
    function real_plus_realclass(lhs, rhs) result(res)
        real, intent(in) :: lhs
        class(RealClass), intent(in) :: rhs
        ...
    end function
...

That pattern is precisely what the upcoming auto-generic procedures is expected to simplify (but it’ll be years until Fortran 202y is published, and then implemented by compilers). But in the meantime, you can reduce some of the code duplication through the include statement.

4

@Chipmonkcheeks I’ve overlooked that in your original code you apparently wished to be able to add your classes also with intrinsic reals.

Since I can no longer edit my above post, here’s an extended code version that allows also for addition from the left of an intrinsic real:

module number_class

   type, abstract :: NumberClass
   contains
      procedure(asn), deferred :: asn
      procedure(add), deferred :: add
      procedure(add_left_real), deferred, pass(self) :: add_left_real
      generic, public :: assignment(=) => asn
      generic, public :: operator(+)   => add, add_left_real
   end type NumberClass
   
   abstract interface
      subroutine asn(self,other)
         import :: NumberClass
         class(NumberClass), intent(out) :: self
         class(NumberClass), intent(in)  :: other
      end subroutine asn
      function add(self,other) result (res)
         import :: NumberClass
         class(NumberClass), intent(in)  :: self, other
         class(NumberClass), allocatable :: res
      end function add
      function add_left_real(other,self) result(res)
         import :: NumberClass
         real,               intent(in)  :: other
         class(NumberClass), intent(in)  :: self
         class(NumberClass), allocatable :: res
      end function add_left_real
   end interface

end module number_class

module real_class

   use number_class, only: NumberClass
   
   type, extends(NumberClass) :: RealClass
      real :: some_real
   contains
      procedure :: asn
      procedure :: add
      procedure, pass(self) :: add_left_real
   end type RealClass

contains

   subroutine asn(self,other)
      class(RealClass),   intent(out) :: self
      class(NumberClass), intent(in)  :: other
      select type (other)
      type is (RealClass)
         self%some_real = other%some_real
      end select
   end subroutine asn
   
   function add(self,other) result(res)
      class(RealClass),   intent(in)  :: self
      class(NumberClass), intent(in)  :: other
      class(NumberClass), allocatable :: res
      select type (other)
      type is (RealClass)
         allocate(RealClass :: res)
         select type (res)
         type is (RealClass)
            res%some_real = self%some_real + other%some_real
         end select
      end select
   end function add

   function add_left_real(other,self) result(res)
      real,               intent(in)  :: other
      class(RealClass),   intent(in)  :: self
      class(NumberClass), allocatable :: res
      allocate(RealClass :: res)
      select type (res)
      type is (RealClass)
         res%some_real = other + self%some_real
      end select
   end function add_left_real

end module real_class

module complex_class

   use number_class, only: NumberClass
   
   type, extends(NumberClass) :: ComplexClass
      complex :: some_comp
   contains
      procedure :: asn
      procedure :: add
      procedure, pass(self) :: add_left_real
   end type ComplexClass

contains

   subroutine asn(self,other)
      class(ComplexClass), intent(out) :: self
      class(NumberClass),  intent(in)  :: other
      select type (other)
      type is (ComplexClass)
         self%some_comp = other%some_comp
      end select
   end subroutine asn
   
   function add(self,other) result(res)
      class(ComplexClass), intent(in)  :: self
      class(NumberClass),  intent(in)  :: other
      class(NumberClass),  allocatable :: res
      select type (other)
      type is (ComplexClass)
         allocate(ComplexClass :: res)
         select type (res)
         type is (ComplexClass)
            res%some_comp = self%some_comp + other%some_comp
         end select
      end select
   end function add

   function add_left_real(other,self) result(res)
      real,                intent(in)  :: other
      class(ComplexClass), intent(in)  :: self
      class(NumberClass),  allocatable :: res
      allocate(ComplexClass :: res)
      select type (res)
      type is (ComplexClass)
         res%some_comp = other + self%some_comp
      end select
   end function add_left_real

end module complex_class

program test_numbers

   use real_class,    only: RealClass
   use complex_class, only: ComplexClass

   type(RealClass)    :: a, b, c
   type(ComplexClass) :: d, e, f
   
   a = RealClass(3.)
   b = RealClass(4.)
   c = a + b
   print '(f0.0)', c%some_real
   c = 5. + a
   print '(f0.0)', c%some_real

   print *
   
   d = ComplexClass( (3.,1.) )
   e = ComplexClass( (4.,1.) )
   f = d + e
   print '(f0.0,sp,f0.0,"i")', f%some_comp
   f = 5. + d
   print '(f0.0,sp,f0.0,"i")', f%some_comp

end program test_numbers

You should be easily able to add the case of addition from the right, and to make the above code conform to the principle of information hiding (by adding private statements, user-defined constructors, and actual methods for the printouts to the classes) which I’ve not bothered to do here.

Also, if your actual goal is to learn about the SOLID principles, then playing with type bound operators and assignments (that in the present language require you to use downcasting [i.e. select type statements], and hence to adopt bad habits) is not too educational a thing to do.

I’d recommend to try to implement some of the well known design patterns in Fortran, instead (see e.g. the book “Head First Design Patterns”).

3 Likes
5

Thanks for the update @kkifonidis. I will also check out a copy of the book you suggested!