fdoc

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

NameTypeIntentAttributesDescription
ctype(fypp_t)inout

the state

paramcharacter(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

Graphs

Calls

Called by