'Copyright Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'userfuncs.bm - Parse rules for SUB and FUNCTION definitions

'Expects: TOK_DECLARE
'Results: NEWLINE
'Returns: 0, always.
function ps_declare
    ps_consume TOK_DECLARE
    if ps_consumed(TOK_SUB) then is_sub = TRUE else ps_consume(TOK_FUNCTION)
    dummy = ps_declare_p(is_sub, 0)
    ps_declare = 0
end function

'Expects: SUB or FUNCTION
'Results: NEWLINE
'Returns: relevant type signature
function ps_declare_p(is_sub, root)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start declare_p"
    $end if
    if ps_final_nested then
        ps_error "SUB and FUNCTION must appear at top level"
    end if
    if tok_token = TOK_UNKNOWN then
        'Entirely new function
        dim sym as symtab_entry_t
        sym-identifier = ucase$(tok_content$)
        sym-stype = SYM_FUNCTION
        tok_advance
        sym-sig = type_add_sig(0, ps_func_sigt$(is_sub, 0))
        sym-func_flags = 0
        symtab_add_entry sym
        ps_declare_p = sym-sig
    elseif tok_token->stype = SYM_FUNCTION then
        'Function already exists
        func = tok_token
        tok_advance
        sigt$ = ps_func_sigt$(is_sub, root)
        cur_sig = func->sig
        'Set sig to the existing instance of the signature, if any
        while cur_sig
            if cur_sig->sig_str = sigt$ then
                sig = cur_sig
                exit while
            end if
            prev_sig = cur_sig
            cur_sig = cur_sig->succ
        wend
        'Append to list if we didn't find it
        if sig = 0 then sig = type_add_sig(prev_sig, sigt$)
        ps_declare_p = sig
    else
        ps_error "Name already in use"
    end if
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed declare_p"
    $end if
end function

'Expects: TOK_FUNCTION or TOK_SUB
'Results: NEWLINE
'Returns -2, which is handled particularly by ps_block, ps_stmt and interactive_mode.
'Assumes the function sym and type signature have already been created by the prepass
'(i.e. ps_declare_p).
'Does not support preload.
function ps_userfunc
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start userfunc"
    $end if
    if ps_consumed(TOK_SUB) then is_sub = TRUE else ps_consume(TOK_FUNCTION)
    func = tok_token
    if func = TOK_UNKNOWN then ps_error "Prepass declaration missing" 'Should never happen

    root = ast_add_node(AST_PROCEDURE)
    ast_add_procedure root
    'Include the ast node number in the scope so we don't mix up multiple implementations
    'of a function with the same name.
    ps_scope_name$ = func->identifier
    ps_scope_id = root
    sig = ps_declare_p(is_sub, root)
    ps_add_nested_structure root
    'Save this value so we can restore it later (and so STATIC can access it)
    ps_main_last_var = ps_scoped_last_var
    ps_scoped_last_var = 0

    'Check if there is already an implementation
    if sig->proc_node then ps_error "Function definition would overwrite existing"

    sig->proc_node = root
    root->ref = func
    root->ref2 = sig

    ps_consume TOK_NEWLINE
    block = ps_block
    for i = 1 to len(ps_queued_entry_nodes$) - 3 step 4
        other = cvl(mid$(ps_queued_entry_nodes$, i, 4))
        block->pre_attach(other)
    next i
    ps_queued_entry_nodes$ = ""
    for i = 1 to len(ps_queued_cleanup_nodes$) - 3 step 4
        other = cvl(mid$(ps_queued_cleanup_nodes$, i, 4))
        block->attach(other)
    next i
    ps_queued_cleanup_nodes$ = ""

    root->pre_attach(block)
    sig->last_var = ps_scoped_last_var
    ps_consume TOK_END
    if is_sub then ps_consume TOK_SUB else ps_consume TOK_FUNCTION

    ps_scoped_last_var = ps_main_last_var
    ps_scope_name$ = ""
    ps_scope_id = 0
    ps_remove_nested_structure

    ps_userfunc = -2
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed userfunc"
    $end if
end function

'Expects: token after name
'Result: TOK_NEWLINE
'Generate a type signature for a function. If root <> 0, also attach AST_VAR nodes
'for formal arguments.
function ps_func_sigt$(is_sub, root)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start func sigt"
    $end if
    if is_sub then return_type = TYPE_NONE else return_type = ps_opt_sigil
    if return_type = 0 then return_type = ps_default_type
    sig$ = type_sigt_create$(return_type)
    if ps_consumed(TOK_OPAREN) then
        if not ps_consumed(TOK_CPAREN) then
            sig$ = type_sigt_merge$(sig$, ps_formal_args$(root))
            ps_consume TOK_CPAREN
        end if
    end if
    ps_func_sigt$ = sig$
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed func sigt"
    $end if
end function

'Expects: token after OPAREN
'Result: CPAREN
'Return list of formal args. If root is <> 0, attach AST_VAR nodes.
function ps_formal_args$(root)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start formal args"
    $end if
    result$ = type_sigt_create$(0)
    do
        flags = 0
        do
            select case tok_token
            case TOK_BYREF
                if flags and TYPE_BYREF then ps_error "Duplicate modifier"
                flags = flags OR TYPE_BYREF
                tok_advance
            case TOK_BYVAL
                if flags and TYPE_BYVAL then ps_error "Duplicate modifier"
                flags = flags OR TYPE_BYVAL
                tok_advance
            case TOK_OPTION
                if flags and TYPE_OPTIONAL then ps_error "Duplicate modifier"
                flags = flags OR TYPE_OPTIONAL
                tok_advance
            case else
                exit do
            end select
        loop
        'Our calling convention can't handle optional byval arguments
        if ((flags AND TYPE_BYVAL) <> 0) and ((flags AND TYPE_OPTIONAL) <> 0) then
            ps_error "Optional arguments cannot be BYVAL"
        end if
        if tok_token <> TOK_UNKNOWN then
            ps_error "Expected new variable name"
        end if
        'We need to do a bit of jumping around to check for arrays, and sigils in
        'multiple places. This somewhat duplicates the logic in parser/array.bm.
        var_name$ = tok_content$
        tok_advance
        sigil = ps_opt_sigil
        if ps_consumed(TOK_OPAREN) then
            is_array = TRUE
            ps_consume TOK_CPAREN
        end if
        sigil2 = ps_opt_sigil
        if sigil2 > 0 and sigil > 0 then ps_error "Cannot give type twice"
        if sigil2 then sigil = sigil2
        if sigil = 0 then sigil = ps_default_type
        'The array is always non-concrete, so if the sigil doesn't have dimension
        'information we let it accept any dimension of array.
        if is_array and not type_is_array(sigil) then sigil = type_make_array(sigil, 0)
        is_array = type_is_array(sigil)
        if is_array and ((flags AND TYPE_BYVAL) <> 0) then
            ps_error "Array must be passed by reference"
        end if
        'No need to do the following logic if we are doing a prepass
        if root then
            var = ast_add_node(AST_VAR)
            'Argument is pass-by-reference, unless explicitly requesting BYVAL
            is_ref = (flags AND TYPE_BYVAL) = 0
            'Stop arguments appearing in the list of variables in the scope
            ps_main_last_var = ps_scoped_last_var
            ps_scoped_last_var = 0
            var->ref = ps_new_var_pp(var_name$, sigil, FALSE, is_ref)
            ps_scoped_last_var = ps_main_last_var
            root->attach(var)
            if is_array then
                node = ast_add_node(AST_ARRAY_CLAIM)
                node->attach(var)
                ps_queue_entry node
                node = ast_add_node(AST_ARRAY_DELETE)
                node->attach(var)
                ps_queue_cleanup node
            end if
        end if
        result$ = type_sigt_add_arg(result$, sigil, flags)
    loop while ps_consumed(TOK_COMMA)
    ps_formal_args$ = result$
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed formal args"
    $end if
end function

'Expects: function name token
'Result: NEWLINE if valid return assignment, unchanged otherwise
'Returns node if this is a function return value assignment, 0 otherwise
function ps_func_return
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start func return"
    $end if
    'Are we in a procedure with a matching name?
    u$ = ucase$(tok_content$)
    if u$ <> ucase$(ps_scope_name$) then
        $if DEBUG_PARSE_TRACE then
        debuginfo "Completed func return (not matching name)"
        $end if
        exit function
    end if
    proc_id = symtab_get_id(u$)
    'Is this actually a function, not a sub?
    return_type = type_sig_return(proc_id->sig)
    if return_type = TYPE_NONE then
        $if DEBUG_PARSE_TRACE then
        debuginfo "Completed func return (is a SUB)"
        $end if
        exit function
    end if
    tok_advance
    'Ensure any type sigils match
    sigil = ps_opt_sigil
    if sigil <> 0 and return_type <> sigil then ps_error "Function return type not consistent"
    'Ok, definitely setting the return value
    ps_consume TOK_EQUALS
    root = ast_add_node(AST_SET_RETURN)
    expr = ps_expr
    expr_type = type_of_expr(expr)
    if not type_can_cast(expr_type, return_type) then ps_error "Function return type does not match that of expression"
    expr = ast_add_cast(expr, return_type)
    root->attach(expr)
    root->ref = return_type
    ps_func_return = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed func return"
    $end if
end function
