Automating comparison operators for derived types

#1

I have a module for working with dates and times that defines derived types such as

type :: time_of_day
   integer :: hour,minute,second
end type time_of_day
type :: date_mdy 
   integer :: month,day,year
end type date_mdy
type :: month_year
   integer :: month,year
end type month_year
type :: date_time
   type(date_mdy) :: date
   type(time_of_day) :: time
end type date_time

Each data type can be converted to an integer, for example 12*year + month for type(month_year), and comparison operators such ==,>,>= can be overloaded for these types. I have done this but am effectively writing the same code for each data type. Ideally I would like to define the integer equivalent of a derived type and have the compiler do the rest of the work. Are there tools to reduce the amount of boilerplate code needed in this situation?

1 Like
#2

Hope you find some useful tool for this. Or, those pursuing more tooling for Fortran will create something along such lines!

In the meantime, users willing to put in the work themselves in the absence of tooling can consider mimicking what’s available in other stronger OO-based approaches as part of the languages such as a built-in “superclass” with some hashcode facility and have their derived types extend from it. Users may find this alleviate their “boilerplate” code somehat.

module base_m
   type, abstract :: base_t
      private
      integer :: m_hash = 0
   contains
      private
      procedure, pass(lhs) :: IsEqual_t
      procedure, pass(lhs) :: IsNotEqual_t
      procedure, pass(this), public :: SetHash
      generic, public :: operator(==) => IsEqual_t
      generic, public :: operator(/=) => IsNotEqual_t
   end type
contains
   subroutine SetHash( this, hash )
      ! Argument list
      class(base_t), intent(inout) :: this
      integer, intent(in)          :: hash
      this%m_hash = hash
      return
   end subroutine
   function IsEqual_t( lhs, rhs ) result( IsEqual )
      ! Argument list
      class(base_t), intent(in) :: lhs
      class(base_t), intent(in) :: rhs
      ! Function result
      logical :: IsEqual
      IsEqual = lhs%m_hash == rhs%m_hash
      return
   end function
   function IsNotEqual_t( lhs, rhs ) result( IsNotEqual )
      ! Argument list
      class(base_t), intent(in) :: lhs
      class(base_t), intent(in) :: rhs
      ! Function result
      logical :: IsNotEqual
      IsNotEqual = lhs%m_hash /= rhs%m_hash
      return
   end function
end module

module date_m
   use base_m, only : base_t
   type, extends(base_t) :: date_t
      integer :: year = 0
      integer :: month = 0
   contains
      private
      procedure, pass(this) :: SetDateToday
      procedure, pass(this) :: SetDateArbitrary
      generic, public :: SetDate => SetDateToday, SetDateArbitrary
   end type
contains
   subroutine SetDateToday( this )
      ! Argument list
      class(date_t), intent(inout) :: this
      ! Local variables
      integer :: vals(8)
      call date_and_time( values=vals )
      this%year = vals(1)
      this%month = vals(2)
      call this%SetHash( hash=(vals(2)*12 + vals(1)) )
   end subroutine
   subroutine SetDateArbitrary( this, year, month )
      ! Argument list
      class(date_t), intent(inout) :: this
      integer, intent(in)          :: year
      integer, intent(in)          :: month
      ! Checks elided
      this%year = year
      this%month = month
      call this%SetHash( hash=(year*12 + month) )
   end subroutine
end module

   use date_m, only : date_t

   type(date_t) :: Today
   type(date_t) :: Bday

   call Today%SetDate()
   call Bday%SetDate( 1990, 1 )

   if ( Today /= Bday ) then
      print *, "Today is not it :-("
   else
      print *, "Happy returns for the day!"
   end if

end

C:\Temp>gfortran -std=f2018 -Wall p.f90 -o p.exe

C:\Temp>p.exe
Today is not it :frowning:

C:\Temp>

#3

For the comparison operators specifically, I have found some use in defining a generic function cmp(x,y) , e.g.,

pure elemental function cmp_mytype(x, y) result(i)
  type(mytype), intent(in) :: x, y
  integer :: i

  if (x > y) then
    i = -1
  else if (y > x) then
    i = 1
  else
    i = 0
  end if
end function

This requires that operator(>) be defined, but then the other comparison operators become simple. For instance, operator(<=) could be implemented as

pure elemental function le_mytype(x, y) result(le)
  type(mytype), intent(in) :: x, y
  logical :: le
  
  select case (cmp(x, y))
  case (0,1)
    le = .true.
  case default
    le = .false.
  end select
end function

It is straightforward to write a script or editor macro or a template text file to generate function skeletons like the above for <, <=, ==, and >=. This has the upshot of needing to get the actual comparison logic correct only once in the implementation of operator(>). You still have to go the extra step of writing the interface block, but whatever.

1 Like
#4

I found a project where I actually did this. Here’s a stripped-down version of what it looks like, with some comments marking which sections are copy-pasted from a template file. Some notes:

  • if you put the comparison logic in cmp, all six operators (>, <, >=, <=, ==, /=) are copy-pasteable (I forgot about /= previously)
  • It’s not necessary to make cmp generic, but I do so because it’s useful in its own right for other things (e.g., sorting).
module myint_type
  implicit none

  public :: myint, cmp, operator(<), operator(>), operator(<=), operator(>=), operator(==), operator(/=)

  type :: myint
    integer :: n
  end type myint

  interface cmp
    module procedure myint_cmp
  end interface cmp

  interface operator(<)
    module procedure myint_lt
  end interface operator(<)

  interface operator(>)
    module procedure myint_gt
  end interface operator(>)

  interface operator(<=)
    module procedure myint_le
  end interface operator(<=)

  interface operator(>=)
    module procedure myint_ge
  end interface operator(>=)

  interface operator(==)
    module procedure myint_eq
  end interface operator(==)

  interface operator(/=)
    module procedure myint_ne
  end interface operator(/=)

contains

  function myint_cmp(x, y) result(i)
    type(myint), intent(in) :: x, y
    integer :: i

    if (x%n > y%n) then
      i = -1
    else if (x%n == y%n) then
      i = 0
    else
      i = 1
    end if
  end function myint_cmp

! ---------- start of template

  function myint_lt(x, y) result(lt)
    type(myint), intent(in) :: x, y
    logical :: lt

    lt = cmp(x, y) == 1
  end function myint_lt

  function myint_gt(x, y) result(gt)
    type(myint), intent(in) :: x, y
    logical :: gt

    gt = cmp(x, y) == -1
  end function myint_gt

  function myint_le(x, y) result(le)
    type(myint), intent(in) :: x, y
    logical :: le

    le = cmp(x, y) /= -1
  end function myint_le

  function myint_ge(x, y) result(ge)
    type(myint), intent(in) :: x, y
    logical :: ge

    ge = cmp(x, y) /= 1
  end function myint_ge

  function myint_eq(x, y) result(eq)
    type(myint), intent(in) :: x, y
    logical :: eq

    eq = cmp(x, y) == 0
  end function myint_eq

  function myint_ne(x, y) result(ne)
    type(myint), intent(in) :: x, y
    logical :: ne

    ne = cmp(x, y) /= 0
  end function myint_ne

! ---------- end of template

end module myint_type