subroutinedef_directiveprivate
subroutine def_directive(c, param)
#:def name(arguments). Each argument's default is compiled to an entry of args, or 0 if none.
Arguments
| Name | Type | Intent | Attributes | Description |
|---|---|---|---|---|
| c | type(fypp_t) | inout | the state | |
| param | character(len=*) | in | what follows the directive |
Calls
Source
Show the code
subroutine def_directive(c, param)
type(fypp_t), intent(inout) :: c !! the state
character(len=*), intent(in) :: param !! what follows the directive
type(scan_t) :: s
integer :: at, close_parentheses, node, name, id, default
at = index(param, '(')
close_parentheses = index(param, ')', back=.true.)
if (at == 0 .or. close_parentheses < at) then
call fail(c, 'cannot read the macro definition: '//param)
return
end if
call intern(c, trim_right(param(:at - 1)), name)
node = new_node(c, N_DEF)
c%nodes(node)%name = name
c%nodes(node)%source = param
allocate (c%nodes(node)%block%targets(0), c%nodes(node)%block%args(0))
s%text = param(at + 1:close_parentheses - 1)
call next_token(c, s)
do while (s%kind == T_NAME .and. .not. allocated(c%error))
call intern(c, s%word, id)
call next_token(c, s)
default = 0
if (at_word(s, '=')) then
call next_token(c, s)
call parse_test(c, s, default)
end if
call push_id(c%nodes(node)%block%targets, id)
call push_id(c%nodes(node)%block%args, default)
if (.not. at_word(s, ',')) exit
call next_token(c, s)
end do
if (s%kind /= T_END) call fail(c, 'cannot read the arguments of: '//param)
call add_body(c, node, 0)
call open_block(c, node)
end subroutine def_directive