akbasic/src/parser.c

/**
 * @file parser.c
 * @brief Implements the recursive-descent parser.
 *
 * A faithful port of basicparser.go, with two changes. The reflection lookup for
 * a verb's special parse path becomes a table lookup, and the debug.PrintStack()
 * the reference calls on a parse failure is gone: an interpreter library does not
 * dump the host's stack to stderr, and the akerr stack trace already carries what
 * that call was for.
 */

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

#include <akerror.h>

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

akerr_ErrorContext *akbasic_parser_init(akbasic_Parser *obj, akbasic_Runtime *runtime)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL parser in init");
    FAIL_ZERO_RETURN(errctx, (runtime != NULL), AKERR_NULLPOINTER, "nil runtime argument");
    obj->runtime = runtime;
    obj->comparing = false;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_parser_zero(akbasic_Parser *obj)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "nil self reference!");
    PASS(errctx, akbasic_environment_zero_parser(obj->runtime->environment));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_parser_new_leaf(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);

    PASS(errctx, akbasic_environment_new_leaf(obj->runtime->environment, dest));
    SUCCEED_RETURN(errctx);
}

bool akbasic_parser_is_at_end(akbasic_Parser *obj)
{
    akbasic_Environment *env = NULL;

    if ( obj == NULL || obj->runtime == NULL || obj->runtime->environment == NULL ) {
	return true;
    }
    env = obj->runtime->environment;
    return (env->curtoken >= (AKBASIC_MAX_TOKENS - 1) || env->curtoken >= env->nexttoken);
}

akbasic_Token *akbasic_parser_peek(akbasic_Parser *obj)
{
    if ( akbasic_parser_is_at_end(obj) ) {
	return NULL;
    }
    return &obj->runtime->environment->tokens[obj->runtime->environment->curtoken];
}

akerr_ErrorContext *akbasic_parser_previous(akbasic_Parser *obj, akbasic_Token **dest)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in previous");
    FAIL_ZERO_RETURN(errctx, (obj->runtime->environment->curtoken != 0), AKBASIC_ERR_SYNTAX,
		     "Current token is index 0, no previous token");
    *dest = &obj->runtime->environment->tokens[obj->runtime->environment->curtoken - 1];
    SUCCEED_RETURN(errctx);
}

static bool check(akbasic_Parser *obj, akbasic_TokenType tokentype)
{
    akbasic_Token *next = NULL;

    if ( akbasic_parser_is_at_end(obj) ) {
	return false;
    }
    next = akbasic_parser_peek(obj);
    return (next != NULL && next->tokentype == tokentype);
}

static void advance(akbasic_Parser *obj)
{
    if ( !akbasic_parser_is_at_end(obj) ) {
	obj->runtime->environment->curtoken += 1;
    }
}

bool akbasic_parser_match(akbasic_Parser *obj, const akbasic_TokenType *types, int count)
{
    int i = 0;

    for ( i = 0; i < count; i++ ) {
	if ( check(obj, types[i]) ) {
	    advance(obj);
	    return true;
	}
    }
    return false;
}

bool akbasic_parser_match1(akbasic_Parser *obj, akbasic_TokenType type)
{
    return akbasic_parser_match(obj, &type, 1);
}

akerr_ErrorContext *akbasic_parser_error(akbasic_Parser *obj, const char *message)
{
    PREPARE_ERROR(errctx);
    akbasic_Token *token = NULL;

    token = akbasic_parser_peek(obj);
    obj->runtime->environment->errorToken = token;
    FAIL_ZERO_RETURN(errctx, (token != NULL), AKBASIC_ERR_SYNTAX, "peek() returned nil token!");
    if ( token->tokentype == AKBASIC_TOK_EOF ) {
	FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX, "%" PRId64 " at end %s", token->lineno, message);
    }
    FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX, "%" PRId64 " at '%s', %s",
		token->lineno, token->lexeme, message);
}

static akerr_ErrorContext *consume(akbasic_Parser *obj, akbasic_TokenType tokentype, const char *message)
{
    PREPARE_ERROR(errctx);

    if ( check(obj, tokentype) ) {
	advance(obj);
	SUCCEED_RETURN(errctx);
    }
    PASS(errctx, akbasic_parser_error(obj, message));
    SUCCEED_RETURN(errctx);
}

/* Forward declarations for the grammar chain. */
static akerr_ErrorContext *logicalandor(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
static akerr_ErrorContext *logicalnot(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
static akerr_ErrorContext *subtraction(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
static akerr_ErrorContext *addition(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
static akerr_ErrorContext *multiplication(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
static akerr_ErrorContext *division(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
static akerr_ErrorContext *unary(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
static akerr_ErrorContext *exponent(akbasic_Parser *obj, akbasic_ASTLeaf **dest);
static akerr_ErrorContext *function_call(akbasic_Parser *obj, akbasic_ASTLeaf **dest);

bool akbasic_parser_skip_separators(akbasic_Parser *obj)
{
    while ( akbasic_parser_match1(obj, AKBASIC_TOK_COLON) ) {
	/*
	 * A run of them, so `10 PRINT 1 :: PRINT 2` and a trailing colon both
	 * work. An empty statement is not an error on a C128 and is not one
	 * here.
	 */
    }
    return !akbasic_parser_is_at_end(obj);
}

akerr_ErrorContext *akbasic_parser_parse(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in parse");
    *dest = NULL;
    /*
     * Statements are separated by colons. The scanner has emitted the token
     * since the port began and nothing consumed it, so a line with two
     * statements on it was a parse error -- TODO.md section 4.
     *
     * Nothing after the separators is a line that ended in one. That is not an
     * error, so the caller gets a NULL leaf and skips it.
     */
    if ( !akbasic_parser_skip_separators(obj) ) {
	SUCCEED_RETURN(errctx);
    }
    PASS(errctx, akbasic_parser_command(obj, dest));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_parser_command(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    static const akbasic_TokenType COMMANDS[] = {
	AKBASIC_TOK_COMMAND, AKBASIC_TOK_COMMAND_IMMEDIATE
    };
    akbasic_ASTLeaf *expr = NULL;
    akbasic_ASTLeaf *right = NULL;
    akbasic_Token *operator_ = NULL;
    akbasic_Token *righttoken = NULL;
    const akbasic_Verb *verb = NULL;
    akbasic_TokenType optype = AKBASIC_TOK_UNDEFINED;
    char opname[AKBASIC_MAX_LINE_LENGTH];

    if ( !akbasic_parser_match(obj, COMMANDS, 2) ) {
	PASS(errctx, akbasic_parser_assignment(obj, dest));
	SUCCEED_RETURN(errctx);
    }

    PASS(errctx, akbasic_parser_previous(obj, &operator_));
    optype = operator_->tokentype;
    strncpy(opname, operator_->lexeme, sizeof(opname) - 1);
    opname[sizeof(opname) - 1] = '\0';

    /* Does this verb need its own parse path? */
    PASS(errctx, akbasic_verb_lookup(opname, &verb));
    if ( verb != NULL && verb->parse != NULL ) {
	PASS(errctx, verb->parse(obj, dest));
	SUCCEED_RETURN(errctx);
    }

    /*
     * Some verbs take no rval. Do not fail when there is not one -- but do fail
     * when there is one and it will not parse.
     */
    righttoken = akbasic_parser_peek(obj);
    if ( righttoken != NULL && righttoken->tokentype != AKBASIC_TOK_UNDEFINED &&
	 righttoken->tokentype != AKBASIC_TOK_COLON ) {
	/*
	 * A colon ends the statement, so `PRINT : PRINT "X"` is a bare PRINT
	 * followed by another statement rather than a PRINT of whatever a colon
	 * evaluates to.
	 */
	PASS(errctx, akbasic_parser_expression(obj, &right));
    }

    PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
    if ( optype == AKBASIC_TOK_COMMAND_IMMEDIATE ) {
	PASS(errctx, akbasic_leaf_new_immediate_command(expr, opname, right));
    } else {
	PASS(errctx, akbasic_leaf_new_command(expr, opname, right));
    }
    *dest = expr;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_parser_assignment(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *identifier = NULL;
    akbasic_ASTLeaf *expr = NULL;
    akbasic_ASTLeaf *right = NULL;

    PASS(errctx, akbasic_parser_expression(obj, &identifier));
    /*
	 * A field access is assignable too, and it is not an identifier: the
	 * name on the left of the = is reached by walking a chain rather than by
	 * looking one name up. Both spellings continue into the = below.
	 */
    if ( identifier == NULL ||
	 (identifier->leaftype != AKBASIC_LEAF_IDENTIFIER_INT &&
	  identifier->leaftype != AKBASIC_LEAF_IDENTIFIER_FLOAT &&
	  identifier->leaftype != AKBASIC_LEAF_IDENTIFIER_STRING &&
	  identifier->leaftype != AKBASIC_LEAF_IDENTIFIER_STRUCT &&
	  identifier->leaftype != AKBASIC_LEAF_FIELD) ) {
	*dest = identifier;
	SUCCEED_RETURN(errctx);
    }
    if ( akbasic_parser_match1(obj, AKBASIC_TOK_ASSIGNMENT) ) {
	PASS(errctx, akbasic_parser_expression(obj, &right));
	PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
	PASS(errctx, akbasic_leaf_new_binary(expr, identifier, AKBASIC_TOK_ASSIGNMENT, right));
	*dest = expr;
	SUCCEED_RETURN(errctx);
    }
    *dest = identifier;
    SUCCEED_RETURN(errctx);
}

/*
 * An argument list is just .right-joined expressions continuing ad infinitum.
 * When requireparens is false and there is no opening paren, this still builds a
 * list -- that is how DATA and READ take a bare comma-separated series.
 */
akerr_ErrorContext *akbasic_parser_argument_list(akbasic_Parser *obj, akbasic_TokenType arglisttype, bool requireparens, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arglist = NULL;
    akbasic_ASTLeaf *expr = NULL;

    *dest = NULL;
    if ( !akbasic_parser_match1(obj, AKBASIC_TOK_LEFT_PAREN) && requireparens ) {
	SUCCEED_RETURN(errctx);
    }
    FAIL_ZERO_RETURN(errctx,
		     (arglisttype == AKBASIC_TOK_ARRAY_SUBSCRIPT ||
		      arglisttype == AKBASIC_TOK_FUNCTION_ARGUMENT),
		     AKBASIC_ERR_SYNTAX,
		     "argumentList expects argListType [ARRAY_SUBSCRIPT || FUNCTION_ARGUMENT]");

    PASS(errctx, akbasic_parser_new_leaf(obj, &arglist));
    arglist->leaftype = AKBASIC_LEAF_ARGUMENTLIST;
    arglist->operator_ = arglisttype;
    PASS(errctx, akbasic_parser_expression(obj, &arglist->right));

    /*
     * Siblings chain through .next, never through .right. Every leaf type that
     * can be an argument already uses .right for something of its own -- a
     * unary's operand, a binary's right-hand side -- and reusing it here is what
     * made ABS(-9) count as two arguments. See akbasic_ASTLeaf.next.
     */
    expr = arglist->right;
    while ( expr != NULL && akbasic_parser_match1(obj, AKBASIC_TOK_COMMA) ) {
	PASS(errctx, akbasic_parser_expression(obj, &expr->next));
	expr = expr->next;
    }
    if ( !akbasic_parser_match1(obj, AKBASIC_TOK_RIGHT_PAREN) && requireparens ) {
	FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX, "Unbalanced parenthesis");
    }
    *dest = arglist;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_parser_expression(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);

    PASS(errctx, logicalandor(obj, dest));
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext *logicalandor(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    static const akbasic_TokenType OPS[] = { AKBASIC_TOK_AND, AKBASIC_TOK_OR };
    akbasic_ASTLeaf *left = NULL;
    akbasic_ASTLeaf *right = NULL;
    akbasic_ASTLeaf *expr = NULL;
    akbasic_Token *operator_ = NULL;

    PASS(errctx, logicalnot(obj, &left));
    if ( akbasic_parser_match(obj, OPS, 2) ) {
	PASS(errctx, akbasic_parser_previous(obj, &operator_));
	PASS(errctx, logicalnot(obj, &right));
	PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
	PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
	*dest = expr;
	SUCCEED_RETURN(errctx);
    }
    *dest = left;
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext *logicalnot(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *right = NULL;
    akbasic_ASTLeaf *expr = NULL;
    akbasic_Token *operator_ = NULL;

    if ( akbasic_parser_match1(obj, AKBASIC_TOK_NOT) ) {
	PASS(errctx, akbasic_parser_previous(obj, &operator_));
	PASS(errctx, akbasic_parser_relation(obj, &right));
	PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
	PASS(errctx, akbasic_leaf_new_unary(expr, operator_->tokentype, right));
	*dest = expr;
	SUCCEED_RETURN(errctx);
    }
    PASS(errctx, akbasic_parser_relation(obj, dest));
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_parser_relation(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    /*
     * A lone `=` is an equality test here when the caller has said a condition
     * is what it is parsing. `==` keeps working either way, which is what the Go
     * reference used and what the whole checked-in corpus is written in. See
     * akbasic_Parser::comparing and TODO.md section 5.
     */
    static const akbasic_TokenType OPS[] = {
	AKBASIC_TOK_LESS_THAN, AKBASIC_TOK_LESS_THAN_EQUAL, AKBASIC_TOK_EQUAL,
	AKBASIC_TOK_NOT_EQUAL, AKBASIC_TOK_GREATER_THAN, AKBASIC_TOK_GREATER_THAN_EQUAL,
	AKBASIC_TOK_ASSIGNMENT
    };
    akbasic_ASTLeaf *left = NULL;
    akbasic_ASTLeaf *right = NULL;
    akbasic_ASTLeaf *expr = NULL;
    akbasic_Token *operator_ = NULL;
    akbasic_TokenType op = AKBASIC_TOK_UNDEFINED;
    /*
     * ASSIGNMENT is the last entry, and it is only offered while `comparing` --
     * see akbasic_Parser. Outside a condition `=` has to stay an assignment, or
     * `A# = 2` stops storing anything and `FOR I# = 1 TO 5` never initializes
     * its counter.
     */
    int opcount = (obj->comparing ? 7 : 6);

    PASS(errctx, subtraction(obj, &left));
    if ( akbasic_parser_match(obj, OPS, opcount) ) {
	PASS(errctx, akbasic_parser_previous(obj, &operator_));
	op = operator_->tokentype;
	if ( op == AKBASIC_TOK_ASSIGNMENT ) {
	    op = AKBASIC_TOK_EQUAL;
	}
	PASS(errctx, subtraction(obj, &right));
	PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
	PASS(errctx, akbasic_leaf_new_binary(expr, left, op, right));
	*dest = expr;
	SUCCEED_RETURN(errctx);
    }
    *dest = left;
    SUCCEED_RETURN(errctx);
}

/*
 * Loops, where the reference returns after one operator (basicparser.go:329).
 * That asymmetry was reproduced faithfully at first and is TODO.md section 6
 * item 12: `1 - 2 - 3` computed `1 - 2` and abandoned the rest of the line,
 * which the statement loop then picked up as a second statement and discarded.
 * A wrong answer, silently -- the highest-impact item on that list.
 *
 * Left-associative, matching addition, multiplication and division here and
 * matching a C128, which evaluates a run of same-precedence operators left to
 * right.
 */
static akerr_ErrorContext *subtraction(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *left = NULL;
    akbasic_ASTLeaf *right = NULL;
    akbasic_ASTLeaf *expr = NULL;
    akbasic_Token *operator_ = NULL;

    PASS(errctx, addition(obj, &left));
    while ( akbasic_parser_match1(obj, AKBASIC_TOK_MINUS) ) {
	PASS(errctx, akbasic_parser_previous(obj, &operator_));
	PASS(errctx, addition(obj, &right));
	if ( expr != NULL ) {
	    left = expr;
	}
	PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
	PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
    }
    *dest = (expr != NULL ? expr : left);
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext *addition(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *left = NULL;
    akbasic_ASTLeaf *right = NULL;
    akbasic_ASTLeaf *expr = NULL;
    akbasic_Token *operator_ = NULL;

    PASS(errctx, multiplication(obj, &left));
    while ( akbasic_parser_match1(obj, AKBASIC_TOK_PLUS) ) {
	PASS(errctx, akbasic_parser_previous(obj, &operator_));
	PASS(errctx, multiplication(obj, &right));
	if ( expr != NULL ) {
	    left = expr;
	}
	PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
	PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
    }
    *dest = (expr != NULL ? expr : left);
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext *multiplication(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *left = NULL;
    akbasic_ASTLeaf *right = NULL;
    akbasic_ASTLeaf *expr = NULL;
    akbasic_Token *operator_ = NULL;

    PASS(errctx, division(obj, &left));
    while ( akbasic_parser_match1(obj, AKBASIC_TOK_STAR) ) {
	PASS(errctx, akbasic_parser_previous(obj, &operator_));
	PASS(errctx, division(obj, &right));
	if ( expr != NULL ) {
	    left = expr;
	}
	PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
	PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
    }
    *dest = (expr != NULL ? expr : left);
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext *division(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *left = NULL;
    akbasic_ASTLeaf *right = NULL;
    akbasic_ASTLeaf *expr = NULL;
    akbasic_Token *operator_ = NULL;

    PASS(errctx, unary(obj, &left));
    while ( akbasic_parser_match1(obj, AKBASIC_TOK_LEFT_SLASH) ) {
	PASS(errctx, akbasic_parser_previous(obj, &operator_));
	PASS(errctx, unary(obj, &right));
	if ( expr != NULL ) {
	    left = expr;
	}
	PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
	PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
    }
    *dest = (expr != NULL ? expr : left);
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext *unary(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *right = NULL;
    akbasic_ASTLeaf *expr = NULL;
    akbasic_Token *operator_ = NULL;

    if ( akbasic_parser_match1(obj, AKBASIC_TOK_MINUS) ) {
	PASS(errctx, akbasic_parser_previous(obj, &operator_));
	PASS(errctx, akbasic_parser_primary(obj, &right));
	PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
	PASS(errctx, akbasic_leaf_new_unary(expr, operator_->tokentype, right));
	*dest = expr;
	SUCCEED_RETURN(errctx);
    }
    PASS(errctx, exponent(obj, dest));
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext *exponent(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *left = NULL;
    akbasic_ASTLeaf *right = NULL;
    akbasic_ASTLeaf *expr = NULL;
    akbasic_Token *operator_ = NULL;

    PASS(errctx, function_call(obj, &left));
    /*
     * Loops for the same reason subtraction does -- `2 ^ 3 ^ 2` abandoned the
     * second operator before this. Left-associative, which is a C128: 2^3^2 is
     * 64 there, not the 512 a right-associative reading gives.
     */
    while ( akbasic_parser_match1(obj, AKBASIC_TOK_CARAT) ) {
	PASS(errctx, akbasic_parser_previous(obj, &operator_));
	PASS(errctx, function_call(obj, &right));
	if ( expr != NULL ) {
	    left = expr;
	}
	PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
	PASS(errctx, akbasic_leaf_new_binary(expr, left, operator_->tokentype, right));
    }
    *dest = (expr != NULL ? expr : left);
    SUCCEED_RETURN(errctx);
}

/* Count the arguments hanging off an argument list. */
static int arglist_length(akbasic_ASTLeaf *arglist)
{
    akbasic_ASTLeaf *leaf = NULL;
    int count = 0;

    if ( arglist == NULL ) {
	return 0;
    }
    for ( leaf = arglist->right; leaf != NULL; leaf = leaf->next ) {
	count += 1;
    }
    return count;
}

/*
 * Called for function *calls* only, never for a DEF. A FUNCTION token is either
 * a table builtin or a user DEF; both check their argument count here, so a
 * wrong-arity call is a parse error rather than a runtime surprise.
 */
static akerr_ErrorContext *function_call(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_ASTLeaf *arglist = NULL;
    akbasic_ASTLeaf *leaf = NULL;
    akbasic_Token *operator_ = NULL;
    const akbasic_Verb *verb = NULL;
    akbasic_FunctionDef *fndef = NULL;
    void *fnptr = NULL;
    char fname[AKBASIC_MAX_LINE_LENGTH];
    int wanted = 0;
    int given = 0;
    bool found = false;

    if ( !akbasic_parser_match1(obj, AKBASIC_TOK_FUNCTION) ) {
	PASS(errctx, akbasic_parser_primary(obj, dest));
	SUCCEED_RETURN(errctx);
    }

    PASS(errctx, akbasic_parser_previous(obj, &operator_));
    strncpy(fname, operator_->lexeme, sizeof(fname) - 1);
    fname[sizeof(fname) - 1] = '\0';

    PASS(errctx, akbasic_verb_lookup(fname, &verb));
    if ( verb != NULL && verb->tokentype == AKBASIC_TOK_FUNCTION ) {
	wanted = verb->arity;
	found = true;
    } else {
	ATTEMPT {
	    CATCH(errctx, akbasic_environment_get_function(obj->runtime->environment, fname, &fnptr));
	    found = true;
	} CLEANUP {
	} PROCESS(errctx) {
	} HANDLE(errctx, AKERR_KEY) {
	    found = false;
	} FINISH(errctx, true);
	if ( found ) {
	    fndef = (akbasic_FunctionDef *)fnptr;
	    wanted = arglist_length(fndef->arglist);
	}
    }
    FAIL_ZERO_RETURN(errctx, found, AKBASIC_ERR_UNDEFINED, "No such function %s", fname);

    PASS(errctx, akbasic_parser_argument_list(obj, AKBASIC_TOK_FUNCTION_ARGUMENT, true, &arglist));
    given = arglist_length(arglist);
    FAIL_ZERO_RETURN(errctx, (given == wanted), AKBASIC_ERR_SYNTAX,
		     "function %s takes %d arguments, received %d", fname, wanted, given);

    PASS(errctx, akbasic_parser_new_leaf(obj, &leaf));
    PASS(errctx, akbasic_leaf_new_function(leaf, fname, arglist));
    *dest = leaf;
    SUCCEED_RETURN(errctx);
}

/**
 * @brief Consume a run of `.field` and `->field` after a primary.
 *
 * Left-associative, so `A@.B@.C#` reads as `(A@.B@).C#` and each step's base is
 * the leaf before it. The two operators are kept apart all the way to the
 * runtime rather than folded into one "field access", because which one was
 * written is the whole of the strict-pointer rule: `.` requires a structure and
 * `->` requires a pointer to one, and getting it wrong is an error rather than a
 * convenience the interpreter silently absorbs.
 */
static akerr_ErrorContext *parse_field_chain(akbasic_Parser *obj, akbasic_ASTLeaf **expr)
{
    PREPARE_ERROR(errctx);
    static const akbasic_TokenType ACCESSORS[] = { AKBASIC_TOK_DOT, AKBASIC_TOK_ARROW };
    /*
     * A field name carries its own type suffix, exactly as a variable does, so
     * the four suffixed identifier tokens are the whole set. A bare identifier
     * is not among them: that spelling is a label everywhere else and a field
     * with no suffix would have no type.
     */
    static const akbasic_TokenType FIELDNAMES[] = {
	AKBASIC_TOK_IDENTIFIER_INT, AKBASIC_TOK_IDENTIFIER_FLOAT,
	AKBASIC_TOK_IDENTIFIER_STRING, AKBASIC_TOK_IDENTIFIER_STRUCT
    };
    akbasic_ASTLeaf *field = NULL;
    akbasic_Token *accessor = NULL;
    akbasic_Token *name = NULL;
    akbasic_TokenType op = AKBASIC_TOK_DOT;

    while ( akbasic_parser_match(obj, ACCESSORS, 2) ) {
	PASS(errctx, akbasic_parser_previous(obj, &accessor));
	op = accessor->tokentype;
	FAIL_ZERO_RETURN(errctx, akbasic_parser_match(obj, FIELDNAMES, 4), AKBASIC_ERR_SYNTAX,
			 "Expected a field name after %s", (op == AKBASIC_TOK_ARROW ? "->" : "."));
	PASS(errctx, akbasic_parser_previous(obj, &name));
	PASS(errctx, akbasic_parser_new_leaf(obj, &field));
	PASS(errctx, akbasic_leaf_new_field(field, *expr, name->lexeme, op));
	/*
	 * A field may itself be an array element -- `E@.DROPS#(2)` -- and the
	 * subscript list belongs to the field, not to the base, so it is
	 * collected here and onto the field leaf's own `.expr`.
	 */
	PASS(errctx, akbasic_parser_argument_list(obj, AKBASIC_TOK_ARRAY_SUBSCRIPT, true, &field->expr));
	*expr = field;
    }
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_parser_primary(akbasic_Parser *obj, akbasic_ASTLeaf **dest)
{
    PREPARE_ERROR(errctx);
    static const akbasic_TokenType PRIMARIES[] = {
	AKBASIC_TOK_LITERAL_INT, AKBASIC_TOK_LITERAL_FLOAT, AKBASIC_TOK_LITERAL_STRING,
	AKBASIC_TOK_IDENTIFIER, AKBASIC_TOK_IDENTIFIER_STRING, AKBASIC_TOK_IDENTIFIER_FLOAT,
	AKBASIC_TOK_IDENTIFIER_INT, AKBASIC_TOK_FUNCTION, AKBASIC_TOK_IDENTIFIER_STRUCT
    };
    akbasic_ASTLeaf *expr = NULL;
    akbasic_ASTLeaf *groupexpr = NULL;
    akbasic_Token *previous = NULL;

    if ( akbasic_parser_match(obj, PRIMARIES, 9) ) {
	PASS(errctx, akbasic_parser_previous(obj, &previous));
	PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
	switch ( previous->tokentype ) {
	case AKBASIC_TOK_LITERAL_INT:
	    PASS(errctx, akbasic_leaf_new_literal_int(expr, previous->lexeme));
	    break;
	case AKBASIC_TOK_LITERAL_FLOAT:
	    PASS(errctx, akbasic_leaf_new_literal_float(expr, previous->lexeme));
	    break;
	case AKBASIC_TOK_LITERAL_STRING:
	    PASS(errctx, akbasic_leaf_new_literal_string(expr, previous->lexeme));
	    break;
	case AKBASIC_TOK_IDENTIFIER_INT:
	    PASS(errctx, akbasic_leaf_new_identifier(expr, AKBASIC_LEAF_IDENTIFIER_INT, previous->lexeme));
	    PASS(errctx, akbasic_parser_argument_list(obj, AKBASIC_TOK_ARRAY_SUBSCRIPT, true, &expr->expr));
	    break;
	case AKBASIC_TOK_IDENTIFIER_FLOAT:
	    PASS(errctx, akbasic_leaf_new_identifier(expr, AKBASIC_LEAF_IDENTIFIER_FLOAT, previous->lexeme));
	    PASS(errctx, akbasic_parser_argument_list(obj, AKBASIC_TOK_ARRAY_SUBSCRIPT, true, &expr->expr));
	    break;
	case AKBASIC_TOK_IDENTIFIER_STRING:
	    PASS(errctx, akbasic_leaf_new_identifier(expr, AKBASIC_LEAF_IDENTIFIER_STRING, previous->lexeme));
	    PASS(errctx, akbasic_parser_argument_list(obj, AKBASIC_TOK_ARRAY_SUBSCRIPT, true, &expr->expr));
	    break;
	case AKBASIC_TOK_IDENTIFIER_STRUCT:
	    PASS(errctx, akbasic_leaf_new_identifier(expr, AKBASIC_LEAF_IDENTIFIER_STRUCT, previous->lexeme));
	    PASS(errctx, akbasic_parser_argument_list(obj, AKBASIC_TOK_ARRAY_SUBSCRIPT, true, &expr->expr));
	    break;
	case AKBASIC_TOK_FUNCTION:
	case AKBASIC_TOK_IDENTIFIER:
	    PASS(errctx, akbasic_leaf_new_identifier(expr, AKBASIC_LEAF_IDENTIFIER, previous->lexeme));
	    break;
	default:
	    FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX, "Invalid literal type, command or function name");
	}
	PASS(errctx, parse_field_chain(obj, &expr));
	*dest = expr;
	SUCCEED_RETURN(errctx);
    }

    if ( akbasic_parser_match1(obj, AKBASIC_TOK_LEFT_PAREN) ) {
	PASS(errctx, akbasic_parser_expression(obj, &groupexpr));
	PASS(errctx, consume(obj, AKBASIC_TOK_RIGHT_PAREN, "Missing ) after expression"));
	PASS(errctx, akbasic_parser_new_leaf(obj, &expr));
	PASS(errctx, akbasic_leaf_new_grouping(expr, groupexpr));
	*dest = expr;
	SUCCEED_RETURN(errctx);
    }

    PASS(errctx, akbasic_parser_error(obj, "Expected expression or literal"));
    SUCCEED_RETURN(errctx);
}