andrew/akbasic
1
0
Fork 0
Code Issues 28 Pull Requests 1 Actions Packages Projects Releases Wiki Activity
Files
e1abcf307aef6ff428fa6475032f4dc26a7340e8
akbasic/src/grammar.c
Andrew Kesterson 6a7c8cd920 Add records: TYPE, DIM ... AS, field access, copy on assign 
BASIC 7.0 has no records at all, so none of this is a port. The `@` suffix was
not invented either: the Go reference reserved IDENTIFIER_STRUCT and never used
it, and src/grammar.c rendered such a leaf as "NOT IMPLEMENTED" until now.

Declaring the type is what buys the storage model. A TYPE states its fields, so
an instance has a known slot count and is laid out exactly as an array is -- one
contiguous run from the same value pool DIM already draws from, with field access
as offset arithmetic. No new pool holds data; the only new table holds
descriptors. A nested value flattens into its container's run, which is why
LINE with two POINTs and a string is five slots rather than three.

Each field takes its type from its own suffix, the same rule every other name
here follows, so a field list needs no type column. An `@` field is the
exception and has to name its type, because three primitive types fit in three
suffix characters and N declared types do not fit in one.

The declaration is prescanned before the program runs, like labels and DATA and
for the same reason: it has to be in effect wherever control goes. Three passes,
each for a case the one before cannot do -- names first so a field can refer to
a type declared later, then field lists, then sizes by repeated resolution. What
never resolves is a cycle of by-value containment, so "a TYPE cannot contain
itself by value" is a diagnosis rather than an assumption, and the message says
to use PTR TO instead.

Assignment copies. That interception is the whole feature and it cannot live in
akbasic_value_clone(), which copies one slot -- and one slot holds a *reference*
to an instance rather than the instance, so going through it would alias. A
structure is intercepted before that path and its slots are copied one at a
time, walking the descriptor rather than memcpy-ing the run, because a pointer
field must copy its reference where a value field must copy its slots.

Two smaller things the work required. All three prescans now sit inside one
ATTEMPT: a malformed declaration is the program's mistake, and it was printing a
stack trace and taking the driver with it, which is the boundary goal 3 exists
to draw. And a fresh variable's structtype is -1 rather than the 0 a memset
leaves, because 0 is a valid type index and every new variable was claiming to
be the first type declared.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
2026-08-01 11:39:47 -04:00

448 lines
16 KiB
C
Raw Blame History

/**
* @file grammar.c
* @brief Implements token and AST leaf construction.
*/
#include <inttypes.h>
#include <stdio.h>
#include <string.h>
#include <akerror.h>
#include <akstdlib.h>
#include <akbasic/error.h>
#include <akbasic/grammar.h>
/* Copy into a leaf's inline identifier/literal buffer, refusing truncation. */
static akerr_ErrorContext *copy_bounded(char *dest, const char *src, const char *what)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (src != NULL), AKERR_NULLPOINTER, "NULL %s", what);
FAIL_ZERO_RETURN(errctx, (strlen(src) < AKBASIC_MAX_STRING_LENGTH),
AKBASIC_ERR_VALUE,
"%s of %zu characters exceeds the %d character limit",
what, strlen(src), AKBASIC_MAX_STRING_LENGTH - 1);
strncpy(dest, src, AKBASIC_MAX_STRING_LENGTH - 1);
dest[AKBASIC_MAX_STRING_LENGTH - 1] = '\0';
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_token_init(akbasic_Token *obj)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL token in init");
obj->tokentype = AKBASIC_TOK_UNDEFINED;
obj->lineno = 0;
obj->lexeme[0] = '\0';
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_leaf_init(akbasic_ASTLeaf *obj, akbasic_LeafType leaftype)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in init");
obj->leaftype = leaftype;
obj->parent = NULL;
obj->left = NULL;
obj->right = NULL;
obj->expr = NULL;
obj->next = NULL;
obj->identifier[0] = '\0';
obj->literal_int = 0;
obj->literal_float = 0.0;
obj->literal_string[0] = '\0';
obj->operator_ = AKBASIC_TOK_UNDEFINED;
SUCCEED_RETURN(errctx);
}
/*
* Take one leaf from the pool. Recursion in clone_into() is bounded by the pool
* capacity, so a cyclic tree exhausts the pool and errors rather than running
* off the stack.
*/
static akerr_ErrorContext *pool_take(akbasic_LeafPool *pool, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (pool != NULL), AKERR_NULLPOINTER, "NULL leaf pool");
FAIL_ZERO_RETURN(errctx, (pool->leaves != NULL), AKERR_NULLPOINTER, "Leaf pool has no storage");
FAIL_ZERO_RETURN(errctx, (pool->next < pool->capacity), AKBASIC_ERR_BOUNDS,
"No more leaves available");
*dest = &pool->leaves[pool->next];
pool->next += 1;
SUCCEED_RETURN(errctx);
}
static akerr_ErrorContext *clone_into(akbasic_ASTLeaf *self, akbasic_LeafPool *pool, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *copy = NULL;
if ( self == NULL ) {
*dest = NULL;
SUCCEED_RETURN(errctx);
}
PASS(errctx, pool_take(pool, &copy));
PASS(errctx, akbasic_leaf_init(copy, self->leaftype));
copy->parent = self->parent;
copy->literal_int = self->literal_int;
copy->literal_float = self->literal_float;
memcpy(copy->literal_string, self->literal_string, sizeof(copy->literal_string));
memcpy(copy->identifier, self->identifier, sizeof(copy->identifier));
copy->operator_ = self->operator_;
PASS(errctx, clone_into(self->left, pool, &copy->left));
PASS(errctx, clone_into(self->right, pool, &copy->right));
PASS(errctx, clone_into(self->expr, pool, &copy->expr));
PASS(errctx, clone_into(self->next, pool, &copy->next));
*dest = copy;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_leaf_clone(akbasic_ASTLeaf *self, akbasic_LeafPool *pool, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in clone");
PASS(errctx, clone_into(self, pool, dest));
SUCCEED_RETURN(errctx);
}
akbasic_ASTLeaf *akbasic_leaf_first_argument(akbasic_ASTLeaf *self)
{
if ( self == NULL ||
self->right == NULL ||
self->right->leaftype != AKBASIC_LEAF_ARGUMENTLIST ||
self->right->operator_ != AKBASIC_TOK_FUNCTION_ARGUMENT ) {
return NULL;
}
return self->right->right;
}
akbasic_ASTLeaf *akbasic_leaf_first_subscript(akbasic_ASTLeaf *self)
{
if ( self == NULL ||
self->expr == NULL ||
self->expr->leaftype != AKBASIC_LEAF_ARGUMENTLIST ||
self->expr->operator_ != AKBASIC_TOK_ARRAY_SUBSCRIPT ) {
return NULL;
}
return self->expr->right;
}
bool akbasic_leaf_is_identifier(akbasic_ASTLeaf *self)
{
return (self != NULL &&
(self->leaftype == AKBASIC_LEAF_IDENTIFIER ||
self->leaftype == AKBASIC_LEAF_IDENTIFIER_INT ||
self->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT ||
self->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING ||
self->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT));
}
akbasic_Type akbasic_leaf_identifier_type(akbasic_ASTLeaf *self)
{
if ( self == NULL ) {
return AKBASIC_TYPE_UNDEFINED;
}
switch ( self->leaftype ) {
case AKBASIC_LEAF_IDENTIFIER_INT:
return AKBASIC_TYPE_INTEGER;
case AKBASIC_LEAF_IDENTIFIER_FLOAT:
return AKBASIC_TYPE_FLOAT;
case AKBASIC_LEAF_IDENTIFIER_STRING:
return AKBASIC_TYPE_STRING;
case AKBASIC_LEAF_IDENTIFIER_STRUCT:
return AKBASIC_TYPE_STRUCT;
default:
/* A bare identifier is a label, and a label has no storage to fill. */
return AKBASIC_TYPE_UNDEFINED;
}
}
bool akbasic_leaf_is_literal(akbasic_ASTLeaf *self)
{
return (self != NULL &&
(self->leaftype == AKBASIC_LEAF_LITERAL_INT ||
self->leaftype == AKBASIC_LEAF_LITERAL_FLOAT ||
self->leaftype == AKBASIC_LEAF_LITERAL_STRING));
}
akerr_ErrorContext *akbasic_leaf_new_comparison(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *left, akbasic_TokenType op, akbasic_ASTLeaf *right)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_comparison");
FAIL_ZERO_RETURN(errctx, (left != NULL && right != NULL), AKERR_NULLPOINTER,
"nil pointer arguments");
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_COMPARISON));
obj->left = left;
obj->right = right;
switch ( op ) {
case AKBASIC_TOK_LESS_THAN:
case AKBASIC_TOK_LESS_THAN_EQUAL:
case AKBASIC_TOK_NOT_EQUAL:
case AKBASIC_TOK_GREATER_THAN:
case AKBASIC_TOK_GREATER_THAN_EQUAL:
SUCCEED_RETURN(errctx);
default:
FAIL_RETURN(errctx, AKBASIC_ERR_SYNTAX, "Invalid operator %d for comparison", (int)op);
}
}
akerr_ErrorContext *akbasic_leaf_new_binary(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *left, akbasic_TokenType op, akbasic_ASTLeaf *right)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_binary");
FAIL_ZERO_RETURN(errctx, (left != NULL && right != NULL), AKERR_NULLPOINTER,
"nil pointer arguments");
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_BINARY));
obj->left = left;
obj->right = right;
obj->operator_ = op;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_leaf_new_unary(akbasic_ASTLeaf *obj, akbasic_TokenType op, akbasic_ASTLeaf *operand)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_unary");
FAIL_ZERO_RETURN(errctx, (operand != NULL), AKERR_NULLPOINTER, "nil pointer arguments");
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_UNARY));
/*
* .left, not .right. An argument list chains its arguments through .right,
* so an operand there is indistinguishable from a second argument: ABS(-9)
* counted as two and was refused. See the note on the declaration.
*/
obj->left = operand;
obj->operator_ = op;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_leaf_new_function(akbasic_ASTLeaf *obj, const char *fname, akbasic_ASTLeaf *right)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_function");
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_FUNCTION));
obj->right = right;
obj->operator_ = AKBASIC_TOK_COMMAND;
PASS(errctx, copy_bounded(obj->identifier, fname, "function name"));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_leaf_new_command(akbasic_ASTLeaf *obj, const char *cmdname, akbasic_ASTLeaf *right)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_command");
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_COMMAND));
obj->right = right;
obj->operator_ = AKBASIC_TOK_COMMAND;
PASS(errctx, copy_bounded(obj->identifier, cmdname, "command name"));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_leaf_new_immediate_command(akbasic_ASTLeaf *obj, const char *cmdname, akbasic_ASTLeaf *right)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_immediate_command");
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_COMMAND_IMMEDIATE));
obj->right = right;
obj->operator_ = AKBASIC_TOK_COMMAND_IMMEDIATE;
PASS(errctx, copy_bounded(obj->identifier, cmdname, "command name"));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_leaf_new_branch(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *expr, akbasic_ASTLeaf *trueleaf, akbasic_ASTLeaf *falseleaf)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_branch");
FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "nil pointer arguments");
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_BRANCH));
obj->expr = expr;
obj->left = trueleaf;
obj->right = falseleaf;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_leaf_new_grouping(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *expr)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_grouping");
FAIL_ZERO_RETURN(errctx, (expr != NULL), AKERR_NULLPOINTER, "nil pointer arguments");
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_GROUPING));
obj->expr = expr;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_leaf_new_literal_int(akbasic_ASTLeaf *obj, const char *lexeme)
{
PREPARE_ERROR(errctx);
long long value = 0;
int base = 10;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_literal_int");
FAIL_ZERO_RETURN(errctx, (lexeme != NULL), AKERR_NULLPOINTER, "NULL lexeme in new_literal_int");
FAIL_ZERO_RETURN(errctx, (lexeme[0] != '\0'), AKBASIC_ERR_VALUE, "Empty integer literal");
/*
* Base 10 unless the lexeme is prefixed `0x`. The reference selects base 8
* for *any* lexeme starting with '0' (basicgrammar.go:224), so `PRINT 010`
* printed 8 and `PRINT 08` was a parse error -- TODO.md section 6 item 10.
* Commodore BASIC has no octal literals, and a leading zero in a listing is
* padding, not a radix.
*/
if ( strlen(lexeme) > 2 && strncmp(lexeme, "0x", 2) == 0 ) {
base = 16;
}
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_LITERAL_INT));
PASS(errctx, aksl_strtoll(lexeme, NULL, base, &value));
obj->literal_int = (int64_t)value;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_leaf_new_literal_float(akbasic_ASTLeaf *obj, const char *lexeme)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_literal_float");
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_LITERAL_FLOAT));
PASS(errctx, aksl_atof(lexeme, &obj->literal_float));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_leaf_new_literal_string(akbasic_ASTLeaf *obj, const char *lexeme)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_literal_string");
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_LITERAL_STRING));
PASS(errctx, copy_bounded(obj->literal_string, lexeme, "string literal"));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_leaf_new_identifier(akbasic_ASTLeaf *obj, akbasic_LeafType leaftype, const char *lexeme)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL leaf in new_identifier");
PASS(errctx, akbasic_leaf_init(obj, leaftype));
PASS(errctx, copy_bounded(obj->identifier, lexeme, "identifier"));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_leaf_new_field(akbasic_ASTLeaf *obj, akbasic_ASTLeaf *base, const char *name, akbasic_TokenType operator_)
{
PREPARE_ERROR(errctx);
FAIL_ZERO_RETURN(errctx, (obj != NULL && base != NULL), AKERR_NULLPOINTER,
"NULL leaf in new_field");
PASS(errctx, akbasic_leaf_init(obj, AKBASIC_LEAF_FIELD));
PASS(errctx, copy_bounded(obj->identifier, name, "field name"));
/*
* The base hangs off `.left`, which is free for this leaf type and is where
* a unary leaf already keeps its operand. Deliberately not `.right` or
* `.expr`: this header's own note records three separate defects that came
* from giving one link field two meanings, and a field chain is the fourth
* thing that would have wanted one.
*/
obj->left = base;
base->parent = obj;
obj->operator_ = operator_;
SUCCEED_RETURN(errctx);
}
static const char *operator_to_str(akbasic_TokenType op)
{
switch ( op ) {
case AKBASIC_TOK_EQUAL: return "=";
case AKBASIC_TOK_LESS_THAN: return "<";
case AKBASIC_TOK_GREATER_THAN: return ">";
case AKBASIC_TOK_LESS_THAN_EQUAL: return "<=";
case AKBASIC_TOK_GREATER_THAN_EQUAL: return ">=";
case AKBASIC_TOK_NOT_EQUAL: return "<>";
case AKBASIC_TOK_PLUS: return "+";
case AKBASIC_TOK_MINUS: return "-";
case AKBASIC_TOK_STAR: return "*";
case AKBASIC_TOK_LEFT_SLASH: return "/";
case AKBASIC_TOK_CARAT: return "^";
case AKBASIC_TOK_NOT: return "NOT";
case AKBASIC_TOK_AND: return "AND";
case AKBASIC_TOK_OR: return "OR";
default: return "";
}
}
akerr_ErrorContext *akbasic_leaf_to_string(akbasic_ASTLeaf *self, char *dest, size_t len)
{
PREPARE_ERROR(errctx);
char sub1[AKBASIC_MAX_STRING_LENGTH];
char sub2[AKBASIC_MAX_STRING_LENGTH];
FAIL_ZERO_RETURN(errctx, (self != NULL), AKERR_NULLPOINTER, "NULL leaf in to_string");
FAIL_ZERO_RETURN(errctx, (dest != NULL), AKERR_NULLPOINTER, "NULL destination in to_string");
FAIL_ZERO_RETURN(errctx, (len > 0), AKBASIC_ERR_BOUNDS, "Zero-length destination in to_string");
switch ( self->leaftype ) {
case AKBASIC_LEAF_LITERAL_INT:
snprintf(dest, len, "%" PRId64, self->literal_int);
break;
case AKBASIC_LEAF_LITERAL_FLOAT:
snprintf(dest, len, "%f", self->literal_float);
break;
case AKBASIC_LEAF_LITERAL_STRING:
snprintf(dest, len, "%s", self->literal_string);
break;
case AKBASIC_LEAF_IDENTIFIER_INT:
case AKBASIC_LEAF_IDENTIFIER_FLOAT:
case AKBASIC_LEAF_IDENTIFIER_STRING:
case AKBASIC_LEAF_IDENTIFIER:
snprintf(dest, len, "%s", self->identifier);
break;
case AKBASIC_LEAF_IDENTIFIER_STRUCT:
snprintf(dest, len, "%s", self->identifier);
break;
case AKBASIC_LEAF_FIELD:
PASS(errctx, akbasic_leaf_to_string(self->left, sub1, sizeof(sub1)));
snprintf(dest, len, "%s%s%s", sub1,
(self->operator_ == AKBASIC_TOK_ARROW ? "->" : "."), self->identifier);
break;
case AKBASIC_LEAF_UNARY:
PASS(errctx, akbasic_leaf_to_string(self->left, sub1, sizeof(sub1)));
snprintf(dest, len, "(%s %s)", operator_to_str(self->operator_), sub1);
break;
case AKBASIC_LEAF_BINARY:
PASS(errctx, akbasic_leaf_to_string(self->left, sub1, sizeof(sub1)));
PASS(errctx, akbasic_leaf_to_string(self->right, sub2, sizeof(sub2)));
snprintf(dest, len, "(%s %s %s)", operator_to_str(self->operator_), sub1, sub2);
break;
case AKBASIC_LEAF_GROUPING:
PASS(errctx, akbasic_leaf_to_string(self->expr, sub1, sizeof(sub1)));
snprintf(dest, len, "(group %s)", sub1);
break;
case AKBASIC_LEAF_COMMAND:
case AKBASIC_LEAF_COMMAND_IMMEDIATE:
case AKBASIC_LEAF_FUNCTION:
/*
* The reference falls through to Go's %+v struct dump here, which has no
* useful C equivalent. Print something a test can assert on instead.
*/
snprintf(dest, len, "(%s)", self->identifier);
break;
default:
snprintf(dest, len, "(leaf %d)", (int)self->leaftype);
break;
}
SUCCEED_RETURN(errctx);
}
Reference in New Issue View Git Blame Copy Permalink