simon/post-scarcity
1
0
Fork 0
Code Issues 18 Pull requests Projects Releases Packages Wiki Activity Actions

Print is less badly broken. Read is less badly broken. GC is too aggressive.

Browse source
This commit is contained in:
Simon Brooke 2026-04-24 21:20:23 +01:00
parent 22b0160a26
commit 63906fe817
19 changed files with 489 additions and 303 deletions
Download patch file Download diff file Expand all files Collapse all files

86
src/c/io/io.c
View file

@ -114,7 +114,8 @@ struct pso_pointer lisp_io_readbase;
/**
* @brief bound to the Lisp symbol representing C_IO_READTABLE in initialisation
*/
struct pso_pointer lisp_io_readtable;
struct pso_pointer lisp_io_read_table;
/**
* Allow a one-character unget facility. This may not be enough - we may need
@ -175,7 +176,7 @@ struct pso_pointer initialise_default_streams( struct pso_pointer
lisp_io_log = c_string_to_lisp_symbol( frame_pointer, C_IO_LOG );
lisp_io_prompt = c_string_to_lisp_symbol( frame_pointer, C_IO_PROMPT );
lisp_io_readbase = c_string_to_lisp_symbol( frame_pointer, C_IO_READBASE );
lisp_io_readtable =
lisp_io_read_table =
c_string_to_lisp_symbol( frame_pointer, C_IO_READTABLE );
debug_print( L"In initialise_default_streams; environment is: ", DEBUG_IO,
@ -192,7 +193,7 @@ struct pso_pointer initialise_default_streams( struct pso_pointer
10 ),
lisp_bind( make_frame
( 3, frame_pointer,
lisp_io_readtable,
lisp_io_read_table,
nil, env ) ) ) ) ) );
lisp_stdin =
@ -451,48 +452,51 @@ struct pso_pointer add_meta_time( struct pso_pointer frame_pointer,
* Callback to assemble metadata for a URL stream. This is naughty because
* it modifies data, but it's really the only way to create metadata.
*/
static size_t write_meta_callback( struct pso_pointer frame_pointer, char *string, size_t size, size_t nmemb,
static size_t write_meta_callback( struct pso_pointer frame_pointer,
char *string, size_t size, size_t nmemb,
struct pso_pointer stream ) {
struct pso2 *object = pointer_to_object( stream );
// TODO: reimplement
/* make a copy of the string that we can destructively change */
char *s = calloc( strlen( string ), sizeof( char ) );
strcpy( s, string );
if ( readp(stream) ||
writep(stream) ) {
int offset = index_of( ':', s );
if ( offset != -1 ) {
s[offset] = ( char ) 0;
char *name = trim( s );
char *value = trim( &s[++offset] );
char32_t wname[strlen( name )];
mbstowcs( wname, name, strlen( name ) + 1 );
object->payload.stream.meta =
add_meta_string( frame_pointer, object->payload.stream.meta, wname, value );
debug_printf( DEBUG_IO, 0,
L"write_meta_callback: added header '%s': value '%s'\n", name, value );
} else if ( strncmp( "HTTP", s, 4 ) == 0 ) {
int offset = index_of( ' ', s );
char *value = trim( &s[offset] );
object->payload.stream.meta =
add_meta_integer( frame_pointer, add_meta_string
(frame_pointer, object->payload.stream.meta, L"status",
value ), L"status-code", strtol( value,
NULL,
10 ) );
debug_printf( DEBUG_IO, 0,
L"write_meta_callback: added header 'status': value '%s'\n", value );
} else {
debug_printf( DEBUG_IO, 0,
L"write_meta_callback: header passed with no colon: '%s'\n", s );
}
} else {
debug_print
( L"Pointer passed to write_meta_callback did not point to a stream: ",
DEBUG_IO, 0 );
debug_dump_object( stream, DEBUG_IO, 0 );
}
free( s );
char *s = calloc( strlen( string ), sizeof( char ) );
strcpy( s, string );
if ( readp( stream ) || writep( stream ) ) {
int offset = index_of( ':', s );
if ( offset != -1 ) {
s[offset] = ( char ) 0;
char *name = trim( s );
char *value = trim( &s[++offset] );
char32_t wname[strlen( name )];
mbstowcs( wname, name, strlen( name ) + 1 );
object->payload.stream.meta =
add_meta_string( frame_pointer, object->payload.stream.meta,
wname, value );
debug_printf( DEBUG_IO, 0,
L"write_meta_callback: added header '%s': value '%s'\n",
name, value );
} else if ( strncmp( "HTTP", s, 4 ) == 0 ) {
int offset = index_of( ' ', s );
char *value = trim( &s[offset] );
object->payload.stream.meta =
add_meta_integer( frame_pointer, add_meta_string
( frame_pointer, object->payload.stream.meta,
L"status", value ), L"status-code",
strtol( value, NULL, 10 ) );
debug_printf( DEBUG_IO, 0,
L"write_meta_callback: added header 'status': value '%s'\n",
value );
} else {
debug_printf( DEBUG_IO, 0,
L"write_meta_callback: header passed with no colon: '%s'\n",
s );
}
} else {
debug_print
( L"Pointer passed to write_meta_callback did not point to a stream: ",
DEBUG_IO, 0 );
debug_dump_object( stream, DEBUG_IO, 0 );
}
free( s );
return 0; // strlen( string );
}

84
src/c/io/print.c
View file

@ -120,7 +120,8 @@ struct pso_pointer write_list_content( struct pso_pointer p, URL_FILE *output,
default:
url_fputws( L" . ", output );
result =
in_write( object->payload.cons.cdr, output, escape, 0 );
in_write( object->payload.cons.cdr, output, escape,
0 );
}
}
} else {
@ -130,11 +131,11 @@ struct pso_pointer write_list_content( struct pso_pointer p, URL_FILE *output,
return result;
}
void in_write_nl (URL_FILE *output, int indent) {
write_char( L'\n', output, false);
for (int i = 0; i < indent; i++) {
write_char( L'\t', output, false);
}
void in_write_nl( URL_FILE *output, int indent ) {
write_char( L'\n', output, false );
for ( int i = 0; i < indent; i++ ) {
write_char( L'\t', output, false );
}
}
/**
@ -160,26 +161,36 @@ struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output,
escape );
break;
case CONSTV:
write_char( L'(', output, escape);
write_char( L'(', output, escape );
result = write_list_content( p, output, escape );
write_char( L')', output, escape);
write_char( L')', output, escape );
break;
case EXCEPTIONTV:{
struct pso3 *exception = pointer_to_pso3( p );
if ( exception != NULL ) {
url_fputws( L"<exception: ", output );
in_write( exception->payload.exception.message, output,
escape, indent );
if ( !c_nilp( exception->payload.exception.meta ) ) {
in_write_nl( output, indent + 1 );
url_fputws( L"metadata: ", output );
in_write( exception->payload.exception.meta,
output, escape, indent );
}
if ( !c_nilp( exception->payload.exception.cause ) ) {
in_write_nl( output, indent + 1 );
url_fputws( L"cause: ", output );
in_write( exception->payload.exception.cause,
output, escape, indent );
}
write_char( L'>', output, escape );
} else {
url_fputws( L"<broken exception :-( >", output );
}
}
break;
case EXCEPTIONTV :
struct pso3* exception = pointer_to_pso3(p);
url_fputws( L"<exception: ", output);
in_write( exception->payload.exception.message, output, escape, indent);
if (!c_nilp( exception->payload.exception.meta)) {
in_write_nl( output, indent+1);
url_fputws( L"metadata: ", output);
in_write( exception->payload.exception.meta, output, escape, indent);
}
if (!c_nilp( exception->payload.exception.cause)) {
in_write_nl( output, indent+1);
url_fputws( L"cause: ", output);
in_write( exception->payload.exception.cause, output, escape, indent);
}
write_char( L'>', output, escape);
break;
case INTEGERTV:
url_fwprintf( output, L"%d",
( int64_t ) ( object->payload.integer.value ) );
@ -196,7 +207,8 @@ struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output,
case WRITETV:
url_fwprintf( output, L"<%s stream: ",
v == READTV ? "read" : "write" );
in_write( object->payload.stream.meta, output, escape, indent );
in_write( object->payload.stream.meta, output, escape,
indent );
write_char( L'>', output, escape );
break;
case TRUETV:
@ -234,15 +246,15 @@ struct pso_pointer write( struct pso_pointer frame_pointer ) {
bool nl_before = c_truep( fetch_arg( frame, 3 ) );
bool nl_after = c_truep( fetch_arg( frame, 4 ) );
struct pso_pointer result = object;
struct pso2* stream_obj = pointer_to_object( stream );
struct pso2 *stream_obj = pointer_to_object( stream );
if ( writep( stream ) ) {
URL_FILE *output = stream_obj->payload.stream.stream;
URL_FILE *output = stream_obj->payload.stream.stream;
if ( nl_before )
url_fputwc( L'\n', output );
result = in_write( object, output, true, 0);
result = in_write( object, output, escape, 0 );
url_fputwc( nl_after ? L'\n' : L' ', output );
} else {
@ -267,12 +279,13 @@ struct pso_pointer print( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer next = inc_ref( make_frame( 5, frame_pointer,
fetch_arg( frame, 0 ), fetch_arg( frame, 1 ), t,
t, nil ));
fetch_arg( frame, 0 ),
fetch_arg( frame, 1 ), t,
t, nil ) );
struct pso_pointer result = write( next );
dec_ref( next);
dec_ref( next );
return result;
}
@ -284,12 +297,13 @@ struct pso_pointer princ( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer );
struct pso_pointer next = inc_ref( make_frame( 5, frame_pointer,
fetch_arg( frame, 0 ), fetch_arg( frame, 1 ),
nil, t, nil ));
fetch_arg( frame, 0 ),
fetch_arg( frame, 1 ),
nil, t, nil ) );
struct pso_pointer result = write( next );
struct pso_pointer result = write( next );
dec_ref( next);
dec_ref( next );
return result;
}

24
src/c/io/read.c
View file

@ -32,6 +32,7 @@
#include "memory/pso2.h"
#include "memory/tags.h"
#include "payloads/character.h"
#include "payloads/exception.h"
#include "payloads/function.h"
#include "payloads/integer.h"
@ -101,9 +102,12 @@ struct pso_pointer read_character( struct pso_pointer frame_pointer ) {
struct pso_pointer result = nil;
struct pso_pointer stream_pointer = fetch_arg( frame, 0 );
if ( readp( stream_pointer ) ) {
result = make_string( frame_pointer,
url_fgetwc( stream_get_url_file
( stream_pointer ) ), nil );
wint_t chr = url_fgetwc( stream_get_url_file( stream_pointer ) );
result = make_character( frame_pointer, chr );
#ifdef DEBUG
debug_printf( DEBUG_IO, 0, L"\nRead character %lc\n", chr );
#endif
}
return result;
@ -204,8 +208,7 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
}
if ( c_nilp( readtable ) ) {
// TODO: check for the value of `*read-table*` in the environment and
// use that.
readtable = c_assoc( lisp_io_read_table, fetch_env( frame_pointer ) );
}
if ( c_nilp( character ) ) {
@ -240,9 +243,9 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
( frame_pointer, c ) );
inc_ref( next );
if ( iswdigit( c ) ) {
result = read_number( next );
result = push_local( frame_pointer, read_number( next ) );
} else if ( iswalpha( c ) ) {
result = read_symbol( next );
result = push_local( frame_pointer, read_symbol( next ) );
} else {
// result =
// throw_exception(
@ -260,10 +263,15 @@ struct pso_pointer read( struct pso_pointer frame_pointer ) {
// ),
// frame_pointer );
}
dec_ref( next );
// dec_ref( next );
break;
}
}
#ifdef DEBUG
debug_print( L"Read object: ", DEBUG_IO, 0 );
debug_print_object( result, DEBUG_IO, 0 );
debug_println( DEBUG_IO );
#endif
return result;
}