akbasic/src/scanner.c

/**
 * @file scanner.c
 * @brief Implements the line tokenizer.
 */

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

#include <akerror.h>
#include <akstdlib.h>

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

akerr_ErrorContext *akbasic_scanner_zero(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in scanner zero");
    obj->current = 0;
    obj->start = 0;
    obj->hasError = false;
    SUCCEED_RETURN(errctx);
}

/**
 * @brief Is the cursor past the end of the line?
 *
 * The answer leaves through @p dest rather than the return value because
 * measuring the line can fail, and a `bool` has nowhere to put that. Same shape
 * as symtab.c's `probe`, and for the same reason. See libakstdlib #38.
 */
static akerr_ErrorContext *is_at_end(akbasic_Runtime *obj, bool *dest)
{
    PREPARE_ERROR(errctx);
    size_t linelen = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in is_at_end");
    PASS(errctx, aksl_strlen(obj->line, &linelen));
    *dest = (obj->current >= (int)linelen);
    SUCCEED_RETURN(errctx);
}

/**
 * @brief The character under the cursor.
 * @param[out] dest The character. Untouched when there is none.
 * @param[out] got  Whether there was one. The old `bool` return.
 */
static akerr_ErrorContext *peek(akbasic_Runtime *obj, char *dest, bool *got)
{
    PREPARE_ERROR(errctx);
    bool atend = false;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL && got != NULL), AKERR_NULLPOINTER,
		     "NULL argument in peek");
    PASS(errctx, is_at_end(obj, &atend));
    if ( atend ) {
	*got = false;
	SUCCEED_RETURN(errctx);
    }
    *dest = obj->line[obj->current];
    *got = true;
    SUCCEED_RETURN(errctx);
}

/**
 * @brief The character one past the cursor.
 * @param[out] dest The character. Untouched when there is none.
 * @param[out] got  Whether there was one. The old `bool` return.
 */
static akerr_ErrorContext *peek_next(akbasic_Runtime *obj, char *dest, bool *got)
{
    PREPARE_ERROR(errctx);
    size_t linelen = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL && got != NULL), AKERR_NULLPOINTER,
		     "NULL argument in peek_next");
    PASS(errctx, aksl_strlen(obj->line, &linelen));
    if ( (obj->current + 1) >= (int)linelen ) {
	*got = false;
	SUCCEED_RETURN(errctx);
    }
    *dest = obj->line[obj->current + 1];
    *got = true;
    SUCCEED_RETURN(errctx);
}

/*
 * The lexeme is the span [start, current), with two special cases the reference
 * relies on: at end of line it runs to the end, and a zero-width span yields the
 * single character at `start` -- unless we are closing a string literal, where
 * an empty span really is the empty string.
 */
static akerr_ErrorContext *get_lexeme(akbasic_Runtime *obj, char *dest, size_t len)
{
    PREPARE_ERROR(errctx);
    size_t measured = 0;
    int linelen = 0;
    int span = 0;

    PASS(errctx, aksl_strlen(obj->line, &measured));
    linelen = (int)measured;
    if ( obj->current == linelen ) {
	span = linelen - obj->start;
    } else if ( obj->start == obj->current ) {
	if ( obj->tokentype == AKBASIC_TOK_LITERAL_STRING ) {
	    dest[0] = '\0';
	    SUCCEED_RETURN(errctx);
	}
	span = 1;
    } else {
	span = obj->current - obj->start;
    }
    FAIL_ZERO_RETURN(errctx, (span >= 0 && (size_t)span < len), AKBASIC_ERR_BOUNDS,
		     "Lexeme of %d characters exceeds the %zu character limit", span, len - 1);
    PASS(errctx, aksl_memcpy(dest, obj->line + obj->start, (size_t)span));
    dest[span] = '\0';
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext *add_token(akbasic_Runtime *obj, akbasic_TokenType token, const char *lexeme)
{
    PREPARE_ERROR(errctx);
    akbasic_Environment *env = obj->environment;
    size_t lexemelen = 0;

    FAIL_ZERO_RETURN(errctx, (env->nexttoken < AKBASIC_MAX_TOKENS), AKBASIC_ERR_BOUNDS,
		     "Line %" PRId64 " has more than %d tokens",
		     env->lineno, AKBASIC_MAX_TOKENS);
    PASS(errctx, aksl_strlen(lexeme, &lexemelen));
    FAIL_ZERO_RETURN(errctx, (lexemelen < AKBASIC_MAX_LINE_LENGTH), AKBASIC_ERR_BOUNDS,
		     "Token lexeme exceeds the %d character limit", AKBASIC_MAX_LINE_LENGTH - 1);
    env->tokens[env->nexttoken].tokentype = token;
    env->tokens[env->nexttoken].lineno = env->lineno;
    PASS(errctx, aksl_strcpy(env->tokens[env->nexttoken].lexeme,
			     sizeof(env->tokens[env->nexttoken].lexeme), lexeme));
    env->nexttoken += 1;
    SUCCEED_RETURN(errctx);
}

/**
 * @brief Consume one more character when it matches, choosing between two token types.
 * @param[out] matched Whether the character was consumed. The old `bool` return.
 *
 * On the chain below `peek`, so it reports the same way. See libakstdlib #38.
 */
static akerr_ErrorContext *match_next_char(akbasic_Runtime *obj, char cm, akbasic_TokenType truetype,
					   akbasic_TokenType falsetype, bool *matched)
{
    PREPARE_ERROR(errctx);
    char nc = '\0';
    bool got = false;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && matched != NULL), AKERR_NULLPOINTER,
		     "NULL argument in match_next_char");
    PASS(errctx, peek(obj, &nc, &got));
    if ( !got ) {
	/*
	 * Nothing left to peek at, so the operator is whatever it is on its
	 * own. The reference returns here *without* setting a type
	 * (basicscanner.go:272), which silently drops a comparison operator in
	 * the final column of a line: `A# =` produced one token, not two, and
	 * the parse error that followed pointed somewhere else entirely.
	 * TODO.md section 6 item 14.
	 */
	obj->tokentype = falsetype;
	*matched = false;
	SUCCEED_RETURN(errctx);
    }
    if ( nc == cm ) {
	obj->current += 1;
	obj->tokentype = truetype;
	*matched = true;
	SUCCEED_RETURN(errctx);
    }
    obj->tokentype = falsetype;
    *matched = false;
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext *match_string(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);
    char c = '\0';
    bool atend = false;
    bool got = false;

    for ( ;; ) {
	PASS(errctx, is_at_end(obj, &atend));
	if ( atend ) {
	    break;
	}
	PASS(errctx, peek(obj, &c, &got));
	if ( !got ) {
	    PASS(errctx, akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE,
					       "UNTERMINATED STRING LITERAL\n"));
	    obj->hasError = true;
	    SUCCEED_RETURN(errctx);
	}
	if ( c == '"' ) {
	    break;
	}
	obj->current += 1;
    }
    obj->tokentype = AKBASIC_TOK_LITERAL_STRING;
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext *match_number(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);
    bool linenumber = (obj->environment->nexttoken == 0);
    char lexeme[AKBASIC_MAX_LINE_LENGTH];
    char c = '\0';
    char nc = '\0';
    int64_t lineno = 0;
    long long converted = 0;
    bool hex = false;
    bool atend = false;
    bool got = false;

    obj->tokentype = AKBASIC_TOK_LITERAL_INT;
    for ( ;; ) {
	PASS(errctx, is_at_end(obj, &atend));
	if ( atend ) {
	    break;
	}
	PASS(errctx, peek(obj, &c, &got));
	if ( c == '.' ) {
	    PASS(errctx, peek_next(obj, &nc, &got));
	    if ( !got || !isdigit((unsigned char)nc) ) {
		PASS(errctx, akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE,
						   "INVALID FLOATING POINT LITERAL\n"));
		obj->hasError = true;
		SUCCEED_RETURN(errctx);
	    }
	    obj->tokentype = AKBASIC_TOK_LITERAL_FLOAT;
	} else if ( c == 'x' && !hex ) {
	    /*
	     * An 'x' in a number run. The reference lets it through and then
	     * stops at the first hex digit after it (basicscanner.go:318), so
	     * `0xff` lexed as `0x` followed by an identifier `ff`, the parser's
	     * base-16 branch was unreachable, and the README's hex support did
	     * not exist. TODO.md section 6 item 15. Once the 'x' is seen, keep
	     * going over hex digits.
	     *
	     * Accepted anywhere in the run rather than only after a leading `0`,
	     * which is the reference's rule and is worth keeping: it is what
	     * makes `1x2` one malformed token that the line-number conversion
	     * then diagnoses by name, instead of two tokens that fail somewhere
	     * less helpful.
	     */
	    hex = true;
	} else if ( hex ) {
	    if ( !isxdigit((unsigned char)c) ) {
		break;
	    }
	} else if ( !isdigit((unsigned char)c) ) {
	    break;
	}
	obj->current += 1;
    }

    if ( obj->tokentype == AKBASIC_TOK_LITERAL_INT && linenumber ) {
	PASS(errctx, get_lexeme(obj, lexeme, sizeof(lexeme)));
	ATTEMPT {
	    CATCH(errctx, aksl_atoll(lexeme, &converted));
	    lineno = (int64_t)converted;
	} CLEANUP {
	} PROCESS(errctx) {
	} HANDLE_DEFAULT(errctx) {
	    char message[AKBASIC_MAX_LINE_LENGTH + 32] = "INTEGER CONVERSION";
	    int written = 0;
	    /*
	     * Reporting can itself fail if the sink is broken, and so can
	     * formatting the message. Neither leaves anything useful to do here --
	     * this block is already handling an error -- so both are ignored, the
	     * message keeps the initialiser above if the format fails, and the flag
	     * lets the next operation surface it.
	     */
	    IGNORE(aksl_snprintf(&written, message, sizeof(message),
				 "INTEGER CONVERSION ON '%s'", lexeme));
	    IGNORE(akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE, message));
	    obj->hasError = true;
	} FINISH(errctx, false);

	if ( obj->hasError ) {
	    SUCCEED_RETURN(errctx);
	}
	obj->environment->lineno = lineno;
	obj->tokentype = AKBASIC_TOK_LINE_NUMBER;
    }
    SUCCEED_RETURN(errctx);
}

static akerr_ErrorContext *match_identifier(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);
    char lexeme[AKBASIC_MAX_LINE_LENGTH];
    char basename[AKBASIC_MAX_LINE_LENGTH];
    const akbasic_Verb *verb = NULL;
    void *fndef = NULL;
    bool userfunction = false;
    char c = '\0';
    size_t used = 0;
    bool atend = false;
    bool got = false;

    obj->tokentype = AKBASIC_TOK_IDENTIFIER;
    for ( ;; ) {
	PASS(errctx, is_at_end(obj, &atend));
	if ( atend ) {
	    break;
	}
	PASS(errctx, peek(obj, &c, &got));
	if ( isdigit((unsigned char)c) || isalpha((unsigned char)c) ) {
	    obj->current += 1;
	    continue;
	}
	switch ( c ) {
	case '@':
	    obj->tokentype = AKBASIC_TOK_IDENTIFIER_STRUCT;
	    obj->current += 1;
	    break;
	case '$':
	    obj->tokentype = AKBASIC_TOK_IDENTIFIER_STRING;
	    obj->current += 1;
	    break;
	case '%':
	    obj->tokentype = AKBASIC_TOK_IDENTIFIER_FLOAT;
	    obj->current += 1;
	    break;
	case '#':
	    obj->tokentype = AKBASIC_TOK_IDENTIFIER_INT;
	    obj->current += 1;
	    break;
	default:
	    break;
	}
	break;
    }

    PASS(errctx, get_lexeme(obj, lexeme, sizeof(lexeme)));

    /*
     * The verb table is searched on the *base* name, with any type suffix
     * stripped. The reference searches with the suffix still attached
     * (basicscanner.go:349), so `PRINT$` misses every table, the "Reserved word
     * in variable name" branch below is dead code, and `PRINT$ = 1` is quietly
     * accepted as an ordinary string variable. TODO.md section 6 item 16.
     */
    PASS(errctx, aksl_strcpy(basename, sizeof(basename), lexeme));
    PASS(errctx, aksl_strlen(basename, &used));
    if ( obj->tokentype != AKBASIC_TOK_IDENTIFIER && used > 0 ) {
	basename[used - 1] = '\0';
    }
    PASS(errctx, akbasic_verb_lookup(basename, &verb));

    ATTEMPT {
	CATCH(errctx, akbasic_environment_get_function(obj->environment, lexeme, &fndef));
	userfunction = true;
    } CLEANUP {
    } PROCESS(errctx) {
    } HANDLE(errctx, AKERR_KEY) {
	userfunction = false;
    } FINISH(errctx, true);

    if ( obj->tokentype == AKBASIC_TOK_IDENTIFIER ) {
	if ( verb != NULL ) {
	    obj->tokentype = verb->tokentype;
	} else if ( userfunction ) {
	    obj->tokentype = AKBASIC_TOK_FUNCTION;
	}
    } else if ( verb != NULL ) {
	/*
	 * A suffixed identifier that collides with a verb or function name.
	 * PRINT$ is not a variable.
	 */
	PASS(errctx, akbasic_runtime_error(obj, AKBASIC_ERRCLASS_SYNTAX,
					   "Reserved word in variable name\n"));
	obj->hasError = true;
    }
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_scanner_scan(akbasic_Runtime *obj, const char *line, char *dest, size_t len)
{
    PREPARE_ERROR(errctx);
    char lexeme[AKBASIC_MAX_LINE_LENGTH];
    char c = '\0';
    bool done = false;
    bool atend = false;
    bool matched = false;
    size_t linelen = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in scan");
    FAIL_ZERO_RETURN(errctx, (line != NULL), AKERR_NULLPOINTER, "NULL line in scan");
    PASS(errctx, aksl_strlen(line, &linelen));
    FAIL_ZERO_RETURN(errctx, (linelen < AKBASIC_MAX_LINE_LENGTH), AKBASIC_ERR_BOUNDS,
		     "Source line of %zu characters exceeds the %d character limit",
		     linelen, AKBASIC_MAX_LINE_LENGTH - 1);

    PASS(errctx, aksl_strcpy(obj->line, sizeof(obj->line), line));
    PASS(errctx, akbasic_environment_zero_parser(obj->environment));
    obj->current = 0;
    obj->start = 0;
    obj->hasError = false;
    /*
     * Cleared here rather than by each caller, so the flag always describes the
     * line this call just scanned. It used to be cleared only in
     * process_line_repl(); the loading paths never touched it, which was
     * harmless while they ignored it and is not now that they decide a line's
     * number by it.
     */
    obj->hadlinenumber = false;

    for ( ;; ) {
	PASS(errctx, is_at_end(obj, &atend));
	if ( atend || done ) {
	    break;
	}
	c = obj->line[obj->current];
	obj->current += 1;

	switch ( c ) {
	case '@': obj->tokentype = AKBASIC_TOK_ATSYMBOL;			break;
	case '^': obj->tokentype = AKBASIC_TOK_CARAT;			break;
	case '(': obj->tokentype = AKBASIC_TOK_LEFT_PAREN;		break;
	case ')': obj->tokentype = AKBASIC_TOK_RIGHT_PAREN;		break;
	case '+': obj->tokentype = AKBASIC_TOK_PLUS;			break;
	/*
	 * `->` reaches a field through a pointer, so a minus has to look ahead
	 * one character before it can call itself a minus. Nothing else in the
	 * language begins `->`, and `A# - >` is not an expression, so there is
	 * no spelling this makes ambiguous.
	 */
	case '-':
	    PASS(errctx, match_next_char(obj, '>', AKBASIC_TOK_ARROW, AKBASIC_TOK_MINUS, &matched));
	    break;
	case '/': obj->tokentype = AKBASIC_TOK_LEFT_SLASH;		break;
	case '*': obj->tokentype = AKBASIC_TOK_STAR;			break;
	case ',': obj->tokentype = AKBASIC_TOK_COMMA;			break;
	case ':': obj->tokentype = AKBASIC_TOK_COLON;			break;
	/*
	 * A field separator. It only reaches this switch when it is *not* part
	 * of a number: match_number() is entered on a digit and consumes its own
	 * decimal point, so `1.5` never gets here and `P@.X#` always does.
	 */
	case '.': obj->tokentype = AKBASIC_TOK_DOT;			break;
	/*
	 * MOVSPR's two separators. Both were UNKNOWN TOKEN until sprites, so
	 * scanning them breaks nothing -- and a `#` only reaches this switch
	 * when it is not an identifier's type suffix, which match_identifier
	 * consumes before returning.
	 */
	case ';': obj->tokentype = AKBASIC_TOK_SEMICOLON;		break;
	case '#': obj->tokentype = AKBASIC_TOK_HASHMARK;		break;
	case '[': obj->tokentype = AKBASIC_TOK_LEFT_SQUAREBRACKET;	break;
	case ']': obj->tokentype = AKBASIC_TOK_RIGHT_SQUAREBRACKET;	break;
	case '=':
	    PASS(errctx, match_next_char(obj, '=', AKBASIC_TOK_EQUAL, AKBASIC_TOK_ASSIGNMENT, &matched));
	    break;
	case '<':
	    PASS(errctx, match_next_char(obj, '=', AKBASIC_TOK_LESS_THAN_EQUAL,
					 AKBASIC_TOK_LESS_THAN, &matched));
	    if ( !matched ) {
		PASS(errctx, match_next_char(obj, '>', AKBASIC_TOK_NOT_EQUAL,
					     AKBASIC_TOK_LESS_THAN, &matched));
	    }
	    break;
	case '>':
	    PASS(errctx, match_next_char(obj, '=', AKBASIC_TOK_GREATER_THAN_EQUAL,
					 AKBASIC_TOK_GREATER_THAN, &matched));
	    break;
	case '"':
	    obj->start = obj->current;
	    PASS(errctx, match_string(obj));
	    break;
	case '\t':
	case ' ':
	    obj->start = obj->current;
	    break;
	case '\r':
	case '\n':
	    done = true;
	    break;
	default:
	    if ( isdigit((unsigned char)c) ) {
		PASS(errctx, match_number(obj));
	    } else if ( isalpha((unsigned char)c) ) {
		PASS(errctx, match_identifier(obj));
	    } else {
		char message[AKBASIC_MAX_LINE_LENGTH];
		int written = 0;

		PASS(errctx, aksl_snprintf(&written, message, sizeof(message),
					   "UNKNOWN TOKEN %c\n", c));
		PASS(errctx, akbasic_runtime_error(obj, AKBASIC_ERRCLASS_PARSE, message));
		obj->hasError = true;
		obj->start = obj->current;
	    }
	    break;
	}

	if ( done ) {
	    break;
	}
	if ( obj->tokentype != AKBASIC_TOK_UNDEFINED && !obj->hasError ) {
	    if ( obj->tokentype == AKBASIC_TOK_REM ) {
		/* Everything after REM is a comment. Stop, keeping the line intact. */
		break;
	    } else if ( obj->tokentype == AKBASIC_TOK_LINE_NUMBER ) {
		obj->hadlinenumber = true;
		/*
		 * The line number is not kept as a token. Rewrite the line to
		 * everything after it, minus leading spaces, and restart the
		 * cursor -- the REPL reads the rewritten line back out and
		 * stores *that* as the program text.
		 */
		int skip = obj->current;
		size_t tail = 0;

		while ( obj->line[skip] == ' ' ) {
		    skip += 1;
		}
		PASS(errctx, aksl_strlen(obj->line + skip, &tail));
		PASS(errctx, aksl_memmove(obj->line, obj->line + skip, tail + 1));
		obj->current = 0;
	    } else {
		PASS(errctx, get_lexeme(obj, lexeme, sizeof(lexeme)));
		PASS(errctx, add_token(obj, obj->tokentype, lexeme));
		if ( obj->tokentype == AKBASIC_TOK_LITERAL_STRING ) {
		    /* Scanning stopped on the closing quote; step past it. */
		    obj->current += 1;
		}
	    }
	    obj->tokentype = AKBASIC_TOK_UNDEFINED;
	    obj->start = obj->current;
	}
    }

    if ( dest != NULL ) {
	PASS(errctx, aksl_strlen(obj->line, &linelen));
	FAIL_ZERO_RETURN(errctx, (linelen < len), AKBASIC_ERR_BOUNDS,
			 "Scanned line does not fit the caller's buffer");
	PASS(errctx, aksl_strcpy(dest, len, obj->line));
    }
    SUCCEED_RETURN(errctx);
}