A.5 Superclass m4 Macros

The main documentation of the Superclass m4 Macros contains additional explanation of this code listing.

dnl
dnl Author: Michael L. Hall
dnl         P.O. Box 1663, MS-D409, LANL
dnl         Los Alamos, NM 87545
dnl         ph: 505-665-4312
dnl         email: hall@lanl.gov
dnl 
dnl Created on: 1/20/99
dnl Date:       03/21/00, 17:19:14
dnl Version:    4.6


dnl The MAKE_INTERFACES macro expands into standard interface 
dnl specifications using the arguments:
dnl
dnl  $1 - Specific Class Suffix
dnl  $2 - Generic Interface Names (separated by spaces)

define([MAKE_INTERFACES],[
  public :: m4_patsubst(m4_shift($@), [ ], [, ])

fortext([BASENAME], m4_shift($@), [
  interface BASENAME
    module procedure BASENAME[]_[]$1
  end interface
]) ])
dnl MAKE_INTERFACES([One], [Initialize Verify_State Finalize])


dnl The SUPERCLASS_USE_ASSOCIATIONS macro outputs the needed "use 
dnl association" statements based on the definition of SUBCLASSES, 
dnl which should be a space-delimited list of the subclasses.

define([SUPERCLASS_USE_ASSOCIATIONS],[
fortext([subclass], SUBCLASSES, [
  use subclass[]_Class
]) ])


dnl The SUPERCLASS_TYPE macro outputs a standard superclass type 
dnl definition. It requires the following definitions:
dnl
dnl   - SUPERCLASS should already be defined to be the name of the 
dnl     superclass.
dnl 
dnl   - SUBCLASSES should already be defined to be a space-delimited 
dnl     list of the subclasses.

define([SUPERCLASS_TYPE],[
  type SUPERCLASS[]_type
    type(character,80) :: Subclass
fortext([subclass], SUBCLASSES, [
    type(subclass[]_type) :: subclass
])    
  end type SUPERCLASS[]_type
])


dnl Define the SUPERCLASS_DECLARATIONS macro, which is used internally 
dnl by the SUPERCLASS_ROUTINE and SUPERCLASS_FUNCTION macros. This macro 
dnl takes each group of three arguments, expands them in a declaration 
dnl form like so:
dnl
dnl   $1 :: $2 ! $3
dnl
dnl and shifts them off the stack. It then continues with the next 
dnl group of three arguments until there are no more arguments.

define([SUPERCLASS_DECLARATIONS],[
    ifelse($#, 0, , 
           $#, 1, [$1],
           $#, 2, [$1 :: $2],
           $#, 3, [$1 :: $2 [!] $3],
       	   [$1 :: $2 [!] $3 SUPERCLASS_DECLARATIONS(m4_shift(m4_shift(m4_shift($@))))] 
    )])


dnl Define the SUPERCLASS_ARGUMENTS macro, which is used internally 
dnl by the SUPERCLASS_ROUTINE and SUPERCLASS_FUNCTION macros. This macro 
dnl takes each group of three arguments (in the same form as the  
dnl SUPERCLASS_DECLARATIONS argument list) and pulls out the second 
dnl argument (the actual variable) only, like so:
dnl
dnl   , $2
dnl
dnl and shifts the original three arguments off the stack. It then 
dnl continues with the next group of three arguments until there are 
dnl no more arguments. At the end of this operation, a variable list 
dnl has been extracted in this form:
dnl
dnl   , var1, var2, var3, var4

define([SUPERCLASS_ARGUMENTS],
   [ifelse($#, 0, , 
           $#, 1, ,
           $#, 2, [, $2],
           $#, 3, [, $2],
           [, $2[]SUPERCLASS_ARGUMENTS(m4_shift(m4_shift(m4_shift($@))))])])


dnl Define the SUPERCLASS_ROUTINE macro, which expands into a complete 
dnl subroutine for the superclass. This subroutine dynamically
dnl dispatches calls to the superclass to the correct subclass routine. 
dnl There are some restrictions that must be true for this macro to
dnl behave correctly:
dnl 
dnl   - SUPERCLASS should already be defined to be the name of the 
dnl     superclass.
dnl 
dnl   - SUBCLASSES should already be defined to be a space-delimited 
dnl     list of the subclasses.
dnl 
dnl   - The argument list for the superclass subroutine call must be the 
dnl     same as the argument list for all of the subclass subroutine calls,
dnl     with the exception that the subclass calls are passed a component
dnl     of the superclass derived type corresponding to that subclass 
dnl     instead of the entire superclass derived type.
dnl 
dnl   - The superclass type must correspond to the type generated by the 
dnl     the SUPERCLASS_TYPE macro.
dnl 
dnl The arguments for the SUPERCLASS_ROUTINE macro are:
dnl 
dnl   $1 - Generic Routine (and Interface) Name.
dnl   $(2 + n*3) - Type declaration for an additional variable to be added 
dnl                to the argument list.
dnl   $(3 + n*3) - Variable name for an additional variable to be added 
dnl                to the argument list.
dnl   $(4 + n*3) - Comment for an additional variable to be added to the 
dnl                argument list.
dnl
dnl where n may be 0, 1, 2, etc., and the only required macro argument is 
dnl the first one.

define([SUPERCLASS_ROUTINE],[
  pushdef([ROUT_NAME], [$1_[]SUPERCLASS])
  pushdef([VARLIST], [m4_shift($@)])
  pushdef([ARGS], [SUPERCLASS_ARGUMENTS(VARLIST)])

  subroutine ROUT_NAME (SUPERCLASS[]ARGS)

    type(SUPERCLASS[]_type) SUPERCLASS
    SUPERCLASS_DECLARATIONS(VARLIST)

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    select case (SUPERCLASS%Subclass)

  fortext([subclass], SUBCLASSES, [
    case ("subclass")

      call $1 (SUPERCLASS%subclass[]ARGS)
  ])
    case default

      write (6,*) 'Error: no ', SUPERCLASS%Subclass, ' in SUPERCLASS[]_Class.'

    end select
  
  end subroutine ROUT_NAME

  popdef([ROUT_NAME])
  popdef([VARLIST])
  popdef([ARGS])
])


dnl Define the SUPERCLASS_FUNCTION macro, which expands into a complete 
dnl function for the superclass. This subroutine dynamically
dnl dispatches calls to the superclass to the correct subclass function. 
dnl There are some restrictions that must be true for this macro to
dnl behave correctly:
dnl 
dnl   - SUPERCLASS should already be defined to be the name of the 
dnl     superclass.
dnl 
dnl   - SUBCLASSES should already be defined to be a space-delimited 
dnl     list of the subclasses.
dnl 
dnl   - The argument list for the superclass function call must be the 
dnl     same as the argument list for all of the subclass function calls,
dnl     with the exception that the subclass calls are passed a component
dnl     of the superclass derived type corresponding to that subclass 
dnl     instead of the entire superclass derived type.
dnl 
dnl   - The superclass type must correspond to the type generated by the 
dnl     the SUPERCLASS_TYPE macro.
dnl 
dnl The arguments for the SUPERCLASS_FUNCTION macro are:
dnl 
dnl   $1 - Generic Function (and Interface) Name.
dnl   $2 - Type declaration for the function.
dnl   $(3 + n*3) - Type declaration for an additional variable to be added 
dnl                to the argument list.
dnl   $(4 + n*3) - Variable name for an additional variable to be added 
dnl                to the argument list.
dnl   $(5 + n*3) - Comment for an additional variable to be added to the 
dnl                argument list.
dnl
dnl where n may be 0, 1, 2, etc., and the only required macro arguments are 
dnl the first two.

define([SUPERCLASS_FUNCTION],[
  pushdef([FNCT_NAME], [$1_[]SUPERCLASS])
  pushdef([VARLIST], [m4_shift(m4_shift($@))])
  pushdef([ARGS], [SUPERCLASS_ARGUMENTS(VARLIST)])

  function FNCT_NAME (SUPERCLASS[]ARGS)

    type(SUPERCLASS[]_type) SUPERCLASS
    $2 :: $1, FNCT_NAME
    SUPERCLASS_DECLARATIONS(VARLIST)

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    select case (SUPERCLASS%Subclass)

  fortext([subclass], SUBCLASSES, [
    case ("subclass")

      FNCT_NAME = $1 (SUPERCLASS%subclass[]ARGS)
  ])
    case default

      write (6,*) 'Error: no ', SUPERCLASS%Subclass, ' in SUPERCLASS[]_Class.'

    end select
  
  end function FNCT_NAME

  popdef([FNCT_NAME])
  popdef([VARLIST])
  popdef([ARGS])
])


dnl Input text used to generate documentation:

dnl define([SUPERCLASS],[Matrix])
dnl define([SUBCLASSES],[One Two Three])
dnl
dnl module SUPERCLASS[]_Class
dnl
dnl   SUPERCLASS_USE_ASSOCIATIONS
dnl   SUPERCLASS_TYPE
dnl
dnl contains
dnl
dnl   SUPERCLASS_ROUTINE([Initialize],
dnl			 [type(real)], [a], [The a variable],
dnl			 [type(integer), intent(in)], [b], [The b variable])
dnl
dnl   SUPERCLASS_FUNCTION([Verify_State], [type(logical)],
dnl			  [type(real)], [b], [The b variable])
dnl
dnl   SUPERCLASS_ROUTINE([Finalize],
dnl			 [type(real)], [c], [The c variable],
dnl			 [type(real)], [d], [The d variable])
dnl
dnl end module SUPERCLASS[]_Class


Michael L. Hall