akbasic/src/structtype.c

/**
 * @file structtype.c
 * @brief Implements the `TYPE` table and the prescan that fills it.
 *
 * The prescan is textual and runs before the program does, exactly as the label
 * and `DATA` prescans do and for the same reason: a declaration has to be in
 * effect wherever control goes, including when a branch skips the lines that
 * made it.
 *
 * **It is three passes, and each one exists for a case that cannot be done in
 * the pass before it.** Pass 1 registers names and line ranges, so a field can
 * name a type declared further down the program. Pass 2 parses field lists, now
 * able to resolve every type reference. Pass 3 computes sizes and offsets by
 * repeated resolution, because a type nested by value must know its own size
 * before its container can -- and a group of types that never resolve is
 * precisely a cycle of by-value containment, which is what makes "a TYPE cannot
 * contain itself by value" a diagnosis rather than an assumption.
 */

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

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

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

#include "verbs.h"

/** @brief Step over spaces and tabs. */
static const char *skip_space(const char *cursor)
{
    while ( *cursor != '\0' && isspace((unsigned char)*cursor) ) {
	cursor += 1;
    }
    return cursor;
}

/**
 * @brief Step over a stored line's own line number, if it still carries one.
 *
 * Every path inside the library files what the scanner already stripped, but
 * akbasic_runtime_store_line() is public and a host may hand it a raw line, so
 * both spellings are real and both are handled here -- the same allowance
 * scan_line_labels() makes.
 */
static const char *skip_lineno(const char *cursor)
{
    cursor = skip_space(cursor);
    if ( isdigit((unsigned char)*cursor) ) {
	while ( isdigit((unsigned char)*cursor) ) {
	    cursor += 1;
	}
    }
    return skip_space(cursor);
}

/*
 * Room to read a word that is *too long* and still see that it was.
 *
 * Reading into a buffer the size of the limit truncates before anything can
 * check, so an over-long name would arrive already trimmed to fit and be
 * accepted -- which is how the length check below was unreachable when it was
 * first written. Twice the limit is enough to tell the two cases apart, and a
 * word longer than this is still longer than the limit, so it is refused either
 * way.
 */
#define STRUCT_WORD_SCRATCH	(AKBASIC_MAX_STRUCT_NAME * 2)

/** @brief Copy the next whitespace-delimited word, uppercased. Empty when the line ends. */
static const char *next_word(const char *cursor, char *dest, size_t len)
{
    size_t used = 0;

    dest[0] = '\0';
    cursor = skip_space(cursor);
    while ( *cursor != '\0' && !isspace((unsigned char)*cursor) ) {
	if ( used + 1 < len ) {
	    dest[used] = (char)toupper((unsigned char)*cursor);
	    used += 1;
	}
	cursor += 1;
    }
    dest[used] = '\0';
    return cursor;
}

/**
 * @brief Compare a word against a keyword. Verbs are case-insensitive here as everywhere.
 *
 * The answer leaves through @p dest rather than the return value because the
 * comparison itself can fail, and a `bool` has nowhere to put that. See
 * libakstdlib #38.
 */
static akerr_ErrorContext *word_is(const char *word, const char *keyword, bool *dest)
{
    PREPARE_ERROR(errctx);
    int cmp = 0;

    FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL dest in word_is");
    PASS(errctx, aksl_strcmp(word, keyword, &cmp));
    *dest = (cmp == 0);
    SUCCEED_RETURN(errctx);
}

/**
 * @brief The type a field name's suffix declares.
 *
 * The same rule every other name in the language follows, which is the reason a
 * field list needs no type column: `W#` is an integer because it says so.
 */
static akerr_ErrorContext *type_from_suffix(const char *name, akbasic_Type *dest)
{
    PREPARE_ERROR(errctx);
    size_t len = 0;

    PASS(errctx, aksl_strlen(name, &len));
    FAIL_ZERO_RETURN(errctx, (len >= 2), AKBASIC_ERR_SYNTAX,
		     "Field name \"%s\" carries no type suffix", name);
    switch ( name[len - 1] ) {
    case '#': *dest = AKBASIC_TYPE_INTEGER; break;
    case '%': *dest = AKBASIC_TYPE_FLOAT;   break;
    case '$': *dest = AKBASIC_TYPE_STRING;  break;
    case '@': *dest = AKBASIC_TYPE_STRUCT;  break;
    default:
	FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX,
		    "Field name \"%s\" carries no type suffix (# integer, %% float, $ string, @ structure)",
		    name);
    }
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_structtype_table_init(akbasic_StructTypeTable *obj)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL table in structtype init");
    PASS(errctx, aksl_memset(obj, 0, sizeof(*obj)));
    obj->count = 0;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_structtype_find(akbasic_StructTypeTable *obj, const char *name, int *dest)
{
    PREPARE_ERROR(errctx);
    int i = 0;
    int cmp = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && name != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in structtype find");
    *dest = -1;
    for ( i = 0; i < obj->count; i++ ) {
	if ( !obj->types[i].used ) {
	    continue;
	}
	PASS(errctx, aksl_strcmp(obj->types[i].name, name, &cmp));
	if ( cmp == 0 ) {
	    *dest = i;
	    SUCCEED_RETURN(errctx);
	}
    }
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_structtype_field(akbasic_StructTypeTable *obj, int typeindex, const char *name, akbasic_StructField **dest)
{
    PREPARE_ERROR(errctx);
    char known[AKBASIC_MAX_STRING_LENGTH];
    const char *separator = NULL;
    akbasic_StructType *type = NULL;
    size_t used = 0;
    size_t namelen = 0;
    size_t seplen = 0;
    int written = 0;
    int i = 0;
    int cmp = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && name != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in structtype field");
    FAIL_ZERO_RETURN(errctx, (typeindex >= 0 && typeindex < obj->count), AKBASIC_ERR_BOUNDS,
		     "Structure type index %d is outside 0..%d", typeindex, obj->count - 1);
    type = &obj->types[typeindex];

    for ( i = 0; i < type->fieldcount; i++ ) {
	PASS(errctx, aksl_strcmp(type->fields[i].name, name, &cmp));
	if ( cmp == 0 ) {
	    *dest = &type->fields[i];
	    SUCCEED_RETURN(errctx);
	}
    }

    /*
     * List what the type does have. The only reason a misspelled field can be
     * caught at all is that the set is closed and the program wrote it down, so
     * the diagnostic may as well show it -- this is the message that turns "why
     * is my total zero" into a one-line fix.
     */
    known[0] = '\0';
    for ( i = 0; i < type->fieldcount; i++ ) {
	separator = (i == 0 ? "" : ", ");
	PASS(errctx, aksl_strlen(separator, &seplen));
	PASS(errctx, aksl_strlen(type->fields[i].name, &namelen));
	/*
	 * The list is advisory, so a full buffer ends it rather than failing the
	 * lookup. aksl_snprintf treats truncation as an error, which is right
	 * everywhere the output matters -- so the fit is decided here, before the
	 * call, instead of being read back out of a return value afterwards.
	 */
	if ( used + seplen + namelen >= sizeof(known) ) {
	    break;
	}
	PASS(errctx, aksl_snprintf(&written, known + used, sizeof(known) - used, "%s%s",
				   separator, type->fields[i].name));
	used += (size_t)written;
    }
    FAIL_RETURN(errctx, AKBASIC_ERR_UNDEFINED, "%s has no field %s (%s)",
		type->name, name, (type->fieldcount > 0 ? known : "it has none"));
}

akerr_ErrorContext *akbasic_structtype_block_at(akbasic_StructTypeTable *obj, int64_t lineno, int *dest)
{
    PREPARE_ERROR(errctx);
    int i = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in structtype block_at");
    *dest = -1;
    for ( i = 0; i < obj->count; i++ ) {
	if ( obj->types[i].used && obj->types[i].firstline == lineno ) {
	    *dest = i;
	    SUCCEED_RETURN(errctx);
	}
    }
    SUCCEED_RETURN(errctx);
}

/* ----------------------------------------------------------------- pass 1 -- */

/**
 * @brief Register every type's name and line range.
 *
 * Names first and fields later, so a field may name a type declared further down
 * the program. A linked list needs that even for itself -- `NEXT@ AS PTR TO
 * NODE` inside `TYPE NODE` refers to a type that is not finished being read.
 */
static akerr_ErrorContext *scan_names(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);
    akbasic_StructTypeTable *table = &obj->structtypes;
    char word[STRUCT_WORD_SCRATCH];
    char name[STRUCT_WORD_SCRATCH];
    const char *cursor = NULL;
    int64_t i = 0;
    int open = -1;
    int existing = 0;
    size_t namelen = 0;
    bool matched = false;
    const akbasic_Verb *verb = NULL;
    int64_t entry = obj->environment->lineno;

    for ( i = 0; i < AKBASIC_MAX_SOURCE_LINES; i++ ) {
	if ( obj->source[i].code[0] == '\0' ) {
	    continue;
	}
	obj->environment->lineno = i;
	cursor = next_word(skip_lineno(obj->source[i].code), word, sizeof(word));

	PASS(errctx, word_is(word, "END", &matched));
	if ( matched ) {
	    (void)next_word(cursor, name, sizeof(name));
	    PASS(errctx, word_is(name, "TYPE", &matched));
	    if ( !matched ) {
		continue;		/* an ordinary END, not our terminator */
	    }
	    FAIL_ZERO_RETURN(errctx, (open >= 0), AKBASIC_ERR_SYNTAX,
			     "END TYPE on line %" PRId64 " closes nothing", i);
	    table->types[open].lastline = i;
	    open = -1;
	    continue;
	}
	PASS(errctx, word_is(word, "TYPE", &matched));
	if ( !matched ) {
	    continue;
	}

	FAIL_ZERO_RETURN(errctx, (open < 0), AKBASIC_ERR_SYNTAX,
			 "TYPE on line %" PRId64 " opens inside %s, which is not closed",
			 i, table->types[open].name);
	(void)next_word(cursor, name, sizeof(name));
	FAIL_ZERO_RETURN(errctx, (name[0] != '\0'), AKBASIC_ERR_SYNTAX,
			 "TYPE on line %" PRId64 " has no name", i);
	PASS(errctx, akbasic_structtype_find(table, name, &existing));
	FAIL_NONZERO_RETURN(errctx, (existing >= 0), AKBASIC_ERR_VALUE,
			    "TYPE %s is declared twice", name);
	/*
	 * A type name is a bare word, and so is every verb, so the two share a
	 * namespace whether we like it or not. Refused here with a message that
	 * says so -- left to the parser it comes out as "Expected expression or
	 * literal", pointing at the line rather than at the problem. This is the
	 * same check the scanner already makes for variable names.
	 */
	PASS(errctx, akbasic_verb_lookup(name, &verb));
	FAIL_NONZERO_RETURN(errctx, (verb != NULL), AKBASIC_ERR_VALUE,
			    "TYPE %s: %s is a reserved word and cannot name a type", name, name);
	FAIL_ZERO_RETURN(errctx, (table->count < AKBASIC_MAX_STRUCT_TYPES), AKBASIC_ERR_BOUNDS,
			 "More than %d TYPE declarations", AKBASIC_MAX_STRUCT_TYPES);

	PASS(errctx, aksl_strlen(name, &namelen));
	FAIL_ZERO_RETURN(errctx, (namelen < AKBASIC_MAX_STRUCT_NAME), AKBASIC_ERR_BOUNDS,
			 "TYPE name \"%s\" exceeds the %d character limit",
			 name, AKBASIC_MAX_STRUCT_NAME - 1);
	open = table->count;
	PASS(errctx, aksl_memset(&table->types[open], 0, sizeof(table->types[open])));
	/* aksl_strcpy always terminates and refuses rather than truncates, which
	   is the behaviour this site already wanted -- two long names truncating
	   to the same prefix would collide silently. The length check above stays
	   because it names the limit in the message. */
	PASS(errctx, aksl_strcpy(table->types[open].name, sizeof(table->types[open].name), name));
	table->types[open].used = true;
	table->types[open].firstline = i;
	table->types[open].lastline = -1;
	table->types[open].slotcount = -1;	/* unresolved until pass 3 */
	table->count += 1;
    }

    FAIL_NONZERO_RETURN(errctx, (open >= 0), AKBASIC_ERR_SYNTAX,
			"TYPE %s is never closed with END TYPE", table->types[open >= 0 ? open : 0].name);
    obj->environment->lineno = entry;
    SUCCEED_RETURN(errctx);
}

/* ----------------------------------------------------------------- pass 2 -- */

/** @brief Parse one field declaration line into a descriptor. */
static akerr_ErrorContext *parse_field(akbasic_StructTypeTable *table, akbasic_StructType *type,
				       const char *line, int64_t lineno)
{
    PREPARE_ERROR(errctx);
    char fieldname[STRUCT_WORD_SCRATCH];
    char word[STRUCT_WORD_SCRATCH];
    const char *cursor = NULL;
    akbasic_StructField *field = NULL;
    akbasic_Type valuetype = AKBASIC_TYPE_UNDEFINED;
    size_t namelen = 0;
    bool matched = false;
    int referenced = 0;
    int cmp = 0;
    int i = 0;

    cursor = next_word(skip_lineno(line), fieldname, sizeof(fieldname));
    if ( fieldname[0] == '\0' || fieldname[0] == '\'' ) {
	SUCCEED_RETURN(errctx);			/* a blank line inside the block */
    }
    PASS(errctx, word_is(fieldname, "REM", &matched));
    if ( matched ) {
	SUCCEED_RETURN(errctx);
    }

    FAIL_ZERO_RETURN(errctx, (type->fieldcount < AKBASIC_MAX_STRUCT_FIELDS), AKBASIC_ERR_BOUNDS,
		     "TYPE %s declares more than %d fields", type->name, AKBASIC_MAX_STRUCT_FIELDS);
    for ( i = 0; i < type->fieldcount; i++ ) {
	PASS(errctx, aksl_strcmp(type->fields[i].name, fieldname, &cmp));
	FAIL_NONZERO_RETURN(errctx, (cmp == 0), AKBASIC_ERR_VALUE,
			    "TYPE %s declares %s twice", type->name, fieldname);
    }

    PASS(errctx, type_from_suffix(fieldname, &valuetype));
    PASS(errctx, aksl_strlen(fieldname, &namelen));
    FAIL_ZERO_RETURN(errctx, (namelen < AKBASIC_MAX_STRUCT_NAME), AKBASIC_ERR_BOUNDS,
		     "Field name \"%s\" exceeds the %d character limit",
		     fieldname, AKBASIC_MAX_STRUCT_NAME - 1);
    field = &type->fields[type->fieldcount];
    PASS(errctx, aksl_memset(field, 0, sizeof(*field)));
    /* Refused rather than truncated, for the same reason a type name is. */
    PASS(errctx, aksl_strcpy(field->name, sizeof(field->name), fieldname));
    field->valuetype = valuetype;
    field->typeindex = -1;
    field->offset = -1;

    if ( valuetype != AKBASIC_TYPE_STRUCT ) {
	/* A primitive needs no more words, and anything after it is a typo. */
	cursor = next_word(cursor, word, sizeof(word));
	FAIL_NONZERO_RETURN(errctx, (word[0] != '\0'), AKBASIC_ERR_SYNTAX,
			    "Line %" PRId64 ": %s is a %s field and takes no AS clause",
			    lineno, fieldname,
			    (valuetype == AKBASIC_TYPE_INTEGER ? "integer" :
			     valuetype == AKBASIC_TYPE_FLOAT ? "float" : "string"));
	field->kind = AKBASIC_FIELD_PRIMITIVE;
	field->slotcount = 1;
	type->fieldcount += 1;
	SUCCEED_RETURN(errctx);
    }

    /*
     * An `@` field is a structure, and `@` alone does not say which -- three
     * primitive types fit in three suffix characters and N declared types do
     * not fit in one. So the declaration has to name it.
     */
    cursor = next_word(cursor, word, sizeof(word));
    PASS(errctx, word_is(word, "AS", &matched));
    FAIL_ZERO_RETURN(errctx, matched, AKBASIC_ERR_SYNTAX,
		     "Line %" PRId64 ": %s must name its type -- %s AS TYPENAME, or %s AS PTR TO TYPENAME",
		     lineno, fieldname, fieldname, fieldname);
    cursor = next_word(cursor, word, sizeof(word));
    PASS(errctx, word_is(word, "PTR", &matched));
    if ( matched ) {
	cursor = next_word(cursor, word, sizeof(word));
	PASS(errctx, word_is(word, "TO", &matched));
	FAIL_ZERO_RETURN(errctx, matched, AKBASIC_ERR_SYNTAX,
			 "Line %" PRId64 ": expected PTR TO TYPENAME", lineno);
	cursor = next_word(cursor, word, sizeof(word));
	field->kind = AKBASIC_FIELD_POINTER;
	field->valuetype = AKBASIC_TYPE_POINTER;
	field->slotcount = 1;			/* a reference, whatever it points at */
    } else {
	field->kind = AKBASIC_FIELD_STRUCT;
	field->slotcount = -1;			/* the nested type's size, in pass 3 */
    }

    FAIL_ZERO_RETURN(errctx, (word[0] != '\0'), AKBASIC_ERR_SYNTAX,
		     "Line %" PRId64 ": %s names no type", lineno, fieldname);
    PASS(errctx, akbasic_structtype_find(table, word, &referenced));
    FAIL_ZERO_RETURN(errctx, (referenced >= 0), AKBASIC_ERR_UNDEFINED,
		     "Line %" PRId64 ": %s names TYPE %s, which is not declared",
		     lineno, fieldname, word);
    field->typeindex = referenced;
    type->fieldcount += 1;
    SUCCEED_RETURN(errctx);
}

/* ----------------------------------------------------------------- pass 3 -- */

/**
 * @brief Resolve sizes and offsets, and diagnose by-value recursion.
 *
 * A type whose fields are all sized can be sized. Repeating that until nothing
 * changes resolves every legal arrangement however the declarations were
 * ordered -- and whatever is left unresolved is a group of types that contain
 * each other by value, which has no finite size. That is the diagnosis rather
 * than a stack overflow later.
 */
static akerr_ErrorContext *resolve_sizes(akbasic_Runtime *runtime, akbasic_StructTypeTable *table)
{
    PREPARE_ERROR(errctx);
    bool progress = true;
    int i = 0;
    int f = 0;

    while ( progress ) {
	progress = false;
	for ( i = 0; i < table->count; i++ ) {
	    akbasic_StructType *type = &table->types[i];
	    int offset = 0;
	    bool ready = true;

	    if ( type->slotcount >= 0 ) {
		continue;
	    }
	    for ( f = 0; f < type->fieldcount; f++ ) {
		akbasic_StructField *field = &type->fields[f];
		if ( field->kind == AKBASIC_FIELD_STRUCT ) {
		    if ( table->types[field->typeindex].slotcount < 0 ) {
			ready = false;
			break;
		    }
		    field->slotcount = table->types[field->typeindex].slotcount;
		}
		field->offset = offset;
		offset += field->slotcount;
	    }
	    if ( ready ) {
		type->slotcount = offset;
		progress = true;
	    }
	}
    }

    for ( i = 0; i < table->count; i++ ) {
	runtime->environment->lineno = table->types[i].firstline;
	FAIL_NONZERO_RETURN(errctx, (table->types[i].slotcount < 0), AKBASIC_ERR_VALUE,
			    "TYPE %s contains itself by value, so it has no size. "
			    "A type may only refer to itself through PTR TO",
			    table->types[i].name);
	FAIL_NONZERO_RETURN(errctx, (table->types[i].slotcount == 0), AKBASIC_ERR_VALUE,
			    "TYPE %s declares no fields", table->types[i].name);
    }
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_structtype_scan(akbasic_Runtime *obj)
{
    PREPARE_ERROR(errctx);
    akbasic_StructTypeTable *table = NULL;
    int64_t i = 0;
    int t = 0;
    int64_t entry = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in structtype scan");
    FAIL_ZERO_RETURN(errctx, (obj->environment != NULL), AKERR_NULLPOINTER,
		     "Runtime has no environment; call akbasic_runtime_init() first");
    table = &obj->structtypes;
    entry = obj->environment->lineno;

    /*
     * Drop what the *script* declared and keep what the *host* registered.
     *
     * This prescan runs again on every RUN, so wiping the table outright would
     * unregister a host's types the first time a script was run -- and the host
     * registered them before loading anything, with no way to know it had to do
     * it again. Host types are registered before a program exists, so they are
     * always a prefix; truncating to that prefix keeps every index a field
     * already recorded pointing at the same type.
     */
    for ( t = 0; t < table->count; t++ ) {
	if ( !table->types[t].ishost ) {
	    break;
	}
    }
    for ( i = t; i < table->count; i++ ) {
	PASS(errctx, aksl_memset(&table->types[i], 0, sizeof(table->types[i])));
    }
    table->count = t;

    PASS(errctx, scan_names(obj));

    for ( t = 0; t < table->count; t++ ) {
	akbasic_StructType *type = &table->types[t];
	for ( i = type->firstline + 1; i < type->lastline; i++ ) {
	    if ( obj->source[i].code[0] == '\0' ) {
		continue;
	    }
	    obj->environment->lineno = i;
	    PASS(errctx, parse_field(table, type, obj->source[i].code, i));
	}
    }

    PASS(errctx, resolve_sizes(obj, table));
    obj->environment->lineno = entry;
    SUCCEED_RETURN(errctx);
}