akbasic/src/runtime_struct.c

/**
 * @file runtime_struct.c
 * @brief The structure verbs and the field machinery behind `.` and `->`.
 *
 * **A structure is laid out exactly as an array is**, and that falls out of
 * declaring the type: `TYPE` states the fields, so an instance has a known slot
 * count and takes one contiguous run from the same value pool `DIM` already
 * draws from. A field access is then offset arithmetic against an offset
 * src/structtype.c computed before the program ran.
 *
 * Two things ride on a value to say which instance is meant -- `structtype` and
 * `structbase`, both added to akbasic_Value for this and neither shared with the
 * numeric fields. A `STRUCT` value and a `POINTER` value carry the *same*
 * reference; what differs is what assignment does with it. A structure copies
 * the slots it points at and a pointer copies the reference, which is the whole
 * of the strict-pointer rule and the reason `.` and `->` are kept apart from the
 * scanner all the way down to here.
 *
 * Copy is **deep through values and stops at pointers**, as it does for a C
 * struct holding a pointer. Because a `TYPE` cannot contain itself by value, the
 * depth of a copy is fixed by the type graph before the program starts, so no
 * copy can recurse forever and none needs a runtime depth counter. Only
 * rendering does, because a pointer can make the graph cyclic.
 */

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

#include <akerror.h>

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

#include "verbs.h"

/* Most verbs answer "did something happen"; this is that answer. */
#define SUCCEED_TRUE(__obj, __dest)			\
    do {						\
	*(__dest) = &(__obj)->staticTrueValue;		\
    } while ( 0 )

akerr_ErrorContext *akbasic_struct_describe(akbasic_Runtime *obj, int typeindex, akbasic_Value *base,
					    bool pointer, akbasic_Value *dest)
{
    PREPARE_ERROR(errctx);

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in struct describe");
    PASS(errctx, akbasic_value_zero(dest));
    dest->valuetype = (pointer ? AKBASIC_TYPE_POINTER : AKBASIC_TYPE_STRUCT);
    dest->structtype = typeindex;
    dest->structbase = base;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_struct_copy(akbasic_Runtime *obj, int typeindex,
					akbasic_Value *src, akbasic_Value *dest)
{
    PREPARE_ERROR(errctx);
    akbasic_StructType *type = NULL;
    int i = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && src != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in struct copy");
    FAIL_ZERO_RETURN(errctx, (typeindex >= 0 && typeindex < obj->structtypes.count),
		     AKBASIC_ERR_BOUNDS, "Structure type index %d is out of range", typeindex);
    type = &obj->structtypes.types[typeindex];

    if ( src == dest ) {
	SUCCEED_RETURN(errctx);
    }
    /*
     * Slot by slot rather than one memcpy of the run, because the two are not
     * the same thing: a nested pointer field must copy its reference and a
     * nested value field must copy its slots, and only walking the descriptor
     * knows which is which. A memcpy would give the right answer today and the
     * wrong one the moment a field needs anything but a byte copy -- a host
     * binding, for instance.
     */
    for ( i = 0; i < type->slotcount; i++ ) {
	PASS(errctx, akbasic_value_clone(&src[i], &dest[i]));
    }
    SUCCEED_RETURN(errctx);
}

/**
 * @brief Resolve a field-access leaf to the slot it addresses.
 *
 * Walks the chain from the base outward, so `A@.POS@.X#` resolves `A@`, then
 * `POS@` within it, then `X#` within that -- each step against a type the
 * declaration already fixed, which is why a misspelled field can be refused by
 * name at all.
 */
akerr_ErrorContext *akbasic_struct_resolve(akbasic_Runtime *obj, akbasic_ASTLeaf *expr,
					   akbasic_StructField **fielddest, akbasic_Value **slotdest)
{
    PREPARE_ERROR(errctx);
    akbasic_Value *basevalue = NULL;
    akbasic_StructField *field = NULL;
    akbasic_Value *slot = NULL;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && expr != NULL && slotdest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in struct resolve");
    FAIL_ZERO_RETURN(errctx, (expr->leaftype == AKBASIC_LEAF_FIELD), AKBASIC_ERR_SYNTAX,
		     "Not a field access");

    PASS(errctx, akbasic_runtime_evaluate(obj, expr->left, &basevalue));

    /*
     * The strict-pointer rule, and the only place it is enforced. `.` requires a
     * structure and `->` requires a pointer to one; neither stands in for the
     * other, so a reader always knows from the spelling whether the thing on the
     * left is a copy or a reference to somebody else's data.
     */
    if ( expr->operator_ == AKBASIC_TOK_ARROW ) {
	FAIL_ZERO_RETURN(errctx, (basevalue->valuetype == AKBASIC_TYPE_POINTER),
			 AKBASIC_ERR_TYPE,
			 "-> needs a pointer on its left; use . to reach a field of a structure");
	FAIL_ZERO_RETURN(errctx, (basevalue->structbase != NULL), AKBASIC_ERR_VALUE,
			 "This pointer is not pointing at anything yet; POINT it AT a structure first");
    } else {
	FAIL_ZERO_RETURN(errctx, (basevalue->valuetype == AKBASIC_TYPE_STRUCT),
			 AKBASIC_ERR_TYPE,
			 (basevalue->valuetype == AKBASIC_TYPE_POINTER
			  ? "'.' needs a structure on its left; use -> to reach a field through a pointer"
			  : "'.' needs a structure on its left"));
	FAIL_ZERO_RETURN(errctx, (basevalue->structbase != NULL), AKBASIC_ERR_VALUE,
			 "This structure has no storage; DIM it AS a type first");
    }

    PASS(errctx, akbasic_structtype_field(&obj->structtypes, basevalue->structtype,
					  expr->identifier, &field));
    slot = basevalue->structbase + field->offset;
    if ( fielddest != NULL ) {
	*fielddest = field;
    }
    *slotdest = slot;
    SUCCEED_RETURN(errctx);
}

akerr_ErrorContext *akbasic_struct_evaluate_field(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    akbasic_StructField *field = NULL;
    akbasic_Value *slot = NULL;
    akbasic_Value *out = NULL;

    PASS(errctx, akbasic_struct_resolve(obj, expr, &field, &slot));

    /*
     * A nested structure evaluates to a description of where it lives, not to a
     * copy of it: `A@.POS@.X#` has to reach through it, and `B@ = A@.POS@` has
     * to know how many slots to copy. The copy happens in assignment, which is
     * the one place that knows a copy was asked for.
     */
    if ( field->kind == AKBASIC_FIELD_STRUCT ) {
	PASS(errctx, akbasic_environment_new_value(obj->environment, &out));
	PASS(errctx, akbasic_struct_describe(obj, field->typeindex, slot, false, out));
	*dest = out;
	SUCCEED_RETURN(errctx);
    }
    *dest = slot;
    SUCCEED_RETURN(errctx);
}

/**
 * @brief Render a structure the way PRINT does.
 *
 * `RECT(W#=3, H#=4)`. Bounded by depth because a pointer can make the graph
 * cyclic -- copy cannot follow one, but rendering must, or a linked list would
 * print as an unhelpful `NODE(VAL#=1, NEXT@=...)` and stop being worth printing.
 */
akerr_ErrorContext *akbasic_struct_to_string(akbasic_Runtime *obj, int typeindex, akbasic_Value *base,
					     int depth, char *dest, size_t len)
{
    PREPARE_ERROR(errctx);
    char rendered[AKBASIC_MAX_STRING_LENGTH];
    akbasic_StructType *type = NULL;
    size_t used = 0;
    int written = 0;
    int i = 0;

    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in struct to_string");
    FAIL_ZERO_RETURN(errctx, (typeindex >= 0 && typeindex < obj->structtypes.count),
		     AKBASIC_ERR_BOUNDS, "Structure type index %d is out of range", typeindex);
    type = &obj->structtypes.types[typeindex];

    if ( depth >= AKBASIC_MAX_STRUCT_DEPTH ) {
	snprintf(dest, len, "%s(...)", type->name);
	SUCCEED_RETURN(errctx);
    }
    written = snprintf(dest, len, "%s(", type->name);
    used = (written > 0 ? (size_t)written : 0);

    for ( i = 0; i < type->fieldcount && used + 1 < len; i++ ) {
	akbasic_StructField *field = &type->fields[i];
	akbasic_Value *slot = base + field->offset;

	switch ( field->kind ) {
	case AKBASIC_FIELD_STRUCT:
	    PASS(errctx, akbasic_struct_to_string(obj, field->typeindex, slot, depth + 1,
						  rendered, sizeof(rendered)));
	    break;
	case AKBASIC_FIELD_POINTER:
	    if ( slot->structbase == NULL ) {
		snprintf(rendered, sizeof(rendered), "NOTHING");
	    } else {
		PASS(errctx, akbasic_struct_to_string(obj, slot->structtype, slot->structbase,
						      depth + 1, rendered, sizeof(rendered)));
	    }
	    break;
	default:
	    PASS(errctx, akbasic_value_to_string(slot, rendered, sizeof(rendered)));
	    break;
	}
	written = snprintf(dest + used, len - used, "%s%s=%s",
			   (i == 0 ? "" : ", "), field->name, rendered);
	if ( written < 0 || (size_t)written >= len - used ) {
	    break;
	}
	used += (size_t)written;
    }
    if ( used + 1 < len ) {
	snprintf(dest + used, len - used, ")");
    }
    SUCCEED_RETURN(errctx);
}

/* ----------------------------------------------------------------- TYPE --- */

akerr_ErrorContext *akbasic_cmd_type(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value *lval, akbasic_Value *rval, akbasic_Value **dest)
{
    PREPARE_ERROR(errctx);
    int block = -1;

    (void)expr; (void)lval; (void)rval;
    FAIL_ZERO_RETURN(errctx, (obj != NULL && dest != NULL), AKERR_NULLPOINTER,
		     "NULL argument in TYPE");

    /*
     * The declaration was read before the program started; what is left to do at
     * run time is to *not* execute the block. Its field lines are declarations,
     * and letting them run would evaluate each field name as a bare identifier
     * and quietly create a global of that name -- so this jumps past END TYPE.
     */
    PASS(errctx, akbasic_structtype_block_at(&obj->structtypes, obj->environment->lineno, &block));
    FAIL_ZERO_RETURN(errctx, (block >= 0), AKBASIC_ERR_STATE,
		     "TYPE was not read by the prescan; this line is not the start of a block");
    obj->environment->nextline = obj->structtypes.types[block].lastline + 1;
    SUCCEED_TRUE(obj, dest);
    SUCCEED_RETURN(errctx);
}