Still doesn't compile, but I think excellent progress.

This commit is contained in:
Simon Brooke 2026-04-28 11:54:15 +01:00
parent dbeb99759a
commit aac4669a3d
34 changed files with 1128 additions and 673 deletions

View file

@ -15,6 +15,8 @@
#include <wctype.h>
#include "debug.h"
#include "environment/privileged_keywords.h"
#include "memory/node.h"
#include "memory/pointer.h"
#include "memory/pso.h"
@ -26,6 +28,7 @@
#include "ops/stack_ops.h"
#include "ops/truth.h"
#include "payloads/cons.h"
#include <stdlib.h>
#include <stdlib.h>
#include <stdlib.h>
@ -92,3 +95,71 @@ struct pso_pointer destroy_exception( struct pso_pointer fp ) {
return nil;
}
/**
* Throw an exception with a cause.
* `throw_exception` is a misnomer, because it doesn't obey the calling signature of a
* lisp function; but it is nevertheless to be preferred to make_exception. A
* real `throw_exception`, which does, will be needed.
* object pointing to it. Then this should become a normal lisp function
* which expects a normally bound frame and environment, such that
* frame->payload.stack_frame.arg[0] is the payload, frame->payload.stack_frame.arg[1] is the cause, and frame->payload.stack_frame.arg[2] is the cons-space
* pointer to the frame in which the exception occurred.
*/
struct pso_pointer throw_exception_with_cause( struct pso_pointer location,
struct pso_pointer message,
struct pso_pointer cause,
struct pso_pointer
frame_pointer ) {
struct pso_pointer result = nil;
#ifdef DEBUG
debug_print( U"\nERROR: `", DEBUG_ANY, 0 );
debug_print_object( message, DEBUG_ANY, 0 );
debug_print( U"` at `", DEBUG_ANY, 0 );
debug_print_object( location, DEBUG_ANY, 0 );
debug_print( U"`\n", DEBUG_ANY, 0 );
if ( !c_nilp( cause ) ) {
debug_print( U"\tCaused by: ", DEBUG_ANY, 0 );
debug_print_object( cause, DEBUG_ANY, 0);
debug_print( U"`\n", DEBUG_ANY, 0 );
}
#endif
struct pso2 *cell = pointer_to_object( message );
if (get_tag_value( message)) {
result = message;
} else {
struct pso_pointer x_frame = inc_ref(make_frame(
2, frame_pointer, message,
(nilp(location)
? nil
: make_cons(frame_pointer,
make_cons(frame_pointer,
privileged_keyword_location, location),
nil)),
cause));
result = push_local(frame_pointer, make_exception(x_frame));
}
return result;
}
/**
* Throw an exception.
* `throw_exception` is a misnomer, because it doesn't obey the calling signature of a
* lisp function; but it is nevertheless to be preferred to make_exception. A
* real `throw_exception`, which does, will be needed.
* object pointing to it. Then this should become a normal lisp function
* which expects a normally bound frame and environment, such that
* frame->payload.stack_frame.arg[0] is the payload, frame->payload.stack_frame.arg[1] is the cause, and frame->payload.stack_frame.arg[2] is the cons-space
* pointer to the frame in which the exception occurred.
*/
struct pso_pointer
throw_exception( struct pso_pointer location,
struct pso_pointer payload,
struct pso_pointer frame_pointer ) {
return throw_exception_with_cause( location, payload, nil, frame_pointer );
}