'Copyright Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'parser.bm - Recursive Descent Parser

sub ps_init
    ps_scoped_last_var = 0
    ps_main_last_var = 0
    ps_actual_linenum = 1
    ps_default_type = TYPE_SINGLE
    ps_allow_implicit_vars = TRUE
end sub

function ps_is_linejoin
    ps_is_linejoin = tok_token = TOK_NEWLINE and tok_content$ = ":"
end function
    
sub ps_consume(expected)
    ps_assert expected
    tok_advance
end sub

function ps_consumed(expected)
    if tok_token = expected then
        if tok_token = TOK_NEWLINE and not ps_is_linejoin then ps_actual_linenum = ps_actual_linenum + 1
        tok_advance
        ps_consumed = TRUE
    end if
end function

sub ps_assert(expected)
    if tok_token <> expected then
        if ucase$(tok_human_readable(tok_token)) = ucase$(tok_content$) then
            ps_error "Syntax error: expected " + tok_human_readable(expected) + " got " + tok_human_readable(tok_token)
        else
            ps_error "Syntax error: expected " + tok_human_readable(expected) + " got " + tok_human_readable(tok_token) + " " + chr$(34) + tok_content$ + chr$(34)
        end if
    else
        $if DEBUG_PARSE_TRACE then
        debuginfo "Assert " + tok_human_readable(expected)
        $end if
    end if
    if tok_token = TOK_NEWLINE and not ps_is_linejoin then ps_actual_linenum = ps_actual_linenum + 1
end sub

'Execute this when at the beginning of a line. As well as consuming whitespace,
'it handles the EOI from interactive mode.
sub ps_line_prelude
    do while tok_token = TOK_NEWLINE
        ps_consume TOK_NEWLINE
    loop
    if tok_token = TOK_EOI then
        ps_consume TOK_EOI
    end if
end sub

function ps_is_terminator(t)
    select case t
    case TOK_ELSE, TOK_NEWLINE
        ps_is_terminator = TRUE
    end select
end function

function ps_last_nested(ast_type)
    for i = len(ps_nested_structures$) - 3 to 1 step -4
        if ast_nodes(cvl(mid$(ps_nested_structures$, i, 4))).typ = ast_type then
            ps_last_nested = cvl(mid$(ps_nested_structures$, i, 4))
            exit function
        end if
    next i
end function

function ps_final_nested
    if len(ps_nested_structures$) = 0 then exit function
    ps_final_nested = cvl(right$(ps_nested_structures$, 4))
end function

sub ps_add_nested_structure(node)
    ps_nested_structures$ = ps_nested_structures$ + mkl$(node)
end sub

sub ps_remove_nested_structure
    ps_nested_structures$ = left$(ps_nested_structures$, len(ps_nested_structures$) - 4)
end sub

function ps_scope$
    'Note: global symbols (functions, SHARED vars) have no / at all
    ps_scope$ = "/" + ps_scope_name$ + "." + ltrim$(str$(ps_scope_id)) + "/"
end function

function ps_get_scope$(token)
    varname$ = token->identifier
    if left$(varname$, 1) <> "/" then
        ps_get_scope$ = ""
    else
        ps_get_scope$ = mid$(varname$, 2, instr(2, varname$, "/") - 2)
    end if
end function

function ps_remove_scope$(n$)
    s = _instrrev(n$, "/")
    if s = 0 then
        ps_remove_scope$ = n$
    else
        ps_remove_scope$ = mid$(n$, s + 1)
    end if
end function

sub ps_queue_cleanup(node)
    ps_queued_cleanup_nodes$ = ps_queued_cleanup_nodes$ + mkl$(node)
end sub

sub ps_queue_entry(node)
    ps_queued_entry_nodes$ = ps_queued_entry_nodes$ + mkl$(node)
end sub

sub ps_error(msg$)
    Error_message$ = msg$
    error 101
end sub

'Expects: first token in block
'Results: block end marker or IEOF
function ps_block
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start block"
    $end if
    root = ast_add_node(AST_BLOCK)
    do
        do while tok_token = TOK_NEWLINE
            ps_consume TOK_NEWLINE
        loop
        stmt = ps_stmt
        ' -2 -> SUB or FUNCTION definition, continue processing input
        if stmt = -1 then exit do 'use -1 to signal the end of a block
        if stmt > 0 then root->attach(stmt) '0 means that statement did not generate any ast nodes
    loop
    ps_block = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "End block"
    $end if
end function

'Top-level parser entry point.
function ps_main
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start main"
    $end if
    dim sym as symtab_entry_t
    sym-identifier = "_MAIN"
    sym-stype = SYM_FUNCTION
    sig = type_add_sig(0, type_sigt_create$(TYPE_NONE))
    sym-sig = sig
    symtab_add_entry sym
    proc_id = symtab_last_entry
    root = ast_add_node(AST_PROCEDURE)
    ast_add_procedure root
    'Do not add to nested structures list because main is the only procedure that
    'can "contain" other procedure, and you can't exit out of it.
    sig->proc_node = root
    root->ref = proc_id
    root->ref2 = sig
    block = ps_block
    root->attach(block)
    sig->last_var = ps_scoped_last_var
    ps_finish_labels block
    if ps_is_module = FALSE then
        proc_id->func_flags = SYM_FUNCTION_PUBLIC
    end if
    ps_main = block
    $if DEBUG_PARSE_TRACE then
    debuginfo "End main"
    $end if
end function

'Because some program elements can be referenced before they are defined, we need to
'do a first pass through the program to identify these declarations. We contrast this
'"prepass" with a main pass, usually an invocation of ps_block or similar.
'The prepass will detect and instantiate the following objects:
' - SUB/FUNCTION definitions
' - DIM SHARED variables
' - TYPE definitions
'everything else is ignored. Importantly, the ast will be reset after this so no nodes
'or constants can be created.
sub ps_prepass
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start prepass"
    $end if

    do
        select case tok_token
        case META_INCLUDE
            ps_meta_include
        case TOK_SUB, TOK_FUNCTION
            if ps_consumed(TOK_SUB) then
                is_sub = TRUE
            else
                ps_consume(TOK_FUNCTION)
                is_sub = FALSE
            end if
            dummy = ps_declare_p(is_sub, 0)
        case TOK_EXIT, TOK_END
            'These could be followed by SUB or FUNCTION which would cause confusion
            tok_advance
            tok_advance
        case TOK_DIM
            tok_advance
            if tok_token = TOK__PRESERVE then tok_advance
            if tok_token <> TOK_SHARED then exit select
            'TODO handle shared variable
        case TOK_TYPE
            dummy = ps_udt
        case TOK__DEFINE
            ps_define_type
        case TOK_DEFINT, TOK_DEFLNG, TOK_DEFSNG, TOK_DEFDBL, TOK_DEFSTR
            ps_deftype
        case TOK_NEWLINE
            ps_line_prelude
        case else
            tok_advance
        end select
    loop until ps_consumed(TOK_IEOF)
     
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed prepass"
    $end if
end sub

$include: 'array.bm'
$include: 'assignment.bm'
$include: 'const.bm'
$include: 'common.bm'
$include: 'default_type.bm'
$include: 'drawing.bm'
$include: 'exit.bm'
$include: 'for.bm'
$include: 'function.bm'
$include: 'goto.bm'
$include: 'if.bm'
$include: 'input.bm'
$include: 'labels.bm'
$include: 'loop.bm'
$include: 'metacommands.bm'
$include: 'option.bm'
$include: 'pratt.bm'
$include: 'preload.bm'
$include: 'print.bm'
$include: 'putimage.bm'
$include: 'select.bm'
$include: 'statement.bm'
$include: 'tokeng.bm'
$include: 'udt.bm'
$include: 'userfuncs.bm'
$include: 'var.bm'
