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

Builds and runs, but print is badly broken. Need some rethink.

Browse source
This commit is contained in:
Simon Brooke 2026-04-24 09:22:06 +01:00
parent 9425506e2a
commit 22b0160a26
7 changed files with 118 additions and 91 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/c/debug.c
View file

@ -19,6 +19,8 @@
#include "io/io.h" #include "io/io.h"
#include "io/print.h" #include "io/print.h"
#include "memory/dump.h"
int verbosity = 0; int verbosity = 0;
@ -143,7 +145,7 @@ void debug_print_object( struct pso_pointer pointer, int level, int indent ) {
if ( level & verbosity ) { if ( level & verbosity ) {
URL_FILE *ustderr = file_to_url_file( stderr ); URL_FILE *ustderr = file_to_url_file( stderr );
fwide( stderr, 1 ); fwide( stderr, 1 );
in_write( pointer, ustderr, PRINT_VARIANT_PRINT ); in_write( pointer, ustderr, PRINT_VARIANT_PRINT, indent );
free( ustderr ); free( ustderr );
} }
#endif #endif
@ -156,14 +158,14 @@ void debug_print_object( struct pso_pointer pointer, int level, int indent ) {
* turn debugging on for only one part of the system. * turn debugging on for only one part of the system.
*/ */
void debug_dump_object( struct pso_pointer pointer, int level, int indent ) { void debug_dump_object( struct pso_pointer pointer, int level, int indent ) {
//#ifdef DEBUG #ifdef DEBUG
// if ( level & verbosity ) { if ( level & verbosity ) {
// URL_FILE *ustderr = file_to_url_file( stderr ); URL_FILE *ustderr = file_to_url_file( stderr );
// fwide( stderr, 1 ); fwide( stderr, 1 );
// dump_object( ustderr, pointer ); // dump_object( ustderr, pointer );
// free( ustderr ); free( ustderr );
// } }
//#endif #endif
} }
///** ///**

88
src/c/io/io.c
View file

@ -451,61 +451,57 @@ struct pso_pointer add_meta_time( struct pso_pointer frame_pointer,
* Callback to assemble metadata for a URL stream. This is naughty because * 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. * it modifies data, but it's really the only way to create metadata.
*/ */
static size_t write_meta_callback( 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 pso_pointer stream ) {
struct pso2 *cell = pointer_to_object( stream ); struct pso2 *object = pointer_to_object( stream );
// TODO: reimplement // TODO: reimplement
/* make a copy of the string that we can destructively change */ /* make a copy of the string that we can destructively change */
// char *s = calloc( strlen( string ), sizeof( char ) ); char *s = calloc( strlen( string ), sizeof( char ) );
// strcpy( s, string ); strcpy( s, string );
// if ( check_tag( cell, READTV) || if ( readp(stream) ||
// check_tag( cell, WRITETV) ) { writep(stream) ) {
// int offset = index_of( ':', s ); int offset = index_of( ':', s );
// if ( offset != -1 ) { if ( offset != -1 ) {
// s[offset] = ( char ) 0; s[offset] = ( char ) 0;
// char *name = trim( s ); char *name = trim( s );
// char *value = trim( &s[++offset] ); char *value = trim( &s[++offset] );
// char32_t wname[strlen( name )]; char32_t wname[strlen( name )];
// mbstowcs( wname, name, strlen( name ) + 1 ); mbstowcs( wname, name, strlen( name ) + 1 );
// cell->payload.stream.meta = object->payload.stream.meta =
// add_meta_string( cell->payload.stream.meta, wname, value ); add_meta_string( frame_pointer, object->payload.stream.meta, wname, value );
// debug_printf( DEBUG_IO, debug_printf( DEBUG_IO, 0,
// L"write_meta_callback: added header '%s': value L"write_meta_callback: added header '%s': value '%s'\n", name, value );
// '%s'\n", name, value ); } else if ( strncmp( "HTTP", s, 4 ) == 0 ) {
// } else if ( strncmp( "HTTP", s, 4 ) == 0 ) { int offset = index_of( ' ', s );
// int offset = index_of( ' ', s ); char *value = trim( &s[offset] );
// char *value = trim( &s[offset] ); object->payload.stream.meta =
// cell->payload.stream.meta = add_meta_integer( frame_pointer, add_meta_string
// add_meta_integer( add_meta_string (frame_pointer, object->payload.stream.meta, L"status",
// ( cell->payload.stream.meta, L"status", value ), L"status-code", strtol( value,
// value ), L"status-code", strtol( value, NULL,
// NULL, 10 ) );
// 10 ) ); debug_printf( DEBUG_IO, 0,
// debug_printf( DEBUG_IO, L"write_meta_callback: added header 'status': value '%s'\n", value );
// L"write_meta_callback: added header 'status': value } else {
// '%s'\n", value ); debug_printf( DEBUG_IO, 0,
// } else { L"write_meta_callback: header passed with no colon: '%s'\n", s );
// debug_printf( DEBUG_IO, }
// L"write_meta_callback: header passed with no colon: } else {
// '%s'\n", s ); debug_print
// } ( L"Pointer passed to write_meta_callback did not point to a stream: ",
// } else { DEBUG_IO, 0 );
// debug_print debug_dump_object( stream, DEBUG_IO, 0 );
// ( L"Pointer passed to write_meta_callback did not point to a }
// stream: ", free( s );
// DEBUG_IO );
// debug_dump_object( stream, DEBUG_IO );
// }
// free( s );
return 0; // strlen( string ); return 0; // strlen( string );
} }
void collect_meta( struct pso_pointer frame_pointer, struct pso_pointer stream, void collect_meta( struct pso_pointer frame_pointer, struct pso_pointer stream,
char *url ) { char *url ) {
struct pso2 *cell = pointer_to_object( stream ); struct pso2 *object = pointer_to_object( stream );
URL_FILE *s = pointer_to_object( stream )->payload.stream.stream; URL_FILE *s = pointer_to_object( stream )->payload.stream.stream;
struct pso_pointer meta = struct pso_pointer meta =
add_meta_string( frame_pointer, cell->payload.stream.meta, L"url", add_meta_string( frame_pointer, object->payload.stream.meta, L"url",
url ); url );
struct stat statbuf; struct stat statbuf;
int result = stat( url, &statbuf ); int result = stat( url, &statbuf );
@ -554,7 +550,7 @@ void collect_meta( struct pso_pointer frame_pointer, struct pso_pointer stream,
/* this is destructive change before the cell is released into the /* this is destructive change before the cell is released into the
* wild, and consequently permissible, just. */ * wild, and consequently permissible, just. */
cell->payload.stream.meta = meta; object->payload.stream.meta = meta;
} }
/** /**

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

@ -34,6 +34,8 @@
#include "memory/pointer.h" #include "memory/pointer.h"
#include "memory/pso.h" #include "memory/pso.h"
#include "memory/pso2.h" #include "memory/pso2.h"
#include "memory/pso3.h"
#include "memory/pso4.h"
#include "memory/tags.h" #include "memory/tags.h"
#include "ops/string_ops.h" #include "ops/string_ops.h"
@ -46,7 +48,7 @@
#include "ops/truth.h" #include "ops/truth.h"
struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output, struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
bool escape ); bool escape, int indent );
/** /**
* @brief write this character `wc` to this `output` stream, escaping it if * @brief write this character `wc` to this `output` stream, escaping it if
@ -70,11 +72,11 @@ struct pso_pointer print_string_like_thing( struct pso_pointer p,
URL_FILE *output, bool escape ) { URL_FILE *output, bool escape ) {
switch ( get_tag_value( p ) ) { switch ( get_tag_value( p ) ) {
case KEYTV: case KEYTV:
url_fputwc( L':', output ); write_char( L':', output, escape );
break; break;
case STRINGTV: case STRINGTV:
if ( escape ) if ( escape )
url_fputwc( L'"', output ); write_char( L'"', output, escape );
break; break;
} }
@ -90,7 +92,7 @@ struct pso_pointer print_string_like_thing( struct pso_pointer p,
if ( stringp( p ) ) { if ( stringp( p ) ) {
if ( escape ) if ( escape )
url_fputwc( L'"', output ); write_char( L'"', output, escape );
} }
return p; return p;
@ -104,7 +106,7 @@ struct pso_pointer write_list_content( struct pso_pointer p, URL_FILE *output,
for ( ; consp( p ); p = c_cdr( p ) ) { for ( ; consp( p ); p = c_cdr( p ) ) {
struct pso2 *object = pointer_to_object( p ); struct pso2 *object = pointer_to_object( p );
result = in_write( object->payload.cons.car, output, escape ); result = in_write( object->payload.cons.car, output, escape, 0 );
if ( exceptionp( result ) ) if ( exceptionp( result ) )
break; break;
@ -113,12 +115,12 @@ struct pso_pointer write_list_content( struct pso_pointer p, URL_FILE *output,
case NILTV: case NILTV:
break; break;
case CONSTV: case CONSTV:
url_fputwc( L' ', output ); write_char( L' ', output, escape );
break; break;
default: default:
url_fputws( L" . ", output ); url_fputws( L" . ", output );
result = result =
in_write( object->payload.cons.cdr, output, escape ); in_write( object->payload.cons.cdr, output, escape, 0 );
} }
} }
} else { } else {
@ -128,6 +130,13 @@ struct pso_pointer write_list_content( struct pso_pointer p, URL_FILE *output,
return result; 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);
}
}
/** /**
* This is kind of modelled after the implementation of PRIN* variants on page * This is kind of modelled after the implementation of PRIN* variants on page
* 383 of the aluminium book. It is the inner workings of all PRIN* functions. * 383 of the aluminium book. It is the inner workings of all PRIN* functions.
@ -139,7 +148,7 @@ struct pso_pointer write_list_content( struct pso_pointer p, URL_FILE *output,
* @return p on success, exception on failure. * @return p on success, exception on failure.
*/ */
struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output, struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output,
bool escape ) { bool escape, int indent ) {
struct pso2 *object = pointer_to_object( p ); struct pso2 *object = pointer_to_object( p );
struct pso_pointer result = nil; struct pso_pointer result = nil;
@ -151,9 +160,25 @@ struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output,
escape ); escape );
break; break;
case CONSTV: case CONSTV:
url_fputwc( L'(', output ); write_char( L'(', output, escape);
result = write_list_content( p, output, escape ); result = write_list_content( p, output, escape );
url_fputwc( L')', output ); write_char( L')', output, escape);
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; break;
case INTEGERTV: case INTEGERTV:
url_fwprintf( output, L"%d", url_fwprintf( output, L"%d",
@ -171,11 +196,11 @@ struct pso_pointer in_write( struct pso_pointer p, URL_FILE *output,
case WRITETV: case WRITETV:
url_fwprintf( output, L"<%s stream: ", url_fwprintf( output, L"<%s stream: ",
v == READTV ? "read" : "write" ); v == READTV ? "read" : "write" );
in_write( object->payload.stream.meta, output, escape ); in_write( object->payload.stream.meta, output, escape, indent );
url_fputwc( L'>', output ); write_char( L'>', output, escape );
break; break;
case TRUETV: case TRUETV:
url_fputwc( L't', output ); write_char( L't', output, escape );
break; break;
default: default:
// TODO: return exception // TODO: return exception
@ -212,18 +237,14 @@ struct pso_pointer write( struct pso_pointer frame_pointer ) {
struct pso2* stream_obj = pointer_to_object( stream ); struct pso2* stream_obj = pointer_to_object( stream );
if ( writep( stream ) ) { if ( writep( stream ) ) {
inc_ref( stream );
URL_FILE *output = stream_obj->payload.stream.stream; URL_FILE *output = stream_obj->payload.stream.stream;
if ( nl_before ) if ( nl_before )
url_fputwc( L'\n', output ); url_fputwc( L'\n', output );
result = in_write( object, output, true ); result = in_write( object, output, true, 0);
url_fputwc( nl_after ? L'\n' : L' ', output ); url_fputwc( nl_after ? L'\n' : L' ', output );
dec_ref( stream );
} else { } else {
result = result =
make_exception( make_frame( 1, frame_pointer, make_exception( make_frame( 1, frame_pointer,
@ -245,9 +266,15 @@ struct pso_pointer write( struct pso_pointer frame_pointer ) {
struct pso_pointer print( struct pso_pointer frame_pointer ) { struct pso_pointer print( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4( frame_pointer );
return write( make_frame( 5, frame_pointer, struct pso_pointer next = inc_ref( make_frame( 5, frame_pointer,
fetch_arg( frame, 0 ), fetch_arg( frame, 1 ), t, fetch_arg( frame, 0 ), fetch_arg( frame, 1 ), t,
t, nil )); t, nil ));
struct pso_pointer result = write( next );
dec_ref( next);
return result;
} }
/** /**
@ -256,7 +283,13 @@ struct pso_pointer print( struct pso_pointer frame_pointer ) {
struct pso_pointer princ( struct pso_pointer frame_pointer ) { struct pso_pointer princ( struct pso_pointer frame_pointer ) {
struct pso4 *frame = pointer_to_pso4( frame_pointer ); struct pso4 *frame = pointer_to_pso4( frame_pointer );
return write( make_frame( 5, frame_pointer, struct pso_pointer next = inc_ref( make_frame( 5, frame_pointer,
fetch_arg( frame, 0 ), fetch_arg( frame, 1 ), fetch_arg( frame, 0 ), fetch_arg( frame, 1 ),
nil, t, nil )); nil, t, nil ));
struct pso_pointer result = write( next );
dec_ref( next);
return result;
} }

2
src/c/io/print.h
View file

@ -24,6 +24,6 @@ struct pso_pointer princ( struct pso_pointer frame_pointer );
#define PRINT_VARIANT_PRINC 2 #define PRINT_VARIANT_PRINC 2
struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output, struct pso_pointer in_write( struct pso_pointer p, URL_FILE * output,
bool variant ); bool escape, int indent );
#endif #endif

3
src/c/memory/pso3.h
View file

@ -34,4 +34,7 @@ struct pso3 {
} payload; } payload;
}; };
#define pointer_to_pso3(p)((struct pso3*)pointer_to_object_of_size_class(p,3))
#endif #endif

2
src/c/payloads/stack.c
View file

@ -134,7 +134,6 @@ struct pso_pointer make_frame_with_env( int arg_count,
if ( stackp( previous ) ) { if ( stackp( previous ) ) {
new_frame->payload.stack_frame.depth = new_frame->payload.stack_frame.depth =
prev_frame->payload.stack_frame.depth + 1; prev_frame->payload.stack_frame.depth + 1;
new_frame->payload.stack_frame.env = env;
} else { } else {
new_frame->payload.stack_frame.depth = 0; new_frame->payload.stack_frame.depth = 0;
} }
@ -144,6 +143,7 @@ struct pso_pointer make_frame_with_env( int arg_count,
int cursor = 0; int cursor = 0;
new_frame->payload.stack_frame.args = arg_count; new_frame->payload.stack_frame.args = arg_count;
new_frame->payload.stack_frame.env = env;
for ( ; cursor < arg_count && cursor < args_in_frame; cursor++ ) { for ( ; cursor < arg_count && cursor < args_in_frame; cursor++ ) {
struct pso_pointer argument = va_arg( args, struct pso_pointer ); struct pso_pointer argument = va_arg( args, struct pso_pointer );

15
src/c/psse.c
View file

@ -134,18 +134,11 @@ int main( int argc, char *argv[] ) {
stdout ); stdout );
} }
struct pso_pointer bootstrap_stack = inc_ref( make_frame_with_env( 1, nil, struct pso_pointer bootstrap_stack = inc_ref(
make_frame_with_env(1, nil,
consp consp
( oblist ) ( oblist ) ? oblist : make_cons(nil, oblist, nil),
? oblist show_prompt ? t : nil));
:
make_cons
( nil,
oblist,
nil ),
show_prompt
? t :
nil ) );
repl( bootstrap_stack ); repl( bootstrap_stack );