akbasic/src/parser_commands.c

/**
 * @file parser_commands.c
 * @brief Verbs that need their own parse path rather than a plain expression.
 *
 * Ported from basicparser_commands.go. Two of these mutate runtime state from
 * inside the parser and that is not an accident: DEF installs the function so a
 * later line can call it, and FOR builds and installs the loop's environment
 * before the body is ever scanned. The waitingForCommand scheme depends on the
 * latter.
 */

#include <inttypes.h>
#include <string.h>

#include <akerror.h>

#include <akbasic/error.h>
#include <akbasic/parser.h>
#include <akbasic/runtime.h>

#include "verbs.h"

akerr_ErrorContext *akbasic_parse_let(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);

    /*
     * LET is optional in this dialect and in Commodore BASIC 7.0. Assignment is
     * handled by expression evaluation, so LET parses as a bare assignment and
     * its exec handler does nothing.
     */
    PASS(errctx, akbasic_parser_assignment(parser, dest));
    SUCCEED_RETURN(errctx);
}

/* LABEL and DIM share a shape: the verb, then one identifier. */
static akerr_ErrorContext *parse_verb_with_identifier(akbasic_Parser *parser, const char *verbname, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *identifier = NULL;
    akbasic_ASTLeaf *command = NULL;

    PASS(errctx, akbasic_parser_primary(parser, &identifier));
    FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(identifier), AKBASIC_ERR_SYNTAX,
		     "Expected identifier");
    PASS(errctx, akbasic_parser_new_leaf(parser, &command));
    PASS(errctx, akbasic_leaf_new_command(command, verbname, identifier));
    *dest = command;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_parse_label(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);

    PASS(errctx, parse_verb_with_identifier(parser, "LABEL", dest));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_parse_dim(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);

    PASS(errctx, parse_verb_with_identifier(parser, "DIM", dest));
    SUCCEED_RETURN(errctx);
}

/*
 * DEF     NAME       (A, ...)        [=          expression]
 * COMMAND IDENTIFIER ARGUMENTLIST    [ASSIGNMENT EXPRESSION]
 *
 * With an `=` the function is a single expression. Without one it is a
 * multi-line subroutine whose body starts on the next line and ends at RETURN,
 * so the environment is told to skip forward to that RETURN rather than execute
 * the body during the definition.
 */
akerr_ErrorContext *akbasic_parse_def(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Runtime *runtime = parser->runtime;
    akbasic_ASTLeaf *identifier = NULL;
    akbasic_ASTLeaf *arglist = NULL;
    akbasic_ASTLeaf *expression = NULL;
    akbasic_ASTLeaf *walk = NULL;
    akbasic_ASTLeaf *command = NULL;
    akbasic_FunctionDef *fndef = NULL;
    size_t i = 0;

    PASS(errctx, akbasic_parser_primary(parser, &identifier));
    FAIL_ZERO_RETURN(errctx, (identifier->leaftype == AKBASIC_LEAF_IDENTIFIER),
		     AKBASIC_ERR_SYNTAX, "Expected identifier");

    PASS(errctx, akbasic_parser_argument_list(parser, AKBASIC_TOK_FUNCTION_ARGUMENT, true, &arglist));
    FAIL_ZERO_RETURN(errctx, (arglist != NULL), AKBASIC_ERR_SYNTAX,
		     "Expected argument list (identifier names)");

    for ( walk = arglist->right; walk != NULL; walk = walk->right ) {
	FAIL_ZERO_RETURN(errctx,
			 (walk->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING ||
			  walk->leaftype == AKBASIC_LEAF_IDENTIFIER_INT ||
			  walk->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT),
			 AKBASIC_ERR_SYNTAX,
			 "Only variable identifiers are valid arguments for DEF");
    }

    PASS(errctx, akbasic_runtime_new_function(runtime, &fndef));

    /* Uppercase the name: verbs and function names are case-insensitive. */
    FAIL_ZERO_RETURN(errctx, (strlen(identifier->identifier) < sizeof(fndef->name)),
		     AKBASIC_ERR_BOUNDS, "Function name '%s' is too long", identifier->identifier);
    for ( i = 0; i < strlen(identifier->identifier); i++ ) {
	char c = identifier->identifier[i];
	fndef->name[i] = (char)((c >= 'a' && c <= 'z') ? (c - 'a' + 'A') : c);
    }
    fndef->name[strlen(identifier->identifier)] = '\0';

    if ( akbasic_parser_match1(parser, AKBASIC_TOK_ASSIGNMENT) ) {
	PASS(errctx, akbasic_parser_expression(parser, &expression));
	PASS(errctx, akbasic_leaf_clone(expression, &fndef->leafpool, &fndef->expression));
    } else {
	/*
	 * No expression: the body is the lines that follow. Record where it
	 * starts and skip to RETURN so the definition itself does not execute
	 * the body.
	 */
	fndef->expression = NULL;
	PASS(errctx, akbasic_environment_wait_for_command(runtime->environment, "RETURN"));
    }
    PASS(errctx, akbasic_leaf_clone(arglist, &fndef->leafpool, &fndef->arglist));
    fndef->lineno = runtime->environment->lineno + 1;

    PASS(errctx, akbasic_symtab_set(&runtime->environment->functions, fndef->name, fndef, 0));

    PASS(errctx, akbasic_parser_new_leaf(parser, &command));
    PASS(errctx, akbasic_leaf_new_command(command, "DEF", NULL));
    *dest = command;
    SUCCEED_RETURN(errctx);
}

/*
 * FOR     ...        TO ....        [STEP    ...]
 * COMMAND ASSIGNMENT    EXPRESSION  [COMMAND EXPRESSION]
 *
 * Sets up the loop's environment with the TO and STEP expressions and the first
 * body line, then makes it the active environment. The FOR leaf itself carries
 * the assignment.
 */
akerr_ErrorContext *akbasic_parse_for(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Runtime *runtime = parser->runtime;
    akbasic_ASTLeaf *assignment = NULL;
    akbasic_ASTLeaf *expr = NULL;
    akbasic_Token *operator_ = NULL;
    akbasic_Environment *parent = runtime->environment;
    akbasic_Environment *newenv = NULL;
    int64_t firstline = 0;

    PASS(errctx, akbasic_parser_assignment(parser, &assignment));
    FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND),
		     AKBASIC_ERR_SYNTAX,
		     "Expected FOR (assignment) TO (expression) [STEP (expression)]");
    PASS(errctx, akbasic_parser_previous(parser, &operator_));
    FAIL_NONZERO_RETURN(errctx, strcmp(operator_->lexeme, "TO"), AKBASIC_ERR_SYNTAX,
			"Expected FOR (assignment) TO (expression) [STEP (expression)]");
    FAIL_ZERO_RETURN(errctx,
		     (assignment != NULL && akbasic_leaf_is_identifier(assignment->left)),
		     AKBASIC_ERR_SYNTAX,
		     "Expected FOR (assignment) TO (expression) [STEP (expression)]");

    firstline = parent->lineno + 1;

    /*
     * The loop body is scanned against the *parent* environment's token stream,
     * so the new environment cannot become active until parsing is done. Parse
     * TO and STEP first, then switch.
     */
    PASS(errctx, akbasic_runtime_new_environment(runtime));
    newenv = runtime->environment;
    runtime->environment = parent;

    PASS(errctx, akbasic_parser_expression(parser, &newenv->forToLeaf));

    if ( akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND) ) {
	PASS(errctx, akbasic_parser_previous(parser, &operator_));
	FAIL_NONZERO_RETURN(errctx, strcmp(operator_->lexeme, "STEP"), AKBASIC_ERR_SYNTAX,
			    "Expected FOR (assignment) TO (expression) [STEP (expression)]");
	PASS(errctx, akbasic_parser_expression(parser, &newenv->forStepLeaf));
    } else {
	/*
	 * Dartmouth BASIC says not to infer a negative step: it is either given
	 * explicitly or assumed to be +1.
	 */
	PASS(errctx, akbasic_parser_new_leaf(parser, &newenv->forStepLeaf));
	PASS(errctx, akbasic_leaf_new_literal_int(newenv->forStepLeaf, "1"));
    }

    /* A NEXT already being awaited means this is an inner loop over the same variable. */
    if ( strcmp(parent->waitingForCommand, "NEXT") == 0 ) {
	newenv->forNextVariable = parent->forNextVariable;
    }
    newenv->loopFirstLine = firstline;

    PASS(errctx, akbasic_parser_new_leaf(parser, &expr));
    PASS(errctx, akbasic_leaf_new_command(expr, "FOR", assignment));

    runtime->environment = newenv;
    *dest = expr;
    SUCCEED_RETURN(errctx);
}

/*
 * READ    VARNAME [, ...]
 * COMMAND ARGUMENTLIST
 *
 * The identifier leaves are deep-copied into the environment, because the DATA
 * line that fills them is parsed later and will have overwritten the per-line
 * leaf pool by then.
 */
akerr_ErrorContext *akbasic_parse_read(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_Environment *env = parser->runtime->environment;
    akbasic_ASTLeaf *arglist = NULL;
    akbasic_ASTLeaf *expr = NULL;
    akbasic_ASTLeaf *command = NULL;
    int i = 0;

    PASS(errctx, akbasic_parser_argument_list(parser, AKBASIC_TOK_FUNCTION_ARGUMENT, false, &arglist));
    FAIL_ZERO_RETURN(errctx, (arglist != NULL && arglist->right != NULL), AKBASIC_ERR_SYNTAX,
		     "Expected identifier");

    env->readLeafPool.next = 0;
    expr = arglist->right;
    for ( i = 0; i < AKBASIC_MAX_LEAVES; i++ ) {
	if ( expr == NULL ) {
	    env->readIdentifierLeaves[i] = NULL;
	    continue;
	}
	FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(expr), AKBASIC_ERR_SYNTAX,
			 "Expected identifier");
	PASS(errctx, akbasic_leaf_clone(expr, &env->readLeafPool, &env->readIdentifierLeaves[i]));
	/*
	 * A cloned identifier keeps its .right chain, which for READ is the
	 * *next* identifier, not a subscript. Sever it so evaluating this leaf
	 * cannot walk into its sibling.
	 */
	env->readIdentifierLeaves[i]->right = NULL;
	expr = expr->right;
    }
    env->readReturnLine = env->lineno + 1;

    PASS(errctx, akbasic_parser_new_leaf(parser, &command));
    PASS(errctx, akbasic_leaf_new_command(command, "READ", arglist));
    *dest = command;
    SUCCEED_RETURN(errctx);
}

/*
 * DATA    LITERAL [, ...]
 * COMMAND ARGUMENTLIST
 */
akerr_ErrorContext *akbasic_parse_data(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arglist = NULL;
    akbasic_ASTLeaf *expr = NULL;
    akbasic_ASTLeaf *command = NULL;

    PASS(errctx, akbasic_parser_argument_list(parser, AKBASIC_TOK_FUNCTION_ARGUMENT, false, &arglist));
    FAIL_ZERO_RETURN(errctx, (arglist != NULL && arglist->right != NULL), AKBASIC_ERR_SYNTAX,
		     "Expected literal");
    for ( expr = arglist->right; expr != NULL; expr = expr->right ) {
	FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_literal(expr), AKBASIC_ERR_SYNTAX,
			 "Expected literal");
    }
    PASS(errctx, akbasic_parser_new_leaf(parser, &command));
    PASS(errctx, akbasic_leaf_new_command(command, "DATA", arglist));
    *dest = command;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_parse_poke(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arglist = NULL;
    akbasic_ASTLeaf *expr = NULL;

    PASS(errctx, akbasic_parser_argument_list(parser, AKBASIC_TOK_FUNCTION_ARGUMENT, false, &arglist));
    FAIL_ZERO_RETURN(errctx, (arglist != NULL), AKBASIC_ERR_SYNTAX,
		     "POKE expected INTEGER, INTEGER");
    PASS(errctx, akbasic_parser_new_leaf(parser, &expr));
    PASS(errctx, akbasic_leaf_new_command(expr, "POKE", arglist));
    *dest = expr;
    SUCCEED_RETURN(errctx);
}

/*
 * IF      relation THEN    command             [ELSE    command]
 * becomes BRANCH(expr=relation, left=then_command, right=else_command).
 */
akerr_ErrorContext *akbasic_parse_if(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *relation = NULL;
    akbasic_ASTLeaf *then_command = NULL;
    akbasic_ASTLeaf *else_command = NULL;
    akbasic_ASTLeaf *branch = NULL;
    akbasic_Token *operator_ = NULL;

    PASS(errctx, akbasic_parser_relation(parser, &relation));
    FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND),
		     AKBASIC_ERR_SYNTAX, "Incomplete IF statement");
    PASS(errctx, akbasic_parser_previous(parser, &operator_));
    FAIL_NONZERO_RETURN(errctx, strcmp(operator_->lexeme, "THEN"), AKBASIC_ERR_SYNTAX,
			"Expected IF ... THEN");

    PASS(errctx, akbasic_parser_command(parser, &then_command));

    if ( akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND) ) {
	PASS(errctx, akbasic_parser_previous(parser, &operator_));
	FAIL_NONZERO_RETURN(errctx, strcmp(operator_->lexeme, "ELSE"), AKBASIC_ERR_SYNTAX,
			    "Expected IF ... THEN ... ELSE ...");
	PASS(errctx, akbasic_parser_command(parser, &else_command));
    }

    PASS(errctx, akbasic_parser_new_leaf(parser, &branch));
    PASS(errctx, akbasic_leaf_new_branch(branch, relation, then_command, else_command));
    *dest = branch;
    SUCCEED_RETURN(errctx);
}

/*
 * INPUT   "PROMPT"   VARIABLE
 * COMMAND EXPRESSION IDENTIFIER
 *
 * The prompt is hung off the identifier's .left, which is where the exec handler
 * looks for it.
 */
akerr_ErrorContext *akbasic_parse_input(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *promptexpr = NULL;
    akbasic_ASTLeaf *identifier = NULL;
    akbasic_ASTLeaf *command = NULL;

    PASS(errctx, akbasic_parser_expression(parser, &promptexpr));
    PASS(errctx, akbasic_parser_primary(parser, &identifier));
    FAIL_ZERO_RETURN(errctx, akbasic_leaf_is_identifier(identifier), AKBASIC_ERR_SYNTAX,
		     "Expected identifier");
    PASS(errctx, akbasic_parser_new_leaf(parser, &command));
    PASS(errctx, akbasic_leaf_new_command(command, "INPUT", identifier));
    identifier->left = promptexpr;
    *dest = command;
    SUCCEED_RETURN(errctx);
}