andrew/akbasic
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

Let DEF take structure parameters, and give call scopes back

Browse Source 
DEF AREA(S@ AS RECT) = S@.W# * S@.H#
    DEF POKEIT(P@ AS PTR TO RECT)

A parameter names its type, exactly as DIM does. A bare `DEF F(S@)` is refused:
@ says "a structure" without saying which, so it does not state a contract the
way S$ does, and accepting it would mean checking fields at the call rather than
at the declaration -- which is the hole naming the type closes. The cost is that
there are no generic functions, and that is a real loss rather than an oversight.

Passing is by value, because a parameter is bound by assignment and assignment
copies; a pointer parameter copies its reference and lets a function change its
caller's record on purpose. Neither is a special rule. What a structure
parameter does need is its storage prepared before the copy, since a structure
variable is a run of slots and there is nothing to copy into until the run
exists.

A DEF parameter list is no longer parsed as an argument list, because a
parameter is a declaration rather than an expression: `S@ AS RECT` stopped that
parser dead with "Unbalanced parenthesis".

akbasic_value_is_truthy() learned that a pointer is true when it points at
something, which had to come with this. Without it there is no way to test for
the end of a list at all -- comparing a pointer to 0 reads a numeric field it
does not carry and answers whatever that field held. A structure is deliberately
given no truth value: it always exists, so the question has no answer worth
guessing at.

And a regression I introduced last commit, plus the older one underneath it.
prev_environment() released a scope but not the variables the scope created, so
a call leaked one slot per parameter and two hundred calls exhausted the
128-slot pool. Giving each DEF call its own scope made that reachable; it was
there for GOSUB all along, measured on a stashed build -- a subroutine with a
local of its own failed after about 128 calls before any of this work. The
release is safe because a scope's table holds only what it created, and it is
the variable slot that comes back rather than its storage, so a pointer into a
record DIMmed in that scope stays sound.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
This commit is contained in:
Andrew Kesterson
2026-08-01 13:05:32 -04:00
parent 00daa17a47
commit c1d06ee4b8
8 changed files with 452 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

98
src/parser_commands.c
View File

@@ -673,6 +673,90 @@ akerr_ErrorContext *akbasic_parse_dim(akbasic_Parser *parser, akbasic_ASTLeaf **
* so the environment is told to skip forward to that RETURN rather than execute
* the body during the definition.
*/
/**
* @brief A `DEF` parameter list, which is not an ordinary argument list.
*
* `akbasic_parser_argument_list()` parses *expressions*, and a parameter is a
* declaration -- `S@ AS RECT` is not an expression and stops that parser dead
* with "Unbalanced parenthesis". So this reads the list itself.
*
* **A structure parameter must name its type.** `@` says "a structure" without
* saying which: three primitive types fit in three suffix characters and N
* declared types do not fit in one, so `X$` fully states its contract and `X@`
* does not. A bare `X@` is refused rather than treated as "any structure",
* because that is duck typing and it puts back exactly the hole naming the type
* closes. The cost is that there are no generic functions, and it is a real one.
*
* The type name is parked on the parameter leaf in `literal_string`, with
* `literal_int` recording `PTR TO` -- the same two free fields, for the same
* reason, that `DIM ... AS` uses.
*/
static akerr_ErrorContext *parse_def_parameters(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
akbasic_ASTLeaf *arglist = NULL;
akbasic_ASTLeaf *param = NULL;
akbasic_ASTLeaf *tail = NULL;
akbasic_Token *word = NULL;
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_LEFT_PAREN),
AKBASIC_ERR_SYNTAX, "Expected an argument list after DEF <name>");
PASS(errctx, akbasic_parser_new_leaf(parser, &arglist));
arglist->leaftype = AKBASIC_LEAF_ARGUMENTLIST;
arglist->operator_ = AKBASIC_TOK_FUNCTION_ARGUMENT;
do {
PASS(errctx, akbasic_parser_primary(parser, &param));
FAIL_ZERO_RETURN(errctx,
(param != NULL &&
(param->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING ||
param->leaftype == AKBASIC_LEAF_IDENTIFIER_INT ||
param->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT ||
param->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT)),
AKBASIC_ERR_SYNTAX,
"Only variable identifiers are valid arguments for DEF");
if ( param->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT ) {
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_IDENTIFIER),
AKBASIC_ERR_SYNTAX,
"%s must name its type: %s AS TYPENAME, or %s AS PTR TO TYPENAME",
param->identifier, param->identifier, param->identifier);
PASS(errctx, akbasic_parser_previous(parser, &word));
FAIL_ZERO_RETURN(errctx, (strcasecmp(word->lexeme, "AS") == 0), AKBASIC_ERR_SYNTAX,
"Expected AS after %s, not %s", param->identifier, word->lexeme);
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_IDENTIFIER),
AKBASIC_ERR_SYNTAX, "Expected a type name after AS");
PASS(errctx, akbasic_parser_previous(parser, &word));
if ( strcasecmp(word->lexeme, "PTR") == 0 ) {
param->literal_int = 1;
/* `TO` is already a verb -- FOR ... TO owns it -- so it arrives
as a command token rather than an identifier. */
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_COMMAND),
AKBASIC_ERR_SYNTAX, "Expected TO after PTR");
PASS(errctx, akbasic_parser_previous(parser, &word));
FAIL_ZERO_RETURN(errctx, (strcasecmp(word->lexeme, "TO") == 0), AKBASIC_ERR_SYNTAX,
"Expected PTR TO TYPENAME, not PTR %s", word->lexeme);
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_IDENTIFIER),
AKBASIC_ERR_SYNTAX, "Expected a type name after PTR TO");
PASS(errctx, akbasic_parser_previous(parser, &word));
}
snprintf(param->literal_string, sizeof(param->literal_string), "%s", word->lexeme);
}
if ( tail == NULL ) {
arglist->right = param;
} else {
tail->next = param;
}
tail = param;
} while ( akbasic_parser_match1(parser, AKBASIC_TOK_COMMA) );
FAIL_ZERO_RETURN(errctx, akbasic_parser_match1(parser, AKBASIC_TOK_RIGHT_PAREN),
AKBASIC_ERR_SYNTAX, "Expected ) after the argument list");
*dest = arglist;
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_parse_def(akbasic_Parser *parser, akbasic_ASTLeaf **dest)
{
PREPARE_ERROR(errctx);
@@ -680,7 +764,6 @@ akerr_ErrorContext *akbasic_parse_def(akbasic_Parser *parser, akbasic_ASTLeaf **
akbasic_ASTLeaf *identifier = NULL;
akbasic_ASTLeaf *arglist = NULL;
akbasic_ASTLeaf *expression = NULL;
akbasic_ASTLeaf *walk = NULL;
akbasic_ASTLeaf *command = NULL;
akbasic_FunctionDef *fndef = NULL;
size_t i = 0;
@@ -689,18 +772,7 @@ akerr_ErrorContext *akbasic_parse_def(akbasic_Parser *parser, akbasic_ASTLeaf **
FAIL_ZERO_RETURN(errctx, (identifier->leaftype == AKBASIC_LEAF_IDENTIFIER),
AKBASIC_ERR_SYNTAX, "Expected identifier");
PASS(errctx, akbasic_parser_argument_list(parser, AKBASIC_TOK_FUNCTION_ARGUMENT, true, &arglist));
FAIL_ZERO_RETURN(errctx, (arglist != NULL), AKBASIC_ERR_SYNTAX,
"Expected argument list (identifier names)");
for ( walk = arglist->right; walk != NULL; walk = walk->next ) {
FAIL_ZERO_RETURN(errctx,
(walk->leaftype == AKBASIC_LEAF_IDENTIFIER_STRING ||
walk->leaftype == AKBASIC_LEAF_IDENTIFIER_INT ||
walk->leaftype == AKBASIC_LEAF_IDENTIFIER_FLOAT),
AKBASIC_ERR_SYNTAX,
"Only variable identifiers are valid arguments for DEF");
}
PASS(errctx, parse_def_parameters(parser, &arglist));
PASS(errctx, akbasic_runtime_new_function(runtime, &fndef));

94
src/runtime.c
View File

@@ -122,12 +122,39 @@ akerr_ErrorContext *akbasic_runtime_prev_environment(akbasic_Runtime *obj)
{
PREPARE_ERROR(errctx);
akbasic_Environment *popped = NULL;
int i = 0;
FAIL_ZERO_RETURN(errctx, (obj != NULL), AKERR_NULLPOINTER, "NULL runtime in prev_environment");
FAIL_ZERO_RETURN(errctx, (obj->environment->parent != NULL), AKBASIC_ERR_ENVIRONMENT,
"No previous environment to return to");
popped = obj->environment;
obj->environment = popped->parent;
/*
* Give back the variables this scope created, as well as the scope.
*
* Safe because a scope's own table holds *only* what it created:
* akbasic_environment_get() walks up to find an outer variable and returns
* it without caching a reference here, so nothing in this table belongs to
* anybody else. That is worth stating, because if it ever started caching,
* this loop would free a parent's variable out from under it.
*
* It is the variable *slot* that comes back, not its storage. The value pool
* never frees, so a pointer into a record DIMmed in this scope stays sound
* after the scope is gone -- which is a documented property of structures,
* not an accident this could take away.
*
* Without it, one variable leaked per call: a function called two hundred
* times exhausted the 128-slot pool and reported "Maximum runtime variables
* reached" on a four-line program.
*/
for ( i = 0; i < popped->variables.capacity; i++ ) {
akbasic_Variable *variable = (akbasic_Variable *)popped->variables.slots[i].value;
if ( popped->variables.slots[i].used && variable != NULL ) {
variable->used = false;
}
}
/*
* Release it. The reference never does, which is a leak the GC papers over;
* here the pool is finite, so an unreleased environment is a bug that shows
@@ -758,6 +785,67 @@ akerr_ErrorContext *akbasic_runtime_interpret_immediate(akbasic_Runtime *obj, ak
SUCCEED_RETURN(errctx);
}
/**
* @brief Give a structure parameter storage in the call's scope, then fill it.
*
* A primitive parameter needs no preparation: `akbasic_environment_assign()`
* creates the variable and writes a value into it. A structure does, because a
* structure variable is a *run* of slots sized by its type and there is nothing
* to copy into until that run exists -- which is the same thing `DIM ... AS`
* does, done here on the caller's behalf.
*
* **Passing is by value, because assignment is.** A structure argument is
* deep-copied, so a function cannot change its caller's record by accident; a
* pointer argument copies the reference, which is how a function changes one on
* purpose. Neither is a special rule -- both fall out of the parameter being
* assigned like any other variable.
*/
static akerr_ErrorContext *bind_structure_parameter(akbasic_Runtime *obj, akbasic_Environment *callenv,
akbasic_ASTLeaf *param, akbasic_Value *argvalue)
{
PREPARE_ERROR(errctx);
akbasic_Variable *variable = NULL;
int64_t sizes[1] = { 1 };
int typeindex = -1;
bool ispointer = (param->literal_int != 0);
PASS(errctx, akbasic_structtype_find(&obj->structtypes, param->literal_string, &typeindex));
FAIL_ZERO_RETURN(errctx, (typeindex >= 0), AKBASIC_ERR_UNDEFINED,
"%s is declared AS %s, which is not a type",
param->identifier, param->literal_string);
/*
* The type check a caller actually meets. `DEF AREA(S@ AS RECT)` handed a
* COORD is refused here, by name -- which is the whole reason a structure
* parameter has to name its type rather than saying only `@`.
*/
FAIL_ZERO_RETURN(errctx,
(argvalue->valuetype == (ispointer ? AKBASIC_TYPE_POINTER : AKBASIC_TYPE_STRUCT)),
AKBASIC_ERR_TYPE,
"%s expects %s%s", param->identifier,
(ispointer ? "a pointer to " : "a "), obj->structtypes.types[typeindex].name);
FAIL_ZERO_RETURN(errctx, (argvalue->structtype == typeindex), AKBASIC_ERR_TYPE,
"%s is %s%s and cannot take a %s", param->identifier,
(ispointer ? "a pointer to " : "a "),
obj->structtypes.types[typeindex].name,
obj->structtypes.types[argvalue->structtype].name);
PASS(errctx, akbasic_environment_create(callenv, param->identifier, &variable));
sizes[0] = (ispointer ? 1 : obj->structtypes.types[typeindex].slotcount);
PASS(errctx, akbasic_variable_init(variable, &obj->valuepool, sizes, 1));
variable->valuetype = AKBASIC_TYPE_STRUCT;
variable->structtype = typeindex;
variable->ispointer = ispointer;
if ( ispointer ) {
PASS(errctx, akbasic_value_clone(argvalue, &variable->values[0]));
SUCCEED_RETURN(errctx);
}
PASS(errctx, akbasic_struct_init_slots(obj, typeindex, variable->values));
PASS(errctx, akbasic_struct_copy(obj, typeindex, argvalue->structbase, variable->values));
SUCCEED_RETURN(errctx);
}
akerr_ErrorContext *akbasic_runtime_user_function(akbasic_Runtime *obj, akbasic_ASTLeaf *expr, akbasic_Value **dest)
{
PREPARE_ERROR(errctx);
@@ -808,7 +896,11 @@ akerr_ErrorContext *akbasic_runtime_user_function(akbasic_Runtime *obj, akbasic_
while ( leafptr != NULL && argptr != NULL ) {
PASS(errctx, akbasic_runtime_evaluate(obj, leafptr, &argvalue));
obj->environment = callenv;
PASS(errctx, akbasic_environment_assign(callenv, argptr, argvalue, &unused));
if ( argptr->leaftype == AKBASIC_LEAF_IDENTIFIER_STRUCT ) {
PASS(errctx, bind_structure_parameter(obj, callenv, argptr, argvalue));
} else {
PASS(errctx, akbasic_environment_assign(callenv, argptr, argvalue, &unused));
}
obj->environment = targetenv;
leafptr = leafptr->next;
argptr = argptr->next;

12
src/value.c
View File

@@ -287,6 +287,18 @@ bool akbasic_value_is_truthy(akbasic_Value *self)
switch ( self->valuetype ) {
case AKBASIC_TYPE_BOOLEAN:
return (self->boolvalue != 0);
case AKBASIC_TYPE_POINTER:
/*
* **A pointer is true when it points at something**, which is what makes
* `IF P@ THEN` the way to ask. Without it there is no way to test for the
* end of a list at all: comparing a pointer to 0 reads a numeric field it
* does not carry and answers whatever that field happened to hold.
*
* A *structure* is deliberately not given a truth value. It always
* exists, so the question has no answer worth guessing at, and falling
* through to false keeps `IF A@ THEN` from quietly meaning something.
*/
return (self->structbase != NULL);
case AKBASIC_TYPE_INTEGER:
return (self->intval != 0);
case AKBASIC_TYPE_FLOAT: