Next: A.6 Unit Test m4 Up: A. m4 Preprocessing Code Previous: A.4 Replicate 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